V10/nbstests/nbs77.a
!<arch>
FM001.f 480975939 170 2 100666 6665 `
*HEADER,FORTR,FM001
*FILES1,FORTR,FM001,X
C COMMENT SECTION
C
C FM001
C
C THIS ROUTINE CONTAINS THE BOILERPLATE SOURCE CODING WHICH
C IS USED TO PRINT THE REPORT HEADINGS AND RUN SUMMARIES FOR EACH
C OF THE ELEMENTARY ROUTINES.
C
C THREE TESTS ARE INCLUDED WHICH CONTAIN THE PROCEDURES FOR
C TESTING THE LANGUAGE FEATURES AND DELETING TESTS.
C
C TEST 1 CHECKS THE PASS PROCEDURE
C TEST 2 CHECKS THE FAIL PROCEDURE
C TEST 3 CHECKS THE DELETE PROCEDURE
C
C IF THIS ROUTINE DOES NOT EXECUTE CORRECTLY, THEN NO OTHER
C ROUTINES WILL BE RUN. THERE IS NO USE IN TRYING TO VALIDATE A
C FORTRAN COMPILER WHICH CANNOT HANDLE SUCH BASIC STATEMENTS.
C
C **********************************************************
C
C A COMPILER VALIDATION SYSTEM FOR THE FORTRAN LANGUAGE
C BASED ON SPECIFICATIONS AS DEFINED IN AMERICAN NATIONAL STANDARD
C PROGRAMMING LANGUAGE FORTRAN X3.9-1978, HAS BEEN DEVELOPED BY THE
C FEDERAL COBOL COMPILER TESTING SERVICE. THE FORTRAN COMPILER
C VALIDATION SYSTEM (FCVS) CONSISTS OF AUDIT ROUTINES, THEIR RELATED
C DATA, AND AN EXECUTIVE SYSTEM. EACH AUDIT ROUTINE IS A FORTRAN
C PROGRAM, SUBPROGRAM OR FUNCTION WHICH INCLUDES TESTS OF SPECIFIC
C LANGUAGE ELEMENTS AND SUPPORTING PROCEDURES INDICATING THE RESULT
C OF EXECUTING THESE TESTS.
C
C THIS PARTICULAR PROGRAM/SUBPROGRAM/FUNCTION CONTAINS FEATURES
C FOUND ONLY IN THE SUBSET AS DEFINED IN X3.9-1978.
C
C SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO -
C
C DEPARTMENT OF THE NAVY
C FEDERAL COBOL COMPILER TESTING SERVICE
C WASHINGTON, D.C. 20376
C
C **********************************************************
C
C
C
C INITIALIZATION SECTION
C
C INITIALIZE CONSTANTS
C **************
C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER.
I01 = 5
C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER.
I02 = 6
C SYSTEM ENVIRONMENT SECTION
C
CX010 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-010 CONTROL CARD.
C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5
C (UNIT NUMBER FOR CARD READER).
CX011 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-011 CONTROL CARD.
C THE CX011 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL
C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX010 ABOVE.
C
CX020 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-020 CONTROL CARD.
C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02 = 6
C (UNIT NUMBER FOR PRINTER).
CX021 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-021 CONTROL CARD.
C THE CX021 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL
C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX020 ABOVE.
C
IVPASS=0
IVFAIL=0
IVDELE=0
ICZERO=0
C
C WRITE PAGE HEADERS
WRITE (I02,90000)
WRITE (I02,90001)
WRITE (I02,90002)
WRITE (I02, 90002)
WRITE (I02,90003)
WRITE (I02,90002)
WRITE (I02,90004)
WRITE (I02,90002)
WRITE (I02,90011)
WRITE (I02,90002)
WRITE (I02,90002)
WRITE (I02,90005)
WRITE (I02,90006)
WRITE (I02,90002)
C TEST SECTION
C
11 CONTINUE
C
C **** TEST 001 ****
C TEST 001 - BASIC PROCEDURE FOR CODING TESTS
C ALSO CHECKS CONTINUE STATEMENT WHICH SHOULD NOT HAVE
C ANY AFFECT ON EXECUTION SEQUENCE
C
IF (ICZERO) 30010, 10, 30010
10 CONTINUE
IVTNUM=1
GO TO 40010
30010 IVDELE=IVDELE+1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 40010, 21, 40010
40010 IF (IVTNUM - 1) 20010, 10010, 20010
10010 IVPASS=IVPASS+1
WRITE (I02,80001) IVTNUM
GO TO 21
20010 IVFAIL=IVFAIL+1
IVCOMP=IVTNUM
IVCORR=1
WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR
21 CONTINUE
C
C **** TEST 002 ****
C TEST - 002 FORCE FAIL CODE TO BE EXECUTED
C
IF (ICZERO) 30020,20,30020
20 CONTINUE
IVTNUM=2
GO TO 40020
30020 IVDELE=IVDELE+1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 40020,31,40020
40020 IF (IVTNUM-1) 20020, 10020, 20020
10020 IVPASS=IVPASS+1
WRITE (I02,80001) IVTNUM
GO TO 31
20020 IVFAIL=IVFAIL+1
IVCOMP=IVTNUM
IVCORR=2
WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR
31 CONTINUE
C
C **** TEST 003 ****
C TEST 003 - DELETE PROCEDURE TESTED
C
IF (ICZERO) 30030,30,30030
30 CONTINUE
C IVTNUM=5000
C GO TO 40030
30030 IVDELE=IVDELE+1
IVTNUM=3
WRITE (I02,80003) IVTNUM
IF (ICZERO) 40030,99999,40030
40030 IF (IVTNUM - 5000) 20030,10030,20030
10030 IVPASS=IVPASS +1
WRITE (I02,80001) IVTNUM
GO TO 99999
20030 IVFAIL=IVFAIL+1
IVCOMP=IVTNUM
IVCORR=5000
WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR
C
C WRITE PAGE FOOTINGS AND RUN SUMMARIES
99999 CONTINUE
WRITE (I02,90002)
WRITE (I02,90006)
WRITE (I02,90002)
WRITE (I02,90002)
WRITE (I02,90007)
WRITE (I02,90002)
WRITE (I02,90008) IVFAIL
WRITE (I02,90009) IVPASS
WRITE (I02,90010) IVDELE
C
C
C SPECIAL OUTPUT STATEMENTS FOR THIS ROUTINE
WRITE (I02,90000)
WRITE (I02,90002)
WRITE (I02,80031)
WRITE (I02,90002)
WRITE (I02,80010)
WRITE (I02,80020)
WRITE (I02,80030)
WRITE (I02,80032)
C
C TERMINATE ROUTINE EXECUTION
STOP
C
C FORMAT STATEMENTS FOR PAGE HEADERS
90000 FORMAT (1H1)
90002 FORMAT (1H )
90001 FORMAT (1H ,10X,34HFORTRAN COMPILER VALIDATION SYSTEM)
90003 FORMAT (1H ,21X,11HVERSION 1.0)
90004 FORMAT (1H ,10X,38HFOR OFFICIAL USE ONLY - COPYRIGHT 1978)
90005 FORMAT (1H ,5X,4HTEST,5X,9HPASS/FAIL, 5X,8HCOMPUTED,8X,7HCORRECT)
90006 FORMAT (1H ,5X,46H----------------------------------------------)
90011 FORMAT (1H ,18X,17HSUBSET LEVEL TEST)
C
C FORMAT STATEMENTS FOR RUN SUMMARIES
90008 FORMAT (1H ,15X,I5,19H ERRORS ENCOUNTERED)
90009 FORMAT (1H ,15X,I5,13H TESTS PASSED)
90010 FORMAT (1H ,15X,I5,14H TESTS DELETED)
C
C FORMAT STATEMENTS FOR TEST RESULTS
80001 FORMAT (1H ,4X,I5,7X,4HPASS)
80002 FORMAT (1H ,4X,I5,7X,4HFAIL)
80003 FORMAT (1H ,4X,I5,7X,7HDELETED)
80004 FORMAT (1H ,4X,I5,7X,4HFAIL,10X,I6,9X,I6)
80005 FORMAT (1H ,4X,I5,7X,4HFAIL,4X,E12.5,3X,E12.5)
C
C FORMATS FOR CURRENT ROUTINE
80031 FORMAT (1H ,10X,39HTHE PROGRAM FM001 EXECUTED CORRECTLY IF)
80010 FORMAT (1H ,15X,13HTEST 1 PASSED)
80020 FORMAT (1H ,15X,42HTEST 2 FAILED WITH COMPUTED AND CORRECT =2)
80030 FORMAT (1H ,15X,18HTEST 3 WAS DELETED)
80032 FORMAT (1H ,15X,34HTHE RUN SUMMARY TOTALS ALL EQUAL 1)
90007 FORMAT (1H ,20X,20HEND OF PROGRAM FM001)
END
*END-OF,FM001
FM002.f 480975941 170 2 100666 9071 `
*HEADER,FORTR,FM002
*FILES1,FORTR,FM002,X
C COMMENT SECTION
C
C FM002
C
C THIS ROUTINE CHECKS THAT COMMENT LINES WHICH HAVE VALID
C FORTRAN STATEMENTS DO NOT AFFECT THE EXECUTION OF THE PROGRAM
C IN ANY WAY.
C
C REFERENCES
C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN,
C X3.9-1978
C
C SECTION 3.2.1, COMMENT LINE
C
C **********************************************************
C
C A COMPILER VALIDATION SYSTEM FOR THE FORTRAN LANGUAGE
C BASED ON SPECIFICATIONS AS DEFINED IN AMERICAN NATIONAL STANDARD
C PROGRAMMING LANGUAGE FORTRAN X3.9-1978, HAS BEEN DEVELOPED BY THE
C FEDERAL COBOL COMPILER TESTING SERVICE. THE FORTRAN COMPILER
C VALIDATION SYSTEM (FCVS) CONSISTS OF AUDIT ROUTINES, THEIR RELATED
C DATA, AND AN EXECUTIVE SYSTEM. EACH AUDIT ROUTINE IS A FORTRAN
C PROGRAM, SUBPROGRAM OR FUNCTION WHICH INCLUDES TESTS OF SPECIFIC
C LANGUAGE ELEMENTS AND SUPPORTING PROCEDURES INDICATING THE RESULT
C OF EXECUTING THESE TESTS.
C
C THIS PARTICULAR PROGRAM/SUBPROGRAM/FUNCTION CONTAINS FEATURES
C FOUND ONLY IN THE SUBSET AS DEFINED IN X3.9-1978.
C
C SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO -
C
C DEPARTMENT OF THE NAVY
C FEDERAL COBOL COMPILER TESTING SERVICE
C WASHINGTON, D.C. 20376
C
C **********************************************************
C
C
C
C INITIALIZATION SECTION
C
C INITIALIZE CONSTANTS
C **************
C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER.
I01 = 5
C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER.
I02 = 6
C SYSTEM ENVIRONMENT SECTION
C
CX010 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-010 CONTROL CARD.
C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5
C (UNIT NUMBER FOR CARD READER).
CX011 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-011 CONTROL CARD.
C THE CX011 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL
C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX010 ABOVE.
C
CX020 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-020 CONTROL CARD.
C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02 = 6
C (UNIT NUMBER FOR PRINTER).
CX021 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-021 CONTROL CARD.
C THE CX021 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL
C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX020 ABOVE.
C
IVPASS=0
IVFAIL=0
IVDELE=0
ICZERO=0
C
C WRITE PAGE HEADERS
WRITE (I02,90000)
WRITE (I02,90001)
WRITE (I02,90002)
WRITE (I02, 90002)
WRITE (I02,90003)
WRITE (I02,90002)
WRITE (I02,90004)
WRITE (I02,90002)
WRITE (I02,90011)
WRITE (I02,90002)
WRITE (I02,90002)
WRITE (I02,90005)
WRITE (I02,90006)
WRITE (I02,90002)
C TEST SECTION
C
41 CONTINUE
IVTNUM=4
C
C **** TEST 004 ****
C TEST 004 - BLANK COMMENT LINE
C
IF (ICZERO) 30040,40,30040
40 CONTINUE
IVON01=4
C
GO TO 40040
30040 IVDELE=IVDELE+1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 40040, 51, 40040
40040 IF (IVON01 - 4) 20040, 10040, 20040
10040 IVPASS=IVPASS+1
WRITE (I02,80001) IVTNUM
GO TO 51
20040 IVFAIL=IVFAIL+1
IVCOMP=IVON01
IVCORR=4
WRITE (I02,80004) IVTNUM,IVCOMP,IVCORR
51 CONTINUE
IVTNUM=5
C
C **** TEST 005 ****
C TEST 005 - GO TO IN COMMENT LINE
C
IF (ICZERO) 30050, 50, 30050
50 CONTINUE
IVON01 = 3
C GO TO 20050
IVON01=5
GO TO 40050
30050 IVDELE=IVDELE+1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 40050, 61, 40050
40050 IF (IVON01 - 5) 20050,10050,20050
10050 IVPASS=IVPASS+1
WRITE (I02,80001) IVTNUM
GO TO 61
20050 IVFAIL=IVFAIL+1
IVCOMP=IVON01
IVCORR=5
WRITE (I02,80004) IVTNUM,IVCOMP,IVCORR
61 CONTINUE
IVTNUM=6
C
C **** TEST 006 ****
C TEST 006 - INTEGER ASSIGNMENT STATEMENT IN COMMENT LINE
C
IF (ICZERO) 30060,60,30060
60 CONTINUE
IVON01=6
C IVON01=1
GO TO 40060
30060 IVDELE=IVDELE+1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 40060,71,40060
40060 IF (IVON01-6) 20060,10060,20060
10060 IVPASS=IVPASS+1
WRITE (I02,80001) IVTNUM
GO TO 71
20060 IVFAIL=IVFAIL+1
IVCOMP=IVON01
IVCORR=6
WRITE (I02,80004) IVTNUM,IVCOMP,IVCORR
71 CONTINUE
IVTNUM=7
C
C **** TEST 007 ****
C TEST 007 - INTEGER ASSIGNMENT STATEMENT IN COMMENT LINE
C INTEGER EXPRESSION TO RIGHT OF =
C
IF (ICZERO) 30070,70,30070
70 CONTINUE
IVON02=6
IVON01=7
C IVON01= 3*IVON02
GO TO 40070
30070 IVDELE=IVDELE+1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 40070,81,40070
40070 IF (IVON01-7) 20070,10070,20070
10070 IVPASS=IVPASS+1
WRITE (I02,80001) IVTNUM
GO TO 81
20070 IVFAIL=IVFAIL+1
IVCOMP=IVON01
IVCORR=7
WRITE (I02,80004) IVTNUM,IVCOMP,IVCORR
81 CONTINUE
IVTNUM=8
C
C **** TEST 008 ****
C TEST 008 - IF STATEMENT IN COMMENT LINE
C
IF (ICZERO) 30080,80,30080
80 CONTINUE
IVON01=300
C IF (IVON01) 20080,20080,20080
IVON01=8
GO TO 40080
30080 IVDELE=IVDELE+1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 40080,91,40080
40080 IF (IVON01-8) 20080,10080,20080
10080 IVPASS=IVPASS+1
WRITE (I02,80001) IVTNUM
GO TO 91
20080 IVFAIL=IVFAIL+1
IVCOMP=IVON01
IVCORR=8
WRITE (I02,80004) IVTNUM,IVCOMP,IVCORR
91 CONTINUE
IVTNUM=9
C
C **** TEST 009 ****
C TEST 009 - WRITE STATEMENT IN A COMMENT LINE
C
IF (ICZERO) 30090,90,30090
90 CONTINUE
IVON01=200
C 92 WRITE (I02,80002) IVTNUM
IVON01=9
GO TO 40090
30090 IVDELE=IVDELE+1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 40090,101,40090
40090 IF (IVON01-9) 20090,10090,20090
10090 IVPASS=IVPASS+1
WRITE (I02,80001) IVTNUM
GO TO 101
20090 IVFAIL=IVFAIL+1
IVCOMP=IVON01
IVCORR=9
WRITE (I02,80004) IVTNUM,IVCOMP,IVCORR
101 IVTNUM=10
C
C **** TEST 010 ****
C TEST 010 - STATEMENT LABEL IN COMMENT LINE
C
IF (ICZERO) 30100,100,30100
100 CONTINUE
GO TO 102
C 102 WRITE (I02,80002)
C GO TO 111
102 IVON01=10
GO TO 40100
30100 IVDELE=IVDELE+1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 40100,111,40100
40100 IF (IVON01-10) 20100,10100,20100
10100 IVPASS=IVPASS+1
WRITE (I02,80001) IVTNUM
GO TO 111
20100 IVFAIL=IVFAIL+1
IVCOMP=IVON01
IVCORR=10
WRITE (I02,80004) IVTNUM,IVCOMP,IVCORR
111 CONTINUE
IVTNUM=11
C
C **** TEST 011 ****
C TEST 011 - CONTINUE IN COMMENT LINE
C FOLLOWED BY INTEGER ASSIGNMENT STATEMENT IN COMMENT
C
IF (ICZERO) 30110,110,30110
110 IVON01=11
C CONTINUE
C IVON01=7000
GO TO 40110
30110 IVDELE=IVDELE+1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 40110,121,40110
40110 IF (IVON01 -11) 20110,10110,20110
10110 IVPASS=IVPASS+1
WRITE (I02,80001) IVTNUM
GO TO 121
20110 IVFAIL=IVFAIL+1
IVCOMP=IVON01
IVCORR=11
WRITE (I02,80004) IVTNUM,IVCOMP,IVCORR
121 CONTINUE
IVTNUM=12
C
C **** TEST 012 ****
C TEST 012 - INTEGER ASSIGNMENT STATEMENT IN COMMENT LINE
C
IF (ICZERO) 30120,120,30120
120 CONTINUE
IVON01=12
C IVON01=IVON01+1
GO TO 40120
30120 IVDELE=IVDELE+1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 40120,99999,40120
40120 IF (IVON01 - 12) 20120,10120,20120
10120 IVPASS=IVPASS+1
WRITE (I02,80001) IVTNUM
GO TO 99999
20120 IVFAIL=IVFAIL+1
IVCOMP=IVON01
IVCORR=12
WRITE (I02,80004) IVTNUM,IVCOMP,IVCORR
C
C WRITE PAGE FOOTINGS AND RUN SUMMARIES
99999 CONTINUE
WRITE (I02,90002)
WRITE (I02,90006)
WRITE (I02,90002)
WRITE (I02,90002)
WRITE (I02,90007)
WRITE (I02,90002)
WRITE (I02,90008) IVFAIL
WRITE (I02,90009) IVPASS
WRITE (I02,90010) IVDELE
C
C
C TERMINATE ROUTINE EXECUTION
STOP
C
C FORMAT STATEMENTS FOR PAGE HEADERS
90000 FORMAT (1H1)
90002 FORMAT (1H )
90001 FORMAT (1H ,10X,34HFORTRAN COMPILER VALIDATION SYSTEM)
90003 FORMAT (1H ,21X,11HVERSION 1.0)
90004 FORMAT (1H ,10X,38HFOR OFFICIAL USE ONLY - COPYRIGHT 1978)
90005 FORMAT (1H ,5X,4HTEST,5X,9HPASS/FAIL, 5X,8HCOMPUTED,8X,7HCORRECT)
90006 FORMAT (1H ,5X,46H----------------------------------------------)
90011 FORMAT (1H ,18X,17HSUBSET LEVEL TEST)
C
C FORMAT STATEMENTS FOR RUN SUMMARIES
90008 FORMAT (1H ,15X,I5,19H ERRORS ENCOUNTERED)
90009 FORMAT (1H ,15X,I5,13H TESTS PASSED)
90010 FORMAT (1H ,15X,I5,14H TESTS DELETED)
C
C FORMAT STATEMENTS FOR TEST RESULTS
80001 FORMAT (1H ,4X,I5,7X,4HPASS)
80002 FORMAT (1H ,4X,I5,7X,4HFAIL)
80003 FORMAT (1H ,4X,I5,7X,7HDELETED)
80004 FORMAT (1H ,4X,I5,7X,4HFAIL,10X,I6,9X,I6)
80005 FORMAT (1H ,4X,I5,7X,4HFAIL,4X,E12.5,3X,E12.5)
C
90007 FORMAT (1H ,20X,20HEND OF PROGRAM FM002)
C COMMENT LINE BEFORE END STATEMENT
END
*END-OF,FM002
FM003.f 480975943 170 2 100666 10377 `
*HEADER,FORTR,FM003
*FILES1,FORTR,FM003,X
C COMMENT SECTION
C
C FM003
C
C THIS ROUTINE CONTAINS THE BASIC CONTINUE TESTS. THESE TESTS
C ENSURE THAT EXECUTION OF A CONTINUE STATEMENT CAUSES CONTINUATION
C OF THE NORMAL PROGRAM EXECUTION SEQUENCE. ONLY THE STATEMENTS IN
C THE BASIC ASSUMPTIONS ARE INCLUDED IN THESE TESTS. OTHER CONTINUE
C TESTS ARE CONTAINED IN OTHER ROUTINES AS PART OF THE TESTS FOR
C OTHER LANGUAGE FEATURES SUCH AS THE DO STATEMENTS TESTS.
C
C REFERENCES
C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN,
C X3.9-1978
C
C SECTION 3.6, NORMAL EXECUTION SEQUENCE AND TRANSFER OF CONTROL
C SECTION 11.11, CONTINUE STATEMENT
C
C
C **********************************************************
C
C A COMPILER VALIDATION SYSTEM FOR THE FORTRAN LANGUAGE
C BASED ON SPECIFICATIONS AS DEFINED IN AMERICAN NATIONAL STANDARD
C PROGRAMMING LANGUAGE FORTRAN X3.9-1978, HAS BEEN DEVELOPED BY THE
C FEDERAL COBOL COMPILER TESTING SERVICE. THE FORTRAN COMPILER
C VALIDATION SYSTEM (FCVS) CONSISTS OF AUDIT ROUTINES, THEIR RELATED
C DATA, AND AN EXECUTIVE SYSTEM. EACH AUDIT ROUTINE IS A FORTRAN
C PROGRAM, SUBPROGRAM OR FUNCTION WHICH INCLUDES TESTS OF SPECIFIC
C LANGUAGE ELEMENTS AND SUPPORTING PROCEDURES INDICATING THE RESULT
C OF EXECUTING THESE TESTS.
C
C THIS PARTICULAR PROGRAM/SUBPROGRAM/FUNCTION CONTAINS FEATURES
C FOUND ONLY IN THE SUBSET AS DEFINED IN X3.9-1978.
C
C SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO -
C
C DEPARTMENT OF THE NAVY
C FEDERAL COBOL COMPILER TESTING SERVICE
C WASHINGTON, D.C. 20376
C
C **********************************************************
C
C
C
C INITIALIZATION SECTION
C
C INITIALIZE CONSTANTS
C **************
C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER.
I01 = 5
C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER.
I02 = 6
C SYSTEM ENVIRONMENT SECTION
C
CX010 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-010 CONTROL CARD.
C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5
C (UNIT NUMBER FOR CARD READER).
CX011 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-011 CONTROL CARD.
C THE CX011 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL
C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX010 ABOVE.
C
CX020 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-020 CONTROL CARD.
C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02 = 6
C (UNIT NUMBER FOR PRINTER).
CX021 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-021 CONTROL CARD.
C THE CX021 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL
C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX020 ABOVE.
C
IVPASS=0
IVFAIL=0
IVDELE=0
ICZERO=0
C
C WRITE PAGE HEADERS
WRITE (I02,90000)
WRITE (I02,90001)
WRITE (I02,90002)
WRITE (I02, 90002)
WRITE (I02,90003)
WRITE (I02,90002)
WRITE (I02,90004)
WRITE (I02,90002)
WRITE (I02,90011)
WRITE (I02,90002)
WRITE (I02,90002)
WRITE (I02,90005)
WRITE (I02,90006)
WRITE (I02,90002)
131 CONTINUE
IVTNUM = 13
C
C **** TEST 013 ****
C TEST 13 - CONTINUE TEST
C CONTINUE STATEMENT FOLLOWING INTEGER ASSIGNMENT
C STATEMENTS.
C
IF (ICZERO) 30130, 130, 30130
130 CONTINUE
IVON01=5
IVON02=6
CONTINUE
GO TO 40130
30130 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 40130, 141, 40130
40130 IF (IVON01-5) 20131,40131,20131
40131 IF (IVON02-6) 20132,10130,20132
10130 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 141
20131 IVCOMP=IVON01
IVCORR=5
GO TO 20130
20132 IVCOMP=IVON02
IVCORR=6
20130 IVFAIL = IVFAIL + 1
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
141 CONTINUE
IVTNUM = 14
C
C **** TEST 014 ****
C TEST 14 - CONTINUE TEST
C CONTINUE STATEMENT BETWEEN INTEGER ASSIGNMENT
C STATEMENTS
C
IF (ICZERO) 30140, 140, 30140
140 CONTINUE
IVON01=14
CONTINUE
IVON02=15
GO TO 40140
30140 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 40140, 151, 40140
40140 IF (IVON01 - 14) 20141,40141,20141
40141 IF (IVON02 - 15) 20142, 10140, 20142
10140 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 151
20141 IVCOMP=IVON01
IVCORR=14
GO TO 20140
20142 IVCOMP=IVON02
IVCORR=15
20140 IVFAIL = IVFAIL + 1
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
151 CONTINUE
IVTNUM = 15
C
C **** TEST 015 ****
C TEST 15 - CONTINUE TEST
C TWO CONSECUTIVE CONTINUE STATEMENTS
C
IF (ICZERO) 30150, 150, 30150
150 CONTINUE
CONTINUE
IVON01=19
IVON02=20
GO TO 40150
30150 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 40150, 161, 40150
40150 IF (IVON01 - 19) 20151,40151,20151
40151 IF (IVON02 -20) 20152,10150,20152
10150 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 161
20151 IVCOMP=IVON01
IVCORR=19
GO TO 20150
20152 IVCOMP=IVON02
IVCORR=20
20150 IVFAIL = IVFAIL + 1
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
161 CONTINUE
IVTNUM = 16
C
C **** TEST 016 ****
C TEST 16 - CONTINUE TEST
C BRANCH TO CONTINUE STATEMENT FROM IF STATEMENT
C
IF (ICZERO) 30160, 160, 30160
160 CONTINUE
IVON01=16
IF (IVON01 - 16) 162,163,162
162 IVCORR=16
GO TO 20160
163 CONTINUE
IVON01=160
GO TO 40160
30160 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 40160, 171, 40160
40160 IF (IVON01-160) 20161,10160,20161
10160 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 171
20161 IVCORR=160
20160 IVFAIL = IVFAIL + 1
IVCOMP=IVON01
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
171 CONTINUE
IVTNUM = 17
C
C **** TEST 017 ****
C TEST 17 - CONTINUE TEST
C TWO OF THE BRANCHES OF AN IF STATEMENT ARE TO THE SAME
C CONTINUE STATEMENT. THE THIRD BRANCH ALSO IS MADE TO
C A CONTINUE STATEMENT.
C
IF (ICZERO) 30170, 170, 30170
170 CONTINUE
IVON01=17
IF (IVON01-19) 173,172,172
172 CONTINUE
IVCORR=17
GO TO 20170
173 CONTINUE
IVON01=170
GO TO 40170
30170 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 40170, 181, 40170
40170 IF (IVON01 - 170) 20171,10170,20171
10170 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 181
20171 IVCORR=170
20170 IVFAIL = IVFAIL + 1
IVCOMP=IVON01
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
181 CONTINUE
IVTNUM = 18
C
C **** TEST 018 ****
C TEST 18 - CONTINUE TEST
C BRANCH TO CONTINUE STATEMENT FROM GO TO STATEMENT
C
IF (ICZERO) 30180, 180, 30180
180 CONTINUE
IF (ICZERO) 184,182,184
182 IVON01=18
GO TO 183
184 IVON01=20
183 CONTINUE
IVON02=180
GO TO 40180
30180 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 40180, 191, 40180
40180 IF (IVON01 - 18) 20181,40181,20181
40181 IF (IVON02 -180) 20182,10180,20182
10180 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 191
20181 IVCORR=18
IVCOMP=IVON01
GO TO 20180
20182 IVCOMP=IVON02
IVCORR=180
20180 IVFAIL = IVFAIL + 1
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
191 CONTINUE
IVTNUM = 19
C
C **** TEST 019 ****
C TEST 19 - CONTINUE TEST
C BRANCH TO THREE CONTINUE STATEMENTS FROM IF STATEMENT.
C CONTINUE STATEMENTS FOLLOW EACH OTHER.
C
IF (ICZERO) 30190, 190, 30190
190 CONTINUE
ICONE = 1
IF (ICONE) 194,192,193
193 CONTINUE
192 CONTINUE
194 CONTINUE
IVON01=19
GO TO 40190
30190 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 40190, 201, 40190
40190 IF (IVON01 - 19) 20190,10190,20190
10190 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 201
20190 IVFAIL = IVFAIL + 1
IVCOMP=IVON01
IVCORR=19
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
201 CONTINUE
IVTNUM = 20
C
C **** TEST 020 ****
C TEST 20 - CONTINUE TEST
C THREE SEPARATE BRANCHES OF AN IF STATEMENT ARE TO
C CONTINUE STATEMENTS.
C
IF (ICZERO) 30200, 200, 30200
200 CONTINUE
ICON02=-2
IF (ICON02) 204,202,203
203 CONTINUE
IVON01=203
GO TO 40200
204 CONTINUE
IVON01 = 204
GO TO 40200
202 CONTINUE
IVON01=202
GO TO 40200
30200 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 40200, 211, 40200
40200 IF (IVON01 - 204) 20200,10200,20200
10200 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 211
20200 IVFAIL = IVFAIL + 1
IVCOMP=IVON01
IVCORR=204
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
211 CONTINUE
C
C WRITE PAGE FOOTINGS AND RUN SUMMARIES
99999 CONTINUE
WRITE (I02,90002)
WRITE (I02,90006)
WRITE (I02,90002)
WRITE (I02,90002)
WRITE (I02,90007)
WRITE (I02,90002)
WRITE (I02,90008) IVFAIL
WRITE (I02,90009) IVPASS
WRITE (I02,90010) IVDELE
C
C
C TERMINATE ROUTINE EXECUTION
STOP
C
C FORMAT STATEMENTS FOR PAGE HEADERS
90000 FORMAT (1H1)
90002 FORMAT (1H )
90001 FORMAT (1H ,10X,34HFORTRAN COMPILER VALIDATION SYSTEM)
90003 FORMAT (1H ,21X,11HVERSION 1.0)
90004 FORMAT (1H ,10X,38HFOR OFFICIAL USE ONLY - COPYRIGHT 1978)
90005 FORMAT (1H ,5X,4HTEST,5X,9HPASS/FAIL, 5X,8HCOMPUTED,8X,7HCORRECT)
90006 FORMAT (1H ,5X,46H----------------------------------------------)
90011 FORMAT (1H ,18X,17HSUBSET LEVEL TEST)
C
C FORMAT STATEMENTS FOR RUN SUMMARIES
90008 FORMAT (1H ,15X,I5,19H ERRORS ENCOUNTERED)
90009 FORMAT (1H ,15X,I5,13H TESTS PASSED)
90010 FORMAT (1H ,15X,I5,14H TESTS DELETED)
C
C FORMAT STATEMENTS FOR TEST RESULTS
80001 FORMAT (1H ,4X,I5,7X,4HPASS)
80002 FORMAT (1H ,4X,I5,7X,4HFAIL)
80003 FORMAT (1H ,4X,I5,7X,7HDELETED)
80004 FORMAT (1H ,4X,I5,7X,4HFAIL,10X,I6,9X,I6)
80005 FORMAT (1H ,4X,I5,7X,4HFAIL,4X,E12.5,3X,E12.5)
C
90007 FORMAT (1H ,20X,20HEND OF PROGRAM FM003)
END
*END-OF,FM003
FM004.f 480975945 170 2 100666 13608 `
*HEADER,FORTR,FM004
*FILES1,FORTR,FM004,X
C COMMENT SECTION
C
C FM004
C
C THIS ROUTINE CONTAINS BASIC ARITHMETIC IF STATEMENT TESTS.
C THE STATEMENT FORMAT IS
C IF (E) K1, K2, K3
C WHERE E IS A SIMPLE INTEGER EXPRESSION OF FORM
C VARIABLE - CONSTANT
C VARIABLE + CONSTANT
C AND K1, K2 AND K3 ARE STATEMENT LABELS. ONLY THE STATEMENTS IN
C THE BASIC ASSUMPTIONS ARE INCLUDED IN THESE TESTS.
C EXECUTION OF AN IF STATEMENT CAUSES EVALUATION OF THE
C EXPRESSION E FOLLOWING WHICH THE STATEMENT LABEL K1, K2 OR K3
C IS EXECUTED NEXT AS THE VALUE OF E IS LESS THAN ZERO, ZERO, OR
C GREATER THAN ZERO, RESPECTIVELY.
C
C THE BASIC UNCONDITIONAL GO TO STATEMENT IS TESTED IN THIS
C ROUTINE. THE STATEMENT IS OF THE FORM
C GO TO K
C WHERE K IS A STATEMENT LABEL.
C EXECUTION OF AN UNCONDITIONAL GO TO STATEMENT CAUSES THE
C STATEMENT IDENTIFIED BY STATEMENT LABEL K TO BE EXECUTED NEXT.
C
C REFERENCES
C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN,
C X3.9-1978
C
C SECTION 3.6, NORMAL EXECUTION SEQUENCE AND TRANSFER OF CONTROL
C SECTION 11.1, GO TO STATEMENT
C SECTION 11.4, ARITHMETIC IF STATEMENT
C
C **********************************************************
C
C A COMPILER VALIDATION SYSTEM FOR THE FORTRAN LANGUAGE
C BASED ON SPECIFICATIONS AS DEFINED IN AMERICAN NATIONAL STANDARD
C PROGRAMMING LANGUAGE FORTRAN X3.9-1978, HAS BEEN DEVELOPED BY THE
C FEDERAL COBOL COMPILER TESTING SERVICE. THE FORTRAN COMPILER
C VALIDATION SYSTEM (FCVS) CONSISTS OF AUDIT ROUTINES, THEIR RELATED
C DATA, AND AN EXECUTIVE SYSTEM. EACH AUDIT ROUTINE IS A FORTRAN
C PROGRAM, SUBPROGRAM OR FUNCTION WHICH INCLUDES TESTS OF SPECIFIC
C LANGUAGE ELEMENTS AND SUPPORTING PROCEDURES INDICATING THE RESULT
C OF EXECUTING THESE TESTS.
C
C THIS PARTICULAR PROGRAM/SUBPROGRAM/FUNCTION CONTAINS FEATURES
C FOUND ONLY IN THE SUBSET AS DEFINED IN X3.9-1978.
C
C SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO -
C
C DEPARTMENT OF THE NAVY
C FEDERAL COBOL COMPILER TESTING SERVICE
C WASHINGTON, D.C. 20376
C
C **********************************************************
C
C
C
C INITIALIZATION SECTION
C
C INITIALIZE CONSTANTS
C **************
C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER.
I01 = 5
C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER.
I02 = 6
C SYSTEM ENVIRONMENT SECTION
C
CX010 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-010 CONTROL CARD.
C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5
C (UNIT NUMBER FOR CARD READER).
CX011 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-011 CONTROL CARD.
C THE CX011 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL
C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX010 ABOVE.
C
CX020 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-020 CONTROL CARD.
C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02 = 6
C (UNIT NUMBER FOR PRINTER).
CX021 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-021 CONTROL CARD.
C THE CX021 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL
C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX020 ABOVE.
C
IVPASS=0
IVFAIL=0
IVDELE=0
ICZERO=0
C
C WRITE PAGE HEADERS
WRITE (I02,90000)
WRITE (I02,90001)
WRITE (I02,90002)
WRITE (I02, 90002)
WRITE (I02,90003)
WRITE (I02,90002)
WRITE (I02,90004)
WRITE (I02,90002)
WRITE (I02,90011)
WRITE (I02,90002)
WRITE (I02,90002)
WRITE (I02,90005)
WRITE (I02,90006)
WRITE (I02,90002)
C TEST SECTION
C
C TESTS 21, 22, AND 23 CONTAIN THE SAME IF STATEMENT BUT THE
C EXPECTED BRANCH IS TO THE FIRST, SECOND OR THIRD STATEMENT LABEL
C AS THE INTEGER EXPRESSION IS LESS THAN ZERO, EQUAL TO ZERO, OR
C GREATER THAN ZERO RESPECTIVELY.
C
211 CONTINUE
IVTNUM = 21
C
C **** TEST 021 ****
C TEST 21 - ARITHMETIC IF STATEMENT TEST
C LESS THAN ZERO BRANCH EXPECTED.
C
IF (ICZERO) 30210, 210, 30210
210 CONTINUE
IVON01=2
IF (IVON01 - 3) 212,213,214
212 IVON02 = -1
GO TO 40210
213 IVON02 = 0
GO TO 40210
214 IVON02 = 1
GO TO 40210
30210 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 40210, 221, 40210
40210 IF (IVON02) 10210, 20210, 20210
10210 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 221
20210 IVFAIL = IVFAIL + 1
IVCOMP=IVON02
IVCORR=-1
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
221 CONTINUE
IVTNUM = 22
C
C **** TEST 022 ****
C TEST 22 - ARITHMETIC IF STATEMENT TEST
C EQUAL TO ZERO BRANCH EXPECTED
C
IF (ICZERO) 30220, 220, 30220
220 CONTINUE
IVON01 = 3
IF (IVON01 - 3) 222,223,224
222 IVON02 = -1
GO TO 40220
223 IVON02 = 0
GO TO 40220
224 IVON02 = 1
GO TO 40220
30220 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 40220, 231, 40220
40220 IF (IVON02) 20220, 10220, 20220
10220 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 231
20220 IVFAIL = IVFAIL + 1
IVCOMP=IVON02
IVCORR= 0
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
231 CONTINUE
IVTNUM = 23
C
C **** TEST 023 ****
C TEST 23 - ARITHMETIC IF STATEMENT TEST
C GREATER THAN ZERO BRANCH EXPECTED
C
IF (ICZERO) 30230, 230, 30230
230 CONTINUE
IVON01 = 4
IF (IVON01 - 3) 232,233,234
232 IVON02 = -1
GO TO 40230
233 IVON02 = 0
GO TO 40230
234 IVON02 = 1
GO TO 40230
30230 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 40230, 241, 40230
40230 IF (IVON02) 20230, 20230, 10230
10230 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 241
20230 IVFAIL = IVFAIL + 1
IVCOMP=IVON02
IVCORR = 1
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
C
C TESTS 24 THROUGH 29 CONTAIN AN IF STATEMENT WITH TWO OF THE
C THREE BRANCH STATEMENT LABELS EQUAL.
C
241 CONTINUE
IVTNUM = 24
C
C **** TEST 024 ****
C TEST 24 - ARITHMETIC IF STATEMENT TEST
C LESS THAN ZERO BRANCH EXPECTED
C
IF (ICZERO) 30240, 240, 30240
240 CONTINUE
IVON01=2
IF (IVON01 - 3) 242,243,242
242 IVON02=-1
GO TO 40240
243 IVON02=0
GO TO 40240
30240 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 40240, 251, 40240
40240 IF (IVON02) 10240, 20240, 20240
10240 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 251
20240 IVFAIL = IVFAIL + 1
IVCOMP=IVON02
IVCORR=-1
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
251 CONTINUE
IVTNUM = 25
C
C **** TEST 025 ****
C TEST 25 - ARITHMETIC IF STATEMENT TEST
C EQUAL TO ZERO BRANCH EXPECTED
C
IF (ICZERO) 30250, 250, 30250
250 CONTINUE
IVON01=3
IF (IVON01 - 3) 252,253,252
252 IVON02= -1
GO TO 40250
253 IVON02 = 0
GO TO 40250
30250 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 40250, 261, 40250
40250 IF (IVON02) 20250,10250,20250
10250 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 261
20250 IVFAIL = IVFAIL + 1
IVCOMP=IVON02
IVCORR=0
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
261 CONTINUE
IVTNUM = 26
C
C **** TEST 026 ****
C TEST 26 - ARITHMETIC IF STATEMENT TEST
C GREATER THAN ZERO BRANCH EXPECTED
C
IF (ICZERO) 30260, 260, 30260
260 CONTINUE
IVON01=4
IF (IVON01-3) 262, 263, 262
262 IVON02= 1
GO TO 40260
263 IVON02 = 0
GO TO 40260
30260 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 40260, 271, 40260
40260 IF (IVON02) 20260, 20260, 10260
10260 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 271
20260 IVFAIL = IVFAIL + 1
IVCOMP=IVON02
IVCORR = 1
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
271 CONTINUE
IVTNUM = 27
C
C **** TEST 027 ****
C TEST 27 - ARITHMETIC IF STATEMENT TEST
C LESS THAN ZERO BRANCH EXPECTED
C
IF (ICZERO) 30270, 270, 30270
270 CONTINUE
IVON01 = -4
IF (IVON01 + 3) 272, 272, 273
272 IVON02= -1
GO TO 40270
273 IVON02 = 1
GO TO 40270
30270 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 40270, 281, 40270
40270 IF (IVON02) 10270, 20270, 20270
10270 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 281
20270 IVFAIL = IVFAIL + 1
IVCOMP=IVON02
IVCORR= -1
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
281 CONTINUE
IVTNUM = 28
C
C **** TEST 028 ****
C TEST 28 - ARITHMETIC IF STATEMENT TEST
C EQUAL TO ZERO BRANCH EXPECTED
C
IF (ICZERO) 30280, 280, 30280
280 CONTINUE
IVON01 = -3
IF (IVON01 + 3) 282, 282, 283
282 IVON02 = 0
GO TO 40280
283 IVON02 = 1
GO TO 40280
30280 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 40280, 291, 40280
40280 IF (IVON02) 20280, 10280, 20280
10280 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 291
20280 IVFAIL = IVFAIL + 1
IVCOMP=IVON02
IVCORR= 0
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
291 CONTINUE
IVTNUM = 29
C
C **** TEST 029 ****
C TEST 29 - ARITHMETIC IF STATEMENT TEST
C GREATER THAN ZERO BRANCH EXPECTED
C
IF (ICZERO) 30290, 290, 30290
290 CONTINUE
IVON01 = -2
IF (IVON01 + 3) 292,292,293
292 IVON02 = -1
GO TO 40290
293 IVON02 = 1
GO TO 40290
30290 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 40290, 301, 40290
40290 IF (IVON02) 20290, 20290, 10290
10290 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 301
20290 IVFAIL = IVFAIL + 1
IVCOMP= IVON02
IVCORR = 1
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
C
C TESTS 30 AND 31 CONTAIN THE BASIC GO TO STATEMENT TESTS.
C
301 CONTINUE
IVTNUM = 30
C
C **** TEST 030 ****
C TEST 30 - UNCONDITIONAL GO TO STATEMENT TEST
C
IF (ICZERO) 30300, 300, 30300
300 CONTINUE
IVON01 = 1
GO TO 302
303 IVON01 = 2
GO TO 304
302 IVON01 = 3
GO TO 303
304 GO TO 40300
30300 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 40300, 311, 40300
40300 IF (IVON01 - 2) 20300,10300,20300
10300 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 311
20300 IVFAIL = IVFAIL + 1
IVCOMP = IVON01
IVCORR = 2
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
311 CONTINUE
IVTNUM = 31
C
C **** TEST 031 ****
C TEST 31 - UNCONDITIONAL GO TO STATEMENT TEST
C
IF (ICZERO) 30310, 310, 30310
310 CONTINUE
IVON01 = 1
GO TO 316
313 GO TO 317
314 IVON01 = 3
GO TO 40310
315 GO TO 313
316 GO TO 315
317 GO TO 314
30310 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 40310, 321, 40310
40310 IF (IVON01 - 3) 20310, 10310, 20310
10310 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 321
20310 IVFAIL = IVFAIL + 1
IVCOMP=IVON01
IVCORR = 3
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
321 CONTINUE
IVTNUM = 32
C
C **** TEST 032 ****
C TEST 32 - ARITHMETIC IF STATEMENT AND UNCONDITIONAL GO TO
C STATEMENT
C THIS TEST COMBINES THE BASIC ARITHMETIC IF STATEMENTS AND
C UNCONDITIONAL GO TO STATEMENTS IN ONE TEST.
C
IF (ICZERO) 30320, 320, 30320
320 CONTINUE
IVON01 = 1
GO TO 322
324 IVON01 = 2
IF (IVON01 -1) 323, 323, 325
327 IVON01 = 5
GO TO 328
326 IVON01 = -4
IF (IVON01 + 4) 323, 327, 323
322 IF (IVON01 - 1) 323, 324, 323
323 GO TO 20320
325 IVON01 = 3
IF (IVON01 -4) 326,323,323
328 GO TO 40320
30320 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 40320, 331, 40320
40320 IF (IVON01 - 5) 20320, 10320, 20320
10320 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 331
20320 IVFAIL = IVFAIL + 1
IVCOMP=IVON01
IVCORR=5
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
331 CONTINUE
C
C WRITE PAGE FOOTINGS AND RUN SUMMARIES
99999 CONTINUE
WRITE (I02,90002)
WRITE (I02,90006)
WRITE (I02,90002)
WRITE (I02,90002)
WRITE (I02,90007)
WRITE (I02,90002)
WRITE (I02,90008) IVFAIL
WRITE (I02,90009) IVPASS
WRITE (I02,90010) IVDELE
C
C
C TERMINATE ROUTINE EXECUTION
STOP
C
C FORMAT STATEMENTS FOR PAGE HEADERS
90000 FORMAT (1H1)
90002 FORMAT (1H )
90001 FORMAT (1H ,10X,34HFORTRAN COMPILER VALIDATION SYSTEM)
90003 FORMAT (1H ,21X,11HVERSION 1.0)
90004 FORMAT (1H ,10X,38HFOR OFFICIAL USE ONLY - COPYRIGHT 1978)
90005 FORMAT (1H ,5X,4HTEST,5X,9HPASS/FAIL, 5X,8HCOMPUTED,8X,7HCORRECT)
90006 FORMAT (1H ,5X,46H----------------------------------------------)
90011 FORMAT (1H ,18X,17HSUBSET LEVEL TEST)
C
C FORMAT STATEMENTS FOR RUN SUMMARIES
90008 FORMAT (1H ,15X,I5,19H ERRORS ENCOUNTERED)
90009 FORMAT (1H ,15X,I5,13H TESTS PASSED)
90010 FORMAT (1H ,15X,I5,14H TESTS DELETED)
C
C FORMAT STATEMENTS FOR TEST RESULTS
80001 FORMAT (1H ,4X,I5,7X,4HPASS)
80002 FORMAT (1H ,4X,I5,7X,4HFAIL)
80003 FORMAT (1H ,4X,I5,7X,7HDELETED)
80004 FORMAT (1H ,4X,I5,7X,4HFAIL,10X,I6,9X,I6)
80005 FORMAT (1H ,4X,I5,7X,4HFAIL,4X,E12.5,3X,E12.5)
C
90007 FORMAT (1H ,20X,20HEND OF PROGRAM FM004)
END
*END-OF,FM004
FM005.f 481212194 170 2 100666 12166 `
*HEADER,FORTR,FM005
*FILES1,FORTR,FM005,X
C COMMENT SECTION
C
C FM005
C
C THIS ROUTINE TESTS THE BASIC ASSUMPTIONS REGARDING THE SIMPLE
C FORMATTED WRITE STATEMENT OF FORM
C WRITE (U,F) OR
C WRITE (U,F) L
C WHERE U IS A LOGICAL UNIT NUMBER
C F IS A FORMAT STATEMENT LABEL, AND
C L IS A LIST OF INTEGER VARIABLES.
C THE FORMAT STATEMENT F CONTAINS NH HOLLERITH FIELD DESCRIPTORS,
C NX BLANK FIELD DESCRIPTORS AND IW NUMERIC FIELD DESCRIPTORS.
C
C THIS ROUTINE TESTS WHETHER THE FIRST CHARACTER OF A FORMAT
C RECORD FOR PRINTER OUTPUT DETERMINES VERTICAL SPACING AS FOLLOWS
C BLANK - ONE LINE
C 1 - ADVANCE TO FIRST LINE OF NEXT PAGE
C
C REFERENCES
C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN,
C X3.9-1978
C
C SECTION 12.8.2, INPUT/OUTPUT LISTS
C SECTION 12.9.5.2, READ, WRITE, AND PRINT STATEMENT
C SECTION 12.9.5.2.3, PRINTING OF FORMATTED RECORDS
C SECTION 13.5.2, H EDITING
C SECTION 13.5.3.2, X EDITING
C SECTION 13.5.9.1, NUMERIC EDITING
C
C ALL OF THE RESULTS OF THIS ROUTINE MUST BE VISUALLY CHECKED
C ON THE OUTPUT REPORT. THE USUAL TEST CODE FOR PASS, FAIL, OR
C DELETE DOES NOT APPLY TO THIS ROUTINE. IF ANY TEST IS TO BE
C DELETED, CHANGE THE OFFENDING WRITE OR FORMAT STATEMENT TO A
C COMMENT. THE PERSON RESPONSIBLE FOR CHECKING THE OUTPUT MUST ALSO
C CHECK THE COMPILER LISTING TO SEE IF ANY STATEMENTS HAVE BEEN
C CHANGED TO COMMENTS.
C
C **********************************************************
C
C A COMPILER VALIDATION SYSTEM FOR THE FORTRAN LANGUAGE
C BASED ON SPECIFICATIONS AS DEFINED IN AMERICAN NATIONAL STANDARD
C PROGRAMMING LANGUAGE FORTRAN X3.9-1978, HAS BEEN DEVELOPED BY THE
C FEDERAL COBOL COMPILER TESTING SERVICE. THE FORTRAN COMPILER
C VALIDATION SYSTEM (FCVS) CONSISTS OF AUDIT ROUTINES, THEIR RELATED
C DATA, AND AN EXECUTIVE SYSTEM. EACH AUDIT ROUTINE IS A FORTRAN
C PROGRAM, SUBPROGRAM OR FUNCTION WHICH INCLUDES TESTS OF SPECIFIC
C LANGUAGE ELEMENTS AND SUPPORTING PROCEDURES INDICATING THE RESULT
C OF EXECUTING THESE TESTS.
C
C THIS PARTICULAR PROGRAM/SUBPROGRAM/FUNCTION CONTAINS FEATURES
C FOUND ONLY IN THE SUBSET AS DEFINED IN X3.9-1978.
C
C SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO -
C
C DEPARTMENT OF THE NAVY
C FEDERAL COBOL COMPILER TESTING SERVICE
C WASHINGTON, D.C. 20376
C
C **********************************************************
C
C
C
C INITIALIZATION SECTION
C
C INITIALIZE CONSTANTS
C **************
C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER.
I01 = 5
C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER.
I02 = 6
C SYSTEM ENVIRONMENT SECTION
C
CX010 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-010 CONTROL CARD.
C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5
C (UNIT NUMBER FOR CARD READER).
CX011 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-011 CONTROL CARD.
C THE CX011 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL
C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX010 ABOVE.
C
CX020 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-020 CONTROL CARD.
C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02 = 6
C (UNIT NUMBER FOR PRINTER).
CX021 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-021 CONTROL CARD.
C THE CX021 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL
C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX020 ABOVE.
C
IVPASS=0
IVFAIL=0
IVDELE=0
ICZERO=0
C
C WRITE PAGE HEADERS
WRITE (I02,90000)
WRITE (I02,90001)
WRITE (I02,90002)
WRITE (I02, 90002)
WRITE (I02,90003)
WRITE (I02,90002)
WRITE (I02,90004)
WRITE (I02,90002)
WRITE (I02,90011)
WRITE (I02,90002)
WRITE (I02,90002)
WRITE (I02,90006)
WRITE (I02,90002)
331 CONTINUE
IVTNUM = 33
C
C **** TEST 033 ****
C TEST 33 - VERTICAL SPACING TEST
C 1 IN FIRST CHARACTER OF FORMATTED PRINT RECORD MEANS
C RECORD IS FIRST LINE AT TOP OF NEXT PAGE.
C
WRITE (I02,80001) IVTNUM
WRITE (I02,80331)
80331 FORMAT (5X,22HLAST LINE ON THIS PAGE)
WRITE (I02,80330)
80330 FORMAT (1H1,31H THIS IS FIRST LINE ON PAGE)
341 CONTINUE
IVTNUM = 34
C
C **** TEST 034 ****
C TEST 34 - VERTICAL SPACING TEST
C PRINT BLANK LINES
C
WRITE (I02,90002)
WRITE (I02,80001) IVTNUM
WRITE (I02,80340)
80340 FORMAT (1H , 10X)
WRITE (I02,80341)
80341 FORMAT (41H THERE IS ONE BLANK LINE BEFORE THIS LINE)
WRITE (I02,80342)
WRITE (I02,80342)
80342 FORMAT (11H )
WRITE (I02,80343)
80343 FORMAT (43H THERE ARE TWO BLANK LINES BEFORE THIS LINE)
WRITE (I02,80344)
WRITE (I02,80344)
WRITE (I02,80344)
80344 FORMAT (11X)
WRITE (I02,80345)
80345 FORMAT (45H THERE ARE THREE BLANK LINES BEFORE THIS LINE)
351 CONTINUE
IVTNUM = 35
C
C **** TEST 035 ****
C TEST 35 - PRINT 54 CHARACTERS
C
WRITE (I02,90002)
WRITE (I02,80001)IVTNUM
WRITE (I02,80351)
80351 FORMAT (33H NEXT LINE CONTAINS 54 CHARACTERS)
WRITE (I02,80350)
80350 FORMAT(55H 123456789012345678901234567890123456789012345678901234)
361 CONTINUE
IVTNUM = 36
C
C **** TEST 036 ****
C TEST 36 - NUMERIC FIELD DESCRIPTOR I1
C
WRITE (I02,90000)
WRITE (I02,90002)
WRITE (I02,80001) IVTNUM
WRITE (I02,80361)
80361 FORMAT (1H ,10X,38HTHIS TEST PRINTS 3 UNDER I1 DESCRIPTOR)
IVON01 = 3
WRITE (I02,80360) IVON01
80360 FORMAT (1H ,10X,I1)
371 CONTINUE
IVTNUM = 37
C
C **** TEST 037 ****
C TEST 37 - NUMERIC FIELD DESCRIPTOR I2
C
WRITE (I02,90002)
WRITE (I02,80001) IVTNUM
WRITE (I02,80371)
80371 FORMAT (11X,39HTHIS TEST PRINTS 15 UNDER I2 DESCRIPTOR)
IVON01 = 15
WRITE (I02,80370) IVON01
80370 FORMAT (1H ,10X,I2)
381 CONTINUE
IVTNUM = 38
C
C **** TEST 038 ****
C TEST 38 - NUMERIC FIELD DESCRIPTOR I3
C
WRITE (I02,90002)
WRITE (I02,80001) IVTNUM
WRITE (I02,80381)
80381 FORMAT (11X,40HTHIS TEST PRINTS 291 UNDER I3 DESCRIPTOR)
IVON01 = 291
WRITE (I02,80380) IVON01
80380 FORMAT (11X,I3)
391 CONTINUE
IVTNUM = 39
C
C **** TEST 039 ****
C TEST 39 - NUMERIC FIELD DESCRIPTOR I4
C
WRITE (I02,90002)
WRITE (I02,80001) IVTNUM
WRITE (I02,80391)
80391 FORMAT (11X,41HTHIS TEST PRINTS 4321 UNDER I4 DESCRIPTOR)
IVON01 = 4321
WRITE (I02,80390) IVON01
80390 FORMAT (11X,I4)
401 CONTINUE
IVTNUM = 40
C
C **** TEST 040 ****
C TEST 40 - NUMERIC FIELD DESCRIPTOR I5
C
WRITE (I02,90002)
WRITE (I02,80001) IVTNUM
WRITE (I02,80401)
80401 FORMAT (1H ,10X,42HTHIS TEST PRINTS 12345 UNDER I5 DESCRIPTOR)
IVON01 = 12345
WRITE (I02,80400) IVON01
80400 FORMAT (1H ,10X,I5)
411 CONTINUE
IVTNUM = 41
C
C **** TEST 041 ****
C TEST 41 - NUMERIC FIELD DESCRIPTORS, INTEGER CONVERSION
C
IVON01 = 1
IVON02 = 22
IVON03 = 333
IVON04 = 4444
IVON05 = 25555
WRITE (I02,90002)
WRITE (I02,80001) IVTNUM
WRITE (I02,80411)
80411 FORMAT (3X,50HTHIS TEST PRINTS 1, 22, 333, 4444, AND 25555 UNDER)
WRITE (I02,80412)
80412 FORMAT (10X,32H(10X,I1,3X,I2,3X,I3,3X,I4,3X,I5))
WRITE (I02,80410) IVON01, IVON02, IVON03, IVON04, IVON05
80410 FORMAT (10X,I1,3X,I2,3X,I3,3X,I4,3X,I5)
421 CONTINUE
IVTNUM = 42
C
C **** TEST 042 ****
C TEST 42 - HOLLERITH, NUMERIC AND X FIELD DESCRIPTORS
C COMBINE HOLLERITH, NUMERIC AND X FIELD DESCRIPTORS IN
C ONE FORMAT STATEMENT
C
IVON01=113
IVON02=8
WRITE (I02,90002)
WRITE (I02,80001) IVTNUM
WRITE (I02,80421)
80421 FORMAT (10X,28HNEXT TWO LINES ARE IDENTICAL)
WRITE (I02,80422)
80422 FORMAT (35H IVON01 = 113 IVON02 = 8)
WRITE (I02,80420) IVON01, IVON02
80420 FORMAT (6X,8HIVON01 =,I5,3X,8HIVON02 =,I5)
431 CONTINUE
IVTNUM=43
C
C **** TEST 043 ****
C TEST 43 - NUMERIC FIELD DESCRIPTOR I2
C PRINT NEGATIVE INTEGER
C
IVON01 = -1
WRITE (I02,90000)
WRITE (I02,90002)
WRITE (I02,80001) IVTNUM
WRITE (I02,80431)
80431 FORMAT (11X,39HTHIS TEST PRINTS -1 UNDER I2 DESCRIPTOR)
WRITE (I02,80430) IVON01
80430 FORMAT (11X,I2)
441 CONTINUE
IVTNUM = 44
C
C **** TEST 044 ****
C TEST 44 - NUMERIC FIELD DESCRIPTOR I3
C PRINT NEGATIVE INTEGER
C
IVON01 = -22
WRITE (I02,90002)
WRITE (I02,80001) IVTNUM
WRITE (I02,80441)
80441 FORMAT (11X,40HTHIS TEST PRINTS -22 UNDER I3 DESCRIPTOR)
WRITE (I02,80440) IVON01
80440 FORMAT (11X,I3)
451 CONTINUE
IVTNUM = 45
C
C **** TEST 045 ****
C TEST 45 - NUMERIC FIELD DESCRIPTOR I4
C PRINT NEGATIVE INTEGER
C
IVON01 = -333
WRITE (I02,90002)
WRITE (I02,80001) IVTNUM
WRITE (I02,80451)
80451 FORMAT (11X,41HTHIS TEST PRINTS -333 UNDER I4 DESCRIPTOR)
WRITE (I02,80450) IVON01
80450 FORMAT (11X,I4)
461 CONTINUE
IVTNUM = 46
C
C **** TEST 046 ****
C TEST 46 - NUMERIC FIELD DESCRIPTOR I5
C PRINT NEGATIVE INTEGER
C
IVON01 = -4444
WRITE (I02,90002)
WRITE (I02,80001) IVTNUM
WRITE (I02,80461)
80461 FORMAT (11X,42HTHIS TEST PRINTS -4444 UNDER I5 DESCRIPTOR)
WRITE (I02,80460) IVON01
80460 FORMAT (11X,I5)
471 CONTINUE
IVTNUM = 47
C
C **** TEST 047 ****
C TEST 47 - NUMERIC FIELD DESCRIPTOR I6
C PRINT NEGATIVE INTEGER
C
IVON01 = -15555
WRITE (I02,90002)
WRITE (I02,80001) IVTNUM
WRITE (I02,80471)
80471 FORMAT (11X,43HTHIS TEST PRINTS -15555 UNDER DESCRIPTOR I6)
WRITE (I02,80470) IVON01
80470 FORMAT (11X,I6)
481 CONTINUE
IVTNUM = 48
C
C **** TEST 048 ****
C TEST 48 - NUMERIC FIELD DESCRIPTORS, INTEGER CONVERSION
C PRINT NEGATIVE INTEGERS
C
IVON01 = -9
IVON02 = -88
IVON03 = -777
IVON04 = -6666
IVON05 = -25555
WRITE (I02,90002)
WRITE (I02,80001) IVTNUM
WRITE (I02,80481)
80481 FORMAT (8X,49HTHIS TEST PRINTS -9, -88, -777, -6666, AND -25555)
WRITE (I02,80482)
80482 FORMAT (11X,43HUNDER FORMAT 10X,I2,3X,I3,3X,I4,3X,I5,3X,I6)
WRITE (I02,80480) IVON01,IVON02,IVON03,IVON04,IVON05
80480 FORMAT (10X,I2,3X,I3,3X,I4,3X,I5,3X,I6)
491 CONTINUE
IVTNUM = 49
C
C **** TEST 049 ****
C TEST 49 - NUMERIC FIELD DESCRIPTOR I5
C MIX POSITIVE AND NEGATIVE INTEGER OUTPUT IN ONE FORMAT
C STATEMENT ALL UNDER I5 DESCRIPTOR
C
IVON01 =5
IVON02 = -54
IVON03 = 543
IVON04 = -5432
IVON05=32000
WRITE (I02,90002)
WRITE (I02,80001) IVTNUM
WRITE (I02,80491)
80491 FORMAT (18X,46HTHIS TEST PRINTS 5, -54, 543, -5432, AND 32000)
WRITE (I02,80492)
80492 FORMAT (11X,33HUNDER I5 NUMERIC FIELD DESCRIPTOR)
WRITE (I02,80490) IVON01,IVON02,IVON03,IVON04,IVON05
80490 FORMAT (11X,I5,3X,I5,3X,I5,3X,I5,3X,I5)
C
C WRITE PAGE FOOTINGS
99999 CONTINUE
WRITE (I02,90002)
WRITE (I02,90006)
WRITE (I02,90002)
WRITE (I02,90007)
C
C TERMINATE ROUTINE EXECUTION
STOP
C
C FORMAT STATEMENTS FOR PAGE HEADERS
90000 FORMAT (1H1)
90002 FORMAT (1H )
90001 FORMAT (1H ,10X,34HFORTRAN COMPILER VALIDATION SYSTEM)
90003 FORMAT (1H ,21X,11HVERSION 1.0)
90004 FORMAT (1H ,10X,38HFOR OFFICIAL USE ONLY - COPYRIGHT 1978)
90005 FORMAT (1H ,5X,4HTEST,5X,9HPASS/FAIL, 5X,8HCOMPUTED,8X,7HCORRECT)
90006 FORMAT (1H ,5X,46H----------------------------------------------)
90011 FORMAT (1H ,18X,17HSUBSET LEVEL TEST)
C FORMAT STATEMENTS FOR THIS ROUTINE
80001 FORMAT (10X,5HTEST ,I2)
90007 FORMAT (1H ,20X,20HEND OF PROGRAM FM005)
END
*END-OF,FM005
FM006.f 480975950 170 2 100666 20064 `
*HEADER,FORTR,FM006
*FILES1,FORTR,FM006,X
C COMMENT SECTION
C
C FM006
C
C THIS ROUTINE TESTS ARITHMETIC ASSIGNMENT STATEMENTS OF
C THE FORM
C INTEGER VARIABLE = INTEGER CONSTANT
C INTEGER VARIABLE = INTEGER VARIABLE
C THE INTEGER CONSTANT MAY BE UNSIGNED, POSITIVE OR NEGATIVE.
C
C AN INTEGER DATUM IS ALWAYS AN EXACT REPRESENTATION OF AN
C INTEGER VALUE. IT MAY ASSUME POSITIVE, NEGATIVE AND ZERO VALUES.
C IT MAY ONLY ASSUME INTEGRAL VALUES.
C
C AN INTEGER CONSTANT IS WRITTEN AS A NONEMPTY STRING OF DIGITS.
C THE CONSTANT IS THE DIGIT STRING INTERPRETED AS A DECIMAL NUMBER.
C
C THIS ROUTINE ALSO CONTAINS TESTS WHICH CHECK ON THE USE OF
C AT LEAST 16 BITS FOR REPRESENTING INTEGER DATA VALUES. THE
C CONSTANT VALUES 32767 AND -32766 ARE USED IN THESE TESTS.
C
C REFERENCES
C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN,
C X3.9-1978
C
C SECTION 4.3, INTEGER TYPE
C SECTION 4.3.1, INTEGER CONSTANT
C SECTION 10.1, ARITHMETIC ASSIGNMENT STATEMENTS
C
C
C **********************************************************
C
C A COMPILER VALIDATION SYSTEM FOR THE FORTRAN LANGUAGE
C BASED ON SPECIFICATIONS AS DEFINED IN AMERICAN NATIONAL STANDARD
C PROGRAMMING LANGUAGE FORTRAN X3.9-1978, HAS BEEN DEVELOPED BY THE
C FEDERAL COBOL COMPILER TESTING SERVICE. THE FORTRAN COMPILER
C VALIDATION SYSTEM (FCVS) CONSISTS OF AUDIT ROUTINES, THEIR RELATED
C DATA, AND AN EXECUTIVE SYSTEM. EACH AUDIT ROUTINE IS A FORTRAN
C PROGRAM, SUBPROGRAM OR FUNCTION WHICH INCLUDES TESTS OF SPECIFIC
C LANGUAGE ELEMENTS AND SUPPORTING PROCEDURES INDICATING THE RESULT
C OF EXECUTING THESE TESTS.
C
C THIS PARTICULAR PROGRAM/SUBPROGRAM/FUNCTION CONTAINS FEATURES
C FOUND ONLY IN THE SUBSET AS DEFINED IN X3.9-1978.
C
C SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO -
C
C DEPARTMENT OF THE NAVY
C FEDERAL COBOL COMPILER TESTING SERVICE
C WASHINGTON, D.C. 20376
C
C **********************************************************
C
C
C
C INITIALIZATION SECTION
C
C INITIALIZE CONSTANTS
C **************
C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER.
I01 = 5
C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER.
I02 = 6
C SYSTEM ENVIRONMENT SECTION
C
CX010 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-010 CONTROL CARD.
C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5
C (UNIT NUMBER FOR CARD READER).
CX011 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-011 CONTROL CARD.
C THE CX011 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL
C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX010 ABOVE.
C
CX020 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-020 CONTROL CARD.
C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02 = 6
C (UNIT NUMBER FOR PRINTER).
CX021 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-021 CONTROL CARD.
C THE CX021 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL
C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX020 ABOVE.
C
IVPASS=0
IVFAIL=0
IVDELE=0
ICZERO=0
C
C WRITE PAGE HEADERS
WRITE (I02,90000)
WRITE (I02,90001)
WRITE (I02,90002)
WRITE (I02, 90002)
WRITE (I02,90003)
WRITE (I02,90002)
WRITE (I02,90004)
WRITE (I02,90002)
WRITE (I02,90011)
WRITE (I02,90002)
WRITE (I02,90002)
WRITE (I02,90005)
WRITE (I02,90006)
WRITE (I02,90002)
C TEST SECTION
C
C ARITHMETIC ASSIGNMENT STATEMENT
C
C TEST 50 THROUGH TEST 61 CONTAIN STATEMENT OF FORM
C INTEGER VARIABLE = INTEGER CONSTANT
C
C TESTS 50 THROUGH 53 CONTAIN UNSIGNED INTEGER CONSTANT.
C
501 CONTINUE
IVTNUM = 50
C
C **** TEST 50 ****
C
IF (ICZERO) 30500, 500, 30500
500 CONTINUE
IVCOMP=3
GO TO 40500
30500 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 40500, 511, 40500
40500 IF (IVCOMP - 3) 20500, 10500, 20500
10500 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 511
20500 IVFAIL = IVFAIL + 1
IVCORR = 3
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
511 CONTINUE
IVTNUM = 51
C
C **** TEST 51 ****
C
IF (ICZERO) 30510, 510, 30510
510 CONTINUE
IVCOMP = 76
GO TO 40510
30510 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 40510, 521, 40510
40510 IF (IVCOMP - 76) 20510, 10510, 20510
10510 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 521
20510 IVFAIL = IVFAIL + 1
IVCORR = 76
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
521 CONTINUE
IVTNUM = 52
C
C **** TEST 52 ****
C
IF (ICZERO) 30520, 520, 30520
520 CONTINUE
IVCOMP = 587
GO TO 40520
30520 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 40520, 531, 40520
40520 IF (IVCOMP - 587) 20520, 10520, 20520
10520 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 531
20520 IVFAIL = IVFAIL + 1
IVCORR = 587
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
531 CONTINUE
IVTNUM = 53
C
C **** TEST 53 ****
C
IF (ICZERO) 30530, 530, 30530
530 CONTINUE
IVCOMP = 9999
GO TO 40530
30530 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 40530, 541, 40530
40530 IF (IVCOMP - 9999) 20530, 10530, 20530
10530 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 541
20530 IVFAIL = IVFAIL + 1
IVCORR = 9999
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
C
C TESTS 54 THROUGH 57 CONTAIN POSITIVE SIGNED INTEGERS
C
541 CONTINUE
IVTNUM = 54
C
C **** TEST 54 ****
C
IF (ICZERO) 30540, 540, 30540
540 CONTINUE
IVCOMP = +3
GO TO 40540
30540 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 40540, 551, 40540
40540 IF (IVCOMP - 3) 20540, 10540, 20540
10540 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 551
20540 IVFAIL = IVFAIL + 1
IVCORR = 3
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
551 CONTINUE
IVTNUM = 55
C
C **** TEST 55 ****
C
IF (ICZERO) 30550, 550, 30550
550 CONTINUE
IVCOMP = +76
GO TO 40550
30550 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 40550, 561, 40550
40550 IF (IVCOMP - 76) 20550, 10550, 20550
10550 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 561
20550 IVFAIL = IVFAIL + 1
IVCORR = 76
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
561 CONTINUE
IVTNUM = 56
C
C **** TEST 56 ****
C
IF (ICZERO) 30560, 560, 30560
560 CONTINUE
IVCOMP = +587
GO TO 40560
30560 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 40560, 571, 40560
40560 IF (IVCOMP - 587) 20560, 10560, 20560
10560 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 571
20560 IVFAIL = IVFAIL + 1
IVCORR = 587
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
571 CONTINUE
IVTNUM = 57
C
C **** TEST 57 ****
C
IF (ICZERO) 30570, 570, 30570
570 CONTINUE
IVCOMP = +9999
GO TO 40570
30570 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 40570, 581, 40570
40570 IF (IVCOMP - 9999) 20570, 10570, 20570
10570 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 581
20570 IVFAIL = IVFAIL + 1
IVCORR = 9999
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
C
C TESTS 58 THROUGH 61 CONTAIN SIGNED NEGATIVE INTEGERS
C
581 CONTINUE
IVTNUM = 58
C
C **** TEST 58 ****
C
IF (ICZERO) 30580, 580, 30580
580 CONTINUE
IVCOMP = -3
GO TO 40580
30580 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 40580, 591, 40580
40580 IF (IVCOMP + 3) 20580, 10580, 20580
10580 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 591
20580 IVFAIL = IVFAIL + 1
IVCORR = -3
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
591 CONTINUE
IVTNUM = 59
C
C **** TEST 59 ****
C
IF (ICZERO) 30590, 590, 30590
590 CONTINUE
IVCOMP = -76
GO TO 40590
30590 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 40590, 601, 40590
40590 IF (IVCOMP + 76) 20590, 10590, 20590
10590 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 601
20590 IVFAIL = IVFAIL + 1
IVCORR = -76
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
601 CONTINUE
IVTNUM = 60
C
C **** TEST 60 ****
C
IF (ICZERO) 30600, 600, 30600
600 CONTINUE
IVCOMP = -587
GO TO 40600
30600 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 40600, 611, 40600
40600 IF (IVCOMP + 587) 20600,10600,20600
10600 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 611
20600 IVFAIL = IVFAIL + 1
IVCORR = -587
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
611 CONTINUE
IVTNUM = 61
C
C **** TEST 61 ****
C
IF (ICZERO) 30610, 610, 30610
610 CONTINUE
IVCOMP = -9999
GO TO 40610
30610 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 40610, 621, 40610
40610 IF (IVCOMP + 9999) 20610, 10610, 20610
10610 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 621
20610 IVFAIL = IVFAIL + 1
IVCORR = -9999
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
C
C TEST 62 THROUGH TEST 73 CONTAIN STATEMENT OF FORM
C INTEGER VARIABLE = INTEGER VARIABLE
C
C TESTS 62 THROUGH 65 CONTAIN UNSIGNED VALUES.
C
621 CONTINUE
IVTNUM = 62
C
C **** TEST 62 ****
C
IF (ICZERO) 30620, 620, 30620
620 CONTINUE
IVON01 = 3
IVCOMP = IVON01
GO TO 40620
30620 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 40620, 631, 40620
40620 IF (IVCOMP - 3) 20620, 10620, 20620
10620 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 631
20620 IVFAIL = IVFAIL + 1
IVCORR = 3
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
631 CONTINUE
IVTNUM = 63
C
C **** TEST 63 ****
C
IF (ICZERO) 30630, 630, 30630
630 CONTINUE
IVON01 = 76
IVCOMP = IVON01
GO TO 40630
30630 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 40630, 641, 40630
40630 IF (IVCOMP - 76) 20630, 10630, 20630
10630 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 641
20630 IVFAIL = IVFAIL + 1
IVCORR = 76
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
641 CONTINUE
IVTNUM = 64
C
C **** TEST 64 ****
C
IF (ICZERO) 30640, 640, 30640
640 CONTINUE
IVON01 = 587
IVCOMP = IVON01
GO TO 40640
30640 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 40640, 651, 40640
40640 IF (IVCOMP - 587) 20640, 10640, 20640
10640 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 651
20640 IVFAIL = IVFAIL + 1
IVCORR = 587
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
651 CONTINUE
IVTNUM = 65
C
C **** TEST 65 ****
C
IF (ICZERO) 30650, 650, 30650
650 CONTINUE
IVON01 = 9999
IVCOMP = IVON01
GO TO 40650
30650 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 40650, 661, 40650
40650 IF (IVCOMP - 9999) 20650, 10650, 20650
10650 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 661
20650 IVFAIL = IVFAIL + 1
IVCORR = 9999
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
C
C TESTS 66 THROUGH 69 CONTAIN POSITIVE VALUES.
C
661 CONTINUE
IVTNUM = 66
C
C **** TEST 66 ****
C
IF (ICZERO) 30660, 660, 30660
660 CONTINUE
IVON01 = +3
IVCOMP = IVON01
GO TO 40660
30660 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 40660, 671, 40660
40660 IF (IVCOMP - 3) 20660,10660,20660
10660 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 671
20660 IVFAIL = IVFAIL + 1
IVCORR = 3
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
671 CONTINUE
IVTNUM = 67
C
C **** TEST 67 ****
C
IF (ICZERO) 30670, 670, 30670
670 CONTINUE
IVON01 = +76
IVCOMP = IVON01
GO TO 40670
30670 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 40670, 681, 40670
40670 IF (IVCOMP - 76) 20670, 10670, 20670
10670 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 681
20670 IVFAIL = IVFAIL + 1
IVCORR = 76
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
681 CONTINUE
IVTNUM = 68
C
C **** TEST 68 ****
C
IF (ICZERO) 30680, 680, 30680
680 CONTINUE
IVON01 = +587
IVCOMP = IVON01
GO TO 40680
30680 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 40680, 691, 40680
40680 IF (IVCOMP - 587) 20680, 10680, 20680
10680 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 691
20680 IVFAIL = IVFAIL + 1
IVCORR = 587
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
691 CONTINUE
IVTNUM = 69
C
C **** TEST 69 ****
C
IF (ICZERO) 30690, 690, 30690
690 CONTINUE
IVON01 = +9999
IVCOMP = IVON01
GO TO 40690
30690 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 40690, 701, 40690
40690 IF (IVCOMP - 9999) 20690, 10690, 20690
10690 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 701
20690 IVFAIL = IVFAIL + 1
IVCORR = 9999
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
C
C TESTS 70 THROUGH 73 CONTAIN NEGATIVE VALUES.
C
701 CONTINUE
IVTNUM = 70
C
C **** TEST 70 ****
C
IF (ICZERO) 30700, 700, 30700
700 CONTINUE
IVON01 = -3
IVCOMP = IVON01
GO TO 40700
30700 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 40700, 711, 40700
40700 IF (IVCOMP + 3) 20700, 10700, 20700
10700 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 711
20700 IVFAIL = IVFAIL + 1
IVCORR = -3
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
711 CONTINUE
IVTNUM = 71
C
C **** TEST 71 ****
C
IF (ICZERO) 30710, 710, 30710
710 CONTINUE
IVON01 = -76
IVCOMP = IVON01
GO TO 40710
30710 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 40710, 721, 40710
40710 IF (IVCOMP + 76) 20710, 10710, 20710
10710 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 721
20710 IVFAIL = IVFAIL + 1
IVCORR = -76
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
721 CONTINUE
IVTNUM = 72
C
C **** TEST 72 ****
C
IF (ICZERO) 30720, 720, 30720
720 CONTINUE
IVON01 = -587
IVCOMP = IVON01
GO TO 40720
30720 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 40720, 731, 40720
40720 IF (IVCOMP + 587) 20720, 10720, 20720
10720 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 731
20720 IVFAIL = IVFAIL + 1
IVCORR = -587
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
731 CONTINUE
IVTNUM = 73
C
C **** TEST 73 ****
C
IF (ICZERO) 30730, 730, 30730
730 CONTINUE
IVON01 = -9999
IVCOMP = IVON01
GO TO 40730
30730 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 40730, 741, 40730
40730 IF (IVCOMP + 9999) 20730, 10730, 20730
10730 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 741
20730 IVFAIL = IVFAIL + 1
IVCORR = -9999
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
C
C TESTS 74 THROUGH 79 CHECK THAT AT LEAST 16 BITS ARE USED IN THE
C INTERNAL REPRESENTATION OF AN INTEGER DATUM. THIS INCLUDES ONE
C BIT FOR THE SIGN. THE LARGEST INTEGER USED IS 32767 =2**15 - 1,
C AND THE SMALLEST INTEGER USED IS -32766.
C
741 CONTINUE
IVTNUM = 74
C
C **** TEST 74 ****
C UNSIGNED CONSTANT 32767
C
IF (ICZERO) 30740, 740, 30740
740 CONTINUE
IVCOMP = 32767
GO TO 40740
30740 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 40740, 751, 40740
40740 IF (IVCOMP - 32767) 20740, 10740, 20740
10740 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 751
20740 IVFAIL = IVFAIL + 1
IVCORR = 32767
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
751 CONTINUE
IVTNUM = 75
C
C **** TEST 75 ****
C SIGNED POSITIVE CONSTANT +32767
C
IF (ICZERO) 30750, 750, 30750
750 CONTINUE
IVCOMP = +32767
GO TO 40750
30750 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 40750, 761, 40750
40750 IF (IVCOMP - 32767) 20750, 10750, 20750
10750 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 761
20750 IVFAIL = IVFAIL + 1
IVCORR = 32767
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
761 CONTINUE
IVTNUM = 76
C
C **** TEST 76 ****
C SIGNED NEGATIVE CONSTANT -32766
C
IF (ICZERO) 30760, 760, 30760
760 CONTINUE
IVCOMP = - 32766
GO TO 40760
30760 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 40760, 771, 40760
40760 IF (IVCOMP + 32766) 20760, 10760, 20760
10760 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 771
20760 IVFAIL = IVFAIL + 1
IVCORR = -32766
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
771 CONTINUE
IVTNUM = 77
C
C **** TEST 77 ****
C
IF (ICZERO) 30770, 770, 30770
770 CONTINUE
IVON01 = 32767
IVCOMP = IVON01
GO TO 40770
30770 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 40770, 781, 40770
40770 IF (IVCOMP - 32767) 20770, 10770, 20770
10770 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 781
20770 IVFAIL = IVFAIL + 1
IVCORR = 32767
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
781 CONTINUE
IVTNUM = 78
C
C **** TEST 78 ****
C
IF (ICZERO) 30780, 780, 30780
780 CONTINUE
IVON01 = +32767
IVCOMP = IVON01
GO TO 40780
30780 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 40780, 791, 40780
40780 IF (IVCOMP - 32767) 20780, 10780, 20780
10780 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 791
20780 IVFAIL = IVFAIL + 1
IVCORR = 32767
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
791 CONTINUE
IVTNUM = 79
C
C **** TEST 79 ****
C
IF (ICZERO) 30790, 790, 30790
790 CONTINUE
IVON01 = -32766
IVCOMP=IVON01
GO TO 40790
30790 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 40790, 801, 40790
40790 IF (IVCOMP + 32766) 20790, 10790, 20790
10790 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 801
20790 IVFAIL = IVFAIL + 1
IVCORR = -32766
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
801 CONTINUE
C
C WRITE PAGE FOOTINGS AND RUN SUMMARIES
99999 CONTINUE
WRITE (I02,90002)
WRITE (I02,90006)
WRITE (I02,90002)
WRITE (I02,90002)
WRITE (I02,90007)
WRITE (I02,90002)
WRITE (I02,90008) IVFAIL
WRITE (I02,90009) IVPASS
WRITE (I02,90010) IVDELE
C
C
C TERMINATE ROUTINE EXECUTION
STOP
C
C FORMAT STATEMENTS FOR PAGE HEADERS
90000 FORMAT (1H1)
90002 FORMAT (1H )
90001 FORMAT (1H ,10X,34HFORTRAN COMPILER VALIDATION SYSTEM)
90003 FORMAT (1H ,21X,11HVERSION 1.0)
90004 FORMAT (1H ,10X,38HFOR OFFICIAL USE ONLY - COPYRIGHT 1978)
90005 FORMAT (1H ,5X,4HTEST,5X,9HPASS/FAIL, 5X,8HCOMPUTED,8X,7HCORRECT)
90006 FORMAT (1H ,5X,46H----------------------------------------------)
90011 FORMAT (1H ,18X,17HSUBSET LEVEL TEST)
C
C FORMAT STATEMENTS FOR RUN SUMMARIES
90008 FORMAT (1H ,15X,I5,19H ERRORS ENCOUNTERED)
90009 FORMAT (1H ,15X,I5,13H TESTS PASSED)
90010 FORMAT (1H ,15X,I5,14H TESTS DELETED)
C
C FORMAT STATEMENTS FOR TEST RESULTS
80001 FORMAT (1H ,4X,I5,7X,4HPASS)
80002 FORMAT (1H ,4X,I5,7X,4HFAIL)
80003 FORMAT (1H ,4X,I5,7X,7HDELETED)
80004 FORMAT (1H ,4X,I5,7X,4HFAIL,10X,I6,9X,I6)
80005 FORMAT (1H ,4X,I5,7X,4HFAIL,4X,E12.5,3X,E12.5)
C
90007 FORMAT (1H ,20X,20HEND OF PROGRAM FM006)
END
*END-OF,FM006
FM007.f 480975953 170 2 100666 14699 `
*HEADER,FORTR,FM007
*FILES1,FORTR,FM007,X
C COMMENT SECTION
C
C FM007
C
C THIS ROUTINE TESTS THE USE OF DATA INITIALIZATION STATEMENTS.
C DATA INITIALIZATION STATEMENTS ARE USED TO DEFINE INITIAL VALUES
C OF INTEGER VARIABLES. THE DATA STATEMENTS CONTAIN UNSIGNED,
C POSITIVE SIGNED AND NEGATIVE SIGNED INTEGER CONSTANTS. THE LAST
C DATA STATEMENT CONTAINS THE FORM
C J*INTEGER CONSTANT
C WHICH INDICATES THE CONSTANT IS TO BE SPECIFIED J TIMES.
C
C THE TESTS IN THIS ROUTINE CHECK THE INTEGER VARIABLES IN THE
C DATA STATEMENT FOR THE ASSIGNED INITIAL VALUES.
C
C REFERENCES
C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN,
C X3.9-1978
C
C SECTION 4.3, INTEGER TYPE
C SECTION 4.3.1, INTEGER CONSTANT
C SECTION 9, DATA STATEMENT
C
C
C DATA INITIALIZATION STATEMENTS
C
DATA IVON01,IVON02,IVON03,IVON04,IVON05/3,76,587,9999,21111/
DATA IVON06,IVON07,IVON08,IVON09,IVON10/+3,+76,+587,+9999,+21111/
DATA IVON11,IVON12,IVON13,IVON14,IVON15/-3,-76,-587,-9999,-21111/
DATA IVON16,IVON17,IVON18,IVON19,IVON20/ 2*119, 2*7, -427/
C
C
C **********************************************************
C
C A COMPILER VALIDATION SYSTEM FOR THE FORTRAN LANGUAGE
C BASED ON SPECIFICATIONS AS DEFINED IN AMERICAN NATIONAL STANDARD
C PROGRAMMING LANGUAGE FORTRAN X3.9-1978, HAS BEEN DEVELOPED BY THE
C FEDERAL COBOL COMPILER TESTING SERVICE. THE FORTRAN COMPILER
C VALIDATION SYSTEM (FCVS) CONSISTS OF AUDIT ROUTINES, THEIR RELATED
C DATA, AND AN EXECUTIVE SYSTEM. EACH AUDIT ROUTINE IS A FORTRAN
C PROGRAM, SUBPROGRAM OR FUNCTION WHICH INCLUDES TESTS OF SPECIFIC
C LANGUAGE ELEMENTS AND SUPPORTING PROCEDURES INDICATING THE RESULT
C OF EXECUTING THESE TESTS.
C
C THIS PARTICULAR PROGRAM/SUBPROGRAM/FUNCTION CONTAINS FEATURES
C FOUND ONLY IN THE SUBSET AS DEFINED IN X3.9-1978.
C
C SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO -
C
C DEPARTMENT OF THE NAVY
C FEDERAL COBOL COMPILER TESTING SERVICE
C WASHINGTON, D.C. 20376
C
C **********************************************************
C
C
C
C INITIALIZATION SECTION
C
C INITIALIZE CONSTANTS
C **************
C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER.
I01 = 5
C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER.
I02 = 6
C SYSTEM ENVIRONMENT SECTION
C
CX010 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-010 CONTROL CARD.
C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5
C (UNIT NUMBER FOR CARD READER).
CX011 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-011 CONTROL CARD.
C THE CX011 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL
C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX010 ABOVE.
C
CX020 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-020 CONTROL CARD.
C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02 = 6
C (UNIT NUMBER FOR PRINTER).
CX021 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-021 CONTROL CARD.
C THE CX021 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL
C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX020 ABOVE.
C
IVPASS=0
IVFAIL=0
IVDELE=0
ICZERO=0
C
C WRITE PAGE HEADERS
WRITE (I02,90000)
WRITE (I02,90001)
WRITE (I02,90002)
WRITE (I02, 90002)
WRITE (I02,90003)
WRITE (I02,90002)
WRITE (I02,90004)
WRITE (I02,90002)
WRITE (I02,90011)
WRITE (I02,90002)
WRITE (I02,90002)
WRITE (I02,90005)
WRITE (I02,90006)
WRITE (I02,90002)
C TEST SECTION
C
C TESTS 80 THROUGH 84 CHECK THE VALUES INITIALIZED BY THE DATA
C STATEMENT CONTAINING IVON01,..., IVON05.
C
801 CONTINUE
IVTNUM = 80
C
C **** TEST 80 ****
C
IF (ICZERO) 30800, 800, 30800
800 CONTINUE
IVCOMP = IVON01
GO TO 40800
30800 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 40800, 811, 40800
40800 IF (IVCOMP - 3) 20800, 10800,20800
10800 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 811
20800 IVFAIL = IVFAIL + 1
IVCORR = 3
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
811 CONTINUE
IVTNUM = 81
C
C **** TEST 81 ****
C
IF (ICZERO) 30810, 810, 30810
810 CONTINUE
IVCOMP = IVON02
GO TO 40810
30810 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 40810, 821, 40810
40810 IF (IVCOMP - 76) 20810, 10810, 20810
10810 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 821
20810 IVFAIL = IVFAIL + 1
IVCORR = 76
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
821 CONTINUE
IVTNUM = 82
C
C **** TEST 82 ****
C
IF (ICZERO) 30820, 820, 30820
820 CONTINUE
IVCOMP = IVON03
GO TO 40820
30820 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 40820, 831, 40820
40820 IF (IVCOMP - 587) 20820, 10820, 20820
10820 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 831
20820 IVFAIL = IVFAIL + 1
IVCORR = 587
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
831 CONTINUE
IVTNUM = 83
C
C **** TEST 83 ****
C
IF (ICZERO) 30830, 830, 30830
830 CONTINUE
IVCOMP =IVON04
GO TO 40830
30830 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 40830, 841, 40830
40830 IF (IVCOMP - 9999) 20830, 10830, 20830
10830 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 841
20830 IVFAIL = IVFAIL + 1
IVCORR = 9999
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
841 CONTINUE
IVTNUM = 84
C
C **** TEST 84 ****
C
IF (ICZERO) 30840, 840, 30840
840 CONTINUE
IVCOMP = IVON05
GO TO 40840
30840 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 40840, 851, 40840
40840 IF (IVCOMP - 21111) 20840, 10840, 20840
10840 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 851
20840 IVFAIL = IVFAIL + 1
IVCORR = 21111
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
C
C TESTS 85 THROUGH 89 CHECK THE VALUES INITIALIZED BY THE DATA
C STATEMENT CONTAINING IVON06,...,IVON10.
C
851 CONTINUE
IVTNUM = 85
C
C **** TEST 85 ****
C
IF (ICZERO) 30850, 850, 30850
850 CONTINUE
IVCOMP=IVON06
GO TO 40850
30850 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 40850, 861, 40850
40850 IF (IVCOMP - 3) 20850, 10850, 20850
10850 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 861
20850 IVFAIL = IVFAIL + 1
IVCORR = 3
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
861 CONTINUE
IVTNUM = 86
C
C **** TEST 86 ****
C
IF (ICZERO) 30860, 860, 30860
860 CONTINUE
IVCOMP = IVON07
GO TO 40860
30860 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 40860, 871, 40860
40860 IF (IVCOMP - 76) 20860, 10860, 20860
10860 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 871
20860 IVFAIL = IVFAIL + 1
IVCORR = 76
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
871 CONTINUE
IVTNUM = 87
C
C **** TEST 87 ****
C
IF (ICZERO) 30870, 870, 30870
870 CONTINUE
IVCOMP = IVON08
GO TO 40870
30870 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 40870, 881, 40870
40870 IF (IVCOMP - 587) 20870, 10870, 20870
10870 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 881
20870 IVFAIL = IVFAIL + 1
IVCORR = 587
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
881 CONTINUE
IVTNUM = 88
C
C **** TEST 88 ****
C
IF (ICZERO) 30880, 880, 30880
880 CONTINUE
IVCOMP = IVON09
GO TO 40880
30880 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 40880, 891, 40880
40880 IF (IVCOMP - 9999) 20880, 10880, 20880
10880 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 891
20880 IVFAIL = IVFAIL + 1
IVCORR = 9999
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
891 CONTINUE
IVTNUM = 89
C
C **** TEST 89 ****
C
IF (ICZERO) 30890, 890, 30890
890 CONTINUE
IVCOMP = IVON10
GO TO 40890
30890 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 40890, 901, 40890
40890 IF (IVCOMP - 21111) 20890, 10890, 20890
10890 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 901
20890 IVFAIL = IVFAIL + 1
IVCORR= 21111
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
C
C TESTS 90 THROUGH 94 CHECK THE VALUES INITIALIZED BY THE DATA
C STATEMENT CONTAINING IVON11,...,IVON15.
C
901 CONTINUE
IVTNUM = 90
C
C **** TEST 90 ****
C
IF (ICZERO) 30900, 900, 30900
900 CONTINUE
IVCOMP = IVON11
GO TO 40900
30900 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 40900, 911, 40900
40900 IF (IVCOMP + 3) 20900, 10900, 20900
10900 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 911
20900 IVFAIL = IVFAIL + 1
IVCORR = -3
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
911 CONTINUE
IVTNUM = 91
C
C **** TEST 91 ****
C
IF (ICZERO) 30910, 910, 30910
910 CONTINUE
IVCOMP = IVON12
GO TO 40910
30910 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 40910, 921, 40910
40910 IF (IVCOMP + 76) 20910, 10910, 20910
10910 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 921
20910 IVFAIL = IVFAIL + 1
IVCORR = -76
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
921 CONTINUE
IVTNUM = 92
C
C **** TEST 92 ****
C
IF (ICZERO) 30920, 920, 30920
920 CONTINUE
IVCOMP= IVON13
GO TO 40920
30920 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 40920, 931, 40920
40920 IF (IVCOMP + 587) 20920, 10920, 20920
10920 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 931
20920 IVFAIL = IVFAIL + 1
IVCORR = -587
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
931 CONTINUE
IVTNUM = 93
C
C **** TEST 93 ****
C
IF (ICZERO) 30930, 930, 30930
930 CONTINUE
IVCOMP = IVON14
GO TO 40930
30930 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 40930, 941, 40930
40930 IF (IVCOMP + 9999) 20930, 10930, 20930
10930 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 941
20930 IVFAIL = IVFAIL + 1
IVCORR = -9999
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
941 CONTINUE
IVTNUM = 94
C
C **** TEST 94 ****
C
IF (ICZERO) 30940, 940, 30940
940 CONTINUE
IVCOMP = IVON15
GO TO 40940
30940 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 40940, 951, 40940
40940 IF (IVCOMP + 21111) 20940, 10940, 20940
10940 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 951
20940 IVFAIL = IVFAIL + 1
IVCORR = -21111
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
C
C TESTS 95 THROUGH 99 CHECK THE VALUES INITIALIZED BY THE DATA
C STATEMENT CONTAINING IVON16,...,IVON20.
C
951 CONTINUE
IVTNUM = 95
C
C **** TEST 95 ****
C
IF (ICZERO) 30950, 950, 30950
950 CONTINUE
IVCOMP =IVON16
GO TO 40950
30950 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 40950, 961, 40950
40950 IF (IVCOMP - 119) 20950, 10950, 20950
10950 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 961
20950 IVFAIL = IVFAIL + 1
IVCORR = 119
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
961 CONTINUE
IVTNUM = 96
C
C **** TEST 96 ****
C
IF (ICZERO) 30960, 960, 30960
960 CONTINUE
IVCOMP=IVON17
GO TO 40960
30960 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 40960, 971, 40960
40960 IF (IVCOMP - 119) 20960, 10960, 20960
10960 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 971
20960 IVFAIL = IVFAIL + 1
IVCORR = 119
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
971 CONTINUE
IVTNUM = 97
C
C **** TEST 97 ****
C
IF (ICZERO) 30970, 970, 30970
970 CONTINUE
IVCOMP = IVON18
GO TO 40970
30970 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 40970, 981, 40970
40970 IF (IVCOMP - 7) 20970, 10970, 20970
10970 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 981
20970 IVFAIL = IVFAIL + 1
IVCORR = 7
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
981 CONTINUE
IVTNUM = 98
C
C **** TEST 98 ****
C
IF (ICZERO) 30980, 980, 30980
980 CONTINUE
IVCOMP = IVON19
GO TO 40980
30980 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 40980, 991, 40980
40980 IF (IVCOMP - 7) 20980, 10980, 20980
10980 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 991
20980 IVFAIL = IVFAIL + 1
IVCORR = 7
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
991 CONTINUE
IVTNUM = 99
C
C **** TEST 99 ****
C
IF (ICZERO) 30990, 990, 30990
990 CONTINUE
IVCOMP = IVON20
GO TO 40990
30990 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 40990, 1001, 40990
40990 IF (IVCOMP + 427) 20990,10990,20990
10990 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 1001
20990 IVFAIL = IVFAIL + 1
IVCORR = -427
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
1001 CONTINUE
C
C WRITE PAGE FOOTINGS AND RUN SUMMARIES
99999 CONTINUE
WRITE (I02,90002)
WRITE (I02,90006)
WRITE (I02,90002)
WRITE (I02,90002)
WRITE (I02,90007)
WRITE (I02,90002)
WRITE (I02,90008) IVFAIL
WRITE (I02,90009) IVPASS
WRITE (I02,90010) IVDELE
C
C
C TERMINATE ROUTINE EXECUTION
STOP
C
C FORMAT STATEMENTS FOR PAGE HEADERS
90000 FORMAT (1H1)
90002 FORMAT (1H )
90001 FORMAT (1H ,10X,34HFORTRAN COMPILER VALIDATION SYSTEM)
90003 FORMAT (1H ,21X,11HVERSION 1.0)
90004 FORMAT (1H ,10X,38HFOR OFFICIAL USE ONLY - COPYRIGHT 1978)
90005 FORMAT (1H ,5X,4HTEST,5X,9HPASS/FAIL, 5X,8HCOMPUTED,8X,7HCORRECT)
90006 FORMAT (1H ,5X,46H----------------------------------------------)
90011 FORMAT (1H ,18X,17HSUBSET LEVEL TEST)
C
C FORMAT STATEMENTS FOR RUN SUMMARIES
90008 FORMAT (1H ,15X,I5,19H ERRORS ENCOUNTERED)
90009 FORMAT (1H ,15X,I5,13H TESTS PASSED)
90010 FORMAT (1H ,15X,I5,14H TESTS DELETED)
C
C FORMAT STATEMENTS FOR TEST RESULTS
80001 FORMAT (1H ,4X,I5,7X,4HPASS)
80002 FORMAT (1H ,4X,I5,7X,4HFAIL)
80003 FORMAT (1H ,4X,I5,7X,7HDELETED)
80004 FORMAT (1H ,4X,I5,7X,4HFAIL,10X,I6,9X,I6)
80005 FORMAT (1H ,4X,I5,7X,4HFAIL,4X,E12.5,3X,E12.5)
C
90007 FORMAT (1H ,20X,20HEND OF PROGRAM FM007)
END
*END-OF,FM007
FM008.f 480975955 170 2 100666 22726 `
*HEADER,FORTR,FM008
*FILES1,FORTR,FM008,X
C COMMENT SECTION.
C
C FM008
C
C THIS ROUTINE TESTS ARITHMETIC ASSIGNMENT STATEMENTS OF THE
C FORM INTEGER VARIABLE = ARITHMETIC EXPRESSION
C WHERE THE ARITHMETIC EXPRESSION IS FORMED WITH THE ARITHMETIC
C OPERATOR + INTEGER CONSTANTS AND POSITIVE INTEGER VARIABLES.
C SOME OF THE TESTS USE PARENTHESES TO GROUP ELEMENTS IN THE
C ARITHMETIC EXPRESSION.
C
C THERE ARE TESTS WHERE THE ARITHMETIC EXPRESSION CONTAINS
C (1) TWO INTEGER CONSTANTS,
C (2) THREE INTEGER CONSTANTS,
C (3) THREE INTEGER CONSTANTS WITH PARENTHESES TO GROUP
C ELEMENTS,
C (4) ONE INTEGER VARIABLE AND ONE INTEGER CONSTANT,
C (5) ONE INTEGER VARIABLE AND TWO INTEGER CONSTANTS,
C (6) ONE INTEGER VARIABLE AND TWO INTEGER CONSTANTS WITH
C PARENTHESES TO GROUP ELEMENTS.
C
C
C REFERENCES
C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN,
C X3.9-1978
C
C SECTION 4.3, INTEGER TYPE
C SECTION 4.3.1, INTEGER CONSTANT
C SECTION 6.1, ARITHMETIC EXPRESSIONS
C SECTION 10.1, ARITHMETIC ASSIGNMENT STATEMENTS
C
C
C **********************************************************
C
C A COMPILER VALIDATION SYSTEM FOR THE FORTRAN LANGUAGE
C BASED ON SPECIFICATIONS AS DEFINED IN AMERICAN NATIONAL STANDARD
C PROGRAMMING LANGUAGE FORTRAN X3.9-1978, HAS BEEN DEVELOPED BY THE
C FEDERAL COBOL COMPILER TESTING SERVICE. THE FORTRAN COMPILER
C VALIDATION SYSTEM (FCVS) CONSISTS OF AUDIT ROUTINES, THEIR RELATED
C DATA, AND AN EXECUTIVE SYSTEM. EACH AUDIT ROUTINE IS A FORTRAN
C PROGRAM, SUBPROGRAM OR FUNCTION WHICH INCLUDES TESTS OF SPECIFIC
C LANGUAGE ELEMENTS AND SUPPORTING PROCEDURES INDICATING THE RESULT
C OF EXECUTING THESE TESTS.
C
C THIS PARTICULAR PROGRAM/SUBPROGRAM/FUNCTION CONTAINS FEATURES
C FOUND ONLY IN THE SUBSET AS DEFINED IN X3.9-1978.
C
C SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO -
C
C DEPARTMENT OF THE NAVY
C FEDERAL COBOL COMPILER TESTING SERVICE
C WASHINGTON, D.C. 20376
C
C **********************************************************
C
C
C
C INITIALIZATION SECTION
C
C INITIALIZE CONSTANTS
C **************
C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER.
I01 = 5
C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER.
I02 = 6
C SYSTEM ENVIRONMENT SECTION
C
CX010 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-010 CONTROL CARD.
C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5
C (UNIT NUMBER FOR CARD READER).
CX011 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-011 CONTROL CARD.
C THE CX011 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL
C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX010 ABOVE.
C
CX020 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-020 CONTROL CARD.
C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02 = 6
C (UNIT NUMBER FOR PRINTER).
CX021 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-021 CONTROL CARD.
C THE CX021 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL
C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX020 ABOVE.
C
IVPASS=0
IVFAIL=0
IVDELE=0
ICZERO=0
C
C WRITE PAGE HEADERS
WRITE (I02,90000)
WRITE (I02,90001)
WRITE (I02,90002)
WRITE (I02, 90002)
WRITE (I02,90003)
WRITE (I02,90002)
WRITE (I02,90004)
WRITE (I02,90002)
WRITE (I02,90011)
WRITE (I02,90002)
WRITE (I02,90002)
WRITE (I02,90005)
WRITE (I02,90006)
WRITE (I02,90002)
C TEST SECTION
C
C ARITHMETIC ASSIGNMENT STATEMENT
C
C TEST 200 THROUGH TEST 214 CONTAIN INTEGER CONSTANTS AND OPERATOR +
C IN ARITHMETIC EXPRESSION.
C
C TEST 200 THROUGH TEST 206 - TWO INTEGER CONSTANTS
C
2001 CONTINUE
IVTNUM = 200
C
C **** TEST 200 ****
C
IF (ICZERO) 32000, 2000, 32000
2000 CONTINUE
IVCOMP = 2+3
GO TO 42000
32000 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 42000, 2011, 42000
42000 IF (IVCOMP - 5) 22000,12000,22000
12000 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 2011
22000 IVFAIL = IVFAIL + 1
IVCORR = 5
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
2011 CONTINUE
IVTNUM = 201
C
C **** TEST 201 ****
C
IF (ICZERO) 32010, 2010, 32010
2010 CONTINUE
IVCOMP = 51 + 52
GO TO 42010
32010 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 42010, 2021, 42010
42010 IF (IVCOMP - 103) 22010,12010,22010
12010 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 2021
22010 IVFAIL = IVFAIL + 1
IVCORR = 103
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
2021 CONTINUE
IVTNUM = 202
C
C **** TEST 202 ****
C
IF (ICZERO) 32020, 2020, 32020
2020 CONTINUE
IVCOMP = 189 + 676
GO TO 42020
32020 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 42020, 2031, 42020
42020 IF (IVCOMP - 865) 22020,12020,22020
12020 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 2031
22020 IVFAIL = IVFAIL + 1
IVCORR = 865
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
2031 CONTINUE
IVTNUM = 203
C
C **** TEST 203 ****
C
IF (ICZERO) 32030, 2030, 32030
2030 CONTINUE
IVCOMP = 1358 + 8001
GO TO 42030
32030 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 42030, 2041, 42030
42030 IF (IVCOMP - 9359) 22030, 12030, 22030
12030 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 2041
22030 IVFAIL = IVFAIL + 1
IVCORR = 9359
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
2041 CONTINUE
IVTNUM = 204
C
C **** TEST 204 ****
C
IF (ICZERO) 32040, 2040, 32040
2040 CONTINUE
IVCOMP = 11112 + 10001
GO TO 42040
32040 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 42040, 2051, 42040
42040 IF (IVCOMP - 21113) 22040, 12040, 22040
12040 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 2051
22040 IVFAIL = IVFAIL + 1
IVCORR=21113
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
2051 CONTINUE
IVTNUM = 205
C
C **** TEST 205 ****
C
IF (ICZERO) 32050, 2050, 32050
2050 CONTINUE
IVCOMP = 189 + 9876
GO TO 42050
32050 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 42050, 2061, 42050
42050 IF (IVCOMP - 10065) 22050,12050,22050
12050 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 2061
22050 IVFAIL = IVFAIL + 1
IVCORR = 10065
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
2061 CONTINUE
IVTNUM = 206
C
C **** TEST 206 ****
C REQUIRES 32767
C
IF (ICZERO) 32060, 2060, 32060
2060 CONTINUE
IVCOMP = 32752 + 15
GO TO 42060
32060 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 42060, 2071, 42060
42060 IF (IVCOMP - 32767) 22060,12060,22060
12060 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 2071
22060 IVFAIL = IVFAIL + 1
IVCORR = 32767
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
C
C TEST 207 THROUGH TEST 210 - THREE INTEGER CONSTANTS
C
2071 CONTINUE
IVTNUM = 207
C
C **** TEST 207 ****
C
IF (ICZERO) 32070, 2070, 32070
2070 CONTINUE
IVCOMP = 2+3+4
GO TO 42070
32070 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 42070, 2081, 42070
42070 IF (IVCOMP - 9) 22070,12070,22070
12070 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 2081
22070 IVFAIL = IVFAIL + 1
IVCORR = 9
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
2081 CONTINUE
IVTNUM = 208
C
C **** TEST 208 ****
C
IF (ICZERO) 32080, 2080, 32080
2080 CONTINUE
IVCOMP = 51 + 52 + 53
GO TO 42080
32080 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 42080, 2091, 42080
42080 IF (IVCOMP - 156) 22080,12080,22080
12080 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 2091
22080 IVFAIL = IVFAIL + 1
IVCORR = 156
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
2091 CONTINUE
IVTNUM = 209
C
C **** TEST 209 ****
C
IF (ICZERO) 32090, 2090, 32090
2090 CONTINUE
IVCOMP = 189 +676+101
GO TO 42090
32090 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 42090, 2101, 42090
42090 IF (IVCOMP - 966) 22090,12090,22090
12090 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 2101
22090 IVFAIL = IVFAIL + 1
IVCORR = 966
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
2101 CONTINUE
IVTNUM = 210
C
C **** TEST 210 ****
C
IF (ICZERO) 32100, 2100, 32100
2100 CONTINUE
IVCOMP = 1358 + 8001 + 2189
GO TO 42100
32100 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 42100, 2111, 42100
42100 IF (IVCOMP - 11548) 22100,12100,22100
12100 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 2111
22100 IVFAIL = IVFAIL + 1
IVCORR = 11548
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
C
C TESTS 211 THROUGH 214 ARE THE SAME AS 207 THROUGH 210 EXCEPT
C PARENTHESES ARE USED TO GROUP THE CONSTANTS.
C
2111 CONTINUE
IVTNUM = 211
C
C **** TEST 211 ****
C
IF (ICZERO) 32110, 2110, 32110
2110 CONTINUE
IVCOMP = (2+3)+4
GO TO 42110
32110 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 42110, 2121, 42110
42110 IF (IVCOMP -9) 22110,12110,22110
12110 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 2121
22110 IVFAIL = IVFAIL + 1
IVCORR = 9
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
2121 CONTINUE
IVTNUM = 212
C
C **** TEST 212 ****
C
IF (ICZERO) 32120, 2120, 32120
2120 CONTINUE
IVCOMP = 51+(52+53)
GO TO 42120
32120 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 42120, 2131, 42120
42120 IF (IVCOMP - 156) 22120,12120,22120
12120 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 2131
22120 IVFAIL = IVFAIL + 1
IVCORR = 156
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
2131 CONTINUE
IVTNUM = 213
C
C **** TEST 213 ****
C
IF (ICZERO) 32130, 2130, 32130
2130 CONTINUE
IVCOMP = 189 +(676+101)
GO TO 42130
32130 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 42130, 2141, 42130
42130 IF (IVCOMP - 966) 22130,12130,22130
12130 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 2141
22130 IVFAIL = IVFAIL + 1
IVCORR = 966
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
2141 CONTINUE
IVTNUM = 214
C
C **** TEST 214 ****
C
IF (ICZERO) 32140, 2140, 32140
2140 CONTINUE
IVCOMP = (1358+2189) + 8001
GO TO 42140
32140 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 42140, 2151, 42140
42140 IF (IVCOMP - 11548) 22140,12140,22140
12140 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 2151
22140 IVFAIL = IVFAIL + 1
IVCORR = 11548
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
C
C TEST 215 THROUGH TEST 234 CONTAIN INTEGER VARIABLES, INTEGER
C CONSTANTS AND THE OPERATOR + IN ARITHMETIC EXPRESSION.
C
C TEST 215 THROUGH TEST 219 - ONE INTEGER VARIABLE AND ONE INTEGER
C CONSTANT IN ARITHMETIC EXPRESSION.
C
2151 CONTINUE
IVTNUM = 215
C
C **** TEST 215 ****
C
IF (ICZERO) 32150, 2150, 32150
2150 CONTINUE
IVON01 = 2
IVCOMP = IVON01 + 3
GO TO 42150
32150 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 42150, 2161, 42150
42150 IF (IVCOMP - 5) 22150,12150,22150
12150 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 2161
22150 IVFAIL = IVFAIL + 1
IVCORR=5
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
2161 CONTINUE
IVTNUM = 216
C
C **** TEST 216 ****
C
IF (ICZERO) 32160, 2160, 32160
2160 CONTINUE
IVON01 = 3
IVCOMP = 2 + IVON01
GO TO 42160
32160 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 42160, 2171, 42160
42160 IF (IVCOMP - 5) 22160,12160,22160
12160 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 2171
22160 IVFAIL = IVFAIL + 1
IVCORR = 5
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
2171 CONTINUE
IVTNUM = 217
C
C **** TEST 217 ****
C
IF (ICZERO) 32170, 2170, 32170
2170 CONTINUE
IVON01 = 51
IVCOMP = IVON01 +52
GO TO 42170
32170 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 42170, 2181, 42170
42170 IF (IVCOMP - 103) 22170,12170,22170
12170 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 2181
22170 IVFAIL = IVFAIL + 1
IVCORR = 103
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
2181 CONTINUE
IVTNUM = 218
C
C **** TEST 218 ****
C
IF (ICZERO) 32180, 2180, 32180
2180 CONTINUE
IVON01 = 676
IVCOMP = 189 + IVON01
GO TO 42180
32180 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 42180, 2191, 42180
42180 IF (IVCOMP - 865) 22180,12180,22180
12180 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 2191
22180 IVFAIL = IVFAIL + 1
IVCORR = 865
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
2191 CONTINUE
IVTNUM = 219
C
C **** TEST 219 ****
C
IF (ICZERO) 32190, 2190, 32190
2190 CONTINUE
IVON01 = 1358
IVCOMP = IVON01 + 8001
GO TO 42190
32190 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 42190, 2201, 42190
42190 IF (IVCOMP - 9359) 22190,12190,22190
12190 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 2201
22190 IVFAIL = IVFAIL + 1
IVCORR = 9359
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
C
C TEST 220 THROUGH TEST 224 - ONE INTEGER VARIABLE, TWO INTEGER
C CONSTANTS IN ARITHMETIC EXPRESSION.
C
2201 CONTINUE
IVTNUM = 220
C
C **** TEST 220 ****
C
IF (ICZERO) 32200, 2200, 32200
2200 CONTINUE
IVON01 = 2
IVCOMP = IVON01 +3 +4
GO TO 42200
32200 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 42200, 2211, 42200
42200 IF (IVCOMP - 9) 22200,12200,22200
12200 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 2211
22200 IVFAIL = IVFAIL + 1
IVCORR = 9
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
2211 CONTINUE
IVTNUM = 221
C
C **** TEST 221 ****
C
IF (ICZERO) 32210, 2210, 32210
2210 CONTINUE
IVON01 = 3
IVCOMP = 2+IVON01+4
GO TO 42210
32210 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 42210, 2221, 42210
42210 IF (IVCOMP - 9) 22210,12210,22210
12210 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 2221
22210 IVFAIL = IVFAIL + 1
IVCORR = 9
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
2221 CONTINUE
IVTNUM = 222
C
C **** TEST 222 ****
C
IF (ICZERO) 32220, 2220, 32220
2220 CONTINUE
IVON01 = 4
IVCOMP= 2+3+IVON01
GO TO 42220
32220 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 42220, 2231, 42220
42220 IF (IVCOMP - 9) 22220,12220,22220
12220 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 2231
22220 IVFAIL = IVFAIL + 1
IVCORR = 9
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
2231 CONTINUE
IVTNUM = 223
C
C **** TEST 223 ****
C
IF (ICZERO) 32230, 2230, 32230
2230 CONTINUE
IVON01 = 2189
IVCOMP = 1358+IVON01+8001
GO TO 42230
32230 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 42230, 2241, 42230
42230 IF (IVCOMP - 11548) 22230,12230,22230
12230 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 2241
22230 IVFAIL = IVFAIL + 1
IVCORR=11548
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
2241 CONTINUE
IVTNUM = 224
C
C **** TEST 224 ****
C
IF (ICZERO) 32240, 2240, 32240
2240 CONTINUE
IVON01 = 11111
IVCOMP = 11111 + IVON01 + 10111
GO TO 42240
32240 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 42240, 2251, 42240
42240 IF (IVCOMP - 32333) 22240,12240,22240
12240 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 2251
22240 IVFAIL = IVFAIL + 1
IVCORR = 32333
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
C
C TEST 225 THROUGH TEST 234 USE PARENTHESES TO GROUP ELEMENTS IN
C AN ARITHMETIC EXPRESSION. THE RESULTS ARE THE SAME AS TESTS
C 220 THROUGH 224.
C
2251 CONTINUE
IVTNUM = 225
C
C **** TEST 225 ****
C
IF (ICZERO) 32250, 2250, 32250
2250 CONTINUE
IVON01 = 2
IVCOMP = (IVON01 +3) + 4
GO TO 42250
32250 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 42250, 2261, 42250
42250 IF (IVCOMP -9) 22250,12250,22250
12250 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 2261
22250 IVFAIL = IVFAIL + 1
IVCORR = 9
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
2261 CONTINUE
IVTNUM = 226
C
C **** TEST 226 ****
C
IF (ICZERO) 32260, 2260, 32260
2260 CONTINUE
IVON01 = 2
IVCOMP = IVON01 + (3+4)
GO TO 42260
32260 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 42260, 2271, 42260
42260 IF (IVCOMP - 9) 22260,12260,22260
12260 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 2271
22260 IVFAIL = IVFAIL + 1
IVCORR = 9
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
2271 CONTINUE
IVTNUM = 227
C
C **** TEST 227 ****
C
IF (ICZERO) 32270, 2270, 32270
2270 CONTINUE
IVON01 = 3
IVCOMP = (2+IVON01) + 4
GO TO 42270
32270 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 42270, 2281, 42270
42270 IF (IVCOMP - 9) 22270,12270,22270
12270 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 2281
22270 IVFAIL = IVFAIL + 1
IVCORR = 9
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
2281 CONTINUE
IVTNUM = 228
C
C **** TEST 228 ****
C
IF (ICZERO) 32280, 2280, 32280
2280 CONTINUE
IVON01 = 3
IVCOMP = 2 +(IVON01+4)
GO TO 42280
32280 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 42280, 2291, 42280
42280 IF (IVCOMP - 9) 22280, 12280, 22280
12280 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 2291
22280 IVFAIL = IVFAIL + 1
IVCORR = 9
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
2291 CONTINUE
IVTNUM = 229
C
C **** TEST 229 ****
C
IF (ICZERO) 32290, 2290, 32290
2290 CONTINUE
IVON01 = 4
IVCOMP = (2+3)+IVON01
GO TO 42290
32290 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 42290, 2301, 42290
42290 IF (IVCOMP - 9) 22290,12290,22290
12290 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 2301
22290 IVFAIL = IVFAIL + 1
IVCORR = 9
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
2301 CONTINUE
IVTNUM = 230
C
C **** TEST 230 ****
C
IF (ICZERO) 32300, 2300, 32300
2300 CONTINUE
IVON01 = 2189
IVCOMP = 1358 + (IVON01+8001)
GO TO 42300
32300 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 42300, 2311, 42300
42300 IF (IVCOMP - 11548) 22300,12300,22300
12300 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 2311
22300 IVFAIL = IVFAIL + 1
IVCORR = 11548
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
2311 CONTINUE
IVTNUM = 231
C
C **** TEST 231 ****
C
IF (ICZERO) 32310, 2310, 32310
2310 CONTINUE
IVON01 = 2189
IVCOMP = (1358+IVON01) + 8001
GO TO 42310
32310 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 42310, 2321, 42310
42310 IF (IVCOMP - 11548) 22310,12310,22310
12310 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 2321
22310 IVFAIL = IVFAIL + 1
IVCORR = 11548
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
2321 CONTINUE
IVTNUM = 232
C
C **** TEST 232 ****
C
IF (ICZERO) 32320, 2320, 32320
2320 CONTINUE
IVON01 = 11111
IVCOMP = (11111 + IVON01) + 10111
GO TO 42320
32320 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 42320, 2331, 42320
42320 IF (IVCOMP - 32333) 22320,12320,22320
12320 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 2331
22320 IVFAIL = IVFAIL + 1
IVCORR = 32333
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
2331 CONTINUE
IVTNUM = 233
C
C **** TEST 233 ****
C
IF (ICZERO) 32330, 2330, 32330
2330 CONTINUE
IVON01 = 11111
IVCOMP = (IVON01 + 10111) + 11111
GO TO 42330
32330 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 42330, 2341, 42330
42330 IF (IVCOMP - 32333) 22330,12330,22330
12330 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 2341
22330 IVFAIL = IVFAIL + 1
IVCORR = 32333
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
2341 CONTINUE
IVTNUM = 234
C
C **** TEST 234 ****
C
IF (ICZERO) 32340, 2340, 32340
2340 CONTINUE
IVON01 = 10111
IVCOMP = 11111 + (11111+IVON01)
GO TO 42340
32340 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 42340, 2351, 42340
42340 IF (IVCOMP - 32333) 22340,12340,22340
12340 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 2351
22340 IVFAIL = IVFAIL + 1
IVCORR = 32333
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
2351 CONTINUE
C
C WRITE PAGE FOOTINGS AND RUN SUMMARIES
99999 CONTINUE
WRITE (I02,90002)
WRITE (I02,90006)
WRITE (I02,90002)
WRITE (I02,90002)
WRITE (I02,90007)
WRITE (I02,90002)
WRITE (I02,90008) IVFAIL
WRITE (I02,90009) IVPASS
WRITE (I02,90010) IVDELE
C
C
C TERMINATE ROUTINE EXECUTION
STOP
C
C FORMAT STATEMENTS FOR PAGE HEADERS
90000 FORMAT (1H1)
90002 FORMAT (1H )
90001 FORMAT (1H ,10X,34HFORTRAN COMPILER VALIDATION SYSTEM)
90003 FORMAT (1H ,21X,11HVERSION 1.0)
90004 FORMAT (1H ,10X,38HFOR OFFICIAL USE ONLY - COPYRIGHT 1978)
90005 FORMAT (1H ,5X,4HTEST,5X,9HPASS/FAIL, 5X,8HCOMPUTED,8X,7HCORRECT)
90006 FORMAT (1H ,5X,46H----------------------------------------------)
90011 FORMAT (1H ,18X,17HSUBSET LEVEL TEST)
C
C FORMAT STATEMENTS FOR RUN SUMMARIES
90008 FORMAT (1H ,15X,I5,19H ERRORS ENCOUNTERED)
90009 FORMAT (1H ,15X,I5,13H TESTS PASSED)
90010 FORMAT (1H ,15X,I5,14H TESTS DELETED)
C
C FORMAT STATEMENTS FOR TEST RESULTS
80001 FORMAT (1H ,4X,I5,7X,4HPASS)
80002 FORMAT (1H ,4X,I5,7X,4HFAIL)
80003 FORMAT (1H ,4X,I5,7X,7HDELETED)
80004 FORMAT (1H ,4X,I5,7X,4HFAIL,10X,I6,9X,I6)
80005 FORMAT (1H ,4X,I5,7X,4HFAIL,4X,E12.5,3X,E12.5)
C
90007 FORMAT (1H ,20X,20HEND OF PROGRAM FM008)
END
*END-OF,FM008
FM009.f 480975960 170 2 100666 20791 `
*HEADER,FORTR,FM009
*FILES1,FORTR,FM009,X
C COMMENT SECTION.
C
C FM009
C
C THIS ROUTINE TESTS ARITHMETIC ASSIGNMENT STATEMENTS OF THE
C FORM
C INTEGER VARIABLE = ARITHMETIC EXPRESSION
C WHERE THE ARITHMETIC EXPRESSION IS FORMED WITH THE ARITHMETIC
C OPERATOR +, INTEGER CONSTANTS AND POSITIVE INTEGER VARIABLES.
C SOME OF THE TESTS USE PARENTHESES TO GROUP ELEMENTS IN THE
C ARITHMETIC EXPRESSION.
C
C THERE ARE TESTS WHERE THE ARITHMETIC EXPRESSION CONTAINS
C (1) TWO INTEGER VARIABLES,
C (2) TWO INTEGER VARIABLES AND ONE INTEGER CONSTANT,
C (3) TWO INTEGER VARIABLES AND ONE INTEGER CONSTANT WITH
C PARENTHESES TO GROUP ELEMENTS.
C
C REFERENCES
C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN,
C X3.9-1978
C
C SECTION 4.3, INTEGER TYPE
C SECTION 4.3.1, INTEGER CONSTANT
C SECTION 6.1, ARITHMETIC EXPRESSIONS
C SECTION 10.1, ARITHMETIC ASSIGNMENT STATEMENTS
C
C **********************************************************
C
C A COMPILER VALIDATION SYSTEM FOR THE FORTRAN LANGUAGE
C BASED ON SPECIFICATIONS AS DEFINED IN AMERICAN NATIONAL STANDARD
C PROGRAMMING LANGUAGE FORTRAN X3.9-1978, HAS BEEN DEVELOPED BY THE
C FEDERAL COBOL COMPILER TESTING SERVICE. THE FORTRAN COMPILER
C VALIDATION SYSTEM (FCVS) CONSISTS OF AUDIT ROUTINES, THEIR RELATED
C DATA, AND AN EXECUTIVE SYSTEM. EACH AUDIT ROUTINE IS A FORTRAN
C PROGRAM, SUBPROGRAM OR FUNCTION WHICH INCLUDES TESTS OF SPECIFIC
C LANGUAGE ELEMENTS AND SUPPORTING PROCEDURES INDICATING THE RESULT
C OF EXECUTING THESE TESTS.
C
C THIS PARTICULAR PROGRAM/SUBPROGRAM/FUNCTION CONTAINS FEATURES
C FOUND ONLY IN THE SUBSET AS DEFINED IN X3.9-1978.
C
C SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO -
C
C DEPARTMENT OF THE NAVY
C FEDERAL COBOL COMPILER TESTING SERVICE
C WASHINGTON, D.C. 20376
C
C **********************************************************
C
C
C
C INITIALIZATION SECTION
C
C INITIALIZE CONSTANTS
C **************
C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER.
I01 = 5
C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER.
I02 = 6
C SYSTEM ENVIRONMENT SECTION
C
CX010 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-010 CONTROL CARD.
C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5
C (UNIT NUMBER FOR CARD READER).
CX011 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-011 CONTROL CARD.
C THE CX011 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL
C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX010 ABOVE.
C
CX020 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-020 CONTROL CARD.
C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02 = 6
C (UNIT NUMBER FOR PRINTER).
CX021 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-021 CONTROL CARD.
C THE CX021 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL
C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX020 ABOVE.
C
IVPASS=0
IVFAIL=0
IVDELE=0
ICZERO=0
C
C WRITE PAGE HEADERS
WRITE (I02,90000)
WRITE (I02,90001)
WRITE (I02,90002)
WRITE (I02, 90002)
WRITE (I02,90003)
WRITE (I02,90002)
WRITE (I02,90004)
WRITE (I02,90002)
WRITE (I02,90011)
WRITE (I02,90002)
WRITE (I02,90002)
WRITE (I02,90005)
WRITE (I02,90006)
WRITE (I02,90002)
C
C TEST SECTION
C
C ARITHMETIC ASSIGNMENT STATEMENT
C
C TEST 235 THROUGH TEST 243 CONTAIN TWO POSITIVE INTEGER VARIABLES
C AND OPERATOR + IN ARITHMETIC EXPRESSION.
C
2351 CONTINUE
IVTNUM = 235
C
C **** TEST 235 ****
C
IF (ICZERO) 32350, 2350, 32350
2350 CONTINUE
IVON01 = 2
IVON02 = 3
IVCOMP = IVON01 + IVON02
GO TO 42350
32350 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 42350, 2361, 42350
42350 IF (IVCOMP - 5) 22350,12350,22350
12350 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 2361
22350 IVFAIL = IVFAIL + 1
IVCORR = 5
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
2361 CONTINUE
IVTNUM = 236
C
C **** TEST 236 ****
C
IF (ICZERO) 32360, 2360, 32360
2360 CONTINUE
IVON01 = 2
IVON02 = 3
IVCOMP = IVON02 + IVON01
GO TO 42360
32360 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 42360, 2371, 42360
42360 IF (IVCOMP - 5) 22360, 12360, 22360
12360 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 2371
22360 IVFAIL = IVFAIL + 1
IVCORR = 5
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
2371 CONTINUE
IVTNUM = 237
C
C **** TEST 237 ****
C
IF (ICZERO) 32370, 2370, 32370
2370 CONTINUE
IVON01 = 51
IVON02 = 52
IVCOMP = IVON01 + IVON02
GO TO 42370
32370 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 42370, 2381, 42370
42370 IF (IVCOMP - 103) 22370, 12370, 22370
12370 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 2381
22370 IVFAIL = IVFAIL + 1
IVCORR = 103
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
2381 CONTINUE
IVTNUM = 238
C
C **** TEST 238 ****
C
IF (ICZERO) 32380, 2380, 32380
2380 CONTINUE
IVON01 = 189
IVON02 = 676
IVCOMP = IVON01 + IVON02
GO TO 42380
32380 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 42380, 2391, 42380
42380 IF (IVCOMP - 865) 22380, 12380, 22380
12380 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 2391
22380 IVFAIL = IVFAIL + 1
IVCORR = 865
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
2391 CONTINUE
IVTNUM = 239
C
C **** TEST 239 ****
C
IF (ICZERO) 32390, 2390, 32390
2390 CONTINUE
IVON01 = 1358
IVON02 = 8001
IVCOMP = IVON01 + IVON02
GO TO 42390
32390 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 42390, 2401, 42390
42390 IF (IVCOMP - 9359) 22390, 12390, 22390
12390 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 2401
22390 IVFAIL = IVFAIL + 1
IVCORR = 9359
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
2401 CONTINUE
IVTNUM = 240
C
C **** TEST 240 ****
C
IF (ICZERO) 32400, 2400, 32400
2400 CONTINUE
IVON01 = 1358
IVON02 = 8001
IVCOMP = IVON02 + IVON01
GO TO 42400
32400 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 42400, 2411, 42400
42400 IF (IVCOMP - 9359) 22400, 12400, 22400
12400 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 2411
22400 IVFAIL = IVFAIL + 1
IVCORR = 9359
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
2411 CONTINUE
IVTNUM = 241
C
C **** TEST 241 ****
C
IF (ICZERO) 32410, 2410, 32410
2410 CONTINUE
IVON01 = 11112
IVON02 = 10001
IVCOMP = IVON01 + IVON02
GO TO 42410
32410 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 42410, 2421, 42410
42410 IF (IVCOMP - 21113) 22410, 12410, 22410
12410 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 2421
22410 IVFAIL = IVFAIL + 1
IVCORR = 21113
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
2421 CONTINUE
IVTNUM = 242
C
C **** TEST 242 ****
C
IF (ICZERO) 32420, 2420, 32420
2420 CONTINUE
IVON01 = 189
IVON02 = 9876
IVCOMP = IVON01 + IVON02
GO TO 42420
32420 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 42420, 2431, 42420
42420 IF (IVCOMP - 10065) 22420, 12420, 22420
12420 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 2431
22420 IVFAIL = IVFAIL + 1
IVCORR = 10065
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
2431 CONTINUE
IVTNUM = 243
C
C **** TEST 243 ****
C REQUIRES 32767
C
IF (ICZERO) 32430, 2430, 32430
2430 CONTINUE
IVON01 = 16383
IVON02 = 16384
IVCOMP = IVON01 + IVON02
GO TO 42430
32430 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 42430, 2441, 42430
42430 IF (IVCOMP - 32767) 22430, 12430, 22430
12430 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 2441
22430 IVFAIL = IVFAIL + 1
IVCORR = 32767
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
C
C TEST 244 THROUGH TEST 250 CONTAIN TWO POSITIVE INTEGER VARIABLES,
C ONE INTEGER CONSTANT, AND OPERATOR + IN ARITHMETIC EXPRESSION.
C
2441 CONTINUE
IVTNUM = 244
C
C **** TEST 244 ****
C
IF (ICZERO) 32440, 2440, 32440
2440 CONTINUE
IVON01 = 2
IVON02 = 3
IVCOMP = IVON01 + IVON02 + 4
GO TO 42440
32440 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 42440, 2451, 42440
42440 IF (IVCOMP - 9) 22440, 12440, 22440
12440 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 2451
22440 IVFAIL = IVFAIL + 1
IVCORR = 9
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
2451 CONTINUE
IVTNUM = 245
C
C **** TEST 245 ****
C
IF (ICZERO) 32450, 2450, 32450
2450 CONTINUE
IVON01 = 2
IVON03 = 4
IVCOMP = IVON01 +3 + IVON03
GO TO 42450
32450 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 42450, 2461, 42450
42450 IF (IVCOMP - 9) 22450, 12450, 22450
12450 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 2461
22450 IVFAIL = IVFAIL + 1
IVCORR = 9
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
2461 CONTINUE
IVTNUM = 246
C
C **** TEST 246 ****
C
IF (ICZERO) 32460, 2460, 32460
2460 CONTINUE
IVON02 = 3
IVON03 = 4
IVCOMP = 2 + IVON02 + IVON03
GO TO 42460
32460 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 42460, 2471, 42460
42460 IF (IVCOMP - 9) 22460, 12460, 22460
12460 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 2471
22460 IVFAIL = IVFAIL + 1
IVCORR = 9
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
2471 CONTINUE
IVTNUM = 247
C
C **** TEST 247 ****
C
IF (ICZERO) 32470, 2470, 32470
2470 CONTINUE
IVON01 = 51
IVON03 = 53
IVCOMP = IVON01 +52 + IVON03
GO TO 42470
32470 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 42470, 2481, 42470
42470 IF (IVCOMP - 156) 22470, 12470, 22470
12470 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 2481
22470 IVFAIL = IVFAIL + 1
IVCORR = 156
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
2481 CONTINUE
IVTNUM = 248
C
C **** TEST 248 ****
C
IF (ICZERO) 32480, 2480, 32480
2480 CONTINUE
IVON02 = 676
IVON03 = 101
IVCOMP = 189 + IVON02 + IVON03
GO TO 42480
32480 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 42480, 2491, 42480
42480 IF (IVCOMP - 966) 22480, 12480, 22480
12480 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 2491
22480 IVFAIL = IVFAIL + 1
IVCORR = 966
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
2491 CONTINUE
IVTNUM = 249
C
C **** TEST 249 ****
C
IF (ICZERO) 32490, 2490, 32490
2490 CONTINUE
IVON01 = 1358
IVON02 = 8001
IVCOMP = IVON01 + IVON02 + 2189
GO TO 42490
32490 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 42490, 2501, 42490
42490 IF (IVCOMP - 11548) 22490, 12490, 22490
12490 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 2501
22490 IVFAIL = IVFAIL + 1
IVCORR = 11548
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
2501 CONTINUE
IVTNUM = 250
C
C **** TEST 250 ****
C REQUIRES 32767
C
IF (ICZERO) 32500, 2500, 32500
2500 CONTINUE
IVON01 = 16383
IVON03 = 4
IVCOMP = IVON01 + 16380 + IVON03
GO TO 42500
32500 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 42500, 2511, 42500
42500 IF (IVCOMP - 32767) 22500,12500,22500
12500 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 2511
22500 IVFAIL = IVFAIL + 1
IVCORR = 32767
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
C
C TEST 251 THROUGH TEST 264 CONTAIN TWO POSITIVE INTEGER VARIABLES,
C ONE INTEGER CONSTANT, AND OPERATOR + IN ARITHMETIC EXPRESSION.
C PARENTHESES ARE USED TO GROUP ELEMENTS. THE RESULTS ARE THE SAME
C AS TESTS 244 THROUGH 250.
C
2511 CONTINUE
IVTNUM = 251
C
C **** TEST 251 ****
C
IF (ICZERO) 32510, 2510, 32510
2510 CONTINUE
IVON01 = 2
IVON02 = 3
IVCOMP = (IVON01 + IVON02) + 4
GO TO 42510
32510 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 42510, 2521, 42510
42510 IF (IVCOMP - 9) 22510,12510,22510
12510 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 2521
22510 IVFAIL = IVFAIL + 1
IVCORR = 9
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
2521 CONTINUE
IVTNUM = 252
C
C **** TEST 252 ****
C
IF (ICZERO) 32520, 2520, 32520
2520 CONTINUE
IVON02 = 3
IVON03 = 4
IVCOMP = 2 + (IVON02 + IVON03)
GO TO 42520
32520 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 42520, 2531, 42520
42520 IF (IVCOMP - 9) 22520,12520,22520
12520 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 2531
22520 IVFAIL = IVFAIL + 1
IVCORR = 9
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
2531 CONTINUE
IVTNUM = 253
C
C **** TEST 253 ****
C
IF (ICZERO) 32530, 2530, 32530
2530 CONTINUE
IVON02 =3
IVON03 =4
IVCOMP = (2+IVON02)+IVON03
GO TO 42530
32530 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 42530, 2541, 42530
42530 IF (IVCOMP -9) 22530,12530,22530
12530 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 2541
22530 IVFAIL = IVFAIL + 1
IVCORR =9
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
2541 CONTINUE
IVTNUM = 254
C
C **** TEST 254 ****
C
IF (ICZERO) 32540, 2540, 32540
2540 CONTINUE
IVON01 = 2
IVON02 = 3
IVCOMP = IVON01 + (IVON02 + 4)
GO TO 42540
32540 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 42540, 2551, 42540
42540 IF (IVCOMP-9)22540,12540,22540
12540 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 2551
22540 IVFAIL = IVFAIL + 1
IVCORR=9
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
2551 CONTINUE
IVTNUM = 255
C
C **** TEST 255 ****
C
IF (ICZERO) 32550, 2550, 32550
2550 CONTINUE
IVON01 = 2
IVON03 = 4
IVCOMP = IVON01 +(3+IVON03)
GO TO 42550
32550 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 42550, 2561, 42550
42550 IF (IVCOMP-9)22550,12550,22550
12550 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 2561
22550 IVFAIL = IVFAIL + 1
IVCORR =9
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
2561 CONTINUE
IVTNUM = 256
C
C **** TEST 256 ****
C
IF (ICZERO) 32560, 2560, 32560
2560 CONTINUE
IVON01 = 2
IVON03 = 4
IVCOMP =(IVON01+3)+IVON03
GO TO 42560
32560 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 42560, 2571, 42560
42560 IF (IVCOMP-9) 22560,12560,22560
12560 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 2571
22560 IVFAIL = IVFAIL + 1
IVCORR =9
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
2571 CONTINUE
IVTNUM = 257
C
C **** TEST 257 ****
C
IF (ICZERO) 32570, 2570, 32570
2570 CONTINUE
IVON01 = 51
IVON03 = 53
IVCOMP=IVON01+(52+IVON03)
GO TO 42570
32570 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 42570, 2581, 42570
42570 IF (IVCOMP -156) 22570,12570,22570
12570 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 2581
22570 IVFAIL = IVFAIL + 1
IVCORR = 156
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
2581 CONTINUE
IVTNUM = 258
C
C **** TEST 258 ****
C
IF (ICZERO) 32580, 2580, 32580
2580 CONTINUE
IVON01 = 51
IVON03 = 53
IVCOMP =(IVON01+52)+IVON03
GO TO 42580
32580 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 42580, 2591, 42580
42580 IF (IVCOMP-156) 22580,12580,22580
12580 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 2591
22580 IVFAIL = IVFAIL + 1
IVCORR = 156
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
2591 CONTINUE
IVTNUM = 259
C
C **** TEST 259 ****
C
IF (ICZERO) 32590, 2590, 32590
2590 CONTINUE
IVON02 = 676
IVON03 = 101
IVCOMP = 189+(IVON02+IVON03)
GO TO 42590
32590 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 42590, 2601, 42590
42590 IF (IVCOMP -966) 22590,12590,22590
12590 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 2601
22590 IVFAIL = IVFAIL + 1
IVCORR =966
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
2601 CONTINUE
IVTNUM = 260
C
C **** TEST 260 ****
C
IF (ICZERO) 32600, 2600, 32600
2600 CONTINUE
IVON02 = 676
IVON03 = 101
IVCOMP = (189 + IVON02) + IVON03
GO TO 42600
32600 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 42600, 2611, 42600
42600 IF (IVCOMP-966) 22600,12600,22600
12600 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 2611
22600 IVFAIL = IVFAIL + 1
IVCORR=966
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
2611 CONTINUE
IVTNUM = 261
C
C **** TEST 261 ****
C
IF (ICZERO) 32610, 2610, 32610
2610 CONTINUE
IVON01 = 1358
IVON02 = 8001
IVCOMP = IVON01 + (IVON02 + 2189)
GO TO 42610
32610 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 42610, 2621, 42610
42610 IF (IVCOMP-11548) 22610,12610,22610
12610 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 2621
22610 IVFAIL = IVFAIL + 1
IVCORR=11548
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
2621 CONTINUE
IVTNUM = 262
C
C **** TEST 262 ****
C
IF (ICZERO) 32620, 2620, 32620
2620 CONTINUE
IVON01 = 1358
IVON02 = 8001
IVCOMP =(IVON01+IVON02)+2189
GO TO 42620
32620 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 42620, 2631, 42620
42620 IF (IVCOMP-11548) 22620,12620,22620
12620 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 2631
22620 IVFAIL = IVFAIL + 1
IVCORR=11548
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
2631 CONTINUE
IVTNUM = 263
C
C **** TEST 263 ****
C REQUIRES 32767
C
IF (ICZERO) 32630, 2630, 32630
2630 CONTINUE
IVON01 = 16383
IVON03 = 16380
IVCOMP = IVON01 + (4+IVON03)
GO TO 42630
32630 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 42630, 2641, 42630
42630 IF (IVCOMP-32767) 22630,12630,22630
12630 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 2641
22630 IVFAIL = IVFAIL + 1
IVCORR =32767
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
2641 CONTINUE
IVTNUM = 264
C
C **** TEST 264 ****
C REQUIRES 32767
C
IF (ICZERO) 32640, 2640, 32640
2640 CONTINUE
IVON01 = 16383
IVON02 = 16380
IVCOMP = (IVON01+IVON02) +4
GO TO 42640
32640 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 42640, 2651, 42640
42640 IF (IVCOMP - 32767) 22640,12640,22640
12640 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 2651
22640 IVFAIL = IVFAIL + 1
IVCORR = 32767
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
2651 CONTINUE
C
C WRITE PAGE FOOTINGS AND RUN SUMMARIES
99999 CONTINUE
WRITE (I02,90002)
WRITE (I02,90006)
WRITE (I02,90002)
WRITE (I02,90002)
WRITE (I02,90007)
WRITE (I02,90002)
WRITE (I02,90008) IVFAIL
WRITE (I02,90009) IVPASS
WRITE (I02,90010) IVDELE
C
C
C TERMINATE ROUTINE EXECUTION
STOP
C
C FORMAT STATEMENTS FOR PAGE HEADERS
90000 FORMAT (1H1)
90002 FORMAT (1H )
90001 FORMAT (1H ,10X,34HFORTRAN COMPILER VALIDATION SYSTEM)
90003 FORMAT (1H ,21X,11HVERSION 1.0)
90004 FORMAT (1H ,10X,38HFOR OFFICIAL USE ONLY - COPYRIGHT 1978)
90005 FORMAT (1H ,5X,4HTEST,5X,9HPASS/FAIL, 5X,8HCOMPUTED,8X,7HCORRECT)
90006 FORMAT (1H ,5X,46H----------------------------------------------)
90011 FORMAT (1H ,18X,17HSUBSET LEVEL TEST)
C
C FORMAT STATEMENTS FOR RUN SUMMARIES
90008 FORMAT (1H ,15X,I5,19H ERRORS ENCOUNTERED)
90009 FORMAT (1H ,15X,I5,13H TESTS PASSED)
90010 FORMAT (1H ,15X,I5,14H TESTS DELETED)
C
C FORMAT STATEMENTS FOR TEST RESULTS
80001 FORMAT (1H ,4X,I5,7X,4HPASS)
80002 FORMAT (1H ,4X,I5,7X,4HFAIL)
80003 FORMAT (1H ,4X,I5,7X,7HDELETED)
80004 FORMAT (1H ,4X,I5,7X,4HFAIL,10X,I6,9X,I6)
80005 FORMAT (1H ,4X,I5,7X,4HFAIL,4X,E12.5,3X,E12.5)
C
90007 FORMAT (1H ,20X,20HEND OF PROGRAM FM009)
END
*END-OF,FM009
FM010.f 480975961 170 2 100666 9554 `
*HEADER,FORTR,FM010
*FILES1,FORTR,FM010,X
C COMMENT SECTION.
C
C FM010
C
C THIS ROUTINE TESTS REFERENCE FORMAT OF FORTRAN STATEMENTS
C AND STATEMENT NUMBERS. THE USE OF THE BLANK CHARACTER IS TESTED
C BOTH WITHIN THE STATEMENT NUMBER FIELD AND WITHIN THE FORTRAN
C STATEMENTS THEMSELVES. LEADING ZERO IS TESTED FOR STATEMENTS AND
C INTEGER CONSTANTS. VARIABLE NAMES WHICH LOOK VERY MUCH LIKE
C FORTRAN RESERVED WORDS ARE TESTED IN ARITHMETIC ASSIGNMENT
C STATEMENTS. NAMING CONVENTIONS USED THROUGHOUT THE FCVS ARE
C TESTED ALSO IN ARITHMETIC ASSIGNMENT STATEMENTS.
C
C REFERENCES
C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN,
C X3.9-1978
C
C SECTION 2.5, VARIABLES
C SECTION 3.1.6, BLANK CHARACTER
C SECTION 3.2.2, INITIAL LINES
C SECTION 3.4, STATEMENT LABELS
C
C
C **********************************************************
C
C A COMPILER VALIDATION SYSTEM FOR THE FORTRAN LANGUAGE
C BASED ON SPECIFICATIONS AS DEFINED IN AMERICAN NATIONAL STANDARD
C PROGRAMMING LANGUAGE FORTRAN X3.9-1978, HAS BEEN DEVELOPED BY THE
C FEDERAL COBOL COMPILER TESTING SERVICE. THE FORTRAN COMPILER
C VALIDATION SYSTEM (FCVS) CONSISTS OF AUDIT ROUTINES, THEIR RELATED
C DATA, AND AN EXECUTIVE SYSTEM. EACH AUDIT ROUTINE IS A FORTRAN
C PROGRAM, SUBPROGRAM OR FUNCTION WHICH INCLUDES TESTS OF SPECIFIC
C LANGUAGE ELEMENTS AND SUPPORTING PROCEDURES INDICATING THE RESULT
C OF EXECUTING THESE TESTS.
C
C THIS PARTICULAR PROGRAM/SUBPROGRAM/FUNCTION CONTAINS FEATURES
C FOUND ONLY IN THE SUBSET AS DEFINED IN X3.9-1978.
C
C SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO -
C
C DEPARTMENT OF THE NAVY
C FEDERAL COBOL COMPILER TESTING SERVICE
C WASHINGTON, D.C. 20376
C
C **********************************************************
C
C
C
C INITIALIZATION SECTION
C
C INITIALIZE CONSTANTS
C **************
C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER.
I01 = 5
C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER.
I02 = 6
C SYSTEM ENVIRONMENT SECTION
C
CX010 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-010 CONTROL CARD.
C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5
C (UNIT NUMBER FOR CARD READER).
CX011 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-011 CONTROL CARD.
C THE CX011 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL
C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX010 ABOVE.
C
CX020 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-020 CONTROL CARD.
C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02 = 6
C (UNIT NUMBER FOR PRINTER).
CX021 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-021 CONTROL CARD.
C THE CX021 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL
C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX020 ABOVE.
C
IVPASS=0
IVFAIL=0
IVDELE=0
ICZERO=0
C
C WRITE PAGE HEADERS
WRITE (I02,90000)
WRITE (I02,90001)
WRITE (I02,90002)
WRITE (I02, 90002)
WRITE (I02,90003)
WRITE (I02,90002)
WRITE (I02,90004)
WRITE (I02,90002)
WRITE (I02,90011)
WRITE (I02,90002)
WRITE (I02,90002)
WRITE (I02,90005)
WRITE (I02,90006)
WRITE (I02,90002)
1001 CONTINUE
IVTNUM = 100
C
C **** TEST 100 ****
C
C TEST 100 - TO CHECK THE VARIOUS COMBINATIONS OF FORMING VARIABLE
C NAMES. THESE ARE ACTUALLY SYMBOLIC NAMES (ANSI X3.9-1978
C SECTION 2.2). THIS IS BASICALLY A SYNTAX CHECK USING A
C COMBINATION OF FROM ONE TO SIX ALPHANUMERIC CHARACTERS WITH
C THE FIRST CHARACTER ALWAYS ALPHABETIC. REFERENCE FORMAT IS
C ALSO CHECKED BY HAVING EACH ASSIGNMENT STATEMENT AN INITIAL
C LINE (SECTION 3.2.2). THIS MEANS ZERO MAY APPEAR IN COLUMN
C SIX WITHOUT EFFECT, THAT LINES MAY BEGIN ANYWHERE FROM
C COLUMN SEVEN TO COLUMN 72, AND BLANKS MAY BE USED FREELY
C WITHOUT MEANING (3.1.6 BLANK CHARACTERS).
C
IF (ICZERO) 31000, 1000, 31000
1000 CONTINUE
A=1.
B =2.
C =3.
D =4.
E =5.
F =6.
0G = 7.
H=8.
I=9
J = 10
K = 11
L = 12
0M=13
N=14
O=15.
P=16.
Q=17.
R=18.
S=19.
T=20.
U=21.
V=22.
W=23.
X=24.
Y=25.
Z=26.
AAAAAA=27.
BBBBB=28.
CCCC=29.
DDD=30
EE=31.
F0=32.
G12=33.
H345 = 34.
I6789 = 35
J01234 = 36
K 5 6 78 9=37
L 2 L 2 L 2 =38
M 3 M 3 M3 = 39
N 40 = 4 0
0 OMY = 4 1.
I PM H = 4 2
GO TO 1 = 4 3.
IF 3 = 44
DO 3 = 53.
CALL FL =62.
TYPE I = 63.
TRUE =71.
FALSE = 72.
GO TO 41000
31000 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 41000, 1011, 41000
41000 IF (IPMH - 42) 21000,11000,21000
11000 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 1011
21000 IVFAIL = IVFAIL + 1
IVCOMP = IPMH
IVCORR = 42
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
1011 CONTINUE
IVTNUM = 101
C
C **** TEST 101 ****
C TEST 101 - CHECKS THE FCVS NAMING CONVENTIONS FOR INTEGER AND
C REAL VARIABLES IN ASSIGNMENT STATEMENTS: VARIABLE = CONSTANT
C BASICALLY A SYNTAX CHECK ON SIX CHARACTER VARIABLE NAMES.
C
IF (ICZERO) 31010, 1010, 31010
1010 CONTINUE
IACE11 = 1
IACE21 = 2
IACE31 = 3
IACN11 = 4
IADN11 = 5
IATE31 = 6
RACE11 = 7.
RACE21 = 8.
RACN31 = 9.
RADE31 = 10.
IVTE69 = 11
IVON78 = 12
RVTNAZ = 13.
RVOEZ9 = 14.
ICTE96 = 15
ICON84 = 16
RCON48 = 17.
RCTE54 = 18.
IDONY4 = 19
IDOEB6 = 20
RDON46 = 21.
IFONS3 = 22
RFON77 = 23.
GO TO 41010
31010 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 41010, 1021, 41010
41010 IF (IVTE69 - 11) 21010,11010,21010
11010 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 1021
21010 IVFAIL = IVFAIL + 1
IVCOMP = IVTE69
IVCORR = 11
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
1021 CONTINUE
IVTNUM = 102
C
C **** TEST 102 ****
C TEST 102 - REFERENCE FORMAT CHECK ON STATEMENT LABELS (SECTION
C 3.4). THESE ARE NON-ZERO INTEGERS, FROM 1 TO 5 DIGITS,
C MAY BEGIN ANYWHERE FROM COLS. 1 TO 5, AND LEADING ZEROS ARE
C NOT SIGNIFICANT. BLANKS WILL BE IMBEDDED IN SOME OF THE
C STATEMENT LABELS AND THESE SHOULD HAVE NO EFFECT. THE
C CONTINUE STATEMENT (SECTION 11.11) IS USED FOR THIS TEST.
C A BASIC FCVS ASSUMPTION IS THAT THE LOGIC WILL FALL THRU A
C SERIES OF CONTINUE STATEMENTS (NORMAL EXECUTION SEQUENCE).
C
IF (ICZERO) 31020, 1020, 31020
1020 CONTINUE
1 CONTINUE
2 CONTINUE
3 CONTINUE
4 CONTINUE
5 CONTINUE
06 CONTINUE
007 CONTINUE
0008 CONTINUE
00009 CONTINUE
010 CONTINUE
1 1 CONTINUE
0 12 CONTINUE
0 1 3 CONTINUE
00 14 CONTINUE
0 15 CONTINUE
0 016 CONTINUE
100 CONTINUE
1 0 1 CONTINUE
10 2 IVON01 = 1
1 03 CONTINUE
1 04 CONTINUE
01 05 CONTINUE
010 6 CONTINUE
0107 CONTINUE
00108 CONTINUE
1 1 1 CONTINUE
1 111 CONTINUE
99 CONTINUE
9 9 9 CONTINUE
99 99 CONTINUE
GO TO 41020
31020 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 41020, 1031, 41020
41020 IF (IVON01 - 1) 21020,11020,21020
11020 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 1031
21020 IVFAIL = IVFAIL + 1
IVCOMP = IVON01
IVCORR = 1
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
1031 CONTINUE
C
C WRITE PAGE FOOTINGS AND RUN SUMMARIES
99999 CONTINUE
WRITE (I02,90002)
WRITE (I02,90006)
WRITE (I02,90002)
WRITE (I02,90002)
WRITE (I02,90007)
WRITE (I02,90002)
WRITE (I02,90008) IVFAIL
WRITE (I02,90009) IVPASS
WRITE (I02,90010) IVDELE
C
C
C TERMINATE ROUTINE EXECUTION
STOP
C
C FORMAT STATEMENTS FOR PAGE HEADERS
90000 FORMAT (1H1)
90002 FORMAT (1H )
90001 FORMAT (1H ,10X,34HFORTRAN COMPILER VALIDATION SYSTEM)
90003 FORMAT (1H ,21X,11HVERSION 1.0)
90004 FORMAT (1H ,10X,38HFOR OFFICIAL USE ONLY - COPYRIGHT 1978)
90005 FORMAT (1H ,5X,4HTEST,5X,9HPASS/FAIL, 5X,8HCOMPUTED,8X,7HCORRECT)
90006 FORMAT (1H ,5X,46H----------------------------------------------)
90011 FORMAT (1H ,18X,17HSUBSET LEVEL TEST)
C
C FORMAT STATEMENTS FOR RUN SUMMARIES
90008 FORMAT (1H ,15X,I5,19H ERRORS ENCOUNTERED)
90009 FORMAT (1H ,15X,I5,13H TESTS PASSED)
90010 FORMAT (1H ,15X,I5,14H TESTS DELETED)
C
C FORMAT STATEMENTS FOR TEST RESULTS
80001 FORMAT (1H ,4X,I5,7X,4HPASS)
80002 FORMAT (1H ,4X,I5,7X,4HFAIL)
80003 FORMAT (1H ,4X,I5,7X,7HDELETED)
80004 FORMAT (1H ,4X,I5,7X,4HFAIL,10X,I6,9X,I6)
80005 FORMAT (1H ,4X,I5,7X,4HFAIL,4X,E12.5,3X,E12.5)
C
90007 FORMAT (1H ,20X,20HEND OF PROGRAM FM010)
END
*END-OF,FM010
FM011.f 480975963 170 2 100666 9200 `
*HEADER,FORTR,FM011
*FILES1,FORTR,FM011,X
C COMMENT SECTION.
C
C FM011
C
C THIS ROUTINE IS A TEST OF BLANK CHARACTERS (SECTION 3.1.6)
C WHICH SHOULD HAVE NO MEANING WHEN EMBEDDED IN FORTRAN RESERVED
C WORDS.
C REFERENCES
C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN,
C X3.9-1978
C
C SECTION 3.1.6, BLANK CHARACTER
DIM EN SION IADN11(3),IADN12(3)
IN TEGER RVTNI1
REA L IVTNR1
LOG ICAL LVTNL1,LVTNL2
COM MON IACE11(3)
EQU IVAL ENCE (IACE11(1),IADN11(1))
D A T A IADN12/3*3/
C
C **********************************************************
C
C A COMPILER VALIDATION SYSTEM FOR THE FORTRAN LANGUAGE
C BASED ON SPECIFICATIONS AS DEFINED IN AMERICAN NATIONAL STANDARD
C PROGRAMMING LANGUAGE FORTRAN X3.9-1978, HAS BEEN DEVELOPED BY THE
C FEDERAL COBOL COMPILER TESTING SERVICE. THE FORTRAN COMPILER
C VALIDATION SYSTEM (FCVS) CONSISTS OF AUDIT ROUTINES, THEIR RELATED
C DATA, AND AN EXECUTIVE SYSTEM. EACH AUDIT ROUTINE IS A FORTRAN
C PROGRAM, SUBPROGRAM OR FUNCTION WHICH INCLUDES TESTS OF SPECIFIC
C LANGUAGE ELEMENTS AND SUPPORTING PROCEDURES INDICATING THE RESULT
C OF EXECUTING THESE TESTS.
C
C THIS PARTICULAR PROGRAM/SUBPROGRAM/FUNCTION CONTAINS FEATURES
C FOUND ONLY IN THE SUBSET AS DEFINED IN X3.9-1978.
C
C SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO -
C
C DEPARTMENT OF THE NAVY
C FEDERAL COBOL COMPILER TESTING SERVICE
C WASHINGTON, D.C. 20376
C
C **********************************************************
C
C
C
C INITIALIZATION SECTION
C
C INITIALIZE CONSTANTS
C **************
C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER.
I01 = 5
C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER.
I02 = 6
C SYSTEM ENVIRONMENT SECTION
C
CX010 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-010 CONTROL CARD.
C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5
C (UNIT NUMBER FOR CARD READER).
CX011 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-011 CONTROL CARD.
C THE CX011 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL
C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX010 ABOVE.
C
CX020 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-020 CONTROL CARD.
C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02 = 6
C (UNIT NUMBER FOR PRINTER).
CX021 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-021 CONTROL CARD.
C THE CX021 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL
C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX020 ABOVE.
C
IVPASS=0
IVFAIL=0
IVDELE=0
ICZERO=0
C
C WRITE PAGE HEADERS
WRITE (I02,90000)
WRITE (I02,90001)
WRITE (I02,90002)
WRITE (I02, 90002)
WRITE (I02,90003)
WRITE (I02,90002)
WRITE (I02,90004)
WRITE (I02,90002)
WRITE (I02,90011)
WRITE (I02,90002)
WRITE (I02,90002)
WRITE (I02,90005)
WRITE (I02,90006)
WRITE (I02,90002)
IVTNUM = 103
C
C **** TEST 103 ****
C TEST 103 - THIS TEST HAS BLANKS EMBEDDED IN A DIMENSION
C STATEMENT. ALSO THE DO STATEMENT WITH AN EMBEDDED BLANK
C WILL BE TESTED TO INITIALIZE VALUES IN AN ARRAY. THE
C CONTINUE AND IF STATEMENTS HAVE EMBEDDED BLANKS AS WELL.
C
IF (ICZERO) 31030, 1030, 31030
1030 CONTINUE
D O 1 IVON01 =1 , 3 , 1
IADN11(IVON01) = IVON01
1 C ON T IN UE
GO TO 41030
31030 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 41030, 1041, 41030
41030 I F (IADN11(2) - 2) 21030,11030,21030
11030 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 1041
21030 IVFAIL = IVFAIL + 1
IVCOMP = IADN11(2)
IVCORR = 2
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
1041 CONTINUE
IVTNUM = 104
C
C **** TEST 104 ****
C TEST 104 - THIS TESTS EMBEDDED BLANKS IN AN INTEGER TYPE
C STATEMENT. FRACTION 1/2 SHOULD BECOME 0 AS AN INTEGER.
C INTEGER TO REAL * 2. BACK TO INTEGER CONVERSION SHOULD BE 0.
C
IF (ICZERO) 31040, 1040, 31040
1040 CONTINUE
RVTNI1 = 2
RVON01 = 1/RVTNI1
IVON02 = RVON01 * 2.
GO TO 41040
31040 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 41040, 1051, 41040
41040 IF( IVON02 - 0 ) 21040,11040,21040
11040 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 1051
21040 IVFAIL = IVFAIL + 1
IVCOMP = IVON02
IVCORR = 0
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
1051 CONTINUE
IVTNUM = 105
C
C **** TEST 105 ****
C TEST 105 - TEST OF EMBEDDED BLANKS IN A REAL TYPE STATEMENT.
C REAL TO REAL*2. TO INTEGER CONVERSION IS PERFORMED. RESULT
C IS 1 IF THE TYPE OF THE TEST VARIABLE(IVTNR1) WAS REAL.
C
IF (ICZERO) 31050, 1050, 31050
1050 CONTINUE
IVTNR1 = .5
RVON03 = IVTNR1*2.
IVON03 = RVON03 +.3
GO TO 41050
31050 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 41050, 1061, 41050
41050 IF(IVON03 - 1) 21050, 11050, 21050
11050 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 1061
21050 IVFAIL = IVFAIL + 1
IVCOMP = IVON03
IVCORR = 1
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
1061 CONTINUE
IVTNUM = 106
C
C **** TEST 106 ****
C TEST 106 - TEST THE LOGICAL TYPE WITH EMBEDDED BLANKS BY A
C LOGIC ASSIGNMENT (V = .TRUE.) SECTION 4.7.1 AND 10.2
C
IF (ICZERO) 31060, 1060, 31060
1060 CONTINUE
LVTNL1 = .TRUE.
GO TO 41060
31060 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 41060, 1071, 41060
41060 IF(ICZERO) 21060,11060,21060
11060 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 1071
21060 IVFAIL = IVFAIL + 1
WRITE (I02,80002) IVTNUM, IVCOMP ,IVCORR
1071 CONTINUE
IVTNUM = 107
C
C **** TEST 107 ****
C TEST 107 - A SECOND TEST OF THE LOGICAL TYPE STATEMENT WITH
C EMBEDDED BLANKS. THE TEST IS AGAIN MADE BY A LOGICAL
C ASSIGNMENT (SECTION 4.7.1 AND 10.2).
C
IF (ICZERO) 31070, 1070, 31070
1070 CONTINUE
LVTNL2 = .FALSE.
GO TO 41070
31070 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 41070, 1081, 41070
41070 IF(ICZERO) 21070,11070,21070
11070 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 1081
21070 IVFAIL = IVFAIL + 1
WRITE (I02,80002) IVTNUM, IVCOMP ,IVCORR
1081 CONTINUE
IVTNUM = 108
C
C **** TEST 108 ****
C TEST 108 - THIS IS A TEST OF BLANKS EMBEDDED IN THE COMMON,
C DIMENSION AND EQUIVALENCE STATEMENTS (SECTION 8.1,
C 8.3. AND 8.2.).
C
IF (ICZERO) 31080, 1080, 31080
1080 CONTINUE
IADN11(3) = 4
GO TO 41080
31080 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 41080, 1091, 41080
41080 IF(IACE11(3) - 4) 21080,11080,21080
11080 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 1091
21080 IVFAIL = IVFAIL + 1
IVCOMP = IACE11(3)
IVCORR = 4
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
1091 CONTINUE
IVTNUM = 109
C
C **** TEST 109 ****
C TEST 109 - THIS TESTS THE EFFECT OF BLANKS EMBEDDED IN THE
C DATA STATEMENT BY CHECKING THE INITIALIZATION OF ARRAY
C ELEMENT VALUES (SECTION 9).
C
IF (ICZERO) 31090, 1090, 31090
1090 CONTINUE
IVON04 = IADN12(1) + IADN12(2) + IADN12(3)
GO TO 41090
31090 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 41090, 1101, 41090
41090 IF(IVON04 - 9) 21090,11090,21090
11090 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 1101
21090 IVFAIL = IVFAIL + 1
IVCOMP = IVON04
IVCORR = 9
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
1101 CONTINUE
C
C WRITE PAGE FOOTINGS AND RUN SUMMARIES
99999 CONTINUE
WRITE (I02,90002)
WRITE (I02,90006)
WRITE (I02,90002)
WRITE (I02,90002)
WRITE (I02,90007)
WRITE (I02,90002)
WRITE (I02,90008) IVFAIL
WRITE (I02,90009) IVPASS
WRITE (I02,90010) IVDELE
C
C
C TERMINATE ROUTINE EXECUTION
STOP
C
C FORMAT STATEMENTS FOR PAGE HEADERS
90000 FORMAT (1H1)
90002 FORMAT (1H )
90001 FORMAT (1H ,10X,34HFORTRAN COMPILER VALIDATION SYSTEM)
90003 FORMAT (1H ,21X,11HVERSION 1.0)
90004 FORMAT (1H ,10X,38HFOR OFFICIAL USE ONLY - COPYRIGHT 1978)
90005 FORMAT (1H ,5X,4HTEST,5X,9HPASS/FAIL, 5X,8HCOMPUTED,8X,7HCORRECT)
90006 FORMAT (1H ,5X,46H----------------------------------------------)
90011 FORMAT (1H ,18X,17HSUBSET LEVEL TEST)
C
C FORMAT STATEMENTS FOR RUN SUMMARIES
90008 FORMAT (1H ,15X,I5,19H ERRORS ENCOUNTERED)
90009 FORMAT (1H ,15X,I5,13H TESTS PASSED)
90010 FORMAT (1H ,15X,I5,14H TESTS DELETED)
C
C FORMAT STATEMENTS FOR TEST RESULTS
80001 FORMAT (1H ,4X,I5,7X,4HPASS)
80002 FORMAT (1H ,4X,I5,7X,4HFAIL)
80003 FORMAT (1H ,4X,I5,7X,7HDELETED)
80004 FORMAT (1H ,4X,I5,7X,4HFAIL,10X,I6,9X,I6)
80005 FORMAT (1H ,4X,I5,7X,4HFAIL,4X,E12.5,3X,E12.5)
C
90007 FORMAT (1H ,20X,20HEND OF PROGRAM FM011)
END
*END-OF,FM011
FM012.f 480975966 170 2 100666 17764 `
*HEADER,FORTR,FM012
*FILES1,FORTR,FM012,X
C
C COMMENT SECTION.
C
C FM012
C
C THIS ROUTINE TESTS THE FORTRAN DO - STATEMENT FROM ITS
C SIMPLIST FORMAT TO THE MORE ABBREVIATED FORMS. VARIOUS INCREMENTS
C ARE USED AND BRANCHING BY VARIOUS METHODS IS TESTED FOR PASSING
C CONTROL OUT OF THE DO RANGE AND RETURNING (EXTENDED RANGE).
C NESTED DO STATEMENTS USING VARIOUS TERMINATING STATEMENTS ARE ALSO
C TESTED BY THIS ROUTINE.
C
C REFERENCES
C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN,
C X3.9-1978
C
C SECTION 11.10, DO STATEMENT
C SECTION 11.10.3, EXECUTES A DO LOOP
C SECTION 11.11, CONTINUE STATEMENT
C
C
C **********************************************************
C
C A COMPILER VALIDATION SYSTEM FOR THE FORTRAN LANGUAGE
C BASED ON SPECIFICATIONS AS DEFINED IN AMERICAN NATIONAL STANDARD
C PROGRAMMING LANGUAGE FORTRAN X3.9-1978, HAS BEEN DEVELOPED BY THE
C FEDERAL COBOL COMPILER TESTING SERVICE. THE FORTRAN COMPILER
C VALIDATION SYSTEM (FCVS) CONSISTS OF AUDIT ROUTINES, THEIR RELATED
C DATA, AND AN EXECUTIVE SYSTEM. EACH AUDIT ROUTINE IS A FORTRAN
C PROGRAM, SUBPROGRAM OR FUNCTION WHICH INCLUDES TESTS OF SPECIFIC
C LANGUAGE ELEMENTS AND SUPPORTING PROCEDURES INDICATING THE RESULT
C OF EXECUTING THESE TESTS.
C
C THIS PARTICULAR PROGRAM/SUBPROGRAM/FUNCTION CONTAINS FEATURES
C FOUND ONLY IN THE SUBSET AS DEFINED IN X3.9-1978.
C
C SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO -
C
C DEPARTMENT OF THE NAVY
C FEDERAL COBOL COMPILER TESTING SERVICE
C WASHINGTON, D.C. 20376
C
C **********************************************************
C
C
C
C INITIALIZATION SECTION
C
C INITIALIZE CONSTANTS
C **************
C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER.
I01 = 5
C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER.
I02 = 6
C SYSTEM ENVIRONMENT SECTION
C
CX010 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-010 CONTROL CARD.
C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5
C (UNIT NUMBER FOR CARD READER).
CX011 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-011 CONTROL CARD.
C THE CX011 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL
C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX010 ABOVE.
C
CX020 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-020 CONTROL CARD.
C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02 = 6
C (UNIT NUMBER FOR PRINTER).
CX021 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-021 CONTROL CARD.
C THE CX021 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL
C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX020 ABOVE.
C
IVPASS=0
IVFAIL=0
IVDELE=0
ICZERO=0
C
C WRITE PAGE HEADERS
WRITE (I02,90000)
WRITE (I02,90001)
WRITE (I02,90002)
WRITE (I02, 90002)
WRITE (I02,90003)
WRITE (I02,90002)
WRITE (I02,90004)
WRITE (I02,90002)
WRITE (I02,90011)
WRITE (I02,90002)
WRITE (I02,90002)
WRITE (I02,90005)
WRITE (I02,90006)
WRITE (I02,90002)
IVTNUM = 110
C
C TEST 110 - DO STATEMENT WITH THE COMPLETE FORMAT, INCREMENT OF 1
C THE LOOP SHOULD BE EXECUTED TEN (10) TIMES THUS THE LOOP
C COUNTER SHOULD HAVE A VALUE OF TEN AT THE COMPLETION OF THE
C DO-LOOP.
C
C
IF (ICZERO) 31100, 1100, 31100
1100 CONTINUE
IVON01=0
DO 1102 I=1,10,1
IVON01=IVON01+1
1102 CONTINUE
GO TO 41100
31100 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 41100, 1111, 41100
41100 IF(IVON01-10) 21100,11100,21100
11100 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 1111
21100 IVFAIL = IVFAIL + 1
IVCOMP=IVON01
IVCORR=10
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
1111 CONTINUE
IVTNUM = 111
C
C TEST 111 - SAME DO TEST AS IN TEST 110 EXCEPT THAT NO INCREMENT
C IS GIVEN. THE INCREMENT SHOULD BE 1 AND THE LOOP PERFORMED
C TEN (10) TIMES AS BEFORE.
C
C
IF (ICZERO) 31110, 1110, 31110
1110 CONTINUE
IVON01=0
DO 1112 J=1,10
IVON01=IVON01+1
1112 CONTINUE
GO TO 41110
31110 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 41110, 1121, 41110
41110 IF(IVON01-10) 21110, 11110, 21110
11110 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 1121
21110 IVFAIL = IVFAIL + 1
IVCOMP=IVON01
IVCORR=10
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
1121 CONTINUE
IVTNUM = 112
C
C TEST 112 - DO STATEMENT WITH AN INCREMENT OTHER THAN ONE (1).
C THE DO - LOOP SHOULD BE EXECUTED FIVE (5) TIMES THUS
C THE VALUE OF THE LOOP COUNTER SHOULD BE FIVE (5) AT THE
C END OF THE DO - LOOP.
C
C
IF (ICZERO) 31120, 1120, 31120
1120 CONTINUE
IVON01=0
DO 1122 K = 1, 10, 2
IVON01=IVON01+1
1122 CONTINUE
GO TO 41120
31120 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 41120, 1131, 41120
41120 IF (IVON01 - 5 ) 21120, 11120, 21120
11120 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 1131
21120 IVFAIL = IVFAIL + 1
IVCOMP=IVON01
IVCORR=5
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
1131 CONTINUE
IVTNUM = 113
C
C TEST 113 - DO STATEMENT WITH THE INITIAL VALUE EQUAL TO THE
C TERMINAL VALUE. THE DO - LOOP SHOULD BE EXECUTED ONE (1)
C TIME THUS THE VALUE OF THE LOOP COUNTER SHOULD BE ONE (1).
C
C
IF (ICZERO) 31130, 1130, 31130
1130 CONTINUE
IVON01=0
DO 1132 L = 2, 2
IVON01=IVON01+1
1132 CONTINUE
GO TO 41130
31130 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 41130, 1141, 41130
41130 IF ( IVON01 - 1 ) 21130, 11130, 21130
11130 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 1141
21130 IVFAIL = IVFAIL + 1
IVCOMP=IVON01
IVCORR=1
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
1141 CONTINUE
IVTNUM = 114
C
C TEST 114 - THIS TESTS THE UNCONDITIONAL BRANCH OUT OF THE
C RANGE OF THE DO USING THE GO TO STATEMENT. THE DO INDEX
C SHOULD RETAIN THE VALUE IT HAD WHEN THE UNCONDITIONAL BRANCH
C WAS MADE. SINCE THE DO LOOP ONLY CONTAINS AN UNCONDITIONAL
C BRANCH, THE VALUE OF THE DO INDEX SHOULD BE ITS INITIAL
C VALUE. IN THIS CASE THE VALUE SHOULD BE ONE (1).
C SEE SECTION 11.10.
C
C
IF (ICZERO) 31140, 1140, 31140
1140 CONTINUE
DO 1142 M=1,10
GO TO 1143
1142 CONTINUE
1143 CONTINUE
GO TO 41140
31140 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 41140, 1151, 41140
41140 IF ( M - 1 ) 21140, 11140, 21140
11140 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 1151
21140 IVFAIL = IVFAIL + 1
IVCOMP=M
IVCORR=1
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
1151 CONTINUE
IVTNUM = 115
C
C TEST 115 - THIS TEST IS SIMILAR TO TEST 114 IN THAT THE DO
C RANGE HAS ONLY AN UNCONDITIONAL BRANCH OUTSIDE OF THE RANGE.
C THE DO INDEX SHOULD AGAIN RETAIN ITS VALUE, IN THIS CASE
C ITS INITIAL VALUE OF ONE (1).
C SEE SECTION 11.10.
C
C
IF (ICZERO) 31150, 1150, 31150
1150 CONTINUE
DO 1152 N = 1, 10
IF ( N - 1 ) 1152, 1153, 1152
1152 CONTINUE
1153 CONTINUE
GO TO 41150
31150 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 41150, 1161, 41150
41150 IF (N - 1 ) 21150, 11150, 21150
11150 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 1161
21150 IVFAIL = IVFAIL + 1
IVCOMP=N
IVCORR=1
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
1161 CONTINUE
IVTNUM = 116
C
C TEST 116 - THIS IS A TEST OF A NEST OF TWO DO RANGES. TWO
C SEPARATE CONTINUE STATEMENTS ARE USED AS TERMINAL STATEMENTS
C FOR THE TWO RESPECTIVE DO RANGES. THE OUTER LOOP SHOULD BE
C PERFORMED TEN (10) TIMES AND THE INNER LOOP SHOULD BE
C PERFORMED TWICE FOR EACH EXECUTION OF THE OUTER LOOP. THE
C LOOP COUNTER SHOULD HAVE A VALUE OF TWENTY (20) SINCE IT
C IS INCREMENTED IN THE INNER DO - LOOP.
C SEE SECTION 11.10.3.
C
C
IF (ICZERO) 31160, 1160, 31160
1160 CONTINUE
IVON01=0
DO 1163 I=1,10,1
DO 1162 J=1,2,1
IVON01=IVON01+1
1162 CONTINUE
1163 CONTINUE
GO TO 41160
31160 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 41160, 1171, 41160
41160 IF ( IVON01 - 20 ) 21160, 11160, 21160
11160 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 1171
21160 IVFAIL = IVFAIL + 1
IVCOMP=IVON01
IVCORR=20
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
1171 CONTINUE
IVTNUM = 117
C
C TEST 117 - THIS IS BASICALLY THE SAME AS TEST 116 EXCEPT THAT
C ONLY ONE CONTINUE STATEMENT IS USED AS THE TERMINATING
C STATEMENT FOR BOTH OF THE DO RANGES. THE VALUE OF THE
C LOOP COUNTER SHOULD AGAIN BE TWENTY (20).
C
C
IF (ICZERO) 31170, 1170, 31170
1170 CONTINUE
IVON01=0
DO 1172 K=1,10,1
DO 1172 L=1,2,1
IVON01=IVON01+1
1172 CONTINUE
GO TO 41170
31170 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 41170, 1181, 41170
41170 IF (IVON01 - 20 ) 21170, 11170, 21170
11170 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 1181
21170 IVFAIL = IVFAIL + 1
IVCOMP=IVON01
IVCORR=20
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
1181 CONTINUE
IVTNUM = 118
C
C TEST 118 - THIS IS BASICALLY THE SAME TEST AS 116 EXCEPT
C THAT THE LOOP COUNTER INCREMENT IS THE TERMINATING STATEMENT
C OF BOTH OF THE DO RANGES. THE VALUE OF THE LOOP COUNTER
C SHOULD BE TWENTY (20), BUT THE NUMBER OF EXECUTIONS OF
C THE OUTER LOOP IS NOW TWO (2) AND THE INNER LOOP EXECUTES
C TEN (10) TIMES FOR EVERY EXECUTION OF THE OUTER LOOP.
C
C
IF (ICZERO) 31180, 1180, 31180
1180 CONTINUE
IVON01=0
DO 1182 M=1,2,1
DO 1182 N=1,10,1
1182 IVON01 = IVON01 + 1
GO TO 41180
31180 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 41180, 1191, 41180
41180 IF (IVON01 - 20 ) 21180, 11180, 21180
11180 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 1191
21180 IVFAIL = IVFAIL + 1
IVCOMP=IVON01
IVCORR=20
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
1191 CONTINUE
IVTNUM = 119
C
C TEST 119 - THIS IS A TEST OF AN UNCONDITIONAL BRANCH OUT OF A
C NESTED DO RANGE QUITE LIKE TEST 114. THE LOOP COUNTER
C SHOULD ONLY BE INCREMENTED ON THE OUTER LOOP RANGE SO
C THE FINAL VALUE OF THE LOOP COUNTER SHOULD BE TEN (10).
C
C
IF (ICZERO) 31190, 1190, 31190
1190 CONTINUE
IVON01=0
DO 1194 I=1,10,1
DO 1193 J=1,2,1
C
C THE FOLLOWING STATEMENT IS TO ELIMINATE THE DEAD CODE PRODUCED
C BY THE STATEMENT GO TO 1194.
C
IF ( ICZERO ) 1193, 1192, 1193
C
1192 GO TO 1194
1193 IVON01 = IVON01 + 1
1194 IVON01 = IVON01 + 1
GO TO 41190
31190 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 41190, 1201, 41190
41190 IF ( IVON01 - 10 ) 21190, 11190, 21190
11190 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 1201
21190 IVFAIL = IVFAIL + 1
IVCOMP=IVON01
IVCORR=10
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
1201 CONTINUE
IVTNUM = 120
C
C TEST 120 - THIS IS BASICALLY THE SAME TEST AS TEST 119 EXCEPT
C THAT AN IF STATEMENT IS USED TO BRANCH OUT OF THE INNER LOOP
C WITHOUT INCREMENTING THE LOOP COUNTER. THE VALUE OF THE
C LOOP COUNTER SHOULD AGAIN BE TEN (10).
C
C
IF (ICZERO) 31200, 1200, 31200
1200 CONTINUE
IVON01=0
DO 1203 I=1,10,1
DO 1202 J=1,2,1
IF ( J - 1 ) 1203, 1203, 1202
1202 IVON01 = IVON01 + 1
1203 IVON01 = IVON01 + 1
GO TO 41200
31200 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 41200, 1211, 41200
41200 IF ( IVON01 - 10 ) 21200, 11200, 21200
11200 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 1211
21200 IVFAIL = IVFAIL + 1
IVCOMP=IVON01
IVCORR=10
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
1211 CONTINUE
IVTNUM = 121
C
C TEST 121 - THIS IS A TEST OF DO NESTS WITHIN DO NESTS. THE
C LOOP COUNTER SHOULD HAVE A FINAL VALUE OF EIGHTY-FOUR (84).
C
C
IF (ICZERO) 31210, 1210, 31210
1210 CONTINUE
IVON01=0
DO 1216 I1=1,2,1
DO 1213 I2=1,3,1
DO 1212 I3=1,4,1
IVON01=IVON01+1
1212 CONTINUE
1213 CONTINUE
DO 1215 I4=1,5,1
DO 1214 I5=1,6,1
IVON01=IVON01+1
1214 CONTINUE
1215 CONTINUE
1216 CONTINUE
GO TO 41210
31210 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 41210, 1221, 41210
41210 IF ( IVON01 - 84 ) 21210, 11210, 21210
11210 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 1221
21210 IVFAIL = IVFAIL + 1
IVCOMP=IVON01
IVCORR=84
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
1221 CONTINUE
IVTNUM = 122
C
C TEST 122 - THIS IS AGAIN A TEST OF DO NESTS BUT COMBINED WITH
C ARITHMETIC IF STATEMENT BRANCHES WITHIN THE DO RANGE. THE
C FINAL LOOP COUNTER VALUE SHOULD BE EIGHTEEN (18).
C
C
IF (ICZERO) 31220, 1220, 31220
1220 CONTINUE
IVON01=0
DO 1228 I1=1,3,1
DO 1223 I2=1,4,1
IF ( I2 - 3 ) 1222, 1224, 1224
1222 IVON01 = IVON01 + 1
1223 CONTINUE
1224 DO 1226 I3=1,5,1
IF ( I3 - 3 ) 1225, 1225, 1227
1225 IVON01 = IVON01 + 1
1226 CONTINUE
1227 CONTINUE
1228 CONTINUE
GO TO 41220
31220 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 41220, 1231, 41220
41220 IF ( IVON01 - 15 ) 21220, 11220, 21220
11220 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 1231
21220 IVFAIL = IVFAIL + 1
IVCOMP=IVON01
IVCORR=15
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
1231 CONTINUE
IVTNUM = 123
C
C NOTE **** TEST 123 WAS DELETED BY FCCTS.
C
IF (ICZERO) 31230, 1230, 31230
1230 CONTINUE
31230 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 41230, 1241, 41230
41230 IF ( IVON01 - 20 ) 21230, 11230, 21230
11230 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 1241
21230 IVFAIL = IVFAIL + 1
IVCOMP=IVON01
IVCORR=20
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
1241 CONTINUE
IVTNUM = 124
C
C TEST 124 - THIS IS A TEST OF A TRIPLE NESTED DO RANGE WITH
C AN UNCONDITIONAL GO TO STATEMENT BRANCH IN THE INNERMOST
C NESTED DO TO THE COMMON TERMINAL STATEMENT. THE FINAL
C LOOP COUNTER VALUE SHOULD BE ONE HUNDRED AND FORTY-TWO (142)
C THE INITIAL VALUE OF THE INNERMOST DO RANGE IS TWO (2).
C
C
IF (ICZERO) 31240, 1240, 31240
1240 CONTINUE
IVON01=0
DO 1242 I2=1,5,1
DO 1242 I3=2,8,1
DO 1242 I1=1,4,1
IVON01=IVON01+1
GO TO 1242
1242 CONTINUE
GO TO 41240
31240 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 41240, 1251, 41240
41240 IF ( IVON01 - 140 ) 21240, 11240, 21240
11240 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 1251
21240 IVFAIL = IVFAIL + 1
IVCOMP=IVON01
IVCORR=140
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
1251 CONTINUE
IVTNUM = 125
C
C TEST 125 - THIS IS BASICALLY THE SAME AS TEST 124 EXCEPT THAT
C AN ARITHMETIC IF BRANCH IS USED INSTEAD OF THE GO TO
C STATEMENT FOR THE BRANCH TO THE TERMINAL STATEMENT COMMON
C TO ALL THREE OF THE DO RANGES.
C THE FINAL VALUE OF THE LOOP COUNTER SHOULD BE ONE
C HUNDRED AND FORTY (140).
C
C
IF (ICZERO) 31250, 1250, 31250
1250 CONTINUE
IVON01=0
DO 1252 I1=1,4,1
DO 1252 I2=1,5,1
DO 1252 I3=2,8,1
IVON01=IVON01+1
IF ( I3 - 9 ) 1252, 1252, 1253
1252 CONTINUE
1253 CONTINUE
GO TO 41250
31250 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 41250, 1261, 41250
41250 IF ( IVON01 - 140 ) 21250, 11250, 21250
11250 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 1261
21250 IVFAIL = IVFAIL + 1
IVCOMP=IVON01
IVCORR=140
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
1261 CONTINUE
C
C WRITE PAGE FOOTINGS AND RUN SUMMARIES
99999 CONTINUE
WRITE (I02,90002)
WRITE (I02,90006)
WRITE (I02,90002)
WRITE (I02,90002)
WRITE (I02,90007)
WRITE (I02,90002)
WRITE (I02,90008) IVFAIL
WRITE (I02,90009) IVPASS
WRITE (I02,90010) IVDELE
C
C
C TERMINATE ROUTINE EXECUTION
STOP
C
C FORMAT STATEMENTS FOR PAGE HEADERS
90000 FORMAT (1H1)
90002 FORMAT (1H )
90001 FORMAT (1H ,10X,34HFORTRAN COMPILER VALIDATION SYSTEM)
90003 FORMAT (1H ,21X,11HVERSION 1.0)
90004 FORMAT (1H ,10X,38HFOR OFFICIAL USE ONLY - COPYRIGHT 1978)
90005 FORMAT (1H ,5X,4HTEST,5X,9HPASS/FAIL, 5X,8HCOMPUTED,8X,7HCORRECT)
90006 FORMAT (1H ,5X,46H----------------------------------------------)
90011 FORMAT (1H ,18X,17HSUBSET LEVEL TEST)
C
C FORMAT STATEMENTS FOR RUN SUMMARIES
90008 FORMAT (1H ,15X,I5,19H ERRORS ENCOUNTERED)
90009 FORMAT (1H ,15X,I5,13H TESTS PASSED)
90010 FORMAT (1H ,15X,I5,14H TESTS DELETED)
C
C FORMAT STATEMENTS FOR TEST RESULTS
80001 FORMAT (1H ,4X,I5,7X,4HPASS)
80002 FORMAT (1H ,4X,I5,7X,4HFAIL)
80003 FORMAT (1H ,4X,I5,7X,7HDELETED)
80004 FORMAT (1H ,4X,I5,7X,4HFAIL,10X,I6,9X,I6)
80005 FORMAT (1H ,4X,I5,7X,4HFAIL,4X,E12.5,3X,E12.5)
C
90007 FORMAT (1H ,20X,20HEND OF PROGRAM FM012)
END
*END-OF,FM012
FM013.f 480975968 170 2 100666 8794 `
*HEADER,FORTR,FM013
*FILES1,FORTR,FM013,X
C
C COMMENT SECTION.
C
C FM013
C
C THIS ROUTINE TESTS THE FORTRAN ASSIGNED GO TO STATEMENT
C AS DESCRIBED IN SECTION 11.3 (ASSIGNED GO TO STATEMENT). FIRST A
C STATEMENT LABEL IS ASSIGNED TO AN INTEGER VARIABLE IN THE ASSIGN
C STATEMENT. SECONDLY A BRANCH IS MADE IN AN ASSIGNED GO TO
C STATEMENT USING THE INTEGER VARIABLE AS THE BRANCH CONTROLLER
C IN A LIST OF POSSIBLE STATEMENT NUMBERS TO BE BRANCHED TO.
C
C REFERENCES
C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN,
C X3.9-1978
C
C SECTION 10.3, STATEMENT LABEL ASSIGNMENT (ASSIGN) STATEMENT
C SECTION 11.3, ASSIGNED GO TO STATEMENT
C
C
C **********************************************************
C
C A COMPILER VALIDATION SYSTEM FOR THE FORTRAN LANGUAGE
C BASED ON SPECIFICATIONS AS DEFINED IN AMERICAN NATIONAL STANDARD
C PROGRAMMING LANGUAGE FORTRAN X3.9-1978, HAS BEEN DEVELOPED BY THE
C FEDERAL COBOL COMPILER TESTING SERVICE. THE FORTRAN COMPILER
C VALIDATION SYSTEM (FCVS) CONSISTS OF AUDIT ROUTINES, THEIR RELATED
C DATA, AND AN EXECUTIVE SYSTEM. EACH AUDIT ROUTINE IS A FORTRAN
C PROGRAM, SUBPROGRAM OR FUNCTION WHICH INCLUDES TESTS OF SPECIFIC
C LANGUAGE ELEMENTS AND SUPPORTING PROCEDURES INDICATING THE RESULT
C OF EXECUTING THESE TESTS.
C
C THIS PARTICULAR PROGRAM/SUBPROGRAM/FUNCTION CONTAINS FEATURES
C FOUND ONLY IN THE SUBSET AS DEFINED IN X3.9-1978.
C
C SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO -
C
C DEPARTMENT OF THE NAVY
C FEDERAL COBOL COMPILER TESTING SERVICE
C WASHINGTON, D.C. 20376
C
C **********************************************************
C
C
C
C INITIALIZATION SECTION
C
C INITIALIZE CONSTANTS
C **************
C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER.
I01 = 5
C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER.
I02 = 6
C SYSTEM ENVIRONMENT SECTION
C
CX010 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-010 CONTROL CARD.
C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5
C (UNIT NUMBER FOR CARD READER).
CX011 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-011 CONTROL CARD.
C THE CX011 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL
C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX010 ABOVE.
C
CX020 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-020 CONTROL CARD.
C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02 = 6
C (UNIT NUMBER FOR PRINTER).
CX021 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-021 CONTROL CARD.
C THE CX021 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL
C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX020 ABOVE.
C
IVPASS=0
IVFAIL=0
IVDELE=0
ICZERO=0
C
C WRITE PAGE HEADERS
WRITE (I02,90000)
WRITE (I02,90001)
WRITE (I02,90002)
WRITE (I02, 90002)
WRITE (I02,90003)
WRITE (I02,90002)
WRITE (I02,90004)
WRITE (I02,90002)
WRITE (I02,90011)
WRITE (I02,90002)
WRITE (I02,90002)
WRITE (I02,90005)
WRITE (I02,90006)
WRITE (I02,90002)
IVTNUM = 126
C
C TEST 126 - THIS TESTS THE SIMPLE ASSIGN STATEMENT IN PREPARATION
C FOR THE ASSIGNED GO TO TEST TO FOLLOW.
C THE ASSIGNED GO TO IS THE SIMPLIST FORM OF THE STATEMENT.
C
C
IF (ICZERO) 31260, 1260, 31260
1260 CONTINUE
ASSIGN 1263 TO I
GO TO I, (1262,1263,1264)
1262 ICON01 = 1262
GO TO 1265
1263 ICON01 = 1263
GO TO 1265
1264 ICON01 = 1264
1265 CONTINUE
GO TO 41260
31260 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 41260, 1271, 41260
41260 IF ( ICON01 - 1263 ) 21260, 11260, 21260
11260 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 1271
21260 IVFAIL = IVFAIL + 1
IVCOMP=ICON01
IVCORR = 1263
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
1271 CONTINUE
IVTNUM = 127
C
C TEST 127 - THIS IS A TEST OF MORE COMPLEX BRANCHING USING
C THE ASSIGN AND ASSIGNED GO TO STATEMENTS. THIS TEST IS NOT
C INTENDED TO BE AN EXAMPLE OF STRUCTURED PROGRAMMING.
C
C
IF (ICZERO) 31270, 1270, 31270
1270 CONTINUE
IVON01=0
1272 ASSIGN 1273 TO J
IVON01=IVON01+1
GO TO 1276
1273 ASSIGN 1274 TO J
IVON01=IVON01 * 10 + 2
GO TO 1276
1274 ASSIGN 1275 TO J
IVON01=IVON01 * 100 + 3
GO TO 1276
1275 GO TO 1277
1276 GO TO J, ( 1272, 1273, 1274, 1275 )
1277 CONTINUE
GO TO 41270
31270 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 41270, 1281, 41270
41270 IF ( IVON01 - 1203 ) 21270, 11270, 21270
11270 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 1281
21270 IVFAIL = IVFAIL + 1
IVCOMP=IVON01
IVCORR=1203
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
1281 CONTINUE
IVTNUM = 128
C
C TEST 128 - TEST OF THE ASSIGNED GO TO WITH ALL OF THE
C STATEMENT NUMBERS IN THE ASSIGNED GO TO LIST THE SAME
C VALUE EXCEPT FOR ONE.
C
C
IF (ICZERO) 31280, 1280, 31280
1280 CONTINUE
ICON01=0
ASSIGN 1283 TO K
GO TO K, ( 1282, 1282, 1282, 1282, 1282, 1282, 1283 )
1282 ICON01 = 0
GO TO 1284
1283 ICON01 = 1
1284 CONTINUE
GO TO 41280
31280 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 41280, 1291, 41280
41280 IF ( ICON01 - 1 ) 21280, 11280, 21280
11280 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 1291
21280 IVFAIL = IVFAIL + 1
IVCOMP=ICON01
IVCORR=1
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
1291 CONTINUE
IVTNUM = 129
C
C TEST 129 - THIS TESTS THE ASSIGN STATEMENT IN CONJUNCTION
C WITH THE NORMAL ARITHMETIC ASSIGN STATEMENT. THE VALUE
C OF THE INDEX FOR THE ASSIGNED GO TO STATEMENT IS CHANGED BY
C THE COMBINATION OF STATEMENTS.
C
C
IF (ICZERO) 31290, 1290, 31290
1290 CONTINUE
ICON01=0
ASSIGN 1292 TO L
L = 1293
ASSIGN 1294 TO L
GO TO L, ( 1294, 1293, 1292 )
1292 ICON01 = 0
GO TO 1295
1293 ICON01 = 0
GO TO 1295
1294 ICON01 = 1
1295 CONTINUE
GO TO 41290
31290 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 41290, 1301, 41290
41290 IF ( ICON01 - 1 ) 21290, 11290, 21290
11290 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 1301
21290 IVFAIL = IVFAIL + 1
IVCOMP=ICON01
IVCORR=1
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
1301 CONTINUE
IVTNUM = 130
C
C TEST 130 - THIS IS A TEST OF A LOOP USING A COMBINATION OF THE
C ASSIGNED GO TO STATEMENT AND THE ARITHMETIC IF STATEMENT.
C THE LOOP SHOULD BE EXECUTED ELEVEN (11) TIMES THEN CONTROL
C SHOULD PASS TO THE CHECK OF THE VALUE FOR IVON01.
C
C
IF (ICZERO) 31300, 1300, 31300
1300 CONTINUE
IVON01=0
1302 ASSIGN 1302 TO M
IVON01=IVON01+1
IF ( IVON01 - 10 ) 1303, 1303, 1304
1303 GO TO 1305
1304 ASSIGN 1306 TO M
1305 GO TO M, ( 1302, 1306 )
1306 CONTINUE
GO TO 41300
31300 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 41300, 1311, 41300
41300 IF ( IVON01 - 11 ) 21300, 11300, 21300
11300 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 1311
21300 IVFAIL = IVFAIL + 1
IVCOMP=IVON01
IVCORR=11
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
1311 CONTINUE
C
C WRITE PAGE FOOTINGS AND RUN SUMMARIES
99999 CONTINUE
WRITE (I02,90002)
WRITE (I02,90006)
WRITE (I02,90002)
WRITE (I02,90002)
WRITE (I02,90007)
WRITE (I02,90002)
WRITE (I02,90008) IVFAIL
WRITE (I02,90009) IVPASS
WRITE (I02,90010) IVDELE
C
C
C TERMINATE ROUTINE EXECUTION
STOP
C
C FORMAT STATEMENTS FOR PAGE HEADERS
90000 FORMAT (1H1)
90002 FORMAT (1H )
90001 FORMAT (1H ,10X,34HFORTRAN COMPILER VALIDATION SYSTEM)
90003 FORMAT (1H ,21X,11HVERSION 1.0)
90004 FORMAT (1H ,10X,38HFOR OFFICIAL USE ONLY - COPYRIGHT 1978)
90005 FORMAT (1H ,5X,4HTEST,5X,9HPASS/FAIL, 5X,8HCOMPUTED,8X,7HCORRECT)
90006 FORMAT (1H ,5X,46H----------------------------------------------)
90011 FORMAT (1H ,18X,17HSUBSET LEVEL TEST)
C
C FORMAT STATEMENTS FOR RUN SUMMARIES
90008 FORMAT (1H ,15X,I5,19H ERRORS ENCOUNTERED)
90009 FORMAT (1H ,15X,I5,13H TESTS PASSED)
90010 FORMAT (1H ,15X,I5,14H TESTS DELETED)
C
C FORMAT STATEMENTS FOR TEST RESULTS
80001 FORMAT (1H ,4X,I5,7X,4HPASS)
80002 FORMAT (1H ,4X,I5,7X,4HFAIL)
80003 FORMAT (1H ,4X,I5,7X,7HDELETED)
80004 FORMAT (1H ,4X,I5,7X,4HFAIL,10X,I6,9X,I6)
80005 FORMAT (1H ,4X,I5,7X,4HFAIL,4X,E12.5,3X,E12.5)
C
90007 FORMAT (1H ,20X,20HEND OF PROGRAM FM013)
END
*END-OF,FM013
FM014.f 480975971 170 2 100666 7388 `
*HEADER,FORTR,FM014
*FILES1,FORTR,FM014,X
C
C COMMENT SECTION.
C
C FM014
C
C THIS ROUTINE TESTS THE FORTRAN COMPUTED GO TO STATEMENT.
C BECAUSE THE FORM OF THE COMPUTED GO TO IS SO STRAIGHTFORWARD, THE
C TESTS MAINLY RELATE TO THE RANGE OF POSSIBLE STATEMENT NUMBERS
C WHICH ARE USED.
C
C REFERENCES
C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN,
C X3.9-1978
C
C SECTION 11.2, COMPUTED GO TO STATEMENT
C
C
C **********************************************************
C
C A COMPILER VALIDATION SYSTEM FOR THE FORTRAN LANGUAGE
C BASED ON SPECIFICATIONS AS DEFINED IN AMERICAN NATIONAL STANDARD
C PROGRAMMING LANGUAGE FORTRAN X3.9-1978, HAS BEEN DEVELOPED BY THE
C FEDERAL COBOL COMPILER TESTING SERVICE. THE FORTRAN COMPILER
C VALIDATION SYSTEM (FCVS) CONSISTS OF AUDIT ROUTINES, THEIR RELATED
C DATA, AND AN EXECUTIVE SYSTEM. EACH AUDIT ROUTINE IS A FORTRAN
C PROGRAM, SUBPROGRAM OR FUNCTION WHICH INCLUDES TESTS OF SPECIFIC
C LANGUAGE ELEMENTS AND SUPPORTING PROCEDURES INDICATING THE RESULT
C OF EXECUTING THESE TESTS.
C
C THIS PARTICULAR PROGRAM/SUBPROGRAM/FUNCTION CONTAINS FEATURES
C FOUND ONLY IN THE SUBSET AS DEFINED IN X3.9-1978.
C
C SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO -
C
C DEPARTMENT OF THE NAVY
C FEDERAL COBOL COMPILER TESTING SERVICE
C WASHINGTON, D.C. 20376
C
C **********************************************************
C
C
C
C INITIALIZATION SECTION
C
C INITIALIZE CONSTANTS
C **************
C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER.
I01 = 5
C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER.
I02 = 6
C SYSTEM ENVIRONMENT SECTION
C
CX010 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-010 CONTROL CARD.
C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5
C (UNIT NUMBER FOR CARD READER).
CX011 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-011 CONTROL CARD.
C THE CX011 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL
C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX010 ABOVE.
C
CX020 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-020 CONTROL CARD.
C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02 = 6
C (UNIT NUMBER FOR PRINTER).
CX021 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-021 CONTROL CARD.
C THE CX021 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL
C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX020 ABOVE.
C
IVPASS=0
IVFAIL=0
IVDELE=0
ICZERO=0
C
C WRITE PAGE HEADERS
WRITE (I02,90000)
WRITE (I02,90001)
WRITE (I02,90002)
WRITE (I02, 90002)
WRITE (I02,90003)
WRITE (I02,90002)
WRITE (I02,90004)
WRITE (I02,90002)
WRITE (I02,90011)
WRITE (I02,90002)
WRITE (I02,90002)
WRITE (I02,90005)
WRITE (I02,90006)
WRITE (I02,90002)
IVTNUM = 131
C
C TEST 131 - TEST OF THE SIMPLIST FORM OF THE COMPUTED GO TO
C STATEMENT WITH THREE POSSIBLE BRANCHES.
C
C
IF (ICZERO) 31310, 1310, 31310
1310 CONTINUE
ICON01=0
I=3
GO TO ( 1312, 1313, 1314 ), I
1312 ICON01 = 1312
GO TO 1315
1313 ICON01 = 1313
GO TO 1315
1314 ICON01 = 1314
1315 CONTINUE
GO TO 41310
31310 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 41310, 1321, 41310
41310 IF ( ICON01 - 1314 ) 21310, 11310, 21310
11310 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 1321
21310 IVFAIL = IVFAIL + 1
IVCOMP=ICON01
IVCORR = 1314
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
1321 CONTINUE
IVTNUM = 132
C
C TEST 132 - THIS TESTS THE COMPUTED GO TO IN CONJUNCTION WITH THE
C THE UNCONDITIONAL GO TO STATEMENT. THIS TEST IS NOT
C INTENDED TO BE AN EXAMPLE OF GOOD STRUCTURED PROGRAMMING.
C
C
IF (ICZERO) 31320, 1320, 31320
1320 CONTINUE
IVON01=0
J=1
GO TO 1326
1322 J = 2
IVON01=IVON01+2
GO TO 1326
1323 J = 3
IVON01=IVON01 * 10 + 3
GO TO 1326
1324 J = 4
IVON01=IVON01 * 100 + 4
GO TO 1326
1325 IVON01 = IVON01 + 1
GO TO 1327
1326 GO TO ( 1322, 1323, 1324, 1325, 1326 ), J
1327 CONTINUE
GO TO 41320
31320 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 41320, 1331, 41320
41320 IF ( IVON01 - 2305 ) 21320, 11320, 21320
11320 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 1331
21320 IVFAIL = IVFAIL + 1
IVCOMP=IVON01
IVCORR=2305
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
1331 CONTINUE
IVTNUM = 133
C
C TEST 133 - THIS IS A TEST OF THE COMPUTED GO TO STATEMENT WITH
C A SINGLE STATEMENT LABEL AS THE LIST OF POSSIBLE BRANCHES.
C
C
IF (ICZERO) 31330, 1330, 31330
1330 CONTINUE
IVON01=0
K=1
GO TO ( 1332 ), K
1332 IVON01 = 1
GO TO 41330
31330 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 41330, 1341, 41330
41330 IF ( IVON01 - 1 ) 21330, 11330, 21330
11330 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 1341
21330 IVFAIL = IVFAIL + 1
IVCOMP=IVON01
IVCORR=1
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
1341 CONTINUE
IVTNUM = 134
C
C TEST 134 - THIS IS A TEST OF FIVE (5) DIGIT STATEMENT NUMBERS
C WHICH EXCEED THE INTEGER 32767 USED IN THE COMPUTED GO TO
C STATEMENT WITH THREE POSSIBLE BRANCHES.
C
C
IF (ICZERO) 31340, 1340, 31340
1340 CONTINUE
IVON01=0
L=2
GO TO ( 99991, 99992, 99993 ), L
99991 IVON01=1
GO TO 1342
99992 IVON01=2
GO TO 1342
99993 IVON01=3
1342 CONTINUE
GO TO 41340
31340 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 41340, 1351, 41340
41340 IF ( IVON01 - 2 ) 21340, 11340, 21340
11340 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 1351
21340 IVFAIL = IVFAIL + 1
IVCOMP=IVON01
IVCORR=2
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
1351 CONTINUE
C
C WRITE PAGE FOOTINGS AND RUN SUMMARIES
99999 CONTINUE
WRITE (I02,90002)
WRITE (I02,90006)
WRITE (I02,90002)
WRITE (I02,90002)
WRITE (I02,90007)
WRITE (I02,90002)
WRITE (I02,90008) IVFAIL
WRITE (I02,90009) IVPASS
WRITE (I02,90010) IVDELE
C
C
C TERMINATE ROUTINE EXECUTION
STOP
C
C FORMAT STATEMENTS FOR PAGE HEADERS
90000 FORMAT (1H1)
90002 FORMAT (1H )
90001 FORMAT (1H ,10X,34HFORTRAN COMPILER VALIDATION SYSTEM)
90003 FORMAT (1H ,21X,11HVERSION 1.0)
90004 FORMAT (1H ,10X,38HFOR OFFICIAL USE ONLY - COPYRIGHT 1978)
90005 FORMAT (1H ,5X,4HTEST,5X,9HPASS/FAIL, 5X,8HCOMPUTED,8X,7HCORRECT)
90006 FORMAT (1H ,5X,46H----------------------------------------------)
90011 FORMAT (1H ,18X,17HSUBSET LEVEL TEST)
C
C FORMAT STATEMENTS FOR RUN SUMMARIES
90008 FORMAT (1H ,15X,I5,19H ERRORS ENCOUNTERED)
90009 FORMAT (1H ,15X,I5,13H TESTS PASSED)
90010 FORMAT (1H ,15X,I5,14H TESTS DELETED)
C
C FORMAT STATEMENTS FOR TEST RESULTS
80001 FORMAT (1H ,4X,I5,7X,4HPASS)
80002 FORMAT (1H ,4X,I5,7X,4HFAIL)
80003 FORMAT (1H ,4X,I5,7X,7HDELETED)
80004 FORMAT (1H ,4X,I5,7X,4HFAIL,10X,I6,9X,I6)
80005 FORMAT (1H ,4X,I5,7X,4HFAIL,4X,E12.5,3X,E12.5)
C
90007 FORMAT (1H ,20X,20HEND OF PROGRAM FM014)
END
*END-OF,FM014
FM016.f 480975974 170 2 100666 23578 `
*HEADER,FORTR,FM016
*FILES1,FORTR,FM016,X
C
C COMMENT SECTION.
C
C FM016
C
C THIS ROUTINE BEGINS A SERIES OF TESTS OF THE FORTRAN
C LOGICAL IF STATEMENT IN ALL OF THE VARIOUS FORMS. THE
C FOLLOWING LOGICAL OPERANDS ARE USED FOR THIS ROUTINE - LOGICAL
C CONSTANTS, LOGICAL VARIABLES, LOGICAL ARRAY ELEMENTS, AND
C ARITHMETIC EXPRESSIONS WITH VARIOUS RELATIONAL OPERATORS. BOTH
C THE TRUE AND FALSE BRANCHES ARE TESTED IN THE SERIES OF TESTS.
C
C REFERENCES
C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN,
C X3.9-1978
C
C SECTION 4.7.1, LOGICAL CONSTANT
C SECTION 6, EXPRESSIONS
C SECTION 6.1, ARITHMETIC EXPRESSIONS
C SECTION 6.3, RELATIONAL EXPRESSIONS
C SECTION 6.4, LOGICAL EXPRESSIONS
C SECTION 6.6, EVALUATION OF EXPRESSIONS
C SECTION 10, ASSIGNMENT STATEMENTS
C SECTION 10.2, LOGICAL ASSIGNMENT STATEMENT
C SECTION 11.5, LOGICAL IF STATEMENT
C
LOGICAL LCTNT1, LCTNF1, LVTNTF, LVTNFT, LATN1A(2)
LOGICAL LADN1D, LADN1B
DIMENSION LADN1D(2), LADN1B(2)
DATA LADN1D/.TRUE., .FALSE./
C
C **********************************************************
C
C A COMPILER VALIDATION SYSTEM FOR THE FORTRAN LANGUAGE
C BASED ON SPECIFICATIONS AS DEFINED IN AMERICAN NATIONAL STANDARD
C PROGRAMMING LANGUAGE FORTRAN X3.9-1978, HAS BEEN DEVELOPED BY THE
C FEDERAL COBOL COMPILER TESTING SERVICE. THE FORTRAN COMPILER
C VALIDATION SYSTEM (FCVS) CONSISTS OF AUDIT ROUTINES, THEIR RELATED
C DATA, AND AN EXECUTIVE SYSTEM. EACH AUDIT ROUTINE IS A FORTRAN
C PROGRAM, SUBPROGRAM OR FUNCTION WHICH INCLUDES TESTS OF SPECIFIC
C LANGUAGE ELEMENTS AND SUPPORTING PROCEDURES INDICATING THE RESULT
C OF EXECUTING THESE TESTS.
C
C THIS PARTICULAR PROGRAM/SUBPROGRAM/FUNCTION CONTAINS FEATURES
C FOUND ONLY IN THE SUBSET AS DEFINED IN X3.9-1978.
C
C SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO -
C
C DEPARTMENT OF THE NAVY
C FEDERAL COBOL COMPILER TESTING SERVICE
C WASHINGTON, D.C. 20376
C
C **********************************************************
C
C
C
C INITIALIZATION SECTION
C
C INITIALIZE CONSTANTS
C **************
C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER.
I01 = 5
C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER.
I02 = 6
C SYSTEM ENVIRONMENT SECTION
C
CX010 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-010 CONTROL CARD.
C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5
C (UNIT NUMBER FOR CARD READER).
CX011 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-011 CONTROL CARD.
C THE CX011 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL
C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX010 ABOVE.
C
CX020 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-020 CONTROL CARD.
C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02 = 6
C (UNIT NUMBER FOR PRINTER).
CX021 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-021 CONTROL CARD.
C THE CX021 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL
C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX020 ABOVE.
C
IVPASS=0
IVFAIL=0
IVDELE=0
ICZERO=0
C
C WRITE PAGE HEADERS
WRITE (I02,90000)
WRITE (I02,90001)
WRITE (I02,90002)
WRITE (I02, 90002)
WRITE (I02,90003)
WRITE (I02,90002)
WRITE (I02,90004)
WRITE (I02,90002)
WRITE (I02,90011)
WRITE (I02,90002)
WRITE (I02,90002)
WRITE (I02,90005)
WRITE (I02,90006)
WRITE (I02,90002)
IVTNUM = 139
C TEST 139 - THIS TESTS THE LOGICAL CONSTANT .TRUE.
C
IF (ICZERO) 31390, 1390, 31390
1390 CONTINUE
IVON01=0
IF ( .TRUE. ) IVON01 = 1
GO TO 41390
31390 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 41390, 1401, 41390
41390 IF ( IVON01 - 1 ) 21390, 11390, 21390
11390 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 1401
21390 IVFAIL = IVFAIL + 1
IVCOMP=IVON01
IVCORR=1
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
1401 CONTINUE
IVTNUM = 140
C TEST 140 - THIS TESTS THE LOGICAL CONSTANT .FALSE.
C
IF (ICZERO) 31400, 1400, 31400
1400 CONTINUE
IVON01=1
IF ( .FALSE. ) IVON01=0
GO TO 41400
31400 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 41400, 1411, 41400
41400 IF ( IVON01 - 1 ) 21400, 11400, 21400
11400 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 1411
21400 IVFAIL = IVFAIL + 1
IVCOMP=IVON01
IVCORR=1
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
1411 CONTINUE
IVTNUM = 141
C TEST 141 - THIS TESTS THE LOGICAL VARIABLE = .TRUE.
C
IF (ICZERO) 31410, 1410, 31410
1410 CONTINUE
LCTNT1=.TRUE.
IVON01 = 0
IF ( LCTNT1 ) IVON01 = 1
GO TO 41410
31410 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 41410, 1421, 41410
41410 IF ( IVON01 - 1 ) 21410, 11410, 21410
11410 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 1421
21410 IVFAIL = IVFAIL + 1
IVCOMP=IVON01
IVCORR=1
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
1421 CONTINUE
IVTNUM = 142
C TEST 142 - THIS TESTS THE LOGICAL VARIABLE = .FALSE.
C
IF (ICZERO) 31420, 1420, 31420
1420 CONTINUE
IVON01=1
LCTNF1=.FALSE.
IF ( LCTNF1 ) IVON01=0
GO TO 41420
31420 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 41420, 1431, 41420
41420 IF ( IVON01 - 1 ) 21420, 11420, 21420
11420 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 1431
21420 IVFAIL = IVFAIL + 1
IVCOMP=IVON01
IVCORR=1
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
1431 CONTINUE
IVTNUM = 143
C TEST 143 - THIS TESTS CHANGING THE VALUE OF A LOGICAL VARIABLE
C FROM .TRUE. TO .FALSE.
C
IF (ICZERO) 31430, 1430, 31430
1430 CONTINUE
LVTNTF=.TRUE.
LVTNTF=.FALSE.
IVON01 = 1
IF ( LVTNTF ) IVON01 = 0
GO TO 41430
31430 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 41430, 1441, 41430
41430 IF ( IVON01 - 1 ) 21430, 11430, 21430
11430 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 1441
21430 IVFAIL = IVFAIL + 1
IVCOMP=IVON01
IVCORR=1
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
1441 CONTINUE
IVTNUM = 144
C TEST 144 - THIS TESTS CHANGING THE VALUE OF A LOGICAL VARIABLE
C FROM .FALSE. TO .TRUE.
C
IF (ICZERO) 31440, 1440, 31440
1440 CONTINUE
LVTNFT=.FALSE.
LVTNFT=.TRUE.
IVON01=0
IF ( LVTNFT ) IVON01=1
GO TO 41440
31440 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 41440, 1451, 41440
41440 IF ( IVON01 - 1 ) 21440, 11440, 21440
11440 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 1451
21440 IVFAIL = IVFAIL + 1
IVCOMP=IVON01
IVCORR=1
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
1451 CONTINUE
IVTNUM = 145
C TEST 145 - TEST OF A LOGICAL ARRAY ELEMENT SET TO .TRUE.
C
IF (ICZERO) 31450, 1450, 31450
1450 CONTINUE
LATN1A(1)=.TRUE.
IVON01=0
IF ( LATN1A(1) ) IVON01=1
GO TO 41450
31450 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 41450, 1461, 41450
41450 IF ( IVON01 - 1 ) 21450, 11450, 21450
11450 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 1461
21450 IVFAIL = IVFAIL + 1
IVCOMP=IVON01
IVCORR=1
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
1461 CONTINUE
IVTNUM = 146
C TEST 146 - TEST OF A LOGICAL ARRAY ELEMENT SET TO .FALSE.
C
IF (ICZERO) 31460, 1460, 31460
1460 CONTINUE
LATN1A(2) = .FALSE.
IVON01=1
IF ( LATN1A(2) ) IVON01=0
GO TO 41460
31460 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 41460, 1471, 41460
41460 IF ( IVON01 - 1 ) 21460, 11460, 21460
11460 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 1471
21460 IVFAIL = IVFAIL + 1
IVCOMP=IVON01
IVCORR=1
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
1471 CONTINUE
IVTNUM = 147
C TEST 147 - TEST OF A LOGICAL ARRAY ELEMENT SET .TRUE.
C IN A DATA INITIALIZATION STATEMENT.
C
IF (ICZERO) 31470, 1470, 31470
1470 CONTINUE
IVON01=0
IF ( LADN1D(1) ) IVON01=1
GO TO 41470
31470 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 41470, 1481, 41470
41470 IF ( IVON01 - 1 ) 21470, 11470, 21470
11470 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 1481
21470 IVFAIL = IVFAIL + 1
IVCOMP=IVON01
IVCORR=1
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
1481 CONTINUE
IVTNUM = 148
C TEST 148 - TEST OF A LOGICAL ARRAY ELEMENT SET .FALSE.
C IN A DATA INITIALIZATION STATEMENT.
C
IF (ICZERO) 31480, 1480, 31480
1480 CONTINUE
IVON01=1
IF ( LADN1D(2) ) IVON01=0
GO TO 41480
31480 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 41480, 1491, 41480
41480 IF ( IVON01 - 1 ) 21480, 11480, 21480
11480 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 1491
21480 IVFAIL = IVFAIL + 1
IVCOMP=IVON01
IVCORR=1
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
1491 CONTINUE
IVTNUM = 149
C TEST 149 - LIKE TEST 145 EXCEPT THAT THE ARRAY DECLARATION WAS
C IN A DIMENSION STATEMENT RATHER THAN IN THE TYPE STATEMENT.
C
IF (ICZERO) 31490, 1490, 31490
1490 CONTINUE
LADN1B(1)=.TRUE.
IVON01=0
IF ( LADN1B(1) ) IVON01=1
GO TO 41490
31490 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 41490, 1501, 41490
41490 IF ( IVON01 - 1 ) 21490, 11490, 21490
11490 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 1501
21490 IVFAIL = IVFAIL + 1
IVCOMP=IVON01
IVCORR=1
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
C
C FOR TESTS 150 THRU 156 THE TRUE PATH IS USED..
C
1501 CONTINUE
IVTNUM = 150
C TEST 150 - RELATIONAL EXPRESSION WITH INTEGER CONSTANTS .LT.
C
IF (ICZERO) 31500, 1500, 31500
1500 CONTINUE
IVON01=0
IF ( 3 .LT. 76 ) IVON01=1
GO TO 41500
31500 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 41500, 1511, 41500
41500 IF ( IVON01 - 1 ) 21500, 11500, 21500
11500 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 1511
21500 IVFAIL = IVFAIL + 1
IVCOMP=IVON01
IVCORR=1
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
1511 CONTINUE
IVTNUM = 151
C TEST 151 - TEST WITH RELATIONAL EXPRESSION .LE.
C
IF (ICZERO) 31510, 1510, 31510
1510 CONTINUE
IVON01=0
IF ( 587 .LE. 587 ) IVON01=1
GO TO 41510
31510 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 41510, 1521, 41510
41510 IF ( IVON01 - 1 ) 21510, 11510, 21510
11510 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 1521
21510 IVFAIL = IVFAIL + 1
IVCOMP=IVON01
IVCORR=1
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
1521 CONTINUE
IVTNUM = 152
C TEST 152 - TEST OF RELATIONAL EXPRESSION WITH INTEGER CONSTANTS
C RELATIONAL OPERATOR IS .EQ.
C
IF (ICZERO) 31520, 1520, 31520
1520 CONTINUE
IVON01=0
IF ( 9999 .EQ. 9999 ) IVON01=1
GO TO 41520
31520 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 41520, 1531, 41520
41520 IF ( IVON01 - 1 ) 21520, 11520, 21520
11520 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 1531
21520 IVFAIL = IVFAIL + 1
IVCOMP=IVON01
IVCORR=1
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
1531 CONTINUE
IVTNUM = 153
C TEST 153 - TEST OF RELATIONAL EXPRESSION WITH INTEGER CONSTANTS
C RELATIONAL OPERATOR IS .NE.
C
IF (ICZERO) 31530, 1530, 31530
1530 CONTINUE
IVON01=0
IF ( 0 .NE. 32767 ) IVON01=1
GO TO 41530
31530 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 41530, 1541, 41530
41530 IF ( IVON01 - 1 ) 21530, 11530, 21530
11530 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 1541
21530 IVFAIL = IVFAIL + 1
IVCOMP=IVON01
IVCORR=1
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
1541 CONTINUE
IVTNUM = 154
C TEST 154 - TEST OF RELATIONAL EXPRESSION WITH INTEGER CONSTANTS
C RELATIONAL OPERATOR IS .GT.
C
IF (ICZERO) 31540, 1540, 31540
1540 CONTINUE
IVON01=0
IF ( 32767 .GT. 76 ) IVON01=1
GO TO 41540
31540 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 41540, 1551, 41540
41540 IF ( IVON01 - 1 ) 21540, 11540, 21540
11540 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 1551
21540 IVFAIL = IVFAIL + 1
IVCOMP=IVON01
IVCORR=1
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
1551 CONTINUE
IVTNUM = 155
C TEST 155 - TEST OF RELATIONAL EXPRESSION WITH INTEGER CONSTANTS
C RELATIONAL OPERATOR IS .GE.
C
IF (ICZERO) 31550, 1550, 31550
1550 CONTINUE
IVON01=0
IF ( 32767 .GE. 76 ) IVON01=1
GO TO 41550
31550 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 41550, 1561, 41550
41550 IF ( IVON01 - 1 ) 21550, 11550, 21550
11550 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 1561
21550 IVFAIL = IVFAIL + 1
IVCOMP=IVON01
IVCORR=1
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
1561 CONTINUE
IVTNUM = 156
C TEST 156 - TEST OF RELATIONAL EXPRESSION WITH INTEGER CONSTANTS
C RELATIONAL OPERATOR IS .GE.
C
IF (ICZERO) 31560, 1560, 31560
1560 CONTINUE
IVON01=0
IF ( 32767 .GE. 32767 ) IVON01=1
GO TO 41560
31560 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 41560, 1571, 41560
41560 IF ( IVON01 - 1 ) 21560, 11560, 21560
11560 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 1571
21560 IVFAIL = IVFAIL + 1
IVCOMP=IVON01
IVCORR=1
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
C
C FOR TESTS 157 THRU 162 THE FALSE PATH IS USED..
C
1571 CONTINUE
IVTNUM = 157
C TEST 157 - RELATIONAL EXPRESSION INTEGER CONSTANTS FALSE PATH
C RELATIONAL OPERATOR IS .LT.
C
IF (ICZERO) 31570, 1570, 31570
1570 CONTINUE
IVON01=1
IF ( 76 .LT. 3 ) IVON01=0
GO TO 41570
31570 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 41570, 1581, 41570
41570 IF ( IVON01 - 1 ) 21570, 11570, 21570
11570 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 1581
21570 IVFAIL = IVFAIL + 1
IVCOMP=IVON01
IVCORR=1
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
1581 CONTINUE
IVTNUM = 158
C TEST 158 - RELATIONAL EXPRESSION INTEGER CONSTANTS FALSE PATH
C RELATIONAL OPERATOR IS .LE.
C
IF (ICZERO) 31580, 1580, 31580
1580 CONTINUE
IVON01=1
IF ( 76 .LE. 3 ) IVON01=0
GO TO 41580
31580 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 41580, 1591, 41580
41580 IF ( IVON01 - 1 ) 21580, 11580, 21580
11580 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 1591
21580 IVFAIL = IVFAIL + 1
IVCOMP=IVON01
IVCORR=1
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
1591 CONTINUE
IVTNUM = 159
C TEST 159 - RELATIONAL EXPRESSION INTEGER CONSTANTS FALSE PATH
C RELATIONAL OPERATOR IS .EQ.
C
IF (ICZERO) 31590, 1590, 31590
1590 CONTINUE
IVON01=1
IF ( 9999 .EQ. 587 ) IVON01=0
GO TO 41590
31590 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 41590, 1601, 41590
41590 IF ( IVON01 - 1 ) 21590, 11590, 21590
11590 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 1601
21590 IVFAIL = IVFAIL + 1
IVCOMP=IVON01
IVCORR=1
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
1601 CONTINUE
IVTNUM = 160
C TEST 160 - RELATIONAL EXPRESSION INTEGER CONSTANTS FALSE PATH
C RELATIONAL OPERATOR IS .NE.
C
IF (ICZERO) 31600, 1600, 31600
1600 CONTINUE
IVON01=1
IF ( 3 .NE. 3 ) IVON01=0
GO TO 41600
31600 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 41600, 1611, 41600
41600 IF ( IVON01 - 1 ) 21600, 11600, 21600
11600 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 1611
21600 IVFAIL = IVFAIL + 1
IVCOMP=IVON01
IVCORR=1
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
1611 CONTINUE
IVTNUM=161
C
C TEST 161 - RELATIONAL EXPRESSION INTEGER CONSTANTS FALSE PATH
C RELATIONAL OPERATOR IS .GT.
C
IF ( ICZERO ) 31610, 1610, 31610
1610 CONTINUE
IVON01=1
IF ( 76 .GT. 32767 ) IVON01=0
GO TO 41610
31610 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF ( ICZERO ) 41610, 1621, 41610
41610 IF ( IVON01 - 1 ) 21610, 11610, 21610
11610 IVPASS = IVPASS+ 1
WRITE (I02,80001) IVTNUM
GO TO 1621
21610 IVFAIL = IVFAIL + 1
IVCOMP=IVON01
IVCORR=1
WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR
1621 CONTINUE
IVTNUM = 162
C
C
C **** TEST 162 ****
C
C TEST 162 - RELATIONAL EXPRESSION INTEGER CONSTANTS FALSE PATH
C RELATIONAL OPERATOR IS .GE.
C
IF (ICZERO) 31620, 1620, 31620
1620 CONTINUE
IVON01=1
IF ( 76 .GE. 32767 ) IVON01 = 0
GO TO 41620
31620 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 41620, 1631, 41620
41620 IF ( IVON01 - 1 ) 21620, 11620, 21620
11620 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 1631
21620 IVFAIL = IVFAIL + 1
IVCOMP=IVON01
IVCORR=1
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
1631 CONTINUE
IVTNUM = 163
C
C **** TEST 163 ****
C TEST 163 - RELATIONAL EXPRESSION WITH INTEGER VARIABLE
C REFERENCES (IC) (RO) (IVR). TRUE PATH. USE .LT.
C
C
IF (ICZERO) 31630, 1630, 31630
1630 CONTINUE
IVON01 = 76
IVON02 = 0
IF ( 3 .LT. IVON01 ) IVON02 = 1
GO TO 41630
31630 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 41630, 1641, 41630
41630 IF ( IVON02 - 1 ) 21630, 11630, 21630
11630 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 1641
21630 IVFAIL = IVFAIL + 1
IVCOMP = IVON02
IVCORR = 1
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
1641 CONTINUE
IVTNUM = 164
C
C **** TEST 164 ****
C TEST 164 - RELATIONAL EXPRESSION. INTEGER VARIABLE REFERENCES.
C TRUE PATH. .LE.
C
C
IF (ICZERO) 31640, 1640, 31640
1640 CONTINUE
IVON01 = 587
IVON02 = 0
IF ( 587 .LE. IVON01 ) IVON02 = 1
GO TO 41640
31640 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 41640, 1651, 41640
41640 IF ( IVON02 - 1 ) 21640, 11640, 21640
11640 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 1651
21640 IVFAIL = IVFAIL + 1
IVCOMP = IVON02
IVCORR = 1
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
1651 CONTINUE
IVTNUM = 165
C
C **** TEST 165 ****
C TEST 165 - RELATIONAL EXPRESSION. INTEGER VARIABLE REFERENCE.
C TRUE PATH. .EQ.
C
C
IF (ICZERO) 31650, 1650, 31650
1650 CONTINUE
IVON01 = 9999
IVON02 = 0
IF ( 9999 .EQ. IVON01 ) IVON02 = 1
GO TO 41650
31650 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 41650, 1661, 41650
41650 IF ( IVON02 - 1 ) 21650, 11650, 21650
11650 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 1661
21650 IVFAIL = IVFAIL + 1
IVCOMP = IVON02
IVCORR = 1
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
1661 CONTINUE
IVTNUM = 166
C
C **** TEST 166 ****
C TEST 166 - RELATIONAL EXPRESSION. INTEGER VARIABLE REFERENCE.
C TRUE PATH. .NE.
C
C
IF (ICZERO) 31660, 1660, 31660
1660 CONTINUE
IVON01 = 32767
IVON02 = 0
IF ( 0 .NE. IVON01 ) IVON02 = 1
GO TO 41660
31660 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 41660, 1671, 41660
41660 IF ( IVON02 - 1 ) 21660, 11660, 21660
11660 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 1671
21660 IVFAIL = IVFAIL + 1
IVCOMP = IVON02
IVCORR = 1
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
1671 CONTINUE
IVTNUM = 167
C
C **** TEST 167 ****
C TEST 167 - RELATIONAL EXPRESSION. INTEGER VARIABLE REFERENCE.
C TRUE PATH. .GT.
C
C
IF (ICZERO) 31670, 1670, 31670
1670 CONTINUE
IVON01 = 76
IVON02 = 0
IF ( 32767 .GT. IVON01 ) IVON02 = 1
GO TO 41670
31670 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 41670, 1681, 41670
41670 IF ( IVON02 - 1 ) 21670, 11670, 21670
11670 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 1681
21670 IVFAIL = IVFAIL + 1
IVCOMP = IVON02
IVCORR = 1
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
1681 CONTINUE
IVTNUM = 168
C
C **** TEST 168 ****
C TEST 168 - RELATIONAL EXPRESSION. INTEGER VARIABLE REFERENCE.
C TRUE PATH. .GE.
C
C
IF (ICZERO) 31680, 1680, 31680
1680 CONTINUE
IVON01 = 76
IVON02 = 0
IF ( 32767 .GE. IVON01 ) IVON02 = 1
GO TO 41680
31680 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 41680, 1691, 41680
41680 IF ( IVON02 - 1 ) 21680, 11680, 21680
11680 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 1691
21680 IVFAIL = IVFAIL + 1
IVCOMP = IVON02
IVCORR = 1
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
1691 CONTINUE
IVTNUM = 169
C
C **** TEST 169 ****
C TEST 169 - RELATIONAL EXPRESSION. INTEGER VARIABLE REFERENCE.
C TRUE PATH. .EQ.
C
C
IF (ICZERO) 31690, 1690, 31690
1690 CONTINUE
IVON01 = 32767
IVON02 = 0
IF ( 32767 .EQ. IVON01 ) IVON02 = 1
GO TO 41690
31690 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 41690, 1701, 41690
41690 IF ( IVON02 - 1 ) 21690, 11690, 21690
11690 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 1701
21690 IVFAIL = IVFAIL + 1
IVCOMP = IVON02
IVCORR = 1
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
1701 CONTINUE
C
C WRITE PAGE FOOTINGS AND RUN SUMMARIES
99999 CONTINUE
WRITE (I02,90002)
WRITE (I02,90006)
WRITE (I02,90002)
WRITE (I02,90002)
WRITE (I02,90007)
WRITE (I02,90002)
WRITE (I02,90008) IVFAIL
WRITE (I02,90009) IVPASS
WRITE (I02,90010) IVDELE
C
C
C TERMINATE ROUTINE EXECUTION
STOP
C
C FORMAT STATEMENTS FOR PAGE HEADERS
90000 FORMAT (1H1)
90002 FORMAT (1H )
90001 FORMAT (1H ,10X,34HFORTRAN COMPILER VALIDATION SYSTEM)
90003 FORMAT (1H ,21X,11HVERSION 1.0)
90004 FORMAT (1H ,10X,38HFOR OFFICIAL USE ONLY - COPYRIGHT 1978)
90005 FORMAT (1H ,5X,4HTEST,5X,9HPASS/FAIL, 5X,8HCOMPUTED,8X,7HCORRECT)
90006 FORMAT (1H ,5X,46H----------------------------------------------)
90011 FORMAT (1H ,18X,17HSUBSET LEVEL TEST)
C
C FORMAT STATEMENTS FOR RUN SUMMARIES
90008 FORMAT (1H ,15X,I5,19H ERRORS ENCOUNTERED)
90009 FORMAT (1H ,15X,I5,13H TESTS PASSED)
90010 FORMAT (1H ,15X,I5,14H TESTS DELETED)
C
C FORMAT STATEMENTS FOR TEST RESULTS
80001 FORMAT (1H ,4X,I5,7X,4HPASS)
80002 FORMAT (1H ,4X,I5,7X,4HFAIL)
80003 FORMAT (1H ,4X,I5,7X,7HDELETED)
80004 FORMAT (1H ,4X,I5,7X,4HFAIL,10X,I6,9X,I6)
80005 FORMAT (1H ,4X,I5,7X,4HFAIL,4X,E12.5,3X,E12.5)
C
90007 FORMAT (1H ,20X,20HEND OF PROGRAM FM016)
END
*END-OF,FM016
FM017.f 480975976 170 2 100666 24106 `
*HEADER,FORTR,FM017
*FILES1,FORTR,FM017,X
C
C COMMENT SECTION.
C
C FM017
C
C THIS ROUTINE CONTINUES TESTS OF THE FORTRAN
C LOGICAL IF STATEMENT IN ALL OF THE VARIOUS FORMS. THE
C FOLLOWING LOGICAL OPERANDS ARE USED FOR THIS ROUTINE - LOGICAL
C CONSTANTS, LOGICAL VARIABLES, LOGICAL ARRAY ELEMENTS, AND
C ARITHMETIC EXPRESSIONS WITH VARIOUS RELATIONAL OPERATORS. BOTH
C THE TRUE AND FALSE BRANCHES ARE TESTED IN THE SERIES OF TESTS.
C
C REFERENCES
C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN,
C X3.9-1978
C
C SECTION 4.7.1, LOGICAL CONSTANT
C SECTION 6, EXPRESSIONS
C SECTION 6.1, ARITHMETIC EXPRESSIONS
C SECTION 6.3, RELATIONAL EXPRESSIONS
C SECTION 6.4, LOGICAL EXPRESSIONS
C SECTION 6.6, EVALUATION OF EXPRESSIONS
C SECTION 10, ASSIGNMENT STATEMENTS
C SECTION 10.2, LOGICAL ASSIGNMENT STATEMENT
C SECTION 11.5, LOGICAL IF STATEMENT
C
DIMENSION IADN11(3)
LOGICAL LATN1A(2), LCTNT1, LCTNT2
C
C **********************************************************
C
C A COMPILER VALIDATION SYSTEM FOR THE FORTRAN LANGUAGE
C BASED ON SPECIFICATIONS AS DEFINED IN AMERICAN NATIONAL STANDARD
C PROGRAMMING LANGUAGE FORTRAN X3.9-1978, HAS BEEN DEVELOPED BY THE
C FEDERAL COBOL COMPILER TESTING SERVICE. THE FORTRAN COMPILER
C VALIDATION SYSTEM (FCVS) CONSISTS OF AUDIT ROUTINES, THEIR RELATED
C DATA, AND AN EXECUTIVE SYSTEM. EACH AUDIT ROUTINE IS A FORTRAN
C PROGRAM, SUBPROGRAM OR FUNCTION WHICH INCLUDES TESTS OF SPECIFIC
C LANGUAGE ELEMENTS AND SUPPORTING PROCEDURES INDICATING THE RESULT
C OF EXECUTING THESE TESTS.
C
C THIS PARTICULAR PROGRAM/SUBPROGRAM/FUNCTION CONTAINS FEATURES
C FOUND ONLY IN THE SUBSET AS DEFINED IN X3.9-1978.
C
C SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO -
C
C DEPARTMENT OF THE NAVY
C FEDERAL COBOL COMPILER TESTING SERVICE
C WASHINGTON, D.C. 20376
C
C **********************************************************
C
C
C
C INITIALIZATION SECTION
C
C INITIALIZE CONSTANTS
C **************
C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER.
I01 = 5
C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER.
I02 = 6
C SYSTEM ENVIRONMENT SECTION
C
CX010 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-010 CONTROL CARD.
C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5
C (UNIT NUMBER FOR CARD READER).
CX011 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-011 CONTROL CARD.
C THE CX011 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL
C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX010 ABOVE.
C
CX020 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-020 CONTROL CARD.
C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02 = 6
C (UNIT NUMBER FOR PRINTER).
CX021 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-021 CONTROL CARD.
C THE CX021 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL
C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX020 ABOVE.
C
IVPASS=0
IVFAIL=0
IVDELE=0
ICZERO=0
C
C WRITE PAGE HEADERS
WRITE (I02,90000)
WRITE (I02,90001)
WRITE (I02,90002)
WRITE (I02, 90002)
WRITE (I02,90003)
WRITE (I02,90002)
WRITE (I02,90004)
WRITE (I02,90002)
WRITE (I02,90011)
WRITE (I02,90002)
WRITE (I02,90002)
WRITE (I02,90005)
WRITE (I02,90006)
WRITE (I02,90002)
IVTNUM = 170
C
C **** TEST 170 ****
C TEST 170 - RELATIONAL EXPRESSION. INTEGER VARIABLE REFERENCE.
C FALSE PATH. .LT.
C
C
IF (ICZERO) 31700, 1700, 31700
1700 CONTINUE
IVON01 = 3
IVON02 = 1
IF ( 76 .LT. IVON01 ) IVON02 = 0
GO TO 41700
31700 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 41700, 1711, 41700
41700 IF ( IVON02 - 1 ) 21700, 11700, 21700
11700 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 1711
21700 IVFAIL = IVFAIL + 1
IVCOMP = IVON02
IVCORR = 1
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
1711 CONTINUE
IVTNUM = 171
C
C **** TEST 171 ****
C TEST 171 - RELATIONAL EXPRESSION. INTEGER VARIABLE REFERENCE.
C FALSE PATH. .LE.
C
C
IF (ICZERO) 31710, 1710, 31710
1710 CONTINUE
IVON01 = 3
IVON02 = 1
IF ( 76 .LE. IVON01 ) IVON02 = 0
GO TO 41710
31710 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 41710, 1721, 41710
41710 IF ( IVON02 - 1 ) 21710, 11710, 21710
11710 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 1721
21710 IVFAIL = IVFAIL + 1
IVCOMP = IVON02
IVCORR = 1
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
1721 CONTINUE
IVTNUM = 172
C
C **** TEST 172 ****
C TEST 172 - RELATIONAL EXPRESSIONAL. INTEGER VARIABLE REFERENCE.
C FALSE PATH. .EQ.
C
C
IF (ICZERO) 31720, 1720, 31720
1720 CONTINUE
IVON01 = 587
IVON02 = 1
IF ( 9999 .EQ. IVON01 ) IVON02 = 0
GO TO 41720
31720 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 41720, 1731, 41720
41720 IF ( IVON02 - 1 ) 21720, 11720, 21720
11720 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 1731
21720 IVFAIL = IVFAIL + 1
IVCOMP = IVON02
IVCORR = 1
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
1731 CONTINUE
IVTNUM = 173
C
C **** TEST 173 ****
C TEST 173 - RELATIONAL EXPRESSION. INTEGER VARIABLE REFERENCE.
C FALSE PATH. .NE.
C
C
IF (ICZERO) 31730, 1730, 31730
1730 CONTINUE
IVON01 = 3
IVON02 = 1
IF ( 3 .NE. IVON01 ) IVON02 = 0
GO TO 41730
31730 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 41730, 1741, 41730
41730 IF ( IVON02 - 1 ) 21730, 11730, 21730
11730 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 1741
21730 IVFAIL = IVFAIL + 1
IVCOMP = IVON02
IVCORR = 1
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
1741 CONTINUE
IVTNUM = 174
C
C **** TEST 174 ****
C TEST 174 - RELATIONAL EXPRESSION. INTEGER VARIABLE REFERENCE.
C FALSE PATH. .GT.
C
C
IF (ICZERO) 31740, 1740, 31740
1740 CONTINUE
IVON01 = 32767
IVON02 = 1
IF ( 76 .GT. IVON01 ) IVON02 = 0
GO TO 41740
31740 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 41740, 1751, 41740
41740 IF ( IVON02 - 1 ) 21740, 11740, 21740
11740 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 1751
21740 IVFAIL = IVFAIL + 1
IVCOMP = IVON02
IVCORR = 1
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
1751 CONTINUE
IVTNUM = 175
C
C **** TEST 175 ****
C TEST 175 - RELATIONAL EXPRESSION. INTEGER VARIABLE REFERENCE.
C FALSE PATH. .GE.
C
C
IF (ICZERO) 31750, 1750, 31750
1750 CONTINUE
IVON01 = 32767
IVON02 = 1
IF ( 76 .GE. IVON01 ) IVON02 = 0
GO TO 41750
31750 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 41750, 1761, 41750
41750 IF ( IVON02 - 1 ) 21750, 11750, 21750
11750 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 1761
21750 IVFAIL = IVFAIL + 1
IVCOMP = IVON02
IVCORR = 1
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
1761 CONTINUE
IVTNUM = 176
C
C **** TEST 176 ****
C TEST 176 - RELATIONAL EXPRESSION. (IVR) (RO) (IC)
C INTEGER VARIABLE REFERENCE WITH INTEGER CONSTANT
C TRUE PATH. .LT.
C
C
IF (ICZERO) 31760, 1760, 31760
1760 CONTINUE
IVON01 = 3
IVON02 = 0
IF ( IVON01 .LT. 76 ) IVON02 = 1
GO TO 41760
31760 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 41760, 1771, 41760
41760 IF ( IVON02 - 1 ) 21760, 11760, 21760
11760 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 1771
21760 IVFAIL = IVFAIL + 1
IVCOMP = IVON02
IVCORR = 1
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
1771 CONTINUE
IVTNUM = 177
C
C **** TEST 177 ****
C TEST 177 - LIKE TEST 176. FALSE PATH. .EQ.
C
C
IF (ICZERO) 31770, 1770, 31770
1770 CONTINUE
IVON01 = 587
IVON02 = 1
IF ( IVON01 .EQ. 9999 ) IVON02=0
GO TO 41770
31770 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 41770, 1781, 41770
41770 IF ( IVON02 - 1 ) 21770, 11770, 21770
11770 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 1781
21770 IVFAIL = IVFAIL + 1
IVCOMP = IVON02
IVCORR = 1
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
1781 CONTINUE
IVTNUM = 178
C
C **** TEST 178 ****
C TEST 178 - LIKE TEST 176. TRUE PATH. .GE.
C
C
IF (ICZERO) 31780, 1780, 31780
1780 CONTINUE
IVON01 = 32767
IVON02 = 0
IF ( IVON01 .GE. 32767 ) IVON02 = 1
GO TO 41780
31780 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 41780, 1791, 41780
41780 IF ( IVON02 - 1 ) 21780, 11780, 21780
11780 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 1791
21780 IVFAIL = IVFAIL + 1
IVCOMP = IVON02
IVCORR = 1
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
1791 CONTINUE
IVTNUM = 179
C
C **** TEST 179 ****
C TEST 179 - RELATIONAL EXPRESSION. INTEGER ARRAY ELEMENT
C REFERENCE. (IC) (RO) (IAER) FALSE PATH. .LT.
C
C
IF (ICZERO) 31790, 1790, 31790
1790 CONTINUE
IVON01 = 1
IADN11(1) = 3
IF ( 76 .LT. IADN11(1) ) IVON01 = 0
GO TO 41790
31790 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 41790, 1801, 41790
41790 IF ( IVON01 - 1 ) 21790, 11790, 21790
11790 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 1801
21790 IVFAIL = IVFAIL + 1
IVCOMP = IVON01
IVCORR = 1
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
1801 CONTINUE
IVTNUM = 180
C
C **** TEST 180 ****
C TEST 180 - LIKE TEST 179. TRUE PATH. .LE.
C
C
IF (ICZERO) 31800, 1800, 31800
1800 CONTINUE
IVON01 = 0
IADN11(2) = 587
IF ( 587 .LE. IADN11(2) ) IVON01 = 1
GO TO 41800
31800 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 41800, 1811, 41800
41800 IF ( IVON01 - 1 ) 21800, 11800, 21800
11800 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 1811
21800 IVFAIL = IVFAIL + 1
IVCOMP = IVON01
IVCORR = 1
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
1811 CONTINUE
IVTNUM = 181
C
C **** TEST 181 ****
C TEST 181 - LIKE TEST 179. FALSE PATH. .GE.
C
C
IF (ICZERO) 31810, 1810, 31810
1810 CONTINUE
IVON01 = 1
IADN11(3) = 32767
IF ( 76 .GE. IADN11(3) ) IVON01 = 0
GO TO 41810
31810 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 41810, 1821, 41810
41810 IF ( IVON01 - 1 ) 21810, 11810, 21810
11810 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 1821
21810 IVFAIL = IVFAIL + 1
IVCOMP = IVON01
IVCORR = 1
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
1821 CONTINUE
IVTNUM = 182
C
C **** TEST 182 ****
C TEST 182 - RELATIONAL EXPRESSION (IAER) (RO) (IC). TRUE
C PATH. .EQ.
C
C
IF (ICZERO) 31820, 1820, 31820
1820 CONTINUE
IVON01 = 0
IADN11(2) = 32767
IF ( IADN11(2) .EQ. 32767 ) IVON01 = 1
GO TO 41820
31820 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 41820, 1831, 41820
41820 IF ( IVON01 - 1 ) 21820, 11820, 21820
11820 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 1831
21820 IVFAIL = IVFAIL + 1
IVCOMP = IVON01
IVCORR = 1
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
1831 CONTINUE
IVTNUM = 183
C
C **** TEST 183 ****
C TEST 183 - RELATIONAL EXPRESSION (IVR) (RO) (IAER)
C FALSE PATH. .NE.
C
C
IF (ICZERO) 31830, 1830, 31830
1830 CONTINUE
IVON01 = 1
IVON02 = 587
IADN11(1) = 587
IF ( IVON02 .NE. IADN11(1) ) IVON01 = 0
GO TO 41830
31830 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 41830, 1841, 41830
41830 IF ( IVON01 - 1 ) 21830, 11830, 21830
11830 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 1841
21830 IVFAIL = IVFAIL + 1
IVCOMP = IVON01
IVCORR = 1
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
1841 CONTINUE
IVTNUM = 184
C
C **** TEST 184 ****
C TEST 184 - RELATIONAL EXPRESSION (IAER) (RO) (IVR)
C TRUE PATH .NE.
C
C
IF (ICZERO) 31840, 1840, 31840
1840 CONTINUE
IVON01 = 0
IADN11(3) = 3
IVON02 = 32767
IF ( IADN11(3) .NE. IVON02 ) IVON01 = 1
GO TO 41840
31840 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 41840, 1851, 41840
41840 IF ( IVON01 - 1 ) 21840, 11840, 21840
11840 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 1851
21840 IVFAIL = IVFAIL + 1
IVCOMP = IVON01
IVCORR = 1
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
1851 CONTINUE
IVTNUM = 185
C
C **** TEST 185 ****
C TEST 185 - TEST OF PARENTHESES ( (LE) )
C TRUE PATH LOGICAL CONSTANT .TRUE.
C
C
IF (ICZERO) 31850, 1850, 31850
1850 CONTINUE
IVON01 = 0
IF ( ( .TRUE. ) ) IVON01 = 1
GO TO 41850
31850 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 41850, 1861, 41850
41850 IF ( IVON01 - 1 ) 21850, 11850, 21850
11850 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 1861
21850 IVFAIL = IVFAIL + 1
IVCOMP = IVON01
IVCORR = 1
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
1861 CONTINUE
IVTNUM = 186
C
C **** TEST 186 ****
C TEST 186 - LIKE TEST 185
C FALSE PATH LOGICAL CONSTANT .FALSE.
C
C
IF (ICZERO) 31860, 1860, 31860
1860 CONTINUE
IVON01 = 1
IF ((( .FALSE. ))) IVON01 = 0
GO TO 41860
31860 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 41860, 1871, 41860
41860 IF ( IVON01 - 1 ) 21860, 11860, 21860
11860 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 1871
21860 IVFAIL = IVFAIL + 1
IVCOMP = IVON01
IVCORR = 1
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
1871 CONTINUE
IVTNUM = 187
C
C **** TEST 187 ****
C TEST 187 - PARENS AROUND LOGICAL VARIABLE REFERENCE ( (LVR) )
C TRUE PATH
C
C
IF (ICZERO) 31870, 1870, 31870
1870 CONTINUE
IVON01 = 0
LCTNT1 = .TRUE.
IF ( ( LCTNT1 ) ) IVON01 = 1
GO TO 41870
31870 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 41870, 1881, 41870
41870 IF ( IVON01 - 1 ) 21870, 11870, 21870
11870 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 1881
21870 IVFAIL = IVFAIL + 1
IVCOMP = IVON01
IVCORR = 1
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
1881 CONTINUE
IVTNUM = 188
C
C **** TEST 188 ****
C TEST 188 - PARENS AROUND LOGICAL ARRAY REFERENCE ( ( LAER ) )
C FALSE PATH
C
IF (ICZERO) 31880, 1880, 31880
1880 CONTINUE
IVON01 = 1
LATN1A(1) = .FALSE.
IF ( ( LATN1A(1) ) ) IVON01 = 0
GO TO 41880
31880 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 41880, 1891, 41880
41880 IF ( IVON01 - 1 ) 21880, 11880, 21880
11880 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 1891
21880 IVFAIL = IVFAIL + 1
IVCOMP = IVON01
IVCORR = 1
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
1891 CONTINUE
IVTNUM = 189
C
C **** TEST 189 ****
C TEST 189 - USE OF .NOT. WITH A LOGICAL PRIMARY .NOT. (LP)
C FALSE PATH .NOT. .TRUE.
C
C
IF (ICZERO) 31890, 1890, 31890
1890 CONTINUE
IVON01 = 1
IF ( .NOT. .TRUE. ) IVON01 = 0
GO TO 41890
31890 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 41890, 1901, 41890
41890 IF ( IVON01 - 1 ) 21890, 11890, 21890
11890 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 1901
21890 IVFAIL = IVFAIL + 1
IVCOMP = IVON01
IVCORR = 1
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
1901 CONTINUE
IVTNUM = 190
C
C **** TEST 190 ****
C TEST 190 - LIKE TEST 189 TRUE PATH .NOT. .FALSE.
C
C
IF (ICZERO) 31900, 1900, 31900
1900 CONTINUE
IVON01 = 0
IF ( .NOT. .FALSE. ) IVON01 = 1
GO TO 41900
31900 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 41900, 1911, 41900
41900 IF ( IVON01 - 1 ) 21900, 11900, 21900
11900 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 1911
21900 IVFAIL = IVFAIL + 1
IVCOMP = IVON01
IVCORR = 1
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
1911 CONTINUE
IVTNUM = 191
C
C **** TEST 191 ****
C TEST 191 - TESTS .NOT. WITH A LOGICAL VARIABLE SET TO .FALSE.
C IN A LOGICAL ASSIGNMENT STATEMENT TRUE PATH
C
C
IF (ICZERO) 31910, 1910, 31910
1910 CONTINUE
IVON01 = 0
LCTNT1 = .FALSE.
IF ( .NOT. LCTNT1 ) IVON01 = 1
GO TO 41910
31910 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 41910, 1921, 41910
41910 IF ( IVON01 - 1 ) 21910, 11910, 21910
11910 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 1921
21910 IVFAIL = IVFAIL + 1
IVCOMP = IVON01
IVCORR = 1
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
1921 CONTINUE
IVTNUM = 192
C
C **** TEST 192 ****
C TEST 192 - LIKE TEST 191 ONLY USES A LOGICAL ARRAY ELEMENT
C SET TO .FALSE. IN A LOGICAL ASSIGNMENT STATEMENT TRUE
C
C
IF (ICZERO) 31920, 1920, 31920
1920 CONTINUE
IVON01 = 0
LATN1A(2) = .FALSE.
IF ( .NOT. LATN1A(2) ) IVON01 = 1
GO TO 41920
31920 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 41920, 1931, 41920
41920 IF ( IVON01 - 1 ) 21920, 11920, 21920
11920 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 1931
21920 IVFAIL = IVFAIL + 1
IVCOMP = IVON01
IVCORR = 1
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
1931 CONTINUE
IVTNUM = 193
C
C **** TEST 193 ****
C TEST 193 - USE OF LOGICAL .AND. (LT) .AND. (LF)
C USES TWO LOGICAL VARIABLES EACH SET TO .FALSE.
C FALSE .AND. FALSE FALSE PATH
C
C
IF (ICZERO) 31930, 1930, 31930
1930 CONTINUE
IVON01 = 1
LCTNT1 = .FALSE.
LCTNT2 = .FALSE.
IF ( LCTNT1 .AND. LCTNT2 ) IVON01 = 0
GO TO 41930
31930 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 41930, 1941, 41930
41930 IF ( IVON01 - 1 ) 21930, 11930, 21930
11930 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 1941
21930 IVFAIL = IVFAIL + 1
IVCOMP = IVON01
IVCORR = 1
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
1941 CONTINUE
IVTNUM = 194
C
C **** TEST 194 ****
C TEST 194 - LIKE TEST 193 FALSE .AND. TRUE FALSE PATH
C
C
IF (ICZERO) 31940, 1940, 31940
1940 CONTINUE
IVON01 = 1
LCTNT1 = .FALSE.
LCTNT2 = .TRUE.
IF ( LCTNT1 .AND. LCTNT2 ) IVON01 = 0
GO TO 41940
31940 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 41940, 1951, 41940
41940 IF ( IVON01 - 1 ) 21940, 11940, 21940
11940 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 1951
21940 IVFAIL = IVFAIL + 1
IVCOMP = IVON01
IVCORR = 1
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
1951 CONTINUE
IVTNUM = 195
C
C **** TEST 195 ****
C TEST 195 - LIKE TEST 193 TRUE .AND. FALSE FALSE PATH
C
C
IF (ICZERO) 31950, 1950, 31950
1950 CONTINUE
IVON01 = 1
LCTNT1 = .TRUE.
LCTNT2 = .FALSE.
IF ( LCTNT1 .AND. LCTNT2 ) IVON01 = 0
GO TO 41950
31950 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 41950, 1961, 41950
41950 IF ( IVON01 - 1 ) 21950, 11950, 21950
11950 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 1961
21950 IVFAIL = IVFAIL + 1
IVCOMP = IVON01
IVCORR = 1
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
1961 CONTINUE
IVTNUM = 196
C
C **** TEST 196 ****
C TEST 196 - LIKE TEST 193 TRUE .AND. TRUE TRUE PATH
C
C
IF (ICZERO) 31960, 1960, 31960
1960 CONTINUE
IVON01 = 0
LCTNT1 = .TRUE.
LCTNT2 = .TRUE.
IF ( LCTNT1 .AND. LCTNT2 ) IVON01 = 1
GO TO 41960
31960 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 41960, 1971, 41960
41960 IF ( IVON01 - 1 ) 21960, 11960, 21960
11960 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 1971
21960 IVFAIL = IVFAIL + 1
IVCOMP = IVON01
IVCORR = 1
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
1971 CONTINUE
IVTNUM = 197
C
C **** TEST 197 ****
C TEST 197 - TEST OF THE INCLUSIVE .OR. . (LE) .OR. (LT)
C USES LOGICAL VARIABLES SET IN LOGICAL ASSIGNMENT STATEMENTS
C FALSE .OR. FALSE FALSE PATH
C
C
IF (ICZERO) 31970, 1970, 31970
1970 CONTINUE
IVON01 = 1
LCTNT1 = .FALSE.
LCTNT2 = .FALSE.
IF ( LCTNT1 .OR. LCTNT2 ) IVON01 = 0
GO TO 41970
31970 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 41970, 1981, 41970
41970 IF ( IVON01 - 1 ) 21970, 11970, 21970
11970 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 1981
21970 IVFAIL = IVFAIL + 1
IVCOMP = IVON01
IVCORR = 1
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
1981 CONTINUE
IVTNUM = 198
C
C **** TEST 198 ****
C TEST 198 - LIKE TEST 197 FALSE .OR. TRUE TRUE PATH
C
C
IF (ICZERO) 31980, 1980, 31980
1980 CONTINUE
IVON01 = 0
LCTNT1 = .FALSE.
LCTNT2 = .TRUE.
IF ( LCTNT1 .OR. LCTNT2 ) IVON01 = 1
GO TO 41980
31980 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 41980, 1991, 41980
41980 IF ( IVON01 - 1 ) 21980, 11980, 21980
11980 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 1991
21980 IVFAIL = IVFAIL + 1
IVCOMP = IVON01
IVCORR = 1
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
1991 CONTINUE
IVTNUM = 199
C
C **** TEST 199 ****
C TEST 199 - LIKE TEST 197. TRUE .OR. FALSE TRUE PATH.
C
C
IF (ICZERO) 31990, 1990, 31990
1990 CONTINUE
IVON01 = 0
LCTNT1 = .TRUE.
LCTNT2 = .FALSE.
IF ( LCTNT1 .OR. LCTNT2 ) IVON01 = 1
GO TO 41990
31990 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 41990, 5001, 41990
41990 IF ( IVON01 - 1 ) 21990, 11990, 21990
11990 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 5001
21990 IVFAIL = IVFAIL + 1
IVCOMP = IVON01
IVCORR = 1
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
5001 CONTINUE
C
C WRITE PAGE FOOTINGS AND RUN SUMMARIES
99999 CONTINUE
WRITE (I02,90002)
WRITE (I02,90006)
WRITE (I02,90002)
WRITE (I02,90002)
WRITE (I02,90007)
WRITE (I02,90002)
WRITE (I02,90008) IVFAIL
WRITE (I02,90009) IVPASS
WRITE (I02,90010) IVDELE
C
C
C TERMINATE ROUTINE EXECUTION
STOP
C
C FORMAT STATEMENTS FOR PAGE HEADERS
90000 FORMAT (1H1)
90002 FORMAT (1H )
90001 FORMAT (1H ,10X,34HFORTRAN COMPILER VALIDATION SYSTEM)
90003 FORMAT (1H ,21X,11HVERSION 1.0)
90004 FORMAT (1H ,10X,38HFOR OFFICIAL USE ONLY - COPYRIGHT 1978)
90005 FORMAT (1H ,5X,4HTEST,5X,9HPASS/FAIL, 5X,8HCOMPUTED,8X,7HCORRECT)
90006 FORMAT (1H ,5X,46H----------------------------------------------)
90011 FORMAT (1H ,18X,17HSUBSET LEVEL TEST)
C
C FORMAT STATEMENTS FOR RUN SUMMARIES
90008 FORMAT (1H ,15X,I5,19H ERRORS ENCOUNTERED)
90009 FORMAT (1H ,15X,I5,13H TESTS PASSED)
90010 FORMAT (1H ,15X,I5,14H TESTS DELETED)
C
C FORMAT STATEMENTS FOR TEST RESULTS
80001 FORMAT (1H ,4X,I5,7X,4HPASS)
80002 FORMAT (1H ,4X,I5,7X,4HFAIL)
80003 FORMAT (1H ,4X,I5,7X,7HDELETED)
80004 FORMAT (1H ,4X,I5,7X,4HFAIL,10X,I6,9X,I6)
80005 FORMAT (1H ,4X,I5,7X,4HFAIL,4X,E12.5,3X,E12.5)
C
90007 FORMAT (1H ,20X,20HEND OF PROGRAM FM017)
END
*END-OF,FM017
FM018.f 480975980 170 2 100666 24716 `
*HEADER,FORTR,FM018
*FILES1,FORTR,FM018,X
C
C COMMENT SECTION.
C
C FM018
C
C THIS ROUTINE CONTINUES TESTS OF THE FORTRAN
C LOGICAL IF STATEMENT IN ALL OF THE VARIOUS FORMS. THE
C FOLLOWING LOGICAL OPERANDS ARE USED FOR THIS ROUTINE - LOGICAL
C CONSTANTS, LOGICAL VARIABLES, LOGICAL ARRAY ELEMENTS, AND
C ARITHMETIC EXPRESSIONS WITH VARIOUS RELATIONAL OPERATORS. BOTH
C THE TRUE AND FALSE BRANCHES ARE TESTED IN THE SERIES OF TESTS.
C
C REFERENCES
C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN,
C X3.9-1978
C
C SECTION 4.7.1, LOGICAL CONSTANT
C SECTION 6, EXPRESSIONS
C SECTION 6.1, ARITHMETIC EXPRESSIONS
C SECTION 6.3, RELATIONAL EXPRESSIONS
C SECTION 6.4, LOGICAL EXPRESSIONS
C SECTION 6.6, EVALUATION OF EXPRESSIONS
C SECTION 10, ASSIGNMENT STATEMENTS
C SECTION 10.2, LOGICAL ASSIGNMENT STATEMENT
C SECTION 11.5, LOGICAL IF STATEMENT
C
LOGICAL LCTNT1, LCTNT2, LATN1A(2)
DIMENSION IADN11(2)
C
C **********************************************************
C
C A COMPILER VALIDATION SYSTEM FOR THE FORTRAN LANGUAGE
C BASED ON SPECIFICATIONS AS DEFINED IN AMERICAN NATIONAL STANDARD
C PROGRAMMING LANGUAGE FORTRAN X3.9-1978, HAS BEEN DEVELOPED BY THE
C FEDERAL COBOL COMPILER TESTING SERVICE. THE FORTRAN COMPILER
C VALIDATION SYSTEM (FCVS) CONSISTS OF AUDIT ROUTINES, THEIR RELATED
C DATA, AND AN EXECUTIVE SYSTEM. EACH AUDIT ROUTINE IS A FORTRAN
C PROGRAM, SUBPROGRAM OR FUNCTION WHICH INCLUDES TESTS OF SPECIFIC
C LANGUAGE ELEMENTS AND SUPPORTING PROCEDURES INDICATING THE RESULT
C OF EXECUTING THESE TESTS.
C
C THIS PARTICULAR PROGRAM/SUBPROGRAM/FUNCTION CONTAINS FEATURES
C FOUND ONLY IN THE SUBSET AS DEFINED IN X3.9-1978.
C
C SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO -
C
C DEPARTMENT OF THE NAVY
C FEDERAL COBOL COMPILER TESTING SERVICE
C WASHINGTON, D.C. 20376
C
C **********************************************************
C
C
C
C INITIALIZATION SECTION
C
C INITIALIZE CONSTANTS
C **************
C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER.
I01 = 5
C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER.
I02 = 6
C SYSTEM ENVIRONMENT SECTION
C
CX010 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-010 CONTROL CARD.
C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5
C (UNIT NUMBER FOR CARD READER).
CX011 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-011 CONTROL CARD.
C THE CX011 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL
C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX010 ABOVE.
C
CX020 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-020 CONTROL CARD.
C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02 = 6
C (UNIT NUMBER FOR PRINTER).
CX021 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-021 CONTROL CARD.
C THE CX021 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL
C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX020 ABOVE.
C
IVPASS=0
IVFAIL=0
IVDELE=0
ICZERO=0
C
C WRITE PAGE HEADERS
WRITE (I02,90000)
WRITE (I02,90001)
WRITE (I02,90002)
WRITE (I02, 90002)
WRITE (I02,90003)
WRITE (I02,90002)
WRITE (I02,90004)
WRITE (I02,90002)
WRITE (I02,90011)
WRITE (I02,90002)
WRITE (I02,90002)
WRITE (I02,90005)
WRITE (I02,90006)
WRITE (I02,90002)
IVTNUM = 500
C
C **** TEST 500 ****
C TEST 500 - LIKE TEST 197. TRUE .OR. TRUE TRUE PATH
C TEST OF THE FORTRAN INCLUSIVE OR (LE) .OR. (LT)
C
C
IF (ICZERO) 35000, 5000, 35000
5000 CONTINUE
IVON01 = 0
LCTNT1 = .TRUE.
LCTNT2 = .TRUE.
IF ( LCTNT1 .OR. LCTNT2 ) IVON01 = 1
GO TO 45000
35000 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 45000, 5011, 45000
45000 IF ( IVON01 - 1 ) 25000, 15000, 25000
15000 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 5011
25000 IVFAIL = IVFAIL + 1
IVCOMP = IVON01
IVCORR = 1
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
5011 CONTINUE
IVTNUM = 501
C
C **** TEST 501 ****
C TEST 501 - TEST OF PARENTHESES AROUND A LOGICAL EXPRESSION
C ( (LE) ) .OR. (LT)
C USES LOGICAL VARIABLES SET IN LOGICAL ASSIGNMENT STATEMENTS
C ( FALSE ) .OR. FALSE FALSE PATH
C
C
IF (ICZERO) 35010, 5010, 35010
5010 CONTINUE
IVON01 = 1
LCTNT1 = .FALSE.
LCTNT2 = .FALSE.
IF ( (LCTNT1) .OR. LCTNT2 ) IVON01 = 0
GO TO 45010
35010 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 45010, 5021, 45010
45010 IF ( IVON01 - 1 ) 25010, 15010, 25010
15010 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 5021
25010 IVFAIL = IVFAIL + 1
IVCOMP = IVON01
IVCORR = 1
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
5021 CONTINUE
IVTNUM = 502
C
C **** TEST 502 ****
C TEST 502 - LIKE TEST 501 EXCEPT THAT IT IT IS OF THE FORM
C (LE) .OR. ( (LT) ) TRUE .OR. (TRUE)
C TRUE PATH
C
C
IF (ICZERO) 35020, 5020, 35020
5020 CONTINUE
IVON01 = 0
LCTNT1 = .TRUE.
LCTNT2 = .TRUE.
IF ( LCTNT1 .OR. ( LCTNT2 ) ) IVON01 = 1
GO TO 45020
35020 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 45020, 5031, 45020
45020 IF ( IVON01 - 1 ) 25020, 15020, 25020
15020 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 5031
25020 IVFAIL = IVFAIL + 1
IVCOMP = IVON01
IVCORR = 1
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
5031 CONTINUE
IVTNUM = 503
C
C **** TEST 503 ****
C TEST 503 - TEST OF PARENTHESES IN LOGICAL EXPRESSIONS
C ( (LE) ) .OR. ( (LT) )
C (FALSE) .OR. (TRUE) TRUE PATH
C
C
IF (ICZERO) 35030, 5030, 35030
5030 CONTINUE
IVON01 = 0
LCTNT1 = .FALSE.
LCTNT2 = .TRUE.
IF ( (LCTNT1) .OR. (LCTNT2) ) IVON01 = 1
GO TO 45030
35030 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 45030, 5041, 45030
45030 IF ( IVON01 - 1 ) 25030, 15030, 25030
15030 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 5041
25030 IVFAIL = IVFAIL + 1
IVCOMP = IVON01
IVCORR = 1
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
5041 CONTINUE
IVTNUM = 504
C
C **** TEST 504 ****
C TEST 504 - LIKE TEST 503 ONLY MORE PARENTHESES TRUE PATH
C
C
IF (ICZERO) 35040, 5040, 35040
5040 CONTINUE
IVON01 = 0
LCTNT1 = .TRUE.
LCTNT2 = .FALSE.
IF ( ( (LCTNT1) .OR. (LCTNT2) ) ) IVON01 = 1
GO TO 45040
35040 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 45040, 5051, 45040
45040 IF ( IVON01 - 1 ) 25040, 15040, 25040
15040 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 5051
25040 IVFAIL = IVFAIL + 1
IVCOMP = IVON01
IVCORR = 1
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
5051 CONTINUE
IVTNUM = 505
C
C **** TEST 505 ****
C TEST 505 - TEST OF PARENTHESES WITH .AND. FALSE PATH
C
C
IF (ICZERO) 35050, 5050, 35050
5050 CONTINUE
IVON01 = 1
LCTNT1 = .FALSE.
LCTNT2 = .FALSE.
IF ( (LCTNT1) .AND. LCTNT2 ) IVON01 = 0
GO TO 45050
35050 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 45050, 5061, 45050
45050 IF ( IVON01 - 1 ) 25050, 15050, 25050
15050 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 5061
25050 IVFAIL = IVFAIL + 1
IVCOMP = IVON01
IVCORR = 1
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
5061 CONTINUE
IVTNUM = 506
C
C **** TEST 506 ****
C TEST 506 - LIKE TEST 505 FALSE PATH
C
C
IF (ICZERO) 35060, 5060, 35060
5060 CONTINUE
IVON01 = 1
LCTNT1 = .FALSE.
LCTNT2 = .TRUE.
IF ( LCTNT1 .AND. (LCTNT2) ) IVON01 = 0
GO TO 45060
35060 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 45060, 5071, 45060
45060 IF ( IVON01 - 1 ) 25060, 15060, 25060
15060 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 5071
25060 IVFAIL = IVFAIL + 1
IVCOMP = IVON01
IVCORR = 1
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
5071 CONTINUE
IVTNUM = 507
C
C **** TEST 507 ****
C TEST 507 - MORE PARENTHESES WITH LOGICAL .AND. FALSE PATH
C
C
IF (ICZERO) 35070, 5070, 35070
5070 CONTINUE
IVON01 = 1
LCTNT1 = .TRUE.
LCTNT2 = .FALSE.
IF ( (LCTNT1) .AND. (LCTNT2) ) IVON01 = 0
GO TO 45070
35070 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 45070, 5081, 45070
45070 IF ( IVON01 - 1 ) 25070, 15070, 25070
15070 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 5081
25070 IVFAIL = IVFAIL + 1
IVCOMP = IVON01
IVCORR = 1
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
5081 CONTINUE
IVTNUM = 508
C
C **** TEST 508 ****
C TEST 508 - TEST OF LOGICAL .NOT. WITH PARENTHESES AROUND A LOGIC
C PRIMARY. FOR THIS TEST A LOGICAL ARRAY ELEMENT IS USED AS
C THE LOGICAL PRIMARY. .NOT. (FALSE) TRUE PATH.
C
C
IF (ICZERO) 35080, 5080, 35080
5080 CONTINUE
IVON01 = 0
LATN1A(1) = .FALSE.
IF ( .NOT. (LATN1A(1)) ) IVON01 = 1
GO TO 45080
35080 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 45080, 5091, 45080
45080 IF ( IVON01 - 1 ) 25080, 15080, 25080
15080 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 5091
25080 IVFAIL = IVFAIL + 1
IVCOMP = IVON01
IVCORR = 1
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
5091 CONTINUE
IVTNUM = 509
C
C **** TEST 509 ****
C TEST 509 - LIKE TEST 508 EXCEPT THAT THE WHOLE EXPRESSION
C IS IN PARENTHESES. FALSE PATH
C
C
IF (ICZERO) 35090, 5090, 35090
5090 CONTINUE
IVON01 = 1
LATN1A(2) = .TRUE.
IF ( ( .NOT. (LATN1A(2)) ) ) IVON01 = 0
GO TO 45090
35090 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 45090, 5101, 45090
45090 IF ( IVON01 - 1 ) 25090, 15090, 25090
15090 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 5101
25090 IVFAIL = IVFAIL + 1
IVCOMP = IVON01
IVCORR = 1
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
5101 CONTINUE
IVTNUM = 510
C
C **** TEST 510 ****
C TEST 510 - INTEGER CONSTANT EXPONIENTATION
C RELATIONAL EXPRESSION USING .EQ. TRUE PATH
C
C
IF (ICZERO) 35100, 5100, 35100
5100 CONTINUE
IVON01 = 0
IF ( 3 ** 3 .EQ. 27 ) IVON01 = 1
GO TO 45100
35100 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 45100, 5111, 45100
45100 IF ( IVON01 - 1 ) 25100, 15100, 25100
15100 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 5111
25100 IVFAIL = IVFAIL + 1
IVCOMP = IVON01
IVCORR = 1
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
5111 CONTINUE
IVTNUM = 511
C
C **** TEST 511 ****
C TEST 511 - EXPONIENTIATION USING AN INTEGER VARIABLE
C RELATIONAL EXPRESSION USING .NE. FALSE PATH
C
C
IF (ICZERO) 35110, 5110, 35110
5110 CONTINUE
IVON01 = 1
IVON02 = 3
IF ( IVON02 ** 3 .NE. 27 ) IVON01 = 0
GO TO 45110
35110 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 45110, 5121, 45110
45110 IF ( IVON01 - 1 ) 25110, 15110, 25110
15110 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 5121
25110 IVFAIL = IVFAIL + 1
IVCOMP = IVON01
IVCORR = 1
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
5121 CONTINUE
IVTNUM = 512
C
C **** TEST 512 ****
C TEST 512 - LIKE TEST 511 USES .LE. TRUE PATH
C
C
IF (ICZERO) 35120, 5120, 35120
5120 CONTINUE
IVON01 = 0
IVON02 = 3
IF ( 3 ** IVON02 .LE. 27 ) IVON01 = 1
GO TO 45120
35120 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 45120, 5131, 45120
45120 IF ( IVON01 - 1 ) 25120, 15120, 25120
15120 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 5131
25120 IVFAIL = IVFAIL + 1
IVCOMP = IVON01
IVCORR = 1
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
5131 CONTINUE
IVTNUM = 513
C
C **** TEST 513 ****
C TEST 513 - LIKE TEST 511 BUT USES ALL INTEGER VARIABLES
C RELATIONAL EXPRESSION USES .LT. FALSE PATH
C
C
IF (ICZERO) 35130, 5130, 35130
5130 CONTINUE
IVON01 = 1
IVON02 = 3
IVON03 = 27
IF ( IVON02 ** IVON02 .LT. IVON03 ) IVON01 = 0
GO TO 45130
35130 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 45130, 5141, 45130
45130 IF ( IVON01 - 1 ) 25130, 15130, 25130
15130 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 5141
25130 IVFAIL = IVFAIL + 1
IVCOMP = IVON01
IVCORR = 1
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
5141 CONTINUE
IVTNUM = 514
C
C **** TEST 514 ****
C TEST 514 - LIKE TEST 511 BUT USES INTEGER ARRAY ELEMENTS
C RELATIONAL EXPRESSION USES .GE. TRUE PATH
C
C
IF (ICZERO) 35140, 5140, 35140
5140 CONTINUE
IVON01 = 0
IVON02 = 3
IADN11(1) = 3
IADN11(2) = 27
IF ( IADN11(1) ** IVON02 .GE. IADN11(2) ) IVON01 = 1
GO TO 45140
35140 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 45140, 5151, 45140
45140 IF ( IVON01 - 1 ) 25140, 15140, 25140
15140 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 5151
25140 IVFAIL = IVFAIL + 1
IVCOMP = IVON01
IVCORR = 1
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
5151 CONTINUE
IVTNUM = 515
C
C **** TEST 515 ****
C TEST 515 - LIKE TEST 514 BUT USES ALL INTEGER ARRAY ELEMENTS
C RELATIONAL EXPRESSION USES .GT. FALSE PATH
C
C
IF (ICZERO) 35150, 5150, 35150
5150 CONTINUE
IVON01 = 1
IADN11(1) = 3
IADN11(2) = 27
IF ( IADN11(1) ** IADN11(1) .GT. IADN11(2) ) IVON01 = 0
GO TO 45150
35150 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 45150, 5161, 45150
45150 IF ( IVON01 - 1 ) 25150, 15150, 25150
15150 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 5161
25150 IVFAIL = IVFAIL + 1
IVCOMP = IVON01
IVCORR = 1
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
5161 CONTINUE
IVTNUM = 516
C
C **** TEST 516 ****
C TEST 516 - TEST OF INTEGER MULTIPLICATION USING INTEGER
C CONSTANTS. RELATIONAL EXPRESSION USES .LT. TRUE PATH
C
C
IF (ICZERO) 35160, 5160, 35160
5160 CONTINUE
IVON01 = 0
IVON02 = 587
IF ( 3 * 3 .LT. IVON02 ) IVON01 = 1
GO TO 45160
35160 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 45160, 5171, 45160
45160 IF ( IVON01 - 1 ) 25160, 15160, 25160
15160 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 5171
25160 IVFAIL = IVFAIL + 1
IVCOMP = IVON01
IVCORR = 1
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
5171 CONTINUE
IVTNUM = 517
C
C **** TEST 517 ****
C TEST 517 - INTEGER MULTIPLICATION WITH INTEGER CONSTANTS,
C VARIABLES, AND ARRAY ELEMENTS. RELATIONAL EXPRESSION USES
C .GT. FALSE PATH
C
C
IF (ICZERO) 35170, 5170, 35170
5170 CONTINUE
IVON01 = 1
IVON02 = 32767
IADN11(1) = 3
IF ( IADN11(1) * 587 .GT. IVON02 ) IVON01 = 0
GO TO 45170
35170 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 45170, 5181, 45170
45170 IF ( IVON01 - 1 ) 25170, 15170, 25170
15170 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 5181
25170 IVFAIL = IVFAIL + 1
IVCOMP = IVON01
IVCORR = 1
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
5181 CONTINUE
IVTNUM = 518
C
C **** TEST 518 ****
C TEST 518 - INTEGER MULTIPLICATION AND EXPONIENTATION
C RELATIONAL EXPRESSION USES .EQ. TRUE PATH
C
C
IF (ICZERO) 35180, 5180, 35180
5180 CONTINUE
IVON01 = 0
IVON02 = 3
IVON03 = 27
IADN11(2) = 3
IF ( IADN11(2) ** 2 * IVON02 .EQ. IVON03 ) IVON01 = 1
GO TO 45180
35180 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 45180, 5191, 45180
45180 IF ( IVON01 - 1 ) 25180, 15180, 25180
15180 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 5191
25180 IVFAIL = IVFAIL + 1
IVCOMP = IVON01
IVCORR = 1
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
5191 CONTINUE
IVTNUM = 519
C
C **** TEST 519 ****
C TEST 519 - INTEGER DIVISION. RELATIONAL EXPRESSION .NE.
C FALSE PATH
C
C
IF (ICZERO) 35190, 5190, 35190
5190 CONTINUE
IVON01 = 1
IVON02 = 27
IADN11(1) = 3
IF ( IVON02 / 9 .NE. IADN11(1) ) IVON01 = 0
GO TO 45190
35190 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 45190, 5201, 45190
45190 IF ( IVON01 - 1 ) 25190, 15190, 25190
15190 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 5201
25190 IVFAIL = IVFAIL + 1
IVCOMP = IVON01
IVCORR = 1
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
5201 CONTINUE
IVTNUM = 520
C
C **** TEST 520 ****
C TEST 520 - INTEGER VARIABLE DIVISION. RELATIONAL EXPRESSION
C USES .GE. TRUE PATH
C
C
IF (ICZERO) 35200, 5200, 35200
5200 CONTINUE
IVON01 = 0
IVON02 = 32767
IVON03 = 3
IVON04 = 9999
IVON05 = 587
IF ( IVON02 / IVON03 .GE. IVON04 / IVON05 ) IVON01 = 1
GO TO 45200
35200 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 45200, 5211, 45200
45200 IF ( IVON01 - 1 ) 25200, 15200, 25200
15200 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 5211
25200 IVFAIL = IVFAIL + 1
IVCOMP = IVON01
IVCORR = 1
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
5211 CONTINUE
IVTNUM = 521
C
C **** TEST 521 ****
C TEST 521 - INTEGER DIVISION AND EXPONIENTATION
C RELATIONAL EXPRESSION USES .LT. FALSE PATH
C
C
IF (ICZERO) 35210, 5210, 35210
5210 CONTINUE
IVON01 = 1
IVON02 = 587
IVON03 = 3
IADN11(2) = 3
IF ( IVON02 / IADN11(2) ** 3 .LT. 3 ** IVON03 / IVON02 ) IVON01 =0
IF ( IVON02 / IADN11(2) ** 3 .LT. 3 ** IVON03 / IVON02 ) IVON01=0
GO TO 45210
35210 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 45210, 5221, 45210
45210 IF ( IVON01 - 1 ) 25210, 15210, 25210
15210 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 5221
25210 IVFAIL = IVFAIL + 1
IVCOMP = IVON01
IVCORR = 1
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
5221 CONTINUE
IVTNUM = 522
C
C **** TEST 522 ****
C TEST 522 - TESTS 522 THRU 535 ARE TESTS OF SIGNED TERMS
C +(T) ALSO -(T)
C RELATIONAL EXPRESSION USES .GT. TRUE PATH
C
C
IF (ICZERO) 35220, 5220, 35220
5220 CONTINUE
IVON01 = 0
IF ( 3 .GT. -3 ) IVON01 = 1
GO TO 45220
35220 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 45220, 5231, 45220
45220 IF ( IVON01 - 1 ) 25220, 15220, 25220
15220 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 5231
25220 IVFAIL = IVFAIL + 1
IVCOMP = IVON01
IVCORR = 1
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
5231 CONTINUE
IVTNUM = 523
C
C **** TEST 523 ****
C TEST 523 - TEST OF SIGNED ZERO .LT. FALSE PATH
C
C
IF (ICZERO) 35230, 5230, 35230
5230 CONTINUE
IVON01 = 1
IF ( 0 .LT. -0 ) IVON01 = 0
GO TO 45230
35230 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 45230, 5241, 45230
45230 IF ( IVON01 - 1 ) 25230, 15230, 25230
15230 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 5241
25230 IVFAIL = IVFAIL + 1
IVCOMP = IVON01
IVCORR = 1
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
5241 CONTINUE
IVTNUM = 524
C
C **** TEST 524 ****
C TEST 524 - TEST OF SIGNED ZERO .LE. TRUE PATH
C
C
IF (ICZERO) 35240, 5240, 35240
5240 CONTINUE
IVON01 = 0
IF ( 0 .LE. -0 ) IVON01 = 1
GO TO 45240
35240 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 45240, 5251, 45240
45240 IF ( IVON01 - 1 ) 25240, 15240, 25240
15240 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 5251
25240 IVFAIL = IVFAIL + 1
IVCOMP = IVON01
IVCORR = 1
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
5251 CONTINUE
IVTNUM = 525
C
C **** TEST 525 ****
C TEST 525 - TEST OF SIGNED ZERO .EQ. TRUE PATH
C
C
IF (ICZERO) 35250, 5250, 35250
5250 CONTINUE
IVON01 = 0
IF ( 0 .EQ. -0 ) IVON01 = 1
GO TO 45250
35250 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 45250, 5261, 45250
45250 IF ( IVON01 - 1 ) 25250, 15250, 25250
15250 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 5261
25250 IVFAIL = IVFAIL + 1
IVCOMP = IVON01
IVCORR = 1
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
5261 CONTINUE
IVTNUM = 526
C
C **** TEST 526 ****
C TEST 526 - TEST OF SIGNED ZERO .NE. FALSE PATH
C
C
IF (ICZERO) 35260, 5260, 35260
5260 CONTINUE
IVON01 = 1
IF ( 0 .NE. -0 ) IVON01 = 0
GO TO 45260
35260 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 45260, 5271, 45260
45260 IF ( IVON01 - 1 ) 25260, 15260, 25260
15260 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 5271
25260 IVFAIL = IVFAIL + 1
IVCOMP = IVON01
IVCORR = 1
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
5271 CONTINUE
IVTNUM = 527
C
C **** TEST 527 ****
C TEST 527 - TEST OF SIGNED ZERO .GE. TRUE PATH
C
C
IF (ICZERO) 35270, 5270, 35270
5270 CONTINUE
IVON01 = 0
IF ( 0 .GE. -0 ) IVON01 = 1
GO TO 45270
35270 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 45270, 5281, 45270
45270 IF ( IVON01 - 1 ) 25270, 15270, 25270
15270 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 5281
25270 IVFAIL = IVFAIL + 1
IVCOMP = IVON01
IVCORR = 1
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
5281 CONTINUE
IVTNUM = 528
C
C **** TEST 528 ****
C TEST 528 - TEST OF SIGNED ZERO .GT. FALSE PATH
C
C
IF (ICZERO) 35280, 5280, 35280
5280 CONTINUE
IVON01 = 1
IF ( 0 .GT. -0 ) IVON01 = 0
GO TO 45280
35280 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 45280, 5291, 45280
45280 IF ( IVON01 - 1 ) 25280, 15280, 25280
15280 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 5291
25280 IVFAIL = IVFAIL + 1
IVCOMP = IVON01
IVCORR = 1
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
5291 CONTINUE
IVTNUM = 529
C
C **** TEST 529 ****
C TEST 529 - TEST OF 32767 AND -32766 .GT. TRUE PATH
C
C
IF (ICZERO) 35290, 5290, 35290
5290 CONTINUE
IVON01 = 0
IF ( 32767 .GT. -32766 ) IVON01 = 1
GO TO 45290
35290 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 45290, 5301, 45290
45290 IF ( IVON01 - 1 ) 25290, 15290, 25290
15290 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 5301
25290 IVFAIL = IVFAIL + 1
IVCOMP = IVON01
IVCORR = 1
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
5301 CONTINUE
C
C WRITE PAGE FOOTINGS AND RUN SUMMARIES
99999 CONTINUE
WRITE (I02,90002)
WRITE (I02,90006)
WRITE (I02,90002)
WRITE (I02,90002)
WRITE (I02,90007)
WRITE (I02,90002)
WRITE (I02,90008) IVFAIL
WRITE (I02,90009) IVPASS
WRITE (I02,90010) IVDELE
C
C
C TERMINATE ROUTINE EXECUTION
STOP
C
C FORMAT STATEMENTS FOR PAGE HEADERS
90000 FORMAT (1H1)
90002 FORMAT (1H )
90001 FORMAT (1H ,10X,34HFORTRAN COMPILER VALIDATION SYSTEM)
90003 FORMAT (1H ,21X,11HVERSION 1.0)
90004 FORMAT (1H ,10X,38HFOR OFFICIAL USE ONLY - COPYRIGHT 1978)
90005 FORMAT (1H ,5X,4HTEST,5X,9HPASS/FAIL, 5X,8HCOMPUTED,8X,7HCORRECT)
90006 FORMAT (1H ,5X,46H----------------------------------------------)
90011 FORMAT (1H ,18X,17HSUBSET LEVEL TEST)
C
C FORMAT STATEMENTS FOR RUN SUMMARIES
90008 FORMAT (1H ,15X,I5,19H ERRORS ENCOUNTERED)
90009 FORMAT (1H ,15X,I5,13H TESTS PASSED)
90010 FORMAT (1H ,15X,I5,14H TESTS DELETED)
C
C FORMAT STATEMENTS FOR TEST RESULTS
80001 FORMAT (1H ,4X,I5,7X,4HPASS)
80002 FORMAT (1H ,4X,I5,7X,4HFAIL)
80003 FORMAT (1H ,4X,I5,7X,7HDELETED)
80004 FORMAT (1H ,4X,I5,7X,4HFAIL,10X,I6,9X,I6)
80005 FORMAT (1H ,4X,I5,7X,4HFAIL,4X,E12.5,3X,E12.5)
C
90007 FORMAT (1H ,20X,20HEND OF PROGRAM FM018)
END
*END-OF,FM018
FM019.f 480975983 170 2 100666 19368 `
*HEADER,FORTR,FM019
*FILES1,FORTR,FM019,X
C
C COMMENT SECTION.
C
C FM019
C
C THIS ROUTINE CONTINUES TESTS OF THE FORTRAN LOGICAL IF STATE
C BY TESTING VARIOUS FORMS OF RELATIONAL EXPRESSIONS WITH ARITHMETIC
C EXPRESSIONS . POSITIVE AND NEGATIVE SIGNS ARE USED IN CONJUNCTION
C WITH PARENTHESES. COMBINATIONS OF LOGICAL .AND. .OR.
C .NOT. ARE USED TO TEST THE MORE COMPLEX EXPRESSIONS.
C
C REFERENCES
C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN,
C X3.9-1978
C
C SECTION 4.7.1, LOGICAL CONSTANT
C SECTION 6, EXPRESSIONS
C SECTION 11.5, LOGICAL IF STATEMENT
C
LOGICAL LCTNT1, LCTNT2
C
C **********************************************************
C
C A COMPILER VALIDATION SYSTEM FOR THE FORTRAN LANGUAGE
C BASED ON SPECIFICATIONS AS DEFINED IN AMERICAN NATIONAL STANDARD
C PROGRAMMING LANGUAGE FORTRAN X3.9-1978, HAS BEEN DEVELOPED BY THE
C FEDERAL COBOL COMPILER TESTING SERVICE. THE FORTRAN COMPILER
C VALIDATION SYSTEM (FCVS) CONSISTS OF AUDIT ROUTINES, THEIR RELATED
C DATA, AND AN EXECUTIVE SYSTEM. EACH AUDIT ROUTINE IS A FORTRAN
C PROGRAM, SUBPROGRAM OR FUNCTION WHICH INCLUDES TESTS OF SPECIFIC
C LANGUAGE ELEMENTS AND SUPPORTING PROCEDURES INDICATING THE RESULT
C OF EXECUTING THESE TESTS.
C
C THIS PARTICULAR PROGRAM/SUBPROGRAM/FUNCTION CONTAINS FEATURES
C FOUND ONLY IN THE SUBSET AS DEFINED IN X3.9-1978.
C
C SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO -
C
C DEPARTMENT OF THE NAVY
C FEDERAL COBOL COMPILER TESTING SERVICE
C WASHINGTON, D.C. 20376
C
C **********************************************************
C
C
C
C INITIALIZATION SECTION
C
C INITIALIZE CONSTANTS
C **************
C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER.
I01 = 5
C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER.
I02 = 6
C SYSTEM ENVIRONMENT SECTION
C
CX010 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-010 CONTROL CARD.
C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5
C (UNIT NUMBER FOR CARD READER).
CX011 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-011 CONTROL CARD.
C THE CX011 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL
C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX010 ABOVE.
C
CX020 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-020 CONTROL CARD.
C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02 = 6
C (UNIT NUMBER FOR PRINTER).
CX021 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-021 CONTROL CARD.
C THE CX021 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL
C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX020 ABOVE.
C
IVPASS=0
IVFAIL=0
IVDELE=0
ICZERO=0
C
C WRITE PAGE HEADERS
WRITE (I02,90000)
WRITE (I02,90001)
WRITE (I02,90002)
WRITE (I02, 90002)
WRITE (I02,90003)
WRITE (I02,90002)
WRITE (I02,90004)
WRITE (I02,90002)
WRITE (I02,90011)
WRITE (I02,90002)
WRITE (I02,90002)
WRITE (I02,90005)
WRITE (I02,90006)
WRITE (I02,90002)
IVTNUM = 530
C
C **** TEST 530 ****
C TEST 530 - TEST OF POSITIVELY SIGNED TERM +(IC) (RO) -(IC)
C .LT. FALSE PATH
C
IF (ICZERO) 35300, 5300, 35300
5300 CONTINUE
IVON01 = 1
IF ( +3 .LT. -3) IVON01 = 0
GO TO 45300
35300 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 45300, 5311, 45300
45300 IF ( IVON01 - 1 ) 25300, 15300, 25300
15300 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 5311
25300 IVFAIL = IVFAIL + 1
IVCOMP = IVON01
IVCORR = 1
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
5311 CONTINUE
IVTNUM = 531
C
C **** TEST 531 ****
C TEST 531 - TEST OF SIGNED ZERO .LT. FALSE PATH
C
C
IF (ICZERO) 35310, 5310, 35310
5310 CONTINUE
IVON01 = 1
IF ( +0 .LT. -0 ) IVON01 = 0
GO TO 45310
35310 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 45310, 5321, 45310
45310 IF ( IVON01 - 1 ) 25310, 15310, 25310
15310 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 5321
25310 IVFAIL = IVFAIL + 1
IVCOMP = IVON01
IVCORR = 1
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
5321 CONTINUE
IVTNUM = 532
C
C **** TEST 532 ****
C TEST 532 - TEST OF SIGNED ZERO .LE. TRUE PATH
C
C
IF (ICZERO) 35320, 5320, 35320
5320 CONTINUE
IVON01 = 0
IF ( +0 .LE. -0 ) IVON01 = 1
GO TO 45320
35320 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 45320, 5331, 45320
45320 IF ( IVON01 - 1 ) 25320, 15320, 25320
15320 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 5331
25320 IVFAIL = IVFAIL + 1
IVCOMP = IVON01
IVCORR = 1
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
5331 CONTINUE
IVTNUM = 533
C
C **** TEST 533 ****
C TEST 533 - TEST OF SIGNED ZERO .EQ. TRUE PATH
C
C
IF (ICZERO) 35330, 5330, 35330
5330 CONTINUE
IVON01 = 0
IF ( +0 .EQ. -0 ) IVON01 = 1
GO TO 45330
35330 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 45330, 5341, 45330
45330 IF ( IVON01 - 1 ) 25330, 15330, 25330
15330 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 5341
25330 IVFAIL = IVFAIL + 1
IVCOMP = IVON01
IVCORR = 1
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
5341 CONTINUE
IVTNUM = 534
C
C **** TEST 534 ****
C TEST 534 - TEST OF SIGNED ZERO .NE. FALSE PATH
C
C
IF (ICZERO) 35340, 5340, 35340
5340 CONTINUE
IVON01 = 1
IF ( +0 .NE. -0 ) IVON01 = 0
GO TO 45340
35340 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 45340, 5351, 45340
45340 IF ( IVON01 - 1 ) 25340, 15340, 25340
15340 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 5351
25340 IVFAIL = IVFAIL + 1
IVCOMP = IVON01
IVCORR = 1
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
5351 CONTINUE
IVTNUM = 535
C
C **** TEST 535 ****
C TEST 535 - TEST OF SIGNED ZERO .GE. TRUE PATH
C
C
IF (ICZERO) 35350, 5350, 35350
5350 CONTINUE
IVON01 = 0
IF ( +0 .GE. -0 ) IVON01 = 1
GO TO 45350
35350 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 45350, 5361, 45350
45350 IF ( IVON01 - 1 ) 25350, 15350, 25350
15350 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 5361
25350 IVFAIL = IVFAIL + 1
IVCOMP = IVON01
IVCORR = 1
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
5361 CONTINUE
IVTNUM = 536
C
C **** TEST 536 ****
C TEST 536 - TEST OF SIGNED ZERO .GT. FALSE PATH
C
C
IF (ICZERO) 35360, 5360, 35360
5360 CONTINUE
IVON01 = 1
IF ( +0 .GT. -0 ) IVON01 = 0
GO TO 45360
35360 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 45360, 5371, 45360
45360 IF ( IVON01 - 1 ) 25360, 15360, 25360
15360 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 5371
25360 IVFAIL = IVFAIL + 1
IVCOMP = IVON01
IVCORR = 1
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
5371 CONTINUE
IVTNUM = 537
C
C **** TEST 537 ****
C TEST 537 - TEST OF +32767 .EQ. -32766 FALSE PATH
C
C
IF (ICZERO) 35370, 5370, 35370
5370 CONTINUE
IVON01 = 1
IF ( +32767 .EQ. -32766 ) IVON01 = 0
GO TO 45370
35370 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 45370, 5381, 45370
45370 IF ( IVON01 - 1 ) 25370, 15370, 25370
15370 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 5381
25370 IVFAIL = IVFAIL + 1
IVCOMP = IVON01
IVCORR = 1
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
5381 CONTINUE
IVTNUM = 538
C
C **** TEST 538 ****
C TEST 538 - TESTS MINUS SIGN WITH INTEGER VARIABLES
C RELATIONAL EXPRESSION USES .LE. TRUE PATH
C
C
IF (ICZERO) 35380, 5380, 35380
5380 CONTINUE
IVON01 = 0
IVON02 = 3
IF ( -IVON02 .LE. -IVON02 ) IVON01 = 1
GO TO 45380
35380 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 45380, 5391, 45380
45380 IF ( IVON01 - 1 ) 25380, 15380, 25380
15380 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 5391
25380 IVFAIL = IVFAIL + 1
IVCOMP = IVON01
IVCORR = 1
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
5391 CONTINUE
IVTNUM = 539
C
C **** TEST 539 ****
C TEST 539 - TEST IS LIKE TEST 538 USES .GE. TRUE PATH
C
C
IF (ICZERO) 35390, 5390, 35390
5390 CONTINUE
IVON01 = 0
IVON02 = 32766
IF ( -IVON02 .GE. -IVON02 ) IVON01 = 1
GO TO 45390
35390 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 45390, 5401, 45390
45390 IF ( IVON01 - 1 ) 25390, 15390, 25390
15390 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 5401
25390 IVFAIL = IVFAIL + 1
IVCOMP = IVON01
IVCORR = 1
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
5401 CONTINUE
IVTNUM = 540
C
C **** TEST 540 ****
C TEST 540 - INTEGER EXPONIENTIATION AND MINUS SIGN USES .NE.
C FALSE PATH
C
C
IF (ICZERO) 35400, 5400, 35400
5400 CONTINUE
IVON01 = 1
IVON02 = 3
IF ( -IVON02 ** 3 .NE. -27 ) IVON01 = 0
GO TO 45400
35400 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 45400, 5411, 45400
45400 IF ( IVON01 - 1 ) 25400, 15400, 25400
15400 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 5411
25400 IVFAIL = IVFAIL + 1
IVCOMP = IVON01
IVCORR = 1
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
5411 CONTINUE
IVTNUM = 541
C
C **** TEST 541 ****
C TEST 541 - LIKE TEST 540 USES .LE. TRUE PATH
C
C
IF (ICZERO) 35410, 5410, 35410
5410 CONTINUE
IVON01 = 0
IVON02 = 3
IF ( -3 ** IVON02 .LE. -27 ) IVON01 = 1
GO TO 45410
35410 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 45410, 5421, 45410
45410 IF ( IVON01 - 1 ) 25410, 15410, 25410
15410 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 5421
25410 IVFAIL = IVFAIL + 1
IVCOMP = IVON01
IVCORR = 1
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
5421 CONTINUE
IVTNUM = 542
C
C **** TEST 542 ****
C TEST 542 - INTEGER EXPONIENTIATION AND MULTIPLICATION
C USES .EQ. TRUE PATH
C
C
IF (ICZERO) 35420, 5420, 35420
5420 CONTINUE
IVON01 = 0
IVON02 = 3
IVON03 = 27
IF ( -IVON02 ** 2 * IVON02 .EQ. -IVON03 ) IVON01 = 1
GO TO 45420
35420 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 45420, 5431, 45420
45420 IF ( IVON01 - 1 ) 25420, 15420, 25420
15420 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 5431
25420 IVFAIL = IVFAIL + 1
IVCOMP = IVON01
IVCORR = 1
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
5431 CONTINUE
IVTNUM = 543
C
C **** TEST 543 ****
C TEST 543 - INTEGER EXPONIENTIATION AND DIVISION
C USES .LT. TRUE PATH
C
C
IF (ICZERO) 35430, 5430, 35430
5430 CONTINUE
IVON01 = 0
IVON02 = 587
IVON03 = 3
IVON04 = 3
IF ( -IVON02/IVON04 ** 3 .LT. -3 ** IVON03/IVON02 ) IVON01 = 1
GO TO 45430
35430 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 45430, 5441, 45430
45430 IF ( IVON01 - 1 ) 25430, 15430, 25430
15430 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 5441
25430 IVFAIL = IVFAIL + 1
IVCOMP = IVON01
IVCORR = 1
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
5441 CONTINUE
IVTNUM = 544
C
C **** TEST 544 ****
C TEST 544 - INTEGER ADDITION AND SUBTRACTION
C USES .EQ. TRUE PATH
C
C
IF (ICZERO) 35440, 5440, 35440
5440 CONTINUE
IVON01 = 0
IVON02 = 3
IVON03 = 587
IF ( IVON02 - IVON03 .EQ. -IVON03 + IVON02 ) IVON01 = 1
GO TO 45440
35440 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 45440, 5451, 45440
45440 IF ( IVON01 - 1 ) 25440, 15440, 25440
15440 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 5451
25440 IVFAIL = IVFAIL + 1
IVCOMP = IVON01
IVCORR = 1
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
5451 CONTINUE
IVTNUM = 545
C
C **** TEST 545 ****
C TEST 545 - INTEGER ADDITION AND SUBTRACTION WITH PARENTHESES
C USES .EQ. TRUE PATH LIKE TEST 544
C
C
IF (ICZERO) 35450, 5450, 35450
5450 CONTINUE
IVON01 = 0
IVON02 = 3
IVON03 = 587
IF ( (IVON02 - IVON03) .EQ. (-IVON03 + IVON02) ) IVON01 = 1
GO TO 45450
35450 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 45450, 5461, 45450
45450 IF ( IVON01 - 1 ) 25450, 15450, 25450
15450 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 5461
25450 IVFAIL = IVFAIL + 1
IVCOMP = IVON01
IVCORR = 1
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
5461 CONTINUE
IVTNUM = 546
C
C **** TEST 546 ****
C TEST 546 - INTEGER EXPONIENTIATION AND DIVISION WITH PARENS
C USES .LT. TRUE PATH
C
C
IF (ICZERO) 35460, 5460, 35460
5460 CONTINUE
IVON01 = 0
IVON02 = 587
IVON03 = 3
IVON04 = 3
IF ((-IVON02/(IVON04**3)).LT.((-3**IVON03)/IVON02))IVON01=1
GO TO 45460
35460 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 45460, 5471, 45460
45460 IF ( IVON01 - 1 ) 25460, 15460, 25460
15460 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 5471
25460 IVFAIL = IVFAIL + 1
IVCOMP = IVON01
IVCORR = 1
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
5471 CONTINUE
IVTNUM = 547
C
C **** TEST 547 ****
C TEST 547 - INTEGER MULTIPLICATION WITH PARENTHESES .LT. FALSE
C
C
IF (ICZERO) 35470, 5470, 35470
5470 CONTINUE
IVON01 = 1
IVON02 = 587
IF ((-3)*(-3).LT.(-IVON02))IVON01=0
GO TO 45470
35470 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 45470, 5481, 45470
45470 IF ( IVON01 - 1 ) 25470, 15470, 25470
15470 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 5481
25470 IVFAIL = IVFAIL + 1
IVCOMP = IVON01
IVCORR = 1
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
5481 CONTINUE
IVTNUM = 548
C
C **** TEST 548 ****
C TEST 548 - INTEGER EXPONIENTIATION, MINUS SIGNS, AND PARENTHESES
C USES .LE. TRUE PATH
C
C
IF (ICZERO) 35480, 5480, 35480
5480 CONTINUE
IVON01 = 0
IVON02 = 3
IVON03 = 27
IF ( ((-IVON02) ** IVON02 .LE. (-IVON03))) IVON01 = 1
GO TO 45480
35480 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 45480, 5491, 45480
45480 IF ( IVON01 - 1 ) 25480, 15480, 25480
15480 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 5491
25480 IVFAIL = IVFAIL + 1
IVCOMP = IVON01
IVCORR = 1
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
5491 CONTINUE
IVTNUM = 549
C
C **** TEST 549 ****
C TEST 549 - TEST THE ORDER OF INTEGER ARITHMETIC OPERATIONS
C USES INTEGER EXPONIENTIATION, ADDITION, MULTIPLICATION,
C AND PARENTHESES. ALSO USES .EQ. TRUE PATH
C SEE SECTION 6.1, ARITHMETIC EXPRESSIONS.
C
C
IF (ICZERO) 35490, 5490, 35490
5490 CONTINUE
IVON01 = 0
IVON02 = 3
IF(IVON02 * IVON02/(IVON02+IVON02)**IVON02+IVON02 .EQ. 3) IVON01=1
GO TO 45490
35490 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 45490, 5501, 45490
45490 IF ( IVON01 - 1 ) 25490, 15490, 25490
15490 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 5501
25490 IVFAIL = IVFAIL + 1
IVCOMP = IVON01
IVCORR = 1
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
5501 CONTINUE
IVTNUM = 550
C
C **** TEST 550 ****
C TEST 550 - COMBINATION OF LOGICAL .NOT. AND .AND.
C .NOT. (LP) .AND. .NOT. (LP)
C TRUE PATH
C
C
IF (ICZERO) 35500, 5500, 35500
5500 CONTINUE
IVON01 = 0
LCTNT1 = .FALSE.
IF ( .NOT. .FALSE. .AND. .NOT. LCTNT1 ) IVON01 = 1
GO TO 45500
35500 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 45500, 5511, 45500
45500 IF ( IVON01 - 1 ) 25500, 15500, 25500
15500 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 5511
25500 IVFAIL = IVFAIL + 1
IVCOMP = IVON01
IVCORR = 1
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
5511 CONTINUE
IVTNUM = 551
C
C **** TEST 551 ****
C TEST 551 - COMBINATION OF LOGICAL .OR. AND .NOT.
C .NOT. (LP) .OR. .NOT. (LP)
C TRUE PATH
C
C
IF (ICZERO) 35510, 5510, 35510
5510 CONTINUE
IVON01 = 0
LCTNT1 = .TRUE.
LCTNT2 = .FALSE.
IF ( .NOT. LCTNT1 .OR. .NOT. LCTNT2 ) IVON01 = 1
GO TO 45510
35510 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 45510, 5521, 45510
45510 IF ( IVON01 - 1 ) 25510, 15510, 25510
15510 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 5521
25510 IVFAIL = IVFAIL + 1
IVCOMP = IVON01
IVCORR = 1
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
5521 CONTINUE
IVTNUM = 552
C
C **** TEST 552 ****
C TEST 552 - COMBINATION OF LOGICAL .AND. .OR. AND .NOT.
C .NOT. ( (LE) .OR. (LT) ) .AND. .NOT. ( (LT) .AND. (LF) )
C .NOT. IS APPLIED TO A LOGICAL EXPRESSION INCLOSED IN PARENS
C FALSE PATH
C
IF (ICZERO) 35520, 5520, 35520
5520 CONTINUE
IVON01 = 1
LCTNT1 = .FALSE.
LCTNT2 = .TRUE.
IF(.NOT.(LCTNT1.OR.LCTNT2).AND..NOT.(LCTNT1.AND.LCTNT2))IVON01 = 0
GO TO 45520
35520 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 45520, 5531, 45520
45520 IF ( IVON01 - 1 ) 25520, 15520, 25520
15520 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 5531
25520 IVFAIL = IVFAIL + 1
IVCOMP = IVON01
IVCORR = 1
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
5531 CONTINUE
C
C WRITE PAGE FOOTINGS AND RUN SUMMARIES
99999 CONTINUE
WRITE (I02,90002)
WRITE (I02,90006)
WRITE (I02,90002)
WRITE (I02,90002)
WRITE (I02,90007)
WRITE (I02,90002)
WRITE (I02,90008) IVFAIL
WRITE (I02,90009) IVPASS
WRITE (I02,90010) IVDELE
C
C
C TERMINATE ROUTINE EXECUTION
STOP
C
C FORMAT STATEMENTS FOR PAGE HEADERS
90000 FORMAT (1H1)
90002 FORMAT (1H )
90001 FORMAT (1H ,10X,34HFORTRAN COMPILER VALIDATION SYSTEM)
90003 FORMAT (1H ,21X,11HVERSION 1.0)
90004 FORMAT (1H ,10X,38HFOR OFFICIAL USE ONLY - COPYRIGHT 1978)
90005 FORMAT (1H ,5X,4HTEST,5X,9HPASS/FAIL, 5X,8HCOMPUTED,8X,7HCORRECT)
90006 FORMAT (1H ,5X,46H----------------------------------------------)
90011 FORMAT (1H ,18X,17HSUBSET LEVEL TEST)
C
C FORMAT STATEMENTS FOR RUN SUMMARIES
90008 FORMAT (1H ,15X,I5,19H ERRORS ENCOUNTERED)
90009 FORMAT (1H ,15X,I5,13H TESTS PASSED)
90010 FORMAT (1H ,15X,I5,14H TESTS DELETED)
C
C FORMAT STATEMENTS FOR TEST RESULTS
80001 FORMAT (1H ,4X,I5,7X,4HPASS)
80002 FORMAT (1H ,4X,I5,7X,4HFAIL)
80003 FORMAT (1H ,4X,I5,7X,7HDELETED)
80004 FORMAT (1H ,4X,I5,7X,4HFAIL,10X,I6,9X,I6)
80005 FORMAT (1H ,4X,I5,7X,4HFAIL,4X,E12.5,3X,E12.5)
C
90007 FORMAT (1H ,20X,20HEND OF PROGRAM FM019)
END
*END-OF,FM019
FM020.f 480975986 170 2 100666 14162 `
*HEADER,FORTR,FM020
*FILES1,FORTR,FM020,X
C
C COMMENT SECTION.
C
C FM020
C
C THIS ROUTINE TESTS THE FORTRAN IN-LINE STATEMENT FUNCTION
C OF TYPE LOGICAL AND INTEGER. INTEGER CONSTANTS, LOGICAL CONSTANTS
C INTEGER VARIABLES, LOGICAL VARIABLES, INTEGER ARITHMETIC EXPRESS-
C IONS ARE ALL USED TO TEST THE STATEMENT FUNCTION DEFINITION AND
C THE VALUE RETURNED FOR THE STATEMENT FUNCTION WHEN IT IS USED
C IN THE MAIN BODY OF THE PROGRAM.
C
C REFERENCES
C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN,
C X3.9-1978
C
C SECTION 8.4.1, INTEGER, REAL, DOUBLE PRECISION, COMPLEX, AND
C LOGICAL TYPE-STATEMENTS
C SECTION 15.3.2, INTRINSIC FUNCTION REFERENCES
C SECTION 15.4, STATEMENT FUNCTIONS
C SECTION 15.4.1, FORMS OF A FUNCTION STATEMENT
C SECTION 15.4.2, REFERENCING A STATEMENT FUNCTION
C SECTION 15.5.2, EXTERNAL FUNCTION REFERENCES
C
LOGICAL LFTN01, LDTN01
LOGICAL LFTN02, LDTN02
LOGICAL LFTN03, LDTN03, LCTN03
LOGICAL LFTN04, LDTN04, LCTN04
DIMENSION IADN11(2)
C
C..... TEST 553
IFON01(IDON01) = 32767
C
C..... TEST 554
LFTN01(LDTN01) = .TRUE.
C
C..... TEST 555
IFON02 ( IDON02 ) = IDON02
C
C..... TEST 556
LFTN02( LDTN02 ) = LDTN02
C
C..... TEST 557
IFON03 (IDON03 )= IDON03
C
C..... TEST 558
LFTN03(LDTN03) = LDTN03
C
C..... TEST 559
LFTN04(LDTN04) = .NOT. LDTN04
C
C..... TEST 560
IFON04(IDON04) = IDON04 ** 2
C
C..... TEST 561
IFON05(IDON05, IDON06) = IDON05 + IDON06
C
C..... TEST 562
IFON06(IDON07, IDON08) = SQRT(FLOAT(IDON07**2)+FLOAT(IDON08**2))
C
C..... TEST 563
IFON07(IDON09) = IDON09 ** 2
IFON08(I,J)=SQRT(FLOAT(IFON07(I))+FLOAT(IFON07(J)))
C
C..... TEST 564
IFON09(K,L) = K / L + K ** L - K * L
C
C
C
C **********************************************************
C
C A COMPILER VALIDATION SYSTEM FOR THE FORTRAN LANGUAGE
C BASED ON SPECIFICATIONS AS DEFINED IN AMERICAN NATIONAL STANDARD
C PROGRAMMING LANGUAGE FORTRAN X3.9-1978, HAS BEEN DEVELOPED BY THE
C FEDERAL COBOL COMPILER TESTING SERVICE. THE FORTRAN COMPILER
C VALIDATION SYSTEM (FCVS) CONSISTS OF AUDIT ROUTINES, THEIR RELATED
C DATA, AND AN EXECUTIVE SYSTEM. EACH AUDIT ROUTINE IS A FORTRAN
C PROGRAM, SUBPROGRAM OR FUNCTION WHICH INCLUDES TESTS OF SPECIFIC
C LANGUAGE ELEMENTS AND SUPPORTING PROCEDURES INDICATING THE RESULT
C OF EXECUTING THESE TESTS.
C
C THIS PARTICULAR PROGRAM/SUBPROGRAM/FUNCTION CONTAINS FEATURES
C FOUND ONLY IN THE SUBSET AS DEFINED IN X3.9-1978.
C
C SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO -
C
C DEPARTMENT OF THE NAVY
C FEDERAL COBOL COMPILER TESTING SERVICE
C WASHINGTON, D.C. 20376
C
C **********************************************************
C
C
C
C INITIALIZATION SECTION
C
C INITIALIZE CONSTANTS
C **************
C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER.
I01 = 5
C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER.
I02 = 6
C SYSTEM ENVIRONMENT SECTION
C
CX010 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-010 CONTROL CARD.
C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5
C (UNIT NUMBER FOR CARD READER).
CX011 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-011 CONTROL CARD.
C THE CX011 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL
C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX010 ABOVE.
C
CX020 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-020 CONTROL CARD.
C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02 = 6
C (UNIT NUMBER FOR PRINTER).
CX021 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-021 CONTROL CARD.
C THE CX021 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL
C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX020 ABOVE.
C
IVPASS=0
IVFAIL=0
IVDELE=0
ICZERO=0
C
C WRITE PAGE HEADERS
WRITE (I02,90000)
WRITE (I02,90001)
WRITE (I02,90002)
WRITE (I02, 90002)
WRITE (I02,90003)
WRITE (I02,90002)
WRITE (I02,90004)
WRITE (I02,90002)
WRITE (I02,90011)
WRITE (I02,90002)
WRITE (I02,90002)
WRITE (I02,90005)
WRITE (I02,90006)
WRITE (I02,90002)
IVTNUM = 553
C
C **** TEST 553 ****
C TEST 553 - THE VALUE OF THE INTEGER FUNCTION IS SET TO A
C CONSTANT OF 32767 REGARDLESS OF THE VALUE OF THE ARGUEMENT
C SUPPLIED TO THE DUMMY ARGUEMENT. TEST OF POSITIVE INTEGER
C CONSTANTS FOR A STATEMENT FUNCTION.
C
C
IF (ICZERO) 35530, 5530, 35530
5530 CONTINUE
IVCOMP = IFON01(3)
GO TO 45530
35530 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 45530, 5541, 45530
45530 IF ( IVCOMP - 32767 ) 25530, 15530, 25530
15530 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 5541
25530 IVFAIL = IVFAIL + 1
IVCORR = 32767
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
5541 CONTINUE
IVTNUM = 554
C
C **** TEST 554 ****
C TEST 554 - TEST OF THE STATEMENT FUNCTION OF TYPE LOGICAL
C SET TO THE LOGICAL CONSTANT .TRUE. REGARDLESS OF THE
C ARGUEMENT SUPPLIED TO THE DUMMY ARGUEMENT.
C A LOGICAL IF STATEMENT IS USED IN CONJUNCTION WITH THE LOGICAL
C STATEMENT FUNCTION. THE TRUE PATH IS TESTED.
C
C
IF (ICZERO) 35540, 5540, 35540
5540 CONTINUE
IVON01 = 0
IF ( LFTN01(.FALSE.) ) IVON01 = 1
GO TO 45540
35540 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 45540, 5551, 45540
45540 IF ( IVON01 - 1 ) 25540, 15540, 25540
15540 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 5551
25540 IVFAIL = IVFAIL + 1
IVCOMP = IVON01
IVCORR = 1
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
5551 CONTINUE
IVTNUM = 555
C
C **** TEST 555 ****
C TEST 555 - THE INTEGER STATEMENT FUNCTION IS SET TO THE VALUE
C OF THE ARGEUMENT SUPPLIED.
C
C
IF (ICZERO) 35550, 5550, 35550
5550 CONTINUE
IVCOMP = IFON02 ( 32767 )
GO TO 45550
35550 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 45550, 5561, 45550
45550 IF ( IVCOMP - 32767 ) 25550, 15550, 25550
15550 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 5561
25550 IVFAIL = IVFAIL + 1
IVCORR = 32767
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
5561 CONTINUE
IVTNUM = 556
C
C **** TEST 556 ****
C TEST 556 - TEST OF A LOGICAL STATEMENT FUNCTION SET TO THE
C VALUE OF THE ARGUEMENT SUPPLIED. THE FALSE PATH OF A LOGICAL
C IF STATEMENT IS USED IN CONJUNCTION WITH THE LOGICAL
C STATEMENT FUNCTION.
C
C
IF (ICZERO) 35560, 5560, 35560
5560 CONTINUE
IVON01 = 1
IF ( LFTN02(.FALSE.) ) IVON01 = 0
GO TO 45560
35560 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 45560, 5571, 45560
45560 IF ( IVON01 - 1 ) 25560, 15560, 25560
15560 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 5571
25560 IVFAIL = IVFAIL + 1
IVCOMP = IVON01
IVCORR = 1
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
5571 CONTINUE
IVTNUM = 557
C
C **** TEST 557 ****
C TEST 557 - THE VALUE OF AN INTEGER FUNCTION IS SET EQUAL TO
C VALUE OF THE ARGUEMENT SUPPLIED. THIS VALUE IS AN INTEGER
C VARIABLE SET TO 32767.
C
C
IF (ICZERO) 35570, 5570, 35570
5570 CONTINUE
ICON01 = 32767
IVCOMP = IFON03 ( ICON01 )
GO TO 45570
35570 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 45570, 5581, 45570
45570 IF ( IVCOMP - 32767 ) 25570, 15570, 25570
15570 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 5581
25570 IVFAIL = IVFAIL + 1
IVCORR = 32767
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
5581 CONTINUE
IVTNUM = 558
C
C **** TEST 558 ****
C TEST 558 - A LOGICAL STATEMENT FUNCTION IS SET EQUAL TO THE
C VALUE OF THE ARGUEMENT SUPPLIED. THIS VALUE IS A LOGICAL
C VARIABLE SET TO .TRUE. THE TRUE PATH OF A LOGICAL IF
C STATEMENT IS USED IN CONJUNCTION WITH THE LOGICAL STATEMENT
C FUNCTION.
C
C
IF (ICZERO) 35580, 5580, 35580
5580 CONTINUE
IVON01 = 0
LCTN03 = .TRUE.
IF ( LFTN03(LCTN03) ) IVON01 = 1
GO TO 45580
35580 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 45580, 5591, 45580
45580 IF ( IVON01 - 1 ) 25580, 15580, 25580
15580 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 5591
25580 IVFAIL = IVFAIL + 1
IVCOMP = IVON01
IVCORR = 1
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
5591 CONTINUE
IVTNUM = 559
C
C **** TEST 559 ****
C TEST 559 - LIKE TEST 558 ONLY THE LOGICAL .NOT. IS USED
C IN THE LOGICAL STATEMENT FUNCTION DEFINITION THE FALSE PATH
C OF A LOGICAL IF STATEMENT IS USED IN CONJUNCTION WITH THE
C LOGICAL STATEMENT FUNCTION.
C
C
IF (ICZERO) 35590, 5590, 35590
5590 CONTINUE
IVON01 = 1
LCTN04 = .TRUE.
IF ( LFTN04(LCTN04) ) IVON01 = 0
GO TO 45590
35590 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 45590, 5601, 45590
45590 IF ( IVON01 - 1 ) 25590, 15590, 25590
15590 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 5601
25590 IVFAIL = IVFAIL + 1
IVCOMP = IVON01
IVCORR = 1
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
5601 CONTINUE
IVTNUM = 560
C
C **** TEST 560 ****
C TEST 560 - INTEGER EXPONIENTIATION USED IN AN INTEGER
C STATEMENT FUNCTION.
C
C
IF (ICZERO) 35600, 5600, 35600
5600 CONTINUE
ICON04 = 3
IVCOMP = IFON04(ICON04)
GO TO 45600
35600 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 45600, 5611, 45600
45600 IF ( IVCOMP - 9 ) 25600, 15600, 25600
15600 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 5611
25600 IVFAIL = IVFAIL + 1
IVCORR = 9
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
5611 CONTINUE
IVTNUM = 561
C
C **** TEST 561 ****
C TEST 561 - TEST OF INTEGER ADDITION USING TWO (2) DUMMY
C ARGUEMENTS.
C
C
IF (ICZERO) 35610, 5610, 35610
5610 CONTINUE
ICON05 = 9
ICON06 = 16
IVCOMP = IFON05(ICON05, ICON06)
GO TO 45610
35610 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 45610, 5621, 45610
45610 IF ( IVCOMP - 25 ) 25610, 15610, 25610
15610 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 5621
25610 IVFAIL = IVFAIL + 1
IVCORR = 25
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
5621 CONTINUE
IVTNUM = 562
C
C **** TEST 562 ****
C TEST 562 - THIS TEST IS THE SOLUTION OF A RIGHT TRIANGLE
C USING INTEGER STATEMENT FUNCTIONS WHICH REFERENCE THE
C INTRINSIC FUNCTIONS SQRT AND FLOAT. THIS IS A 3-4-5
C RIGHT TRIANGLE.
C
C
IF (ICZERO) 35620, 5620, 35620
5620 CONTINUE
ICON07 = 3
ICON08 = 4
IVCOMP = IFON06(ICON07, ICON08)
GO TO 45620
35620 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 45620, 5631, 45620
45620 IF ( IVCOMP - 5 ) 5622, 15620, 5622
5622 IF ( IVCOMP - 4 ) 25620, 15620, 25620
15620 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 5631
25620 IVFAIL = IVFAIL + 1
IVCORR = 5
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
5631 CONTINUE
IVTNUM = 563
C
C **** TEST 563 ****
C TEST 563 - SOLUTION OF A 3-4-5 RIGHT TRIANGLE LIKE TEST 562
C EXCEPT THAT BOTH INTRINSIC AND PREVIOUSLY DEFINED STATEMENT
C FUNCTIONS ARE USED.
C
C
IF (ICZERO) 35630, 5630, 35630
5630 CONTINUE
ICON09 = 3
ICON10 = 4
IVCOMP = IFON08(ICON09, ICON10)
GO TO 45630
35630 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 45630, 5641, 45630
45630 IF ( IVCOMP - 5 ) 5632, 15630, 5632
5632 IF ( IVCOMP - 4 ) 25630, 15630, 25630
15630 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 5641
25630 IVFAIL = IVFAIL + 1
IVCORR = 5
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
5641 CONTINUE
IVTNUM = 564
C
C **** TEST 564 ****
C TEST 564 - USE OF ARRAY ELEMENTS IN AN INTEGER STATEMENT
C FUNCTION WHICH USES THE OPERATIONS OF + - * / .
C
C
IF (ICZERO) 35640, 5640, 35640
5640 CONTINUE
IADN11(1) = 2
IADN11(2) = 2
IVCOMP = IFON09( IADN11(1), IADN11(2) )
GO TO 45640
35640 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 45640, 5651, 45640
45640 IF ( IVCOMP - 1 ) 25640, 15640, 25640
15640 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 5651
25640 IVFAIL = IVFAIL + 1
IVCORR = 1
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
5651 CONTINUE
C
C WRITE PAGE FOOTINGS AND RUN SUMMARIES
99999 CONTINUE
WRITE (I02,90002)
WRITE (I02,90006)
WRITE (I02,90002)
WRITE (I02,90002)
WRITE (I02,90007)
WRITE (I02,90002)
WRITE (I02,90008) IVFAIL
WRITE (I02,90009) IVPASS
WRITE (I02,90010) IVDELE
C
C
C TERMINATE ROUTINE EXECUTION
STOP
C
C FORMAT STATEMENTS FOR PAGE HEADERS
90000 FORMAT (1H1)
90002 FORMAT (1H )
90001 FORMAT (1H ,10X,34HFORTRAN COMPILER VALIDATION SYSTEM)
90003 FORMAT (1H ,21X,11HVERSION 1.0)
90004 FORMAT (1H ,10X,38HFOR OFFICIAL USE ONLY - COPYRIGHT 1978)
90005 FORMAT (1H ,5X,4HTEST,5X,9HPASS/FAIL, 5X,8HCOMPUTED,8X,7HCORRECT)
90006 FORMAT (1H ,5X,46H----------------------------------------------)
90011 FORMAT (1H ,18X,17HSUBSET LEVEL TEST)
C
C FORMAT STATEMENTS FOR RUN SUMMARIES
90008 FORMAT (1H ,15X,I5,19H ERRORS ENCOUNTERED)
90009 FORMAT (1H ,15X,I5,13H TESTS PASSED)
90010 FORMAT (1H ,15X,I5,14H TESTS DELETED)
C
C FORMAT STATEMENTS FOR TEST RESULTS
80001 FORMAT (1H ,4X,I5,7X,4HPASS)
80002 FORMAT (1H ,4X,I5,7X,4HFAIL)
80003 FORMAT (1H ,4X,I5,7X,7HDELETED)
80004 FORMAT (1H ,4X,I5,7X,4HFAIL,10X,I6,9X,I6)
80005 FORMAT (1H ,4X,I5,7X,4HFAIL,4X,E12.5,3X,E12.5)
C
90007 FORMAT (1H ,20X,20HEND OF PROGRAM FM020)
END
*END-OF,FM020
FM021.f 480975990 170 2 100666 28031 `
*HEADER,FORTR,FM021
*FILES1,FORTR,FM021,X
C
C COMMENT SECTION.
C
C FM021
C
C THIS ROUTINE TESTS THE FORTRAN DATA INITIALIZATION
C STATEMENT. INTEGER, REAL, AND LOGICAL DATA TYPES ARE TESTED
C USING UNSIGNED CONSTANTS, SIGNED CONSTANTS, AND LOGICAL
C CONSTANTS.. INTEGER, REAL, LOGICAL, AND MIXED TYPE ARRAYS
C ARE ALSO TESTED.
C
C REFERENCES
C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN,
C X3.9-1978
C
C SECTION 4.1.3, DATA TYPE PREPARATION
C SECTION 4.4.3, REAL CONSTANT
C SECTION 9, DATA STATEMENT
C
INTEGER RATN11(3)
LOGICAL LCTN01, LCTN02, LATN11(3), LADN11
REAL IATN11(3)
DIMENSION IADN11(3), RADN11(4), LADN11(6), RADN13(4), IADN12(4)
DIMENSION IADN13(4)
C
DATA ICON01/0/
DATA ICON02/3/
DATA ICON03/76/
DATA ICON04/587/
DATA ICON05/9999/
DATA ICON06/32767/
DATA ICON07/-0/
DATA ICON08/-32766/
DATA ICON09/00003/
DATA ICON10/ 3 2 7 6 7 /
DATA LCTN01/.TRUE./
DATA LCTN02/.FALSE./
DATA RCON01/0./
DATA RCON02 /.0/
DATA RCON03/0.0/
DATA RCON04/32767./
DATA RCON05/-32766./
DATA RCON06/-000587./
DATA RCON07/99.99/
DATA RCON08/ -03. 2 7 6 6/
DATA IADN11(1)/3/, IADN11(3)/-587/, IADN11(2)/32767/
DATA IADN12/4*9999/
DATA IADN13/0,2*-32766,-587/
DATA LADN11/.TRUE., .FALSE., 2*.TRUE., 2*.FALSE./
DATA RADN11/32767., -32.766, 2*587./
DATA LATN11/.TRUE., 2*.FALSE./, IATN11/2*32767., -32766./
DATA RATN11/3*-32766/
DATA RADN13/32.767E03, -3.2766E-01, .587E+03, 9E1/
C
C
C **********************************************************
C
C A COMPILER VALIDATION SYSTEM FOR THE FORTRAN LANGUAGE
C BASED ON SPECIFICATIONS AS DEFINED IN AMERICAN NATIONAL STANDARD
C PROGRAMMING LANGUAGE FORTRAN X3.9-1978, HAS BEEN DEVELOPED BY THE
C FEDERAL COBOL COMPILER TESTING SERVICE. THE FORTRAN COMPILER
C VALIDATION SYSTEM (FCVS) CONSISTS OF AUDIT ROUTINES, THEIR RELATED
C DATA, AND AN EXECUTIVE SYSTEM. EACH AUDIT ROUTINE IS A FORTRAN
C PROGRAM, SUBPROGRAM OR FUNCTION WHICH INCLUDES TESTS OF SPECIFIC
C LANGUAGE ELEMENTS AND SUPPORTING PROCEDURES INDICATING THE RESULT
C OF EXECUTING THESE TESTS.
C
C THIS PARTICULAR PROGRAM/SUBPROGRAM/FUNCTION CONTAINS FEATURES
C FOUND ONLY IN THE SUBSET AS DEFINED IN X3.9-1978.
C
C SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO -
C
C DEPARTMENT OF THE NAVY
C FEDERAL COBOL COMPILER TESTING SERVICE
C WASHINGTON, D.C. 20376
C
C **********************************************************
C
C
C
C INITIALIZATION SECTION
C
C INITIALIZE CONSTANTS
C **************
C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER.
I01 = 5
C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER.
I02 = 6
C SYSTEM ENVIRONMENT SECTION
C
CX010 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-010 CONTROL CARD.
C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5
C (UNIT NUMBER FOR CARD READER).
CX011 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-011 CONTROL CARD.
C THE CX011 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL
C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX010 ABOVE.
C
CX020 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-020 CONTROL CARD.
C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02 = 6
C (UNIT NUMBER FOR PRINTER).
CX021 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-021 CONTROL CARD.
C THE CX021 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL
C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX020 ABOVE.
C
IVPASS=0
IVFAIL=0
IVDELE=0
ICZERO=0
C
C WRITE PAGE HEADERS
WRITE (I02,90000)
WRITE (I02,90001)
WRITE (I02,90002)
WRITE (I02, 90002)
WRITE (I02,90003)
WRITE (I02,90002)
WRITE (I02,90004)
WRITE (I02,90002)
WRITE (I02,90011)
WRITE (I02,90002)
WRITE (I02,90002)
WRITE (I02,90005)
WRITE (I02,90006)
WRITE (I02,90002)
IVTNUM = 565
C
C **** TEST 565 ****
C TEST 565 - TEST OF AN INTEGER VARIABLE SET TO THE INTEGER
C CONSTANT ZERO.
C
C
IF (ICZERO) 35650, 5650, 35650
5650 CONTINUE
GO TO 45650
35650 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 45650, 5661, 45650
45650 IF ( ICON01 - 0 ) 25650, 15650, 25650
15650 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 5661
25650 IVFAIL = IVFAIL + 1
IVCOMP = ICON01
IVCORR = 0
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
5661 CONTINUE
IVTNUM = 566
C
C **** TEST 566 ****
C TEST 566 - TEST OF AN INTEGER VARIABLE SET TO THE INTEGER
C CONSTANT 3.
C
C
IF (ICZERO) 35660, 5660, 35660
5660 CONTINUE
GO TO 45660
35660 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 45660, 5671, 45660
45660 IF ( ICON02 - 3 ) 25660, 15660, 25660
15660 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 5671
25660 IVFAIL = IVFAIL + 1
IVCOMP = ICON02
IVCORR = 3
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
5671 CONTINUE
IVTNUM = 567
C
C **** TEST 567 ****
C TEST 567 - TEST OF AN INTEGER VARIABLE SET TO THE INTEGER
C CONSTANT 76.
C
C
IF (ICZERO) 35670, 5670, 35670
5670 CONTINUE
GO TO 45670
35670 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 45670, 5681, 45670
45670 IF ( ICON03 - 76 ) 25670, 15670, 25670
15670 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 5681
25670 IVFAIL = IVFAIL + 1
IVCOMP = ICON03
IVCORR = 76
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
5681 CONTINUE
IVTNUM = 568
C
C **** TEST 568 ****
C TEST 568 - TEST OF AN INTEGER VARIABLE SET TO THE INTEGER
C CONSTANT 587.
C
C
IF (ICZERO) 35680, 5680, 35680
5680 CONTINUE
GO TO 45680
35680 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 45680, 5691, 45680
45680 IF ( ICON04 - 587 ) 25680, 15680, 25680
15680 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 5691
25680 IVFAIL = IVFAIL + 1
IVCOMP = ICON04
IVCORR = 587
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
5691 CONTINUE
IVTNUM = 569
C
C **** TEST 569 ****
C TEST 569 - TEST OF AN INTEGER VARIABLE SET TO THE INTEGER
C CONSTANT 9999.
C
C
IF (ICZERO) 35690, 5690, 35690
5690 CONTINUE
GO TO 45690
35690 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 45690, 5701, 45690
45690 IF ( ICON05 - 9999 ) 25690, 15690, 25690
15690 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 5701
25690 IVFAIL = IVFAIL + 1
IVCOMP = ICON05
IVCORR = 9999
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
5701 CONTINUE
IVTNUM = 570
C
C **** TEST 570 ****
C TEST 570 - TEST OF AN INTEGER VARIABLE SET TO THE INTEGER
C CONSTANT 32767.
C
C
IF (ICZERO) 35700, 5700, 35700
5700 CONTINUE
GO TO 45700
35700 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 45700, 5711, 45700
45700 IF ( ICON06 - 32767 ) 25700, 15700, 25700
15700 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 5711
25700 IVFAIL = IVFAIL + 1
IVCOMP = ICON06
IVCORR = 32767
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
5711 CONTINUE
IVTNUM = 571
C
C **** TEST 571 ****
C TEST 571 - TEST OF AN INTEGER VARIABLE SET TO THE INTEGER
C CONSTANT -0. NOTE THAT SIGNED ZERO AND UNSIGNED ZERO
C SHOULD BE EQUAL FOR ANY INTEGER OPERATION.
C
C
IF (ICZERO) 35710, 5710, 35710
5710 CONTINUE
GO TO 45710
35710 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 45710, 5721, 45710
45710 IF ( ICON07 - 0 ) 25710, 15710, 25710
15710 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 5721
25710 IVFAIL = IVFAIL + 1
IVCOMP = ICON07
IVCORR = -0
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
5721 CONTINUE
IVTNUM = 572
C
C **** TEST 572 ****
C TEST 572 - TEST OF AN INTEGER VARIABLE SET TO THE INTEGER
C CONSTANT (SIGNED) -32766.
C
C
IF (ICZERO) 35720, 5720, 35720
5720 CONTINUE
GO TO 45720
35720 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 45720, 5731, 45720
45720 IF ( ICON08 + 32766 ) 25720, 15720, 25720
15720 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 5731
25720 IVFAIL = IVFAIL + 1
IVCOMP = ICON08
IVCORR = -32766
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
5731 CONTINUE
IVTNUM = 573
C
C **** TEST 573 ****
C TEST 573 - TEST THE EFFECT OF LEADING ZERO ON AN INTEGER
C CONSTANT 00003.
C
C
IF (ICZERO) 35730, 5730, 35730
5730 CONTINUE
GO TO 45730
35730 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 45730, 5741, 45730
45730 IF ( ICON09 - 3 ) 25730, 15730, 25730
15730 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 5741
25730 IVFAIL = IVFAIL + 1
IVCOMP = ICON09
IVCORR = 3
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
5741 CONTINUE
IVTNUM = 574
C
C **** TEST 574 ****
C TEST 574 - TEST OF BLANKS IMBEDDED IN AN INTEGER CONSTANT
C WHICH WAS / 3 2 7 6 7/ IN THE DATA INITIALIZATION STATEMENT.
C
C
IF (ICZERO) 35740, 5740, 35740
5740 CONTINUE
GO TO 45740
35740 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 45740, 5751, 45740
45740 IF ( ICON10 - 32767 ) 25740, 15740, 25740
15740 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 5751
25740 IVFAIL = IVFAIL + 1
IVCOMP = ICON10
IVCORR = 32767
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
5751 CONTINUE
IVTNUM = 575
C
C **** TEST 575 ****
C TEST 575 - TEST OF A LOGICAL VARIABLE SET TO THE LOGICAL
C CONSTANT .TRUE.
C TRUE PATH OF A LOGICAL IF STATEMENT IS USED IN THE TEST.
C
C
IF (ICZERO) 35750, 5750, 35750
5750 CONTINUE
IVON01 = 0
IF ( LCTN01 ) IVON01 = 1
GO TO 45750
35750 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 45750, 5761, 45750
45750 IF ( IVON01 - 1 ) 25750, 15750, 25750
15750 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 5761
25750 IVFAIL = IVFAIL + 1
IVCOMP = IVON01
IVCORR = 1
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
5761 CONTINUE
IVTNUM = 576
C
C **** TEST 576 ****
C TEST 576 - TEST OF A LOGICAL VARIABLE SET TO THE LOGICAL
C CONSTANT .FALSE. THE FALSE PATH OF A LOGICAL IF STATEMENT
C IS ALSO USED IN THE TEST.
C
C
IF (ICZERO) 35760, 5760, 35760
5760 CONTINUE
IVON01 = 1
IF ( LCTN02 ) IVON01 = 0
GO TO 45760
35760 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 45760, 5771, 45760
45760 IF ( IVON01 - 1 ) 25760, 15760, 25760
15760 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 5771
25760 IVFAIL = IVFAIL + 1
IVCOMP = IVON01
IVCORR = 1
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
5771 CONTINUE
IVTNUM = 577
C
C **** TEST 577 ****
C TEST 577 - REAL VARIABLE SET TO 0.
C
C
IF (ICZERO) 35770, 5770, 35770
5770 CONTINUE
GO TO 45770
35770 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 45770, 5781, 45770
45770 IF ( RCON01 - 0. ) 25770, 15770, 25770
15770 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 5781
25770 IVFAIL = IVFAIL + 1
IVCOMP = RCON01
IVCORR = 0
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
5781 CONTINUE
IVTNUM = 578
C
C **** TEST 578 ****
C TEST 578 - REAL VARIABLE SET TO .0
C
C
IF (ICZERO) 35780, 5780, 35780
5780 CONTINUE
GO TO 45780
35780 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 45780, 5791, 45780
45780 IF ( RCON02 - .0 ) 25780, 15780, 25780
15780 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 5791
25780 IVFAIL = IVFAIL + 1
IVCOMP = RCON02
IVCORR = 0
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
5791 CONTINUE
IVTNUM = 579
C
C **** TEST 579 ****
C TEST 579 - REAL VARIABLE SET TO 0.0
C
C
IF (ICZERO) 35790, 5790, 35790
5790 CONTINUE
GO TO 45790
35790 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 45790, 5801, 45790
45790 IF ( RCON03 - 0.0 ) 25790, 15790, 25790
15790 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 5801
25790 IVFAIL = IVFAIL + 1
IVCOMP = RCON03
IVCORR = 0
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
5801 CONTINUE
IVTNUM = 580
C
C **** TEST 580 ****
C TEST 580 - REAL VARIABLE SET TO 32767.
C
C
IF (ICZERO) 35800, 5800, 35800
5800 CONTINUE
GO TO 45800
35800 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 45800, 5811, 45800
45800 IF ( RCON04 - 32767. ) 25800, 15800, 25800
15800 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 5811
25800 IVFAIL = IVFAIL + 1
IVCOMP = RCON04
IVCORR = 32767
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
5811 CONTINUE
IVTNUM = 581
C
C **** TEST 581 ****
C TEST 581 - REAL VARIABLE SET TO -32766.
C
C
IF (ICZERO) 35810, 5810, 35810
5810 CONTINUE
GO TO 45810
35810 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 45810, 5821, 45810
45810 IF ( RCON05 + 32766 ) 25810, 15810, 25810
15810 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 5821
25810 IVFAIL = IVFAIL + 1
IVCOMP = RCON05
IVCORR = -32766
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
5821 CONTINUE
IVTNUM = 582
C
C **** TEST 582 ****
C TEST 582 - REAL VARIABLE SET TO -000587. TEST OF LEADING SIGN
C AND LEADING ZEROS ON A REAL CONSTANT.
C
C
IF (ICZERO) 35820, 5820, 35820
5820 CONTINUE
GO TO 45820
35820 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 45820, 5831, 45820
45820 IF ( RCON06 + 587. ) 25820, 15820, 25820
15820 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 5831
25820 IVFAIL = IVFAIL + 1
IVCOMP = RCON06
IVCORR = -587
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
5831 CONTINUE
IVTNUM = 583
C
C **** TEST 583 ****
C TEST 583 - REAL VARIABLE SET TO 99.99
C
C
IF (ICZERO) 35830, 5830, 35830
5830 CONTINUE
GO TO 45830
35830 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 45830, 5841, 45830
45830 IF ( RCON07 - 99.99 ) 25830, 15830, 25830
15830 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 5841
25830 IVFAIL = IVFAIL + 1
IVCOMP = RCON07
IVCORR = 99
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
5841 CONTINUE
IVTNUM = 584
C
C **** TEST 584 ****
C TEST 584 - REAL VARIABLE SET TO /-03. 2 7 6 6/ TO TEST
C THE EFFECT OF BLANKS IMBEDDED IN A REAL CONSTANT.
C
C
IF (ICZERO) 35840, 5840, 35840
5840 CONTINUE
GO TO 45840
35840 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 45840, 5851, 45840
45840 IF ( RCON08 + 3.2766 ) 25840, 15840, 25840
15840 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 5851
25840 IVFAIL = IVFAIL + 1
IVCOMP = RCON08
IVCORR = -3
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
5851 CONTINUE
IVTNUM = 585
C
C **** TEST 585 ****
C TEST 585 - INTEGER ARRAY ELEMENT SET TO 3
C
C
IF (ICZERO) 35850, 5850, 35850
5850 CONTINUE
GO TO 45850
35850 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 45850, 5861, 45850
45850 IF ( IADN11(1) - 3 ) 25850, 15850, 25850
15850 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 5861
25850 IVFAIL = IVFAIL + 1
IVCOMP = IADN11(1)
IVCORR = 3
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
5861 CONTINUE
IVTNUM = 586
C
C **** TEST 586 ****
C TEST 586 - INTEGER ARRAY ELEMENT SET TO 32767
C
C
IF (ICZERO) 35860, 5860, 35860
5860 CONTINUE
GO TO 45860
35860 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 45860, 5871, 45860
45860 IF ( IADN11(2) - 32767 ) 25860, 15860, 25860
15860 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 5871
25860 IVFAIL = IVFAIL + 1
IVCOMP = IADN11(2)
IVCORR = 32767
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
5871 CONTINUE
IVTNUM = 587
C
C **** TEST 587 ****
C TEST 587 - INTEGER ARRAY ELEMENT SET TO -587
C
C
IF (ICZERO) 35870, 5870, 35870
5870 CONTINUE
GO TO 45870
35870 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 45870, 5881, 45870
45870 IF ( IADN11(3) + 587 ) 25870, 15870, 25870
15870 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 5881
25870 IVFAIL = IVFAIL + 1
IVCOMP = IADN11(3)
IVCORR = -587
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
5881 CONTINUE
IVTNUM = 588
C
C **** TEST 588 ****
C TEST 588 - TEST OF THE REPEAT FIELD /4*999/ IN A DATA STATE.
C
C
IF (ICZERO) 35880, 5880, 35880
5880 CONTINUE
GO TO 45880
35880 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 45880, 5891, 45880
45880 IF ( IADN12(3) - 9999 ) 25880, 15880, 25880
15880 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 5891
25880 IVFAIL = IVFAIL + 1
IVCOMP = IADN12(3)
IVCORR = 9999
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
5891 CONTINUE
IVTNUM = 589
C
C **** TEST 589 ****
C TEST 589 - TEST OF SETTING THE WHOLE INTEGER ARRAY ELEMENTS
C IN ONE DATA INITIALIZATION STATEMENT. THE FIRST ELEMENT
C IS SET TO 0
C
C
IF (ICZERO) 35890, 5890, 35890
5890 CONTINUE
GO TO 45890
35890 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 45890, 5901, 45890
45890 IF ( IADN13(1) - 0 ) 25890, 15890, 25890
15890 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 5901
25890 IVFAIL = IVFAIL + 1
IVCOMP = IADN13(1)
IVCORR = 0
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
5901 CONTINUE
IVTNUM = 590
C
C **** TEST 590 ****
C TEST 590 - SEE TEST 589. THE SECOND ELEMENT WAS SET TO -32766
C
C
IF (ICZERO) 35900, 5900, 35900
5900 CONTINUE
GO TO 45900
35900 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 45900, 5911, 45900
45900 IF ( IADN13(2) + 32766 ) 25900, 15900, 25900
15900 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 5911
25900 IVFAIL = IVFAIL + 1
IVCOMP = IADN13(2)
IVCORR = -32766
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
5911 CONTINUE
IVTNUM = 591
C
C **** TEST 591 ****
C TEST 591 - SEE TEST 589. THE THIRD ELEMENT WAS SET TO -32766
C
C
IF (ICZERO) 35910, 5910, 35910
5910 CONTINUE
GO TO 45910
35910 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 45910, 5921, 45910
45910 IF ( IADN13(3) + 32766 ) 25910, 15910, 25910
15910 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 5921
25910 IVFAIL = IVFAIL + 1
IVCOMP = IADN13(3)
IVCORR = -32766
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
5921 CONTINUE
IVTNUM = 592
C
C **** TEST 592 ****
C TEST 592 - SEE TEST 589. THE FOURTH ELEMENT WAS SET TO -587
C
C
IF (ICZERO) 35920, 5920, 35920
5920 CONTINUE
GO TO 45920
35920 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 45920, 5931, 45920
45920 IF ( IADN13(4) + 587 ) 25920, 15920, 25920
15920 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 5931
25920 IVFAIL = IVFAIL + 1
IVCOMP = IADN13(4)
IVCORR = -587
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
5931 CONTINUE
IVTNUM = 593
C
C **** TEST 593 ****
C TEST 593 - TEST OF SETTING THE WHOLE LOGICAL ARRAY IN ONE
C DATA INITIALIZATION STATEMENT. THE FIRST ELEMENT IS .TRUE.
C THE SECOND AND THIRD ELEMENTS ARE .FALSE.
C THE FALSE PATH OF A LOGICAL IF STATEMENT IS USED TESTING 2.
C
C
IF (ICZERO) 35930, 5930, 35930
5930 CONTINUE
IVON01 = 1
IF ( LADN11(2) ) IVON01 = 0
GO TO 45930
35930 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 45930, 5941, 45930
45930 IF ( IVON01 - 1 ) 25930, 15930, 25930
15930 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 5941
25930 IVFAIL = IVFAIL + 1
IVCOMP = IVON01
IVCORR = 1
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
5941 CONTINUE
IVTNUM = 594
C
C **** TEST 594 ****
C TEST 594 - SEE TEST 593. THE FOURTH ELEMENT IS TESTED
C WITH THE TRUE PATH OF THE LOGICAL IF STATEMENT.
C
C
IF (ICZERO) 35940, 5940, 35940
5940 CONTINUE
IVON01 = 0
IF ( LADN11(4) ) IVON01 = 1
GO TO 45940
35940 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 45940, 5951, 45940
45940 IF ( IVON01 - 1 ) 25940, 15940, 25940
15940 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 5951
25940 IVFAIL = IVFAIL + 1
IVCOMP = IVON01
IVCORR = 1
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
5951 CONTINUE
IVTNUM = 595
C
C **** TEST 595 ****
C TEST 595 - A WHOLE REAL ARRAY IS SET IN ONE DATA INITIALIZATION
C STATEMENT. THE SECOND ELEMENT IS -32.766
C
C
IF (ICZERO) 35950, 5950, 35950
5950 CONTINUE
GO TO 45950
35950 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 45950, 5961, 45950
45950 IF ( RADN11(2) + 32.766 ) 25950, 15950, 25950
15950 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 5961
25950 IVFAIL = IVFAIL + 1
IVCOMP = RADN11(2)
IVCORR = -32
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
5961 CONTINUE
IVTNUM = 596
C
C **** TEST 596 ****
C TEST 596 - SEE TEST 595. THE FOURTH ELEMENT IS SET TO 587
C BY A REPEAT FIELD.
C
C
IF (ICZERO) 35960, 5960, 35960
5960 CONTINUE
GO TO 45960
35960 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 45960, 5971, 45960
45960 IF ( RADN11(4) - 587 ) 25960, 15960, 25960
15960 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 5971
25960 IVFAIL = IVFAIL + 1
IVCOMP = RADN11(4)
IVCORR = 587
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
5971 CONTINUE
IVTNUM = 597
C
C **** TEST 597 ****
C TEST 597 - TEST OF MIXED ARRAY ELEMENT TYPES IN A SINGLE DATA
C INITIALIZATION STATEMENT. THE TYPE LOGICAL STATEMENT CONTAINS
C THE ARRAY DECLARATIONS. THE FALSE PATH OF A LOGICAL
C IF STATEMENT TESTS THE LOGICAL RESULTS.
C
C
IF (ICZERO) 35970, 5970, 35970
5970 CONTINUE
IVON01 = 1
IF ( LATN11(2) ) IVON01 = 0
GO TO 45970
35970 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 45970, 5981, 45970
45970 IF ( IVON01 - 1 ) 25970, 15970, 25970
15970 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 5981
25970 IVFAIL = IVFAIL + 1
IVCOMP = IVON01
IVCORR = 1
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
5981 CONTINUE
IVTNUM = 598
C
C **** TEST 598 ****
C TEST 598 - TYPE OF THE DATA WAS SET EXPLICITLY REAL IN THE
C DECLARATIVE FOR THE ARRAY. DATA SHOULD BE SET TO 32767.
C
C
IF (ICZERO) 35980, 5980, 35980
5980 CONTINUE
GO TO 45980
35980 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 45980, 5991, 45980
45980 IF ( IATN11(2) - 32767. ) 25980, 15980, 25980
15980 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 5991
25980 IVFAIL = IVFAIL + 1
IVCOMP = IATN11(2)
IVCORR = 32767
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
5991 CONTINUE
IVTNUM = 599
C
C **** TEST 599 ****
C TEST 599 - TYPE OF THE DATA WAS SET EXPLICITLY INTEGER IN THE
C DECLARATIVE FOR THE ARRAY. DATA SHOULD BE SET TO -32766
C
C
IF (ICZERO) 35990, 5990, 35990
5990 CONTINUE
GO TO 45990
35990 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 45990, 6001, 45990
45990 IF ( RATN11(2) + 32766 ) 25990, 15990, 25990
15990 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 6001
25990 IVFAIL = IVFAIL + 1
IVCOMP = RATN11(2)
IVCORR = -32766
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
6001 CONTINUE
IVTNUM = 600
C
C **** TEST 600 ****
C TEST 600 - TEST OF REAL DECIMAL CONSTANTS USING E-NOTATION.
C SEE SECTION 4.4.2. THE VALUE OF THE ELEMENT SHOULD
C BE SET TO 32767.
C
C
IF (ICZERO) 36000, 6000, 36000
6000 CONTINUE
GO TO 46000
36000 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 46000, 6011, 46000
46000 IF ( RADN13(1) - 32767. ) 26000, 16000, 26000
16000 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 6011
26000 IVFAIL = IVFAIL + 1
IVCOMP = RADN13(1)
IVCORR = 32767
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
6011 CONTINUE
IVTNUM = 601
C
C **** TEST 601 ****
C TEST 601 - LIKE TEST 600. REAL DECIMAL CONSTANT VALUE -.32766
C
C
IF (ICZERO) 36010, 6010, 36010
6010 CONTINUE
GO TO 46010
36010 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 46010, 6021, 46010
46010 IF ( RADN13(2) + .32766 ) 26010, 16010, 26010
16010 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 6021
26010 IVFAIL = IVFAIL + 1
IVCOMP = RADN13(2)
IVCORR = 0
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
6021 CONTINUE
IVTNUM = 602
C
C **** TEST 602 ****
C TEST 602 - LIKE TEST 600. REAL DECIMAL CONSTANT VALUE 587.
C
C
IF (ICZERO) 36020, 6020, 36020
6020 CONTINUE
GO TO 46020
36020 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 46020, 6031, 46020
46020 IF ( RADN13(3) - 587 ) 26020, 16020, 26020
16020 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 6031
26020 IVFAIL = IVFAIL + 1
IVCOMP = RADN13(3)
IVCORR = 587
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
6031 CONTINUE
IVTNUM = 603
C
C **** TEST 603 ****
C TEST 603 - LIKE TEST 600. REAL DECIMAL CONSTANT VALUE 90.
C
C
IF (ICZERO) 36030, 6030, 36030
6030 CONTINUE
GO TO 46030
36030 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 46030, 6041, 46030
46030 IF ( RADN13(4) - 90. ) 26030, 16030, 26030
16030 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 6041
26030 IVFAIL = IVFAIL + 1
IVCOMP = RADN13(4)
IVCORR = 90
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
6041 CONTINUE
C
C WRITE PAGE FOOTINGS AND RUN SUMMARIES
99999 CONTINUE
WRITE (I02,90002)
WRITE (I02,90006)
WRITE (I02,90002)
WRITE (I02,90002)
WRITE (I02,90007)
WRITE (I02,90002)
WRITE (I02,90008) IVFAIL
WRITE (I02,90009) IVPASS
WRITE (I02,90010) IVDELE
C
C
C TERMINATE ROUTINE EXECUTION
STOP
C
C FORMAT STATEMENTS FOR PAGE HEADERS
90000 FORMAT (1H1)
90002 FORMAT (1H )
90001 FORMAT (1H ,10X,34HFORTRAN COMPILER VALIDATION SYSTEM)
90003 FORMAT (1H ,21X,11HVERSION 1.0)
90004 FORMAT (1H ,10X,38HFOR OFFICIAL USE ONLY - COPYRIGHT 1978)
90005 FORMAT (1H ,5X,4HTEST,5X,9HPASS/FAIL, 5X,8HCOMPUTED,8X,7HCORRECT)
90006 FORMAT (1H ,5X,46H----------------------------------------------)
90011 FORMAT (1H ,18X,17HSUBSET LEVEL TEST)
C
C FORMAT STATEMENTS FOR RUN SUMMARIES
90008 FORMAT (1H ,15X,I5,19H ERRORS ENCOUNTERED)
90009 FORMAT (1H ,15X,I5,13H TESTS PASSED)
90010 FORMAT (1H ,15X,I5,14H TESTS DELETED)
C
C FORMAT STATEMENTS FOR TEST RESULTS
80001 FORMAT (1H ,4X,I5,7X,4HPASS)
80002 FORMAT (1H ,4X,I5,7X,4HFAIL)
80003 FORMAT (1H ,4X,I5,7X,7HDELETED)
80004 FORMAT (1H ,4X,I5,7X,4HFAIL,10X,I6,9X,I6)
80005 FORMAT (1H ,4X,I5,7X,4HFAIL,4X,E12.5,3X,E12.5)
C
90007 FORMAT (1H ,20X,20HEND OF PROGRAM FM021)
END
*END-OF,FM021
FM022.f 480975993 170 2 100666 24137 `
*HEADER,FORTR,FM022
*FILES1,FORTR,FM022,X
C COMMENT SECTION.
C
C FM022
C
C THIS ROUTINE TESTS ARRAYS WITH FIXED DIMENSION AND SIZE LIMITS
C SET EITHER IN A BLANK COMMON OR DIMENSION STATEMENT. THE VALUES
C OF THE ARRAY ELEMENTS ARE SET IN VARIOUS WAYS SUCH AS SIMPLE
C ASSIGNMENT STATEMENTS, SET TO THE VALUES OF OTHER ARRAY ELEMENTS
C (EITHER POSITIVE OR NEGATIVE), SET BY INTEGER TO REAL OR REAL TO
C INTEGER CONVERSION, SET BY ARITHMETIC EXPRESSIONS, OR SET BY
C USE OF THE EQUIVALENCE STATEMENT.
C
C REFERENCES
C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN,
C X3.9-1978
C
C SECTION 8, SPECIFICATION STATEMENTS
C SECTION 8.1, DIMENSION STATEMENT
C SECTION 8.2, EQUIVALENCE STATEMENT
C SECTION 8.3, COMMON STATEMENT
C SECTION 8.4, TYPE-STATEMENTS
C SECTION 9, DATA STATEMENT
C
C
C
COMMON IADN14(5), RADN14(5), LADN13(2)
C
DIMENSION IADN11(5), RADN11(5), LADN11(2)
DIMENSION IADN12(5), RADN12(5), LADN12(2)
DIMENSION IADN15(2), RADN15(2)
DIMENSION IADN16(4), IADN17(4)
C
INTEGER RADN13(5)
REAL IADN13(5)
LOGICAL LADN11, LADN12, LADN13, LCTN01
C
EQUIVALENCE (IADN14(1), IADN15(1)), (RADN14(2),RADN15(2))
EQUIVALENCE (LADN13(1),LCTN01), (IADN14(5), ICON02)
EQUIVALENCE (RADN14(5), RCON01)
EQUIVALENCE ( IADN16(3), IADN17(2) )
C
DATA IADN12(1)/3/, RADN12(1)/-512./, IADN13(1)/0.5/, RADN13(1)/-3/
C
C
C
C **********************************************************
C
C A COMPILER VALIDATION SYSTEM FOR THE FORTRAN LANGUAGE
C BASED ON SPECIFICATIONS AS DEFINED IN AMERICAN NATIONAL STANDARD
C PROGRAMMING LANGUAGE FORTRAN X3.9-1978, HAS BEEN DEVELOPED BY THE
C FEDERAL COBOL COMPILER TESTING SERVICE. THE FORTRAN COMPILER
C VALIDATION SYSTEM (FCVS) CONSISTS OF AUDIT ROUTINES, THEIR RELATED
C DATA, AND AN EXECUTIVE SYSTEM. EACH AUDIT ROUTINE IS A FORTRAN
C PROGRAM, SUBPROGRAM OR FUNCTION WHICH INCLUDES TESTS OF SPECIFIC
C LANGUAGE ELEMENTS AND SUPPORTING PROCEDURES INDICATING THE RESULT
C OF EXECUTING THESE TESTS.
C
C THIS PARTICULAR PROGRAM/SUBPROGRAM/FUNCTION CONTAINS FEATURES
C FOUND ONLY IN THE SUBSET AS DEFINED IN X3.9-1978.
C
C SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO -
C
C DEPARTMENT OF THE NAVY
C FEDERAL COBOL COMPILER TESTING SERVICE
C WASHINGTON, D.C. 20376
C
C **********************************************************
C
C
C
C INITIALIZATION SECTION
C
C INITIALIZE CONSTANTS
C **************
C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER.
I01 = 5
C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER.
I02 = 6
C SYSTEM ENVIRONMENT SECTION
C
CX010 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-010 CONTROL CARD.
C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5
C (UNIT NUMBER FOR CARD READER).
CX011 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-011 CONTROL CARD.
C THE CX011 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL
C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX010 ABOVE.
C
CX020 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-020 CONTROL CARD.
C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02 = 6
C (UNIT NUMBER FOR PRINTER).
CX021 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-021 CONTROL CARD.
C THE CX021 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL
C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX020 ABOVE.
C
IVPASS=0
IVFAIL=0
IVDELE=0
ICZERO=0
C
C WRITE PAGE HEADERS
WRITE (I02,90000)
WRITE (I02,90001)
WRITE (I02,90002)
WRITE (I02, 90002)
WRITE (I02,90003)
WRITE (I02,90002)
WRITE (I02,90004)
WRITE (I02,90002)
WRITE (I02,90011)
WRITE (I02,90002)
WRITE (I02,90002)
WRITE (I02,90005)
WRITE (I02,90006)
WRITE (I02,90002)
IVTNUM = 604
C
C **** TEST 604 ****
C TEST 604 - THIS TESTS A SIMPLE ASSIGNMENT STATEMENT IN SETTING
C AN INTEGER ARRAY ELEMENT TO A POSITIVE VALUE OF 32767.
C
IF (ICZERO) 36040, 6040, 36040
6040 CONTINUE
IADN11(5) = 32767
IVCOMP = IADN11(5)
GO TO 46040
36040 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 46040, 6051, 46040
46040 IF ( IVCOMP - 32767 ) 26040, 16040, 26040
16040 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 6051
26040 IVFAIL = IVFAIL + 1
IVCORR = 32767
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
6051 CONTINUE
IVTNUM = 605
C
C **** TEST 605 ****
C TEST 605 - TEST OF A SIMPLE ASSIGN WITH A NEGATIVE VALUE -32766
C
IF (ICZERO) 36050, 6050, 36050
6050 CONTINUE
IADN11(1) = -32766
IVCOMP = IADN11(1)
GO TO 46050
36050 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 46050, 6061, 46050
46050 IF ( IVCOMP + 32766 ) 26050, 16050, 26050
16050 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 6061
26050 IVFAIL = IVFAIL + 1
IVCORR = -32766
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
6061 CONTINUE
IVTNUM = 606
C
C **** TEST 606 ****
C TEST 606 - TEST OF UNSIGNED ZERO SET TO AN ARRAY ELEMENT
C BY A SIMPLE ASSIGNMENT STATEMENT.
C
IF (ICZERO) 36060, 6060, 36060
6060 CONTINUE
IADN11(3) = 0
IVCOMP = IADN11(3)
GO TO 46060
36060 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 46060, 6071, 46060
46060 IF ( IVCOMP - 0 ) 26060, 16060, 26060
16060 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 6071
26060 IVFAIL = IVFAIL + 1
IVCORR = 0
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
6071 CONTINUE
IVTNUM = 607
C
C **** TEST 607 ****
C TEST 607 - TEST OF A NEGATIVELY SIGNED ZERO COMPARED TO A
C ZERO UNSIGNED BOTH VALUES SET AS INTEGER ARRAY ELEMENTS.
C
IF (ICZERO) 36070, 6070, 36070
6070 CONTINUE
IADN11(2) = -0
IADN11(3) = 0
ICON01 = 0
IF ( IADN11(2) .EQ. IADN11(3) ) ICON01 = 1
GO TO 46070
36070 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 46070, 6081, 46070
46070 IF ( ICON01 - 1 ) 26070, 16070, 26070
16070 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 6081
26070 IVFAIL = IVFAIL + 1
IVCOMP = ICON01
IVCORR = 1
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
6081 CONTINUE
IVTNUM = 608
C
C **** TEST 608 ****
C TEST 608 - TEST OF SETTING ONE INTEGER ARRAY ELEMENT EQUAL TO
C THE VALUE OF ANOTHER INTEGER ARRAY ELEMENT. THE VALUE IS 32767.
C
IF (ICZERO) 36080, 6080, 36080
6080 CONTINUE
IADN11(1) = 32767
IADN12(5) = IADN11(1)
IVCOMP = IADN12(5)
GO TO 46080
36080 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 46080, 6091, 46080
46080 IF ( IVCOMP - 32767 ) 26080, 16080, 26080
16080 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 6091
26080 IVFAIL = IVFAIL + 1
IVCORR = 32767
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
6091 CONTINUE
IVTNUM = 609
C
C **** TEST 609 ****
C TEST 609 - TEST OF AN ARRAY ELEMENT SET TO ANOTHER ARRAY ELEMENT
C WHICH HAD BEEN SET AT COMPILE TIME BY A DATA INITIALIZATION
C STATEMENT. AN INTEGER ARRAY IS USED WITH THE VALUE 3.
C
IF (ICZERO) 36090, 6090, 36090
6090 CONTINUE
IADN11(4) = IADN12(1)
IVCOMP = IADN11(4)
GO TO 46090
36090 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 46090, 6101, 46090
46090 IF ( IVCOMP - 3 ) 26090, 16090, 26090
16090 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 6101
26090 IVFAIL = IVFAIL + 1
IVCORR = 3
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
6101 CONTINUE
IVTNUM = 610
C
C **** TEST 610 ****
C TEST 610 - TEST OF SETTING A REAL ARRAY ELEMENT TO A POSITIVE
C VALUE IN A SIMPLE ASSIGNMENT STATEMENT. VALUE IS 32767.
C
IF (ICZERO) 36100, 6100, 36100
6100 CONTINUE
RADN11(5) = 32767.
IVCOMP = RADN11(5)
GO TO 46100
36100 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 46100, 6111, 46100
46100 IF ( IVCOMP - 32767 ) 26100, 16100, 26100
16100 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 6111
26100 IVFAIL = IVFAIL + 1
IVCORR = 32767
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
6111 CONTINUE
IVTNUM = 611
C
C **** TEST 611 ****
C TEST 611 - TEST OF SETTING A REAL ARRAY ELEMENT TO A NEGATIVE
C VALUE IN A SIMPLE ASSIGNMENT STATEMENT. VALUE IS -32766.
C
IF (ICZERO) 36110, 6110, 36110
6110 CONTINUE
RADN11(1) = -32766.
IVCOMP = RADN11(1)
GO TO 46110
36110 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 46110, 6121, 46110
46110 IF ( IVCOMP + 32766 ) 26110, 16110, 26110
16110 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 6121
26110 IVFAIL = IVFAIL + 1
IVCORR = -32766
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
6121 CONTINUE
IVTNUM = 612
C
C **** TEST 612 ****
C TEST 612 - TEST OF SETTING A REAL ARRAY ELEMENT TO UNSIGNED ZERO
C IN A SIMPLE ASSIGNMENT STATEMENT.
C
IF (ICZERO) 36120, 6120, 36120
6120 CONTINUE
RADN11(3) = 0.
IVCOMP = RADN11(3)
GO TO 46120
36120 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 46120, 6131, 46120
46120 IF ( IVCOMP - 0 ) 26120, 16120, 26120
16120 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 6131
26120 IVFAIL = IVFAIL + 1
IVCORR = 0
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
6131 CONTINUE
IVTNUM = 613
C
C **** TEST 613 ****
C TEST 613 - TEST OF A NEGATIVELY SIGNED ZERO IN A REAL ARRAY
C ELEMENT COMPARED TO A REAL ELEMENT SET TO AN UNSIGNED ZERO.
C
IF (ICZERO) 36130, 6130, 36130
6130 CONTINUE
RADN11(2) = -0.0
RADN11(3) = 0.0
ICON01 = 0
IF ( RADN11(2) .EQ. RADN11(3) ) ICON01 = 1
GO TO 46130
36130 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 46130, 6141, 46130
46130 IF ( ICON01 - 1 ) 26130, 16130, 26130
16130 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 6141
26130 IVFAIL = IVFAIL + 1
IVCOMP = ICON01
IVCORR = 1
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
6141 CONTINUE
IVTNUM = 614
C
C **** TEST 614 ****
C TEST 614 - TEST OF SETTING ONE REAL ARRAY ELEMENT EQUAL TO THE
C VALUE OF ANOTHER REAL ARRAY ELEMENT. THE VALUE IS 32767.
C
IF (ICZERO) 36140, 6140, 36140
6140 CONTINUE
RADN11(1) = 32767.
RADN12(5) = RADN11(1)
IVCOMP = RADN12(5)
GO TO 46140
36140 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 46140, 6151, 46140
46140 IF ( IVCOMP - 32767 ) 26140, 16140, 26140
16140 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 6151
26140 IVFAIL = IVFAIL + 1
IVCORR = 32767
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
6151 CONTINUE
IVTNUM = 615
C
C **** TEST 615 ****
C TEST 615 - TEST OF A REAL ARRAY ELEMENT SET TO ANOTHER REAL
C ARRAY ELEMENT WHICH HAD BEEN SET AT COMPILE TIME BY A DATA
C INITIALIZATION STATEMENT. THE VALUE IS -512.
C
IF (ICZERO) 36150, 6150, 36150
6150 CONTINUE
RADN11(4) = RADN12(1)
IVCOMP = RADN11(4)
GO TO 46150
36150 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 46150, 6161, 46150
46150 IF ( IVCOMP + 512 ) 26150, 16150, 26150
16150 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 6161
26150 IVFAIL = IVFAIL + 1
IVCORR = - 512
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
6161 CONTINUE
IVTNUM = 616
C
C **** TEST 616 ****
C TEST 616 - TEST OF SETTING THE VALUE OF AN INTEGER ARRAY ELEMENT
C BY AN ARITHMETIC EXPRESSION.
C
IF (ICZERO) 36160, 6160, 36160
6160 CONTINUE
ICON01 = 1
IADN11(3) = ICON01 + 1
IVCOMP = IADN11(3)
GO TO 46160
36160 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 46160, 6171, 46160
46160 IF ( IVCOMP - 2 ) 26160, 16160, 26160
16160 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 6171
26160 IVFAIL = IVFAIL + 1
IVCORR = 2
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
6171 CONTINUE
IVTNUM = 617
C
C **** TEST 617 ****
C TEST 617 - TEST OF SETTING THE VALUE OF A REAL ARRAY ELEMENT
C BY AN ARITHMETIC EXPRESSION.
C
IF (ICZERO) 36170, 6170, 36170
6170 CONTINUE
RCON01 = 1.
RADN11(3) = RCON01 + 1.
IVCOMP = RADN11(3)
GO TO 46170
36170 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 46170, 6181, 46170
46170 IF ( IVCOMP - 2 ) 26170, 16170, 26170
16170 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 6181
26170 IVFAIL = IVFAIL + 1
IVCORR = 2
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
6181 CONTINUE
IVTNUM = 618
C
C **** TEST 618 ****
C TEST 618 - TEST OF SETTING THE VALUE OF AN INTEGER ARRAY ELEMENT
C TO ANOTHER INTEGER ARRAY ELEMENT AND CHANGING THE SIGN.
C
IF (ICZERO) 36180, 6180, 36180
6180 CONTINUE
IADN11(2) = 32766
IADN11(4) = - IADN11(2)
IVCOMP = IADN11(4)
GO TO 46180
36180 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 46180, 6191, 46180
46180 IF ( IVCOMP + 32766 ) 26180, 16180, 26180
16180 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 6191
26180 IVFAIL = IVFAIL + 1
IVCORR = -32766
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
6191 CONTINUE
IVTNUM = 619
C
C **** TEST 619 ****
C TEST 619 - TEST OF SETTING THE VALUE OF A REAL ARRAY ELEMENT
C TO THE VALUE OF ANOTHER REAL ARRAY ELEMENT AND CHANGING THE SIGN.
C
IF (ICZERO) 36190, 6190, 36190
6190 CONTINUE
RADN11(2) = 32766.
RADN11(4) = - RADN11(2)
IVCOMP = RADN11(4)
GO TO 46190
36190 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 46190, 6201, 46190
46190 IF ( IVCOMP + 32766 ) 26190, 16190, 26190
16190 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 6201
26190 IVFAIL = IVFAIL + 1
IVCORR = -32766
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
6201 CONTINUE
IVTNUM = 620
C
C **** TEST 620 ****
C TEST 620 - TEST OF SETTING THE VALUE OF A LOGICAL ARRAY ELEMENT
C TO THE VALUE OF ANOTHER LOGICAL ARRAY ELEMENT.
C
IF (ICZERO) 36200, 6200, 36200
6200 CONTINUE
LADN11(1) = .TRUE.
LADN12(1) = LADN11(1)
ICON01 = 0
IF ( LADN12(1) ) ICON01 = 1
GO TO 46200
36200 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 46200, 6211, 46200
46200 IF ( ICON01 - 1 ) 26200, 16200, 26200
16200 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 6211
26200 IVFAIL = IVFAIL + 1
IVCOMP = ICON01
IVCORR = 1
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
6211 CONTINUE
IVTNUM = 621
C
C **** TEST 621 ****
C TEST 621 - TEST OF SETTING THE VALUE OF A LOGICAL ARRAY ELEMENT
C TO THE VALUE OF ANOTHER LOGICAL ARRAY ELEMENT AND CHANGING
C THE VALUE FROM .TRUE. TO .FALSE. BY USING THE .NOT. STATEMENT.
C
IF (ICZERO) 36210, 6210, 36210
6210 CONTINUE
LADN11(2) = .TRUE.
LADN12(2) = .NOT. LADN11(2)
ICON01 = 1
IF ( LADN12(2) ) ICON01 = 0
GO TO 46210
36210 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 46210, 6221, 46210
46210 IF ( ICON01 - 1 ) 26210, 16210, 26210
16210 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 6221
26210 IVFAIL = IVFAIL + 1
IVCOMP = ICON01
IVCORR = 1
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
6221 CONTINUE
IVTNUM = 622
C
C **** TEST 622 ****
C TEST 622 - TEST OF THE TYPE STATEMENT AND THE DATA
C INITIALIZATION STATEMENT. THE EXPLICITLY REAL ARRAY ELEMENT
C SHOULD HAVE THE VALUE OF .5
C
IF (ICZERO) 36220, 6220, 36220
6220 CONTINUE
IVCOMP = 2. * IADN13(1)
GO TO 46220
36220 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 46220, 6231, 46220
46220 IF ( IVCOMP - 1 ) 26220, 16220, 26220
16220 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 6231
26220 IVFAIL = IVFAIL + 1
IVCORR = 1
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
6231 CONTINUE
IVTNUM = 623
C
C **** TEST 623 ****
C TEST 623 - TEST OF REAL TO INTEGER CONVERSION USING ARRAYS.
C THE INITIALIZED VALUE OF 0.5 SHOULD BE TRUNCATED TO ZERO.
C
IF (ICZERO) 36230, 6230, 36230
6230 CONTINUE
IADN11(1) = IADN13(1)
IVCOMP = IADN11(1)
GO TO 46230
36230 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 46230, 6241, 46230
46230 IF ( IVCOMP - 0 ) 26230, 16230, 26230
16230 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 6241
26230 IVFAIL = IVFAIL + 1
IVCORR = 0
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
6241 CONTINUE
IVTNUM = 624
C
C **** TEST 624 ****
C TEST 624 - TEST OF THE COMMON STATEMENT BY SETTING THE VALUE OF
C AN INTEGER ARRAY ELEMENT IN A DIMENSIONED ARRAY TO THE VALUE
C OF A REAL ARRAY ELEMENT IN COMMON. THE ELEMENT IN COMMON HAD ITS
C VALUE SET IN A SIMPLE ASSIGNMENT STATEMENT TO 9999.
C
IF (ICZERO) 36240, 6240, 36240
6240 CONTINUE
RADN14(1) = 9999.
IADN11(1) = RADN14(1)
IVCOMP = IADN11(1)
GO TO 46240
36240 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 46240, 6251, 46240
46240 IF ( IVCOMP - 9999 ) 26240, 16240, 26240
16240 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 6251
26240 IVFAIL = IVFAIL + 1
IVCORR = 9999
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
6251 CONTINUE
IVTNUM = 625
C
C **** TEST 625 ****
C TEST 625 - TEST OF SETTING THE VALUE OF AN INTEGER ARRAY ELEMENT
C IN COMMON TO THE VALUE OF A REAL ARRAY ELEMENT ALSO IN BLANK
C COMMON AND CHANGING THE SIGN. THE VALUE USED IS 9999.
C
IF (ICZERO) 36250, 6250, 36250
6250 CONTINUE
RADN14(1) = 9999.
IADN14(1) = - RADN14(1)
IVCOMP = IADN14(1)
GO TO 46250
36250 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 46250, 6261, 46250
46250 IF ( IVCOMP + 9999 ) 26250, 16250, 26250
16250 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 6261
26250 IVFAIL = IVFAIL + 1
IVCORR = - 9999
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
6261 CONTINUE
IVTNUM = 626
C
C **** TEST 626 ****
C TEST 626 - TEST OF SETTING THE VALUE OF A LOGICAL ARRAY ELEMENT
C IN BLANK COMMON TO .NOT. .TRUE.
C THE VALUE OF ANOTHER LOGICAL ARRAY ELEMENT ALSO IN COMMON IS THEN
C SET TO .NOT. OF THE VALUE OF THE FIRST.
C VALUE OF THE FIRST ELEMENT SHOULD BE .FALSE.
C VALUE OF THE SECOND ELEMENT SHOULD BE .TRUE.
C
IF (ICZERO) 36260, 6260, 36260
6260 CONTINUE
LADN13(1) = .NOT. .TRUE.
LADN13(2) = .NOT. LADN13(1)
ICON01 = 0
IF ( LADN13(2) ) ICON01 = 1
GO TO 46260
36260 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 46260, 6271, 46260
46260 IF ( ICON01 - 1 ) 26260, 16260, 26260
16260 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 6271
26260 IVFAIL = IVFAIL + 1
IVCOMP = ICON01
IVCORR = 1
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
6271 CONTINUE
IVTNUM = 627
C
C **** TEST 627 ****
C TEST 627 - TEST OF EQUIVALENCE ON THE FIRST ELEMENTS OF INTEGER
C ARRAYS ONE OF WHICH IS IN COMMON AND THE OTHER ONE IS DIMENSIONED.
C
IF (ICZERO) 36270, 6270, 36270
6270 CONTINUE
IADN14(2) = 32767
IVCOMP = IADN15(2)
GO TO 46270
36270 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 46270, 6281, 46270
46270 IF ( IVCOMP - 32767 ) 26270, 16270, 26270
16270 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 6281
26270 IVFAIL = IVFAIL + 1
IVCORR = 32767
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
6281 CONTINUE
IVTNUM = 628
C
C **** TEST 628 ****
C TEST 628 - TEST OF EQUIVALENCE ON REAL ARRAYS ONE OF WHICH IS
C IN COMMON AND THE OTHER ONE IS DIMENSIONED. THE ARRAYS WERE
C ALIGNED ON THEIR SECOND ELEMENTS.
C
IF (ICZERO) 36280, 6280, 36280
6280 CONTINUE
RADN15(1) = -32766.
IVCOMP = RADN14(1)
GO TO 46280
36280 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 46280, 6291, 46280
46280 IF ( IVCOMP + 32766 ) 26280, 16280, 26280
16280 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 6291
26280 IVFAIL = IVFAIL + 1
IVCORR = -32766
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
6291 CONTINUE
IVTNUM = 629
C
C **** TEST 629 ****
C TEST 629 - TEST OF EQUIVALENCE WITH LOGICAL ELEMENTS. AN ARRAY
C ELEMENT IN COMMON IS EQUIVALENCED TO A LOGICAL VARIABLE.
C
IF (ICZERO) 36290, 6290, 36290
6290 CONTINUE
LADN13(2) = .TRUE.
LCTN01 = .NOT. LADN13(2)
ICON01 = 1
IF ( LADN13(1) ) ICON01 = 0
GO TO 46290
36290 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 46290, 6301, 46290
46290 IF ( ICON01 - 1 ) 26290, 16290, 26290
16290 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 6301
26290 IVFAIL = IVFAIL + 1
IVCOMP = ICON01
IVCORR = 1
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
6301 CONTINUE
IVTNUM = 630
C
C **** TEST 630 ****
C TEST 630 - TEST OF EQUIVALENCE WITH REAL AND INTEGER ELEMENTS
C WHICH ARE EQUIVALENCED TO ARRAY ELEMENTS IN COMMON.
C
IF (ICZERO) 36300, 6300, 36300
6300 CONTINUE
RCON01 = 1.
ICON02 = - RADN14(5)
IVCOMP = IADN14(5)
GO TO 46300
36300 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 46300, 6311, 46300
46300 IF ( IVCOMP + 1 ) 26300, 16300, 26300
16300 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 6311
26300 IVFAIL = IVFAIL + 1
IVCORR = -1
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
6311 CONTINUE
IVTNUM = 631
C
C **** TEST 631 ****
C TEST 631 - TEST OF EQUIVALENCE ON INTEGER ARRAY ELEMENTS.
C BOTH ARRAYS ARE DIMENSIONED. THE FOURTH ELEMENT
C OF THE FIRST OF THE ARRAYS SHOULD BE EQUAL TO THE THIRD ELEMENT OF
C THE SECOND ARRAY.
C
IF (ICZERO) 36310, 6310, 36310
6310 CONTINUE
IADN16(4) = 9999
IVCOMP = IADN17(3)
GO TO 46310
36310 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 46310, 6321, 46310
46310 IF ( IVCOMP - 9999 ) 26310, 16310, 26310
16310 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 6321
26310 IVFAIL = IVFAIL + 1
IVCORR = 9999
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
6321 CONTINUE
C
C WRITE PAGE FOOTINGS AND RUN SUMMARIES
99999 CONTINUE
WRITE (I02,90002)
WRITE (I02,90006)
WRITE (I02,90002)
WRITE (I02,90002)
WRITE (I02,90007)
WRITE (I02,90002)
WRITE (I02,90008) IVFAIL
WRITE (I02,90009) IVPASS
WRITE (I02,90010) IVDELE
C
C
C TERMINATE ROUTINE EXECUTION
STOP
C
C FORMAT STATEMENTS FOR PAGE HEADERS
90000 FORMAT (1H1)
90002 FORMAT (1H )
90001 FORMAT (1H ,10X,34HFORTRAN COMPILER VALIDATION SYSTEM)
90003 FORMAT (1H ,21X,11HVERSION 1.0)
90004 FORMAT (1H ,10X,38HFOR OFFICIAL USE ONLY - COPYRIGHT 1978)
90005 FORMAT (1H ,5X,4HTEST,5X,9HPASS/FAIL, 5X,8HCOMPUTED,8X,7HCORRECT)
90006 FORMAT (1H ,5X,46H----------------------------------------------)
90011 FORMAT (1H ,18X,17HSUBSET LEVEL TEST)
C
C FORMAT STATEMENTS FOR RUN SUMMARIES
90008 FORMAT (1H ,15X,I5,19H ERRORS ENCOUNTERED)
90009 FORMAT (1H ,15X,I5,13H TESTS PASSED)
90010 FORMAT (1H ,15X,I5,14H TESTS DELETED)
C
C FORMAT STATEMENTS FOR TEST RESULTS
80001 FORMAT (1H ,4X,I5,7X,4HPASS)
80002 FORMAT (1H ,4X,I5,7X,4HFAIL)
80003 FORMAT (1H ,4X,I5,7X,7HDELETED)
80004 FORMAT (1H ,4X,I5,7X,4HFAIL,10X,I6,9X,I6)
80005 FORMAT (1H ,4X,I5,7X,4HFAIL,4X,E12.5,3X,E12.5)
C
90007 FORMAT (1H ,20X,20HEND OF PROGRAM FM022)
END
*END-OF,FM022
FM023.f 480975995 170 2 100666 14235 `
*HEADER,FORTR,FM023
*FILES1,FORTR,FM023,X
C COMMENT SECTION.
C
C FM023
C
C TWO DIMENSIONED ARRAYS ARE USED IN THIS ROUTINE.
C THIS ROUTINE TESTS ARRAYS WITH FIXED DIMENSION AND SIZE LIMITS
C SET EITHER IN A BLANK COMMON OR DIMENSION STATEMENT. THE VALUES
C OF THE ARRAY ELEMENTS ARE SET IN VARIOUS WAYS SUCH AS SIMPLE
C ASSIGNMENT STATEMENTS, SET TO THE VALUES OF OTHER ARRAY ELEMENTS
C (EITHER POSITIVE OR NEGATIVE), SET BY INTEGER TO REAL OR REAL TO
C INTEGER CONVERSION, SET BY ARITHMETIC EXPRESSIONS, OR SET BY
C USE OF THE EQUIVALENCE STATEMENT.
C
C
C REFERENCES
C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN,
C X3.9-1978
C
C SECTION 8, SPECIFICATION STATEMENTS
C SECTION 8.1, DIMENSION STATEMENT
C SECTION 8.2, EQUIVALENCE STATEMENT
C SECTION 8.3, COMMON STATEMENT
C SECTION 8.4, TYPE-STATEMENTS
C SECTION 9, DATA STATEMENT
C
COMMON IADN22(2,2), RADN22(2,2), ICOE01, RCOE01
DIMENSION IADN21(2,2), RADN21(2,2)
DIMENSION IADE23(2,2), IADE24(2,2), RADE23(2,2), RADE24(2,2)
EQUIVALENCE (IADE23(2,2),IADN22(2,2),IADE24(2,2))
EQUIVALENCE (RADE23(2,2),RADN22(2,2),RADE24(2,2))
EQUIVALENCE (ICOE01,ICOE02,ICOE03,ICOE04), (RCOE01,RCOE02,RCOE03)
INTEGER RADN11(2), RADN25(2,2)
LOGICAL LADN21(2,2)
DATA RADN21(2,2)/-512./
DATA LADN21/4*.TRUE./
C
C **********************************************************
C
C A COMPILER VALIDATION SYSTEM FOR THE FORTRAN LANGUAGE
C BASED ON SPECIFICATIONS AS DEFINED IN AMERICAN NATIONAL STANDARD
C PROGRAMMING LANGUAGE FORTRAN X3.9-1978, HAS BEEN DEVELOPED BY THE
C FEDERAL COBOL COMPILER TESTING SERVICE. THE FORTRAN COMPILER
C VALIDATION SYSTEM (FCVS) CONSISTS OF AUDIT ROUTINES, THEIR RELATED
C DATA, AND AN EXECUTIVE SYSTEM. EACH AUDIT ROUTINE IS A FORTRAN
C PROGRAM, SUBPROGRAM OR FUNCTION WHICH INCLUDES TESTS OF SPECIFIC
C LANGUAGE ELEMENTS AND SUPPORTING PROCEDURES INDICATING THE RESULT
C OF EXECUTING THESE TESTS.
C
C THIS PARTICULAR PROGRAM/SUBPROGRAM/FUNCTION CONTAINS FEATURES
C FOUND ONLY IN THE SUBSET AS DEFINED IN X3.9-1978.
C
C SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO -
C
C DEPARTMENT OF THE NAVY
C FEDERAL COBOL COMPILER TESTING SERVICE
C WASHINGTON, D.C. 20376
C
C **********************************************************
C
C
C
C INITIALIZATION SECTION
C
C INITIALIZE CONSTANTS
C **************
C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER.
I01 = 5
C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER.
I02 = 6
C SYSTEM ENVIRONMENT SECTION
C
CX010 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-010 CONTROL CARD.
C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5
C (UNIT NUMBER FOR CARD READER).
CX011 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-011 CONTROL CARD.
C THE CX011 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL
C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX010 ABOVE.
C
CX020 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-020 CONTROL CARD.
C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02 = 6
C (UNIT NUMBER FOR PRINTER).
CX021 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-021 CONTROL CARD.
C THE CX021 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL
C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX020 ABOVE.
C
IVPASS=0
IVFAIL=0
IVDELE=0
ICZERO=0
C
C WRITE PAGE HEADERS
WRITE (I02,90000)
WRITE (I02,90001)
WRITE (I02,90002)
WRITE (I02, 90002)
WRITE (I02,90003)
WRITE (I02,90002)
WRITE (I02,90004)
WRITE (I02,90002)
WRITE (I02,90011)
WRITE (I02,90002)
WRITE (I02,90002)
WRITE (I02,90005)
WRITE (I02,90006)
WRITE (I02,90002)
IVTNUM = 632
C
C **** TEST 632 ****
C TEST 632 - TESTS SETTING AN INTEGER ARRAY ELEMENT BY A
C SIMPLE ASSIGNMENT STATEMENT TO THE VALUE 9999.
C
IF (ICZERO) 36320, 6320, 36320
6320 CONTINUE
IADN21(1,1) = 9999
IVCOMP = IADN21(1,1)
GO TO 46320
36320 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 46320, 6331, 46320
46320 IF ( IVCOMP - 9999 ) 26320, 16320, 26320
16320 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 6331
26320 IVFAIL = IVFAIL + 1
IVCORR = 9999
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
6331 CONTINUE
IVTNUM = 633
C
C **** TEST 633 ****
C TEST 633 - TESTS SETTING A REAL ARRAY ELEMENT BY A SIMPLE
C ASSIGNMENT STATEMENT TO THE VALUE -32766.
C
IF (ICZERO) 36330, 6330, 36330
6330 CONTINUE
RADN21(1,2) = -32766.
IVCOMP = RADN21(1,2)
GO TO 46330
36330 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 46330, 6341, 46330
46330 IF ( IVCOMP + 32766 ) 26330, 16330, 26330
16330 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 6341
26330 IVFAIL = IVFAIL + 1
IVCORR = -32766
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
6341 CONTINUE
IVTNUM = 634
C
C **** TEST 634 ****
C TEST 634 - TEST OF THE DATA INITIALIZATION STATEMENT AND SETTING
C AN INTEGER ARRAY ELEMENT EQUAL TO THE VALUE OF A REAL ARRAY
C ELEMENT. THE VALUE USED IS -512.
C
IF (ICZERO) 36340, 6340, 36340
6340 CONTINUE
IADN21(2,2) = RADN21(2,2)
IVCOMP = IADN21(2,2)
GO TO 46340
36340 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 46340, 6351, 46340
46340 IF ( IVCOMP + 512 ) 26340, 16340, 26340
16340 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 6351
26340 IVFAIL = IVFAIL + 1
IVCORR = -512
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
6351 CONTINUE
IVTNUM = 635
C
C **** TEST 635 ****
C TEST 635 - TEST OF SETTING A TWO DIMENSIONED ARRAY ELEMENT
C EQUAL TO THE VALUE OF A ONE DIMENSIONED ARRAY ELEMENT.
C BOTH ARRAYS ARE SET INTEGER BY THE TYPE STATEMENT AND THE TWO
C DIMENSIONED ARRAY ELEMENT IS MINUS THE VALUE OF THE ONE DIMENSION
C ELEMENT. THE VALUE USED IS 3.
C
IF (ICZERO) 36350, 6350, 36350
6350 CONTINUE
RADN11(1) = 3
RADN25(2,2) = - RADN11(1)
IVCOMP = RADN25(2,2)
GO TO 46350
36350 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 46350, 6361, 46350
46350 IF ( IVCOMP + 3 ) 26350, 16350, 26350
16350 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 6361
26350 IVFAIL = IVFAIL + 1
IVCORR = -3
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
6361 CONTINUE
IVTNUM = 636
C
C **** TEST 636 ****
C TEST 636 - TEST OF LOGICAL ARRAY ELEMENTS SET BY DATA STATEMENTS
C
IF (ICZERO) 36360, 6360, 36360
6360 CONTINUE
ICON01 = 0
IF ( LADN21(2,1) ) ICON01 = 1
GO TO 46360
36360 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 46360, 6371, 46360
46360 IF ( ICON01 - 1 ) 26360, 16360, 26360
16360 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 6371
26360 IVFAIL = IVFAIL + 1
IVCOMP = ICON01
IVCORR = 1
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
6371 CONTINUE
IVTNUM = 637
C
C **** TEST 637 ****
C TEST 637 - TEST OF REAL TO INTEGER CONVERSION AND SETTING
C INTEGER ARRAY ELEMENTS TO THE VALUE OBTAINED IN AN ARITHMETIC
C EXPRESSION USING REAL ARRAY ELEMENTS. .5 + .5 = 1
C
IF (ICZERO) 36370, 6370, 36370
6370 CONTINUE
RADN21(1,2) = 00000.5
RADN21(2,1) = .500000
IADN21(2,1) = RADN21(1,2) + RADN21(2,1)
IVCOMP = IADN21(2,1)
GO TO 46370
36370 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 46370, 6381, 46370
46370 IF ( IVCOMP - 1 ) 26370, 16370, 26370
16370 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 6381
26370 IVFAIL = IVFAIL + 1
IVCORR = 1
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
6381 CONTINUE
IVTNUM = 638
C
C **** TEST 638 ****
C TEST 638 - TEST OF EQUIVALENCE OF THREE INTEGER ARRAYS ONE OF
C WHICH IS IN COMMON.
C
IF (ICZERO) 36380, 6380, 36380
6380 CONTINUE
IADN22(2,1) = -9999
IVCOMP = IADE23(2,1)
GO TO 46380
36380 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 46380, 6391, 46380
46380 IF ( IVCOMP + 9999 ) 26380, 16380, 26380
16380 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 6391
26380 IVFAIL = IVFAIL + 1
IVCORR = -9999
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
6391 CONTINUE
IVTNUM = 639
C
C **** TEST 639 ****
C TEST 639 - LIKE TEST 638 ONLY THE OTHER EQUIVALENCED ARRAY IS
C TESTED FOR THE VALUE -9999.
C
IF (ICZERO) 36390, 6390, 36390
6390 CONTINUE
IADE23(2,1) = -9999
IVCOMP = IADE24(2,1)
GO TO 46390
36390 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 46390, 6401, 46390
46390 IF ( IVCOMP + 9999 ) 26390, 16390, 26390
16390 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 6401
26390 IVFAIL = IVFAIL + 1
IVCORR = -9999
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
6401 CONTINUE
IVTNUM = 640
C
C **** TEST 640 ****
C TEST 640 - TEST OF THREE REAL ARRAYS THAT ARE EQUIVALENCED.
C ONE OF THE ARRAYS IS IN COMMON. THE VALUE 512 IS SET INTO ONE OF
C THE DIMENSIONED ARRAY ELEMENTS BY AN INTEGER TO REAL CONVERSION
C ASSIGNMENT STATEMENT.
C
IF (ICZERO) 36400, 6400, 36400
6400 CONTINUE
RADE24(2,2) = 512
IVCOMP = RADN22(2,2)
GO TO 46400
36400 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 46400, 6411, 46400
46400 IF ( IVCOMP - 512 ) 26400, 16400, 26400
16400 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 6411
26400 IVFAIL = IVFAIL + 1
IVCORR = 512
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
6411 CONTINUE
IVTNUM = 641
C
C **** TEST 641 ****
C TEST 641 - LIKE TEST 640 ONLY THE OTHER EQUIVALENCED ARRAY IS
C TESTED FOR THE VALUE 512.
C
IF (ICZERO) 36410, 6410, 36410
6410 CONTINUE
RADN22(2,2) = 512
IVCOMP = RADE23(2,2)
GO TO 46410
36410 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 46410, 6421, 46410
46410 IF ( IVCOMP - 512 ) 26410, 16410, 26410
16410 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 6421
26410 IVFAIL = IVFAIL + 1
IVCORR = 512
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
6421 CONTINUE
IVTNUM = 642
C
C **** TEST 642 ****
C TEST 642 - TEST OF FOUR INTEGER VARIABLES THAT ARE EQUIVALENCED.
C ONE OF THE INTEGER VARIABLES IS IN BLANK COMMON. THE VALUE USED
C IS 3 SET BY AN ASSIGNMENT STATEMENT.
C
IF (ICZERO) 36420, 6420, 36420
6420 CONTINUE
ICOE03 = 3
IVCOMP = ICOE01
GO TO 46420
36420 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 46420, 6431, 46420
46420 IF ( IVCOMP - 3 ) 26420, 16420, 26420
16420 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 6431
26420 IVFAIL = IVFAIL + 1
IVCORR = 3
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
6431 CONTINUE
IVTNUM = 643
C
C **** TEST 643 ****
C TEST 643 - LIKE TEST 642 BUT ANOTHER OF THE ELEMENTS IS TESTED
C BY AN ARITHMETIC EXPRESSION USING THE EQUIVALENCED ELEMENTS.
C THE VALUE OF ALL OF THE ELEMENTS SHOULD INITITIALLY BE 3 SINCE
C THEY ALL SHOULD SHARE THE SAME STORAGE LOCATION. ICOE04 = 3+3+3+3
C ICOE04 = 12 THEN THE ELEMENT ICOE02 IS TESTED FOR THE VALUE 12.
C
IF (ICZERO) 36430, 6430, 36430
6430 CONTINUE
ICOE01 = 3
ICOE04 = ICOE01 + ICOE02 + ICOE03 + ICOE04
IVCOMP = ICOE02
GO TO 46430
36430 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 46430, 6441, 46430
46430 IF ( IVCOMP - 12 ) 26430, 16430, 26430
16430 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 6441
26430 IVFAIL = IVFAIL + 1
IVCORR = 12
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
6441 CONTINUE
IVTNUM = 644
C
C **** TEST 644 ****
C TEST 644 - TEST OF EQUIVALENCE WITH THREE REAL VARIABLES ONE
C OF WHICH IS IN BLANK COMMON. THE ELEMENTS ARE SET INITIALLY TO .5
C THEN ALL OF THE ELEMENTS ARE USED IN AN ARITHMETIC EXPRESSION
C RCOE01 =(.5 + .5 + .5) * 2. SO RCOE01 = 3. ELEMENT RCOE02
C IS TESTED FOR THE VALUE 3.
C
IF (ICZERO) 36440, 6440, 36440
6440 CONTINUE
RCOE02 = 0.5
RCOE01 = ( RCOE01 + RCOE02 + RCOE03 ) * 2.
IVCOMP = RCOE02
GO TO 46440
36440 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 46440, 6451, 46440
46440 IF ( IVCOMP - 3 ) 26440, 16440, 26440
16440 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 6451
26440 IVFAIL = IVFAIL + 1
IVCORR = 3
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
6451 CONTINUE
C
C WRITE PAGE FOOTINGS AND RUN SUMMARIES
99999 CONTINUE
WRITE (I02,90002)
WRITE (I02,90006)
WRITE (I02,90002)
WRITE (I02,90002)
WRITE (I02,90007)
WRITE (I02,90002)
WRITE (I02,90008) IVFAIL
WRITE (I02,90009) IVPASS
WRITE (I02,90010) IVDELE
C
C
C TERMINATE ROUTINE EXECUTION
STOP
C
C FORMAT STATEMENTS FOR PAGE HEADERS
90000 FORMAT (1H1)
90002 FORMAT (1H )
90001 FORMAT (1H ,10X,34HFORTRAN COMPILER VALIDATION SYSTEM)
90003 FORMAT (1H ,21X,11HVERSION 1.0)
90004 FORMAT (1H ,10X,38HFOR OFFICIAL USE ONLY - COPYRIGHT 1978)
90005 FORMAT (1H ,5X,4HTEST,5X,9HPASS/FAIL, 5X,8HCOMPUTED,8X,7HCORRECT)
90006 FORMAT (1H ,5X,46H----------------------------------------------)
90011 FORMAT (1H ,18X,17HSUBSET LEVEL TEST)
C
C FORMAT STATEMENTS FOR RUN SUMMARIES
90008 FORMAT (1H ,15X,I5,19H ERRORS ENCOUNTERED)
90009 FORMAT (1H ,15X,I5,13H TESTS PASSED)
90010 FORMAT (1H ,15X,I5,14H TESTS DELETED)
C
C FORMAT STATEMENTS FOR TEST RESULTS
80001 FORMAT (1H ,4X,I5,7X,4HPASS)
80002 FORMAT (1H ,4X,I5,7X,4HFAIL)
80003 FORMAT (1H ,4X,I5,7X,7HDELETED)
80004 FORMAT (1H ,4X,I5,7X,4HFAIL,10X,I6,9X,I6)
80005 FORMAT (1H ,4X,I5,7X,4HFAIL,4X,E12.5,3X,E12.5)
C
90007 FORMAT (1H ,20X,20HEND OF PROGRAM FM023)
END
*END-OF,FM023
FM024.f 480975997 170 2 100666 12083 `
*HEADER,FORTR,FM024
*FILES1,FORTR,FM024,X
C COMMENT SECTION.
C
C FM024
C
C THREE DIMENSIONED ARRAYS ARE USED IN THIS ROUTINE.
C THIS ROUTINE TESTS ARRAYS WITH FIXED DIMENSION AND SIZE LIMITS
C SET EITHER IN A BLANK COMMON OR DIMENSION STATEMENT. THE VALUES
C OF THE ARRAY ELEMENTS ARE SET IN VARIOUS WAYS SUCH AS SIMPLE
C ASSIGNMENT STATEMENTS, SET TO THE VALUES OF OTHER ARRAY ELEMENTS
C (EITHER POSITIVE OR NEGATIVE), SET BY INTEGER TO REAL OR REAL TO
C INTEGER CONVERSION, SET BY ARITHMETIC EXPRESSIONS, OR SET BY
C USE OF THE EQUIVALENCE STATEMENT.
C
C
C REFERENCES
C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN,
C X3.9-1978
C
C SECTION 8, SPECIFICATION STATEMENTS
C SECTION 8.1, DIMENSION STATEMENT
C SECTION 8.2, EQUIVALENCE STATEMENT
C SECTION 8.3, COMMON STATEMENT
C SECTION 8.4, TYPE-STATEMENTS
C SECTION 9, DATA STATEMENT
C
COMMON ICOE01, RCOE01, LCOE01
COMMON IADE31(3,3,3), RADE31(3,3,3), LADE31(3,3,3)
COMMON IADN31(2,2,2), RADN31(2,2,2), LADN31(2,2,2)
C
DIMENSION IADE32(3,3,3), RADE32(3,3,3), LADE32(3,3,3)
DIMENSION IADN32(2,2,2), IADN21(2,2), IADN11(2)
DIMENSION IADE21(2,2), IADE11(4)
C
EQUIVALENCE (IADE31(1,1,1), IADE32(1,1,1) )
EQUIVALENCE ( RADE31(1,1,1), RADE32(1,1,1) )
EQUIVALENCE ( LADE31(1,1,1), LADE32(1,1,1) )
EQUIVALENCE ( IADE31(1,1,1), IADE21(1,1), IADE11(1) )
EQUIVALENCE ( ICOE01, ICOE02, ICOE03 )
C
LOGICAL LADE31, LADN31, LADE32, LCOE01
INTEGER RADN33(2,2,2), RADN21(2,4), RADN11(8)
REAL IADN33(2,2,2), IADN22(2,4), IADN12(8)
C
C
C **********************************************************
C
C A COMPILER VALIDATION SYSTEM FOR THE FORTRAN LANGUAGE
C BASED ON SPECIFICATIONS AS DEFINED IN AMERICAN NATIONAL STANDARD
C PROGRAMMING LANGUAGE FORTRAN X3.9-1978, HAS BEEN DEVELOPED BY THE
C FEDERAL COBOL COMPILER TESTING SERVICE. THE FORTRAN COMPILER
C VALIDATION SYSTEM (FCVS) CONSISTS OF AUDIT ROUTINES, THEIR RELATED
C DATA, AND AN EXECUTIVE SYSTEM. EACH AUDIT ROUTINE IS A FORTRAN
C PROGRAM, SUBPROGRAM OR FUNCTION WHICH INCLUDES TESTS OF SPECIFIC
C LANGUAGE ELEMENTS AND SUPPORTING PROCEDURES INDICATING THE RESULT
C OF EXECUTING THESE TESTS.
C
C THIS PARTICULAR PROGRAM/SUBPROGRAM/FUNCTION CONTAINS FEATURES
C FOUND ONLY IN THE SUBSET AS DEFINED IN X3.9-1978.
C
C SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO -
C
C DEPARTMENT OF THE NAVY
C FEDERAL COBOL COMPILER TESTING SERVICE
C WASHINGTON, D.C. 20376
C
C **********************************************************
C
C
C
C INITIALIZATION SECTION
C
C INITIALIZE CONSTANTS
C **************
C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER.
I01 = 5
C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER.
I02 = 6
C SYSTEM ENVIRONMENT SECTION
C
CX010 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-010 CONTROL CARD.
C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5
C (UNIT NUMBER FOR CARD READER).
CX011 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-011 CONTROL CARD.
C THE CX011 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL
C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX010 ABOVE.
C
CX020 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-020 CONTROL CARD.
C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02 = 6
C (UNIT NUMBER FOR PRINTER).
CX021 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-021 CONTROL CARD.
C THE CX021 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL
C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX020 ABOVE.
C
IVPASS=0
IVFAIL=0
IVDELE=0
ICZERO=0
C
C WRITE PAGE HEADERS
WRITE (I02,90000)
WRITE (I02,90001)
WRITE (I02,90002)
WRITE (I02, 90002)
WRITE (I02,90003)
WRITE (I02,90002)
WRITE (I02,90004)
WRITE (I02,90002)
WRITE (I02,90011)
WRITE (I02,90002)
WRITE (I02,90002)
WRITE (I02,90005)
WRITE (I02,90006)
WRITE (I02,90002)
IVTNUM = 645
C
C **** TEST 645 ****
C TEST 645 - TESTS SETTING A THREE DIMENSION INTEGER ARRAY ELEMENT
C BY A SIMPLE INTEGER ASSIGNMENT STATEMENT.
C
IF (ICZERO) 36450, 6450, 36450
6450 CONTINUE
IADN31(2,2,2) = -9999
IVCOMP = IADN31(2,2,2)
GO TO 46450
36450 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 46450, 6461, 46450
46450 IF ( IVCOMP + 9999 ) 26450, 16450, 26450
16450 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 6461
26450 IVFAIL = IVFAIL + 1
IVCORR = -9999
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
6461 CONTINUE
IVTNUM = 646
C
C **** TEST 646 ****
C TEST 646 - TESTS SETTING A THREE DIMENSION REAL ARRAY ELEMENT
C BY A SIMPLE REAL ASSIGNMENT STATEMENT.
C
IF (ICZERO) 36460, 6460, 36460
6460 CONTINUE
RADN31(1,2,1) = 512.
IVCOMP = RADN31(1,2,1)
GO TO 46460
36460 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 46460, 6471, 46460
46460 IF ( IVCOMP - 512 ) 26460, 16460, 26460
16460 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 6471
26460 IVFAIL = IVFAIL + 1
IVCORR = 512
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
6471 CONTINUE
IVTNUM = 647
C
C **** TEST 647 ****
C TEST 647 - TESTS SETTING A THREE DIMENSION LOGICAL ARRAY ELEMENT
C BY A SIMPLE LOGICAL ASSIGNMENT STATEMENT.
C
IF (ICZERO) 36470, 6470, 36470
6470 CONTINUE
LADN31(1,2,2) = .TRUE.
ICON01 = 0
IF ( LADN31(1,2,2) ) ICON01 = 1
GO TO 46470
36470 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 46470, 6481, 46470
46470 IF ( ICON01 - 1 ) 26470, 16470, 26470
16470 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 6481
26470 IVFAIL = IVFAIL + 1
IVCOMP = ICON01
IVCORR = 1
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
6481 CONTINUE
IVTNUM = 648
C
C **** TEST 648 ****
C TEST 648 - TESTS SETTING A ONE, TWO, AND THREE DIMENSION ARRAY
C ELEMENT TO A VALUE IN ARITHMETIC ASSIGNMENT STATEMENTS. ALL THREE
C ELEMENTS ARE INTEGERS. THE INTEGER ARRAY ELEMENTS ARE THEN USED
C IN AN ARITHMETIC STATEMENT AND THE RESULT IS STORED BY INTEGER
C TO REAL CONVERSION INTO A THREE DIMENSION REAL ARRAY ELEMENT.
C
IF (ICZERO) 36480, 6480, 36480
6480 CONTINUE
IADN11(2) = 1
IADN21(2,2) = 2
IADN32(2,2,2) = 3
RADN31(2,2,1) = IADN11(2) + IADN21(2,2) + IADN32(2,2,2)
IVCOMP = RADN31(2,2,1)
GO TO 46480
36480 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 46480, 6491, 46480
46480 IF ( IVCOMP - 6) 26480, 16480, 26480
16480 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 6491
26480 IVFAIL = IVFAIL + 1
IVCORR = 6
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
6491 CONTINUE
IVTNUM = 649
C
C **** TEST 649 ****
C TEST 649 - TESTS OF ONE, TWO, AND THREE DIMENSION ARRAY ELEMENTS
C SET EXPLICITLY INTEGER BY THE INTEGER TYPE STATEMENT. ALL ELEMENT
C VALUES SHOULD BE ZERO FROM REAL TO INTEGER TRUNCATION FROM A VALUE
C OF 0.5. ALL THREE ELEMENTS ARE USED IN AN ARITHMETIC EXPRESSION.
C THE VALUE OF THE SUM OF THE ELEMENTS SHOULD BE ZERO.
C
IF (ICZERO) 36490, 6490, 36490
6490 CONTINUE
RADN11(8) = 0000.50000
RADN21(2,4) = .50000
RADN33(2,2,2) = 00000.5
RADN11(1) = RADN11(8) + RADN21(2,4) + RADN33(2,2,2)
IVCOMP = RADN11(1)
GO TO 46490
36490 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 46490, 6501, 46490
46490 IF ( IVCOMP - 0 ) 26490, 16490, 26490
16490 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 6501
26490 IVFAIL = IVFAIL + 1
IVCORR = 0
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
6501 CONTINUE
IVTNUM = 650
C
C **** TEST 650 ****
C TEST 650 - TEST OF THE EQUIVALENCE STATEMENT. A REAL ARRAY
C ELEMENT IS SET BY AN ASSIGNMENT STATEMENT. ITS EQUIVALENT ELEMENT
C IN COMMON IS USED TO SET THE VALUE OF AN INTEGER ARRAY ELEMENT
C ALSO IN COMMON. FINALLY THE DIMENSIONED EQUIVALENT INTEGER
C ARRAY ELEMENT IS TESTED FOR THE VALUE USED THROUGHOUT 32767.
C
IF (ICZERO) 36500, 6500, 36500
6500 CONTINUE
RADE32(2,2,2) = 32767.
IADE31(2,2,2) = RADE31(2,2,2)
IVCOMP = IADE32(2,2,2)
GO TO 46500
36500 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 46500, 6511, 46500
46500 IF ( IVCOMP - 32767 ) 26500, 16500, 26500
16500 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 6511
26500 IVFAIL = IVFAIL + 1
IVCORR = 32767
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
6511 CONTINUE
IVTNUM = 651
C
C **** TEST 651 ****
C TEST 651 - THIS IS A TEST OF COMMON AND DIMENSION AS WELL AS A
C TEST OF THE EQUIVALENCE STATEMENT USING LOGICAL ARRAY ELEMENTS
C BOTH IN COMMON AND DIMENSIONED. A LOGICAL VARIABLE IN COMMON IS
C SET TO A VALUE OF .NOT. THE VALUE USED IN THE EQUIVALENCED ARRAY
C ELEMENTS WHICH WERE SET IN A LOGICAL ASSIGNMENT STATEMENT.
C
IF (ICZERO) 36510, 6510, 36510
6510 CONTINUE
LADE31(1,2,3) = .FALSE.
LCOE01 = .NOT. LADE32(1,2,3)
ICON01 = 0
IF ( LCOE01 ) ICON01 = 1
GO TO 46510
36510 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 46510, 6521, 46510
46510 IF ( ICON01 - 1 ) 26510, 16510, 26510
16510 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 6521
26510 IVFAIL = IVFAIL + 1
IVCOMP = ICON01
IVCORR = 1
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
6521 CONTINUE
IVTNUM = 652
C
C **** TEST 652 ****
C TEST 652 - TESTS OF ONE, TWO, AND THREE DIMENSION ARRAY ELEMENTS
C SET EXPLICITLY REAL BY THE REAL TYPE STATEMENT. ALL ELEMENT
C VALUES SHOULD BE 0.5 FROM THE REAL ASSIGNMENT STATEMENT. THE
C ARRAY ELEMENTS ARE SUMMED AND THEN THE SUM MULTIPLIED BY 2.
C FINALLY 0.2 IS ADDED TO THE RESULT AND THE FINAL RESULT CONVERTED
C TO AN INTEGER ( ( .5 + .5 + .5 ) * 2. ) + 0.2
C
IF (ICZERO) 36520, 6520, 36520
6520 CONTINUE
IADN12(5) = 0.5
IADN22(1,3) = 0.5
IADN33(1,2,2) = 0.5
IVCOMP = ( ( IADN12(5) + IADN22(1,3) + IADN33(1,2,2) ) * 2. ) + .2
GO TO 46520
36520 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 46520, 6531, 46520
46520 IF ( IVCOMP - 3 ) 26520, 16520, 26520
16520 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 6531
26520 IVFAIL = IVFAIL + 1
IVCORR = 3
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
6531 CONTINUE
C
C WRITE PAGE FOOTINGS AND RUN SUMMARIES
99999 CONTINUE
WRITE (I02,90002)
WRITE (I02,90006)
WRITE (I02,90002)
WRITE (I02,90002)
WRITE (I02,90007)
WRITE (I02,90002)
WRITE (I02,90008) IVFAIL
WRITE (I02,90009) IVPASS
WRITE (I02,90010) IVDELE
C
C
C TERMINATE ROUTINE EXECUTION
STOP
C
C FORMAT STATEMENTS FOR PAGE HEADERS
90000 FORMAT (1H1)
90002 FORMAT (1H )
90001 FORMAT (1H ,10X,34HFORTRAN COMPILER VALIDATION SYSTEM)
90003 FORMAT (1H ,21X,11HVERSION 1.0)
90004 FORMAT (1H ,10X,38HFOR OFFICIAL USE ONLY - COPYRIGHT 1978)
90005 FORMAT (1H ,5X,4HTEST,5X,9HPASS/FAIL, 5X,8HCOMPUTED,8X,7HCORRECT)
90006 FORMAT (1H ,5X,46H----------------------------------------------)
90011 FORMAT (1H ,18X,17HSUBSET LEVEL TEST)
C
C FORMAT STATEMENTS FOR RUN SUMMARIES
90008 FORMAT (1H ,15X,I5,19H ERRORS ENCOUNTERED)
90009 FORMAT (1H ,15X,I5,13H TESTS PASSED)
90010 FORMAT (1H ,15X,I5,14H TESTS DELETED)
C
C FORMAT STATEMENTS FOR TEST RESULTS
80001 FORMAT (1H ,4X,I5,7X,4HPASS)
80002 FORMAT (1H ,4X,I5,7X,4HFAIL)
80003 FORMAT (1H ,4X,I5,7X,7HDELETED)
80004 FORMAT (1H ,4X,I5,7X,4HFAIL,10X,I6,9X,I6)
80005 FORMAT (1H ,4X,I5,7X,4HFAIL,4X,E12.5,3X,E12.5)
C
90007 FORMAT (1H ,20X,20HEND OF PROGRAM FM024)
END
*END-OF,FM024
FM025.f 480976000 170 2 100666 14708 `
*HEADER,FORTR,FM025
*FILES1,FORTR,FM025,X
C COMMENT SECTION.
C
C FM025
C
C THIS ROUTINE TESTS ARRAYS WITH IF STATEMENTS, DO LOOPS,
C ASSIGNED AND COMPUTED GO TO STATEMENTS IN CONJUNCTION WITH ARRAY
C ELEMENTS IN COMMON OR DIMENSIONED. ONE, TWO, AND THREE
C DIMENSIONED ARRAYS ARE USED. THE SUBSCRIPTS ARE INTEGER CONSTANTS
C OR SOMETIMES INTEGER VARIABLES WHEN THE ELEMENTS ARE IN LOOPS
C AND ALL ARRAYS HAVE FIXED SIZE LIMITS. INTEGER, REAL, AND LOGICAL
C ARRAYS ARE USED WITH THE TYPE SOMETIMES SPECIFIED WITH THE
C EXPLICIT TYPE STATEMENT.
C
C REFERENCES
C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN,
C X3.9-1978
C
C SECTION 8, SPECIFICATION STATEMENTS
C SECTION 8.1, DIMENSION STATEMENT
C SECTION 8.3, COMMON STATEMENT
C SECTION 8.4, TYPE-STATEMENTS
C SECTION 9, DATA STATEMENT
C SECTION 11.2, COMPUTED GO TO STATEMENT
C SECTION 11.3, ASSIGNED GO TO STATEMENT
C SECTION 11.10, DO STATEMENT
C
COMMON IADN31(2,2,2), RADN31(2,2,2), LADN31(2,2,2)
C
DIMENSION IADN32(2,2,2), IADN21(2,2), IADN11(2)
C
LOGICAL LADN31
INTEGER RADN33(2,2,2), RADN21(2,4), RADN11(8)
REAL IADN33(2,2,2), IADN22(2,4), IADN12(8)
C
C
C **********************************************************
C
C A COMPILER VALIDATION SYSTEM FOR THE FORTRAN LANGUAGE
C BASED ON SPECIFICATIONS AS DEFINED IN AMERICAN NATIONAL STANDARD
C PROGRAMMING LANGUAGE FORTRAN X3.9-1978, HAS BEEN DEVELOPED BY THE
C FEDERAL COBOL COMPILER TESTING SERVICE. THE FORTRAN COMPILER
C VALIDATION SYSTEM (FCVS) CONSISTS OF AUDIT ROUTINES, THEIR RELATED
C DATA, AND AN EXECUTIVE SYSTEM. EACH AUDIT ROUTINE IS A FORTRAN
C PROGRAM, SUBPROGRAM OR FUNCTION WHICH INCLUDES TESTS OF SPECIFIC
C LANGUAGE ELEMENTS AND SUPPORTING PROCEDURES INDICATING THE RESULT
C OF EXECUTING THESE TESTS.
C
C THIS PARTICULAR PROGRAM/SUBPROGRAM/FUNCTION CONTAINS FEATURES
C FOUND ONLY IN THE SUBSET AS DEFINED IN X3.9-1978.
C
C SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO -
C
C DEPARTMENT OF THE NAVY
C FEDERAL COBOL COMPILER TESTING SERVICE
C WASHINGTON, D.C. 20376
C
C **********************************************************
C
C
C
C INITIALIZATION SECTION
C
C INITIALIZE CONSTANTS
C **************
C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER.
I01 = 5
C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER.
I02 = 6
C SYSTEM ENVIRONMENT SECTION
C
CX010 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-010 CONTROL CARD.
C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5
C (UNIT NUMBER FOR CARD READER).
CX011 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-011 CONTROL CARD.
C THE CX011 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL
C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX010 ABOVE.
C
CX020 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-020 CONTROL CARD.
C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02 = 6
C (UNIT NUMBER FOR PRINTER).
CX021 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-021 CONTROL CARD.
C THE CX021 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL
C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX020 ABOVE.
C
IVPASS=0
IVFAIL=0
IVDELE=0
ICZERO=0
C
C WRITE PAGE HEADERS
WRITE (I02,90000)
WRITE (I02,90001)
WRITE (I02,90002)
WRITE (I02, 90002)
WRITE (I02,90003)
WRITE (I02,90002)
WRITE (I02,90004)
WRITE (I02,90002)
WRITE (I02,90011)
WRITE (I02,90002)
WRITE (I02,90002)
WRITE (I02,90005)
WRITE (I02,90006)
WRITE (I02,90002)
IVTNUM = 653
C
C **** TEST 653 ****
C TEST 653 - TEST OF SETTING ALL VALUES OF AN INTEGER ARRAY
C BY THE INTEGER INDEX OF A DO LOOP. THE ARRAY HAS ONE DIMENSION.
C
IF (ICZERO) 36530, 6530, 36530
6530 CONTINUE
DO 6532 I = 1,2,1
IADN11(I) = I
6532 CONTINUE
IVCOMP = IADN11(1)
GO TO 46530
36530 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 46530, 6541, 46530
46530 IF ( IVCOMP - 1 ) 26530, 16530, 26530
16530 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 6541
26530 IVFAIL = IVFAIL + 1
IVCORR = 1
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
6541 CONTINUE
IVTNUM = 654
C
C **** TEST 654 ****
C TEST 654 - SEE TEST 653. THIS TEST CHECKS THE SECOND ELEMENT OF
C THE INTEGER ARRAY IADN11(2).
C
IF (ICZERO) 36540, 6540, 36540
6540 CONTINUE
IVCOMP = IADN11(2)
GO TO 46540
36540 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 46540, 6551, 46540
46540 IF ( IVCOMP - 2 ) 26540, 16540, 26540
16540 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 6551
26540 IVFAIL = IVFAIL + 1
IVCORR = 2
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
6551 CONTINUE
IVTNUM = 655
C
C **** TEST 655 ****
C TEST 655 - TEST OF SETTING THE VALUES OF THE COLUMN OF A TWO
C DIMENSION INTEGER ARRAY BY A DO LOOP. THE VALUES FOR THE ELEMENTS
C IN A COLUMN IS THE NUMBER OF THE COLUMN AS SET BY THE DO LOOP
C INDEX. ROW NUMBERS ARE INTEGER CONSTANTS.
C THE VALUES FOR THE ELEMENTS ARE AS FOLLOWS
C 1 2
C 1 2
C
IF (ICZERO) 36550, 6550, 36550
6550 CONTINUE
DO 6552 J = 1, 2
IADN21(1,J) = J
IADN21(2,J) = J
6552 CONTINUE
IVCOMP = IADN21(1,1)
GO TO 46550
36550 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 46550, 6561, 46550
46550 IF ( IVCOMP - 1 ) 26550, 16550, 26550
16550 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 6561
26550 IVFAIL = IVFAIL + 1
IVCORR = 1
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
6561 CONTINUE
IVTNUM = 656
C
C **** TEST 656 ****
C TEST 656 - SEE TEST 655. THIS TEST CHECKS THE VALUE OF THE
C INTEGER ARRAY IADN21(2,2)
C
IF (ICZERO) 36560, 6560, 36560
6560 CONTINUE
IVCOMP = IADN21(2,2)
GO TO 46560
36560 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 46560, 6571, 46560
46560 IF ( IVCOMP - 2 ) 26560, 16560, 26560
16560 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 6571
26560 IVFAIL = IVFAIL + 1
IVCORR = 2
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
6571 CONTINUE
IVTNUM = 657
C
C **** TEST 657 ****
C TEST 657 - THIS TESTS SETTING BOTH THE ROW AND COLUMN SUBSCRIPTS
C IN A TWO DIMENSION INTEGER ARRAY WITH A DOUBLE NESTED DO LOOP.
C THE ELEMENT VALUES ARE SET BY AN INTEGER COUNTER. ELEMENT VALUES
C ARE AS FOLLOWS 1 2
C 3 4
C
IF (ICZERO) 36570, 6570, 36570
6570 CONTINUE
ICON01 = 0
DO 6573 I = 1, 2
DO 6572 J = 1, 2
ICON01 = ICON01 + 1
IADN21(I,J) = ICON01
6572 CONTINUE
6573 CONTINUE
IVCOMP = IADN21(1,2)
GO TO 46570
36570 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 46570, 6581, 46570
46570 IF ( IVCOMP - 2 ) 26570, 16570, 26570
16570 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 6581
26570 IVFAIL = IVFAIL + 1
IVCORR = 2
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
6581 CONTINUE
IVTNUM = 658
C
C **** TEST 658 ****
C TEST 658 - SEE TEST 657. THIS TEST CHECKS THE VALUE OF ARRAY
C ELEMENT IADN21(2,1) = 3
C
IF (ICZERO) 36580, 6580, 36580
6580 CONTINUE
IVCOMP = IADN21(2,1)
GO TO 46580
36580 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 46580, 6591, 46580
46580 IF ( IVCOMP - 3 ) 26580, 16580, 26580
16580 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 6591
26580 IVFAIL = IVFAIL + 1
IVCORR = 3
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
6591 CONTINUE
IVTNUM = 659
C
C **** TEST 659 ****
C TEST 659 - THIS TEST USES A TRIPLE NESTED DO LOOP TO SET THE
C ELEMENTS IN ALL THREE DIMENSIONS OF AN INTEGER ARRAY THAT IS
C DIMENSIONED. THE VALUES FOR THE ELEMENTS ARE AS FOLLOWS
C FOR ELEMENT (I,J,K) = I + J + K
C SO FOR ELEMENT (1,1,2) = 1 + 1 + 2 = 4
C
IF (ICZERO) 36590, 6590, 36590
6590 CONTINUE
DO 6594 I = 1, 2
DO 6593 J = 1, 2
DO 6592 K = 1, 2
IADN32( I, J, K ) = I + J + K
6592 CONTINUE
6593 CONTINUE
6594 CONTINUE
IVCOMP = IADN32(1,1,2)
GO TO 46590
36590 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 46590, 6601, 46590
46590 IF ( IVCOMP - 4 ) 26590, 16590, 26590
16590 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 6601
26590 IVFAIL = IVFAIL + 1
IVCORR = 4
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
6601 CONTINUE
IVTNUM = 660
C
C **** TEST 660 ****
C TEST 660 - SEE TEST 659. THIS CHECKS FOR IADN32(2,2,2) = 6
C
IF (ICZERO) 36600, 6600, 36600
6600 CONTINUE
IVCOMP = IADN32(2,2,2)
GO TO 46600
36600 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 46600, 6611, 46600
46600 IF ( IVCOMP - 6 ) 26600, 16600, 26600
16600 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 6611
26600 IVFAIL = IVFAIL + 1
IVCORR = 6
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
6611 CONTINUE
IVTNUM = 661
C
C **** TEST 661 ****
C TEST 661 - THIS TEST SETS THE ELEMENTS OF AN INTEGER ARRAY IN
C COMMON TO MINUS THE VALUE OF THE INTEGER ARRAY SET IN TEST 659.
C ELEMENT IADN32(1,1,2) = 4 SO ELEMENT IADN31(1,1,2) = -4
C THE SAME INTEGER ASSIGNMENT STATEMENT IS USED AS THE TERMINATING
C STATEMENT FOR ALL THREE DO LOOPS USED TO SET THE ARRAY VALUES
C OF INTEGER ARRAY IADN31.
C IF TEST 659 FAILS, THEN THIS TEST SHOULD ALSO FAIL. HOWEVER, THE
C COMPUTED VALUES SHOULD RELATE IN THAT THE COMPUTED VALUE FOR
C TEST 661 SHOULD BE MINUS THE COMPUTED VALUE FOR TEST 659.
C
IF (ICZERO) 36610, 6610, 36610
6610 CONTINUE
DO 6612 I = 1, 2
DO 6612 J = 1, 2
DO 6612 K = 1, 2
6612 IADN31(I,J,K) = - IADN32 ( I, J, K )
IVCOMP = IADN31(1,1,2)
GO TO 46610
36610 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 46610, 6621, 46610
46610 IF ( IVCOMP + 4 ) 26610, 16610, 26610
16610 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 6621
26610 IVFAIL = IVFAIL + 1
IVCORR = -4
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
6621 CONTINUE
IVTNUM = 662
C
C **** TEST 662 ****
C TEST 662 - THIS IS A TEST OF A TRIPLE NESTED DO LOOP USED TO
C SET THE VALUES OF A LOGICAL ARRAY LADN31. UNLIKE THE OTHER TESTS
C THE THIRD DIMENSION IS SET LAST, THE FIRST DIMENSION IS SET SECOND
C AND THE SECOND DIMENSION IS SET FIRST. ALL ARRAY ELEMENTS ARE SET
C TO THE LOGICAL CONSTANT .FALSE.
C
IF (ICZERO) 36620, 6620, 36620
6620 CONTINUE
DO 6622 K = 1, 2
DO 6622 I = 1, 2
DO 6622 J = 1, 2
LADN31( I, J, K ) = .FALSE.
6622 CONTINUE
ICON01 = 1
IF ( LADN31(2,1,2) ) ICON01 = 0
GO TO 46620
36620 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 46620, 6631, 46620
46620 IF ( ICON01 - 1 ) 26620, 16620, 26620
16620 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 6631
26620 IVFAIL = IVFAIL + 1
IVCOMP = ICON01
IVCORR = 1
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
6631 CONTINUE
IVTNUM = 663
C
C NOTE **** TEST 663 WAS DELETED BY FCCTS.
C
IF (ICZERO) 36630, 6630, 36630
6630 CONTINUE
36630 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 46630, 6641, 46630
46630 IF ( ICON01 - 6633 ) 26630, 16630, 26630
16630 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 6641
26630 IVFAIL = IVFAIL + 1
IVCOMP = ICON01
IVCORR = 6633
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
6641 CONTINUE
IVTNUM = 664
C
C NOTE **** TEST 664 WAS DELETED BY FCCTS.
C
IF (ICZERO) 36640, 6640, 36640
6640 CONTINUE
36640 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 46640, 6651, 46640
46640 IF ( ICON01 - 6643 ) 26640, 16640, 26640
16640 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 6651
26640 IVFAIL = IVFAIL + 1
IVCOMP = ICON01
IVCORR = 6443
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
6651 CONTINUE
IVTNUM = 665
C
C **** TEST 665 ****
C TEST 665 - ARRAY ELEMENTS SET TO TYPE REAL BY THE EXPLICIT
C REAL STATEMENT ARE SET TO THE VALUE 0.5 AND USED TO SET THE VALUE
C OF AN ARRAY ELEMENT SET TO TYPE INTEGER BY THE INTEGER STATEMENT.
C THIS LAST INTEGER ELEMENT IS USED IN A LOGICAL IF STATEMENT
C THAT SHOULD COMPARE TRUE. ( .5 + .5 + .5 ) * 2. .EQ. 3
C
IF (ICZERO) 36650, 6650, 36650
6650 CONTINUE
IADN33(2,2,2) = 0.5
IADN22(2,4) = 0.5
IADN12(8) = 0.5
RADN11(8) = ( IADN33(2,2,2) + IADN22(2,4) + IADN12(8) ) * 2.
ICON01 = 0
IF ( RADN11(8) .EQ. 3 ) ICON01 = 1
GO TO 46650
36650 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 46650, 6661, 46650
46650 IF ( ICON01 - 1 ) 26650, 16650, 26650
16650 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 6661
26650 IVFAIL = IVFAIL + 1
IVCOMP = ICON01
IVCORR = 1
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
6661 CONTINUE
C
C WRITE PAGE FOOTINGS AND RUN SUMMARIES
99999 CONTINUE
WRITE (I02,90002)
WRITE (I02,90006)
WRITE (I02,90002)
WRITE (I02,90002)
WRITE (I02,90007)
WRITE (I02,90002)
WRITE (I02,90008) IVFAIL
WRITE (I02,90009) IVPASS
WRITE (I02,90010) IVDELE
C
C
C TERMINATE ROUTINE EXECUTION
STOP
C
C FORMAT STATEMENTS FOR PAGE HEADERS
90000 FORMAT (1H1)
90002 FORMAT (1H )
90001 FORMAT (1H ,10X,34HFORTRAN COMPILER VALIDATION SYSTEM)
90003 FORMAT (1H ,21X,11HVERSION 1.0)
90004 FORMAT (1H ,10X,38HFOR OFFICIAL USE ONLY - COPYRIGHT 1978)
90005 FORMAT (1H ,5X,4HTEST,5X,9HPASS/FAIL, 5X,8HCOMPUTED,8X,7HCORRECT)
90006 FORMAT (1H ,5X,46H----------------------------------------------)
90011 FORMAT (1H ,18X,17HSUBSET LEVEL TEST)
C
C FORMAT STATEMENTS FOR RUN SUMMARIES
90008 FORMAT (1H ,15X,I5,19H ERRORS ENCOUNTERED)
90009 FORMAT (1H ,15X,I5,13H TESTS PASSED)
90010 FORMAT (1H ,15X,I5,14H TESTS DELETED)
C
C FORMAT STATEMENTS FOR TEST RESULTS
80001 FORMAT (1H ,4X,I5,7X,4HPASS)
80002 FORMAT (1H ,4X,I5,7X,4HFAIL)
80003 FORMAT (1H ,4X,I5,7X,7HDELETED)
80004 FORMAT (1H ,4X,I5,7X,4HFAIL,10X,I6,9X,I6)
80005 FORMAT (1H ,4X,I5,7X,4HFAIL,4X,E12.5,3X,E12.5)
C
90007 FORMAT (1H ,20X,20HEND OF PROGRAM FM025)
END
*END-OF,FM025
FM026.f 480976002 170 2 100666 7703 `
*HEADER,FORTR,FM026
*FILES1,FORTR,FM026
C COMMENT SECTION
C
C FM026
C
C THIS ROUTINE CONTAINS THE BASIC SUBROUTINE REFERENCE TESTS.
C THE SUBROUTINE FS027 IS CALLED BY THIS PROGRAM. THE SUBROUTINE
C FS027 INCREMENTS THE CALLING ARGUMENT BY 1 AND RETURNS TO THE
C CALLING PROGRAM.
C
C EXECUTION OF A SUBROUTINE REFERENCE RESULTS IN AN ASSOCIATION
C OF ACTUAL ARGUMENTS WITH ALL APPEARANCES OF DUMMY ARGUMENTS IN
C THE DEFINING SUBPROGRAM. FOLLOWING THESE ASSOCIATIONS, EXECUTION
C OF THE FIRST EXECUTABLE STATEMENT OF THE DEFINING SUBPROGRAM
C IS UNDERTAKEN.
C
C REFERENCES
C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN,
C X3.9-1978
C
C SECTION 15.6.2, SUBROUTINE REFERENCE
C
C **********************************************************
C
C A COMPILER VALIDATION SYSTEM FOR THE FORTRAN LANGUAGE
C BASED ON SPECIFICATIONS AS DEFINED IN AMERICAN NATIONAL STANDARD
C PROGRAMMING LANGUAGE FORTRAN X3.9-1978, HAS BEEN DEVELOPED BY THE
C FEDERAL COBOL COMPILER TESTING SERVICE. THE FORTRAN COMPILER
C VALIDATION SYSTEM (FCVS) CONSISTS OF AUDIT ROUTINES, THEIR RELATED
C DATA, AND AN EXECUTIVE SYSTEM. EACH AUDIT ROUTINE IS A FORTRAN
C PROGRAM, SUBPROGRAM OR FUNCTION WHICH INCLUDES TESTS OF SPECIFIC
C LANGUAGE ELEMENTS AND SUPPORTING PROCEDURES INDICATING THE RESULT
C OF EXECUTING THESE TESTS.
C
C THIS PARTICULAR PROGRAM/SUBPROGRAM/FUNCTION CONTAINS FEATURES
C FOUND ONLY IN THE SUBSET AS DEFINED IN X3.9-1978.
C
C SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO -
C
C DEPARTMENT OF THE NAVY
C FEDERAL COBOL COMPILER TESTING SERVICE
C WASHINGTON, D.C. 20376
C
C **********************************************************
C
C
C
C INITIALIZATION SECTION
C
C INITIALIZE CONSTANTS
C **************
C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER.
I01 = 5
C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER.
I02 = 6
C SYSTEM ENVIRONMENT SECTION
C
CX010 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-010 CONTROL CARD.
C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5
C (UNIT NUMBER FOR CARD READER).
CX011 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-011 CONTROL CARD.
C THE CX011 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL
C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX010 ABOVE.
C
CX020 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-020 CONTROL CARD.
C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02 = 6
C (UNIT NUMBER FOR PRINTER).
CX021 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-021 CONTROL CARD.
C THE CX021 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL
C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX020 ABOVE.
C
IVPASS=0
IVFAIL=0
IVDELE=0
ICZERO=0
C
C WRITE PAGE HEADERS
WRITE (I02,90000)
WRITE (I02,90001)
WRITE (I02,90002)
WRITE (I02, 90002)
WRITE (I02,90003)
WRITE (I02,90002)
WRITE (I02,90004)
WRITE (I02,90002)
WRITE (I02,90011)
WRITE (I02,90002)
WRITE (I02,90002)
WRITE (I02,90005)
WRITE (I02,90006)
WRITE (I02,90002)
C
C TEST SECTION
C
C SUBROUTINE REFERENCE - CALL
C
IVTNUM = 666
C
C **** TEST 666 ****
C SUBROUTINE CALL - ARGUMENT NAME SAME AS SUBROUTINE ARGUMENT NAME.
C
IF (ICZERO) 36660, 6660, 36660
6660 CONTINUE
IVON01 = 0
CALL FS027(IVON01)
IVCOMP = IVON01
GO TO 46660
36660 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 46660, 6671, 46660
46660 IF (IVCOMP - 1) 26660,16660,26660
16660 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 6671
26660 IVFAIL = IVFAIL + 1
IVCORR = 1
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
6671 CONTINUE
IVTNUM = 667
C
C **** TEST 667 ****
C SUBROUTINE CALL - ARGUMENT NAME SAME AS INTERNAL VARIABLE IN
C SUBROUTINE.
C
IF (ICZERO) 36670, 6670, 36670
6670 CONTINUE
IVON02 = 2
CALL FS027(IVON02)
IVCOMP = IVON02
GO TO 46670
36670 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 46670, 6681, 46670
46670 IF (IVCOMP - 3) 26670,16670,26670
16670 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 6681
26670 IVFAIL = IVFAIL + 1
IVCORR = 3
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
6681 CONTINUE
IVTNUM = 668
C
C **** TEST 668 ****
C SUBROUTINE CALL - ARGUMENT NAME DIFFERENT FROM SUBROUTINE ARGUMENT
C AND INTERNAL VARIABLE.
C
IF (ICZERO) 36680, 6680, 36680
6680 CONTINUE
IVON01 = 7
IVON03 = -12
CALL FS027(IVON03)
IVCOMP = IVON03
GO TO 46680
36680 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 46680, 6691, 46680
46680 IF (IVCOMP + 11 ) 26680,16680,26680
16680 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 6691
26680 IVFAIL = IVFAIL + 1
IVCORR = -11
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
6691 CONTINUE
IVTNUM = 669
C
C **** TEST 669 ****
C REPEATED SUBROUTINE CALLS IN A DO LOOP.
C
IF (ICZERO) 36690, 6690, 36690
6690 CONTINUE
IVCOMP = 0
DO 6692 IVON04 = 1,5
CALL FS027 (IVCOMP)
6692 CONTINUE
GO TO 46690
36690 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 46690, 6701, 46690
46690 IF (IVCOMP - 5) 26690,16690,26690
16690 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 6701
26690 IVFAIL = IVFAIL + 1
IVCORR = 5
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
C **** END OF TESTS ****
6701 CONTINUE
C
C WRITE PAGE FOOTINGS AND RUN SUMMARIES
99999 CONTINUE
WRITE (I02,90002)
WRITE (I02,90006)
WRITE (I02,90002)
WRITE (I02,90002)
WRITE (I02,90007)
WRITE (I02,90002)
WRITE (I02,90008) IVFAIL
WRITE (I02,90009) IVPASS
WRITE (I02,90010) IVDELE
C
C
C TERMINATE ROUTINE EXECUTION
STOP
C
C FORMAT STATEMENTS FOR PAGE HEADERS
90000 FORMAT (1H1)
90002 FORMAT (1H )
90001 FORMAT (1H ,10X,34HFORTRAN COMPILER VALIDATION SYSTEM)
90003 FORMAT (1H ,21X,11HVERSION 1.0)
90004 FORMAT (1H ,10X,38HFOR OFFICIAL USE ONLY - COPYRIGHT 1978)
90005 FORMAT (1H ,5X,4HTEST,5X,9HPASS/FAIL, 5X,8HCOMPUTED,8X,7HCORRECT)
90006 FORMAT (1H ,5X,46H----------------------------------------------)
90011 FORMAT (1H ,18X,17HSUBSET LEVEL TEST)
C
C FORMAT STATEMENTS FOR RUN SUMMARIES
90008 FORMAT (1H ,15X,I5,19H ERRORS ENCOUNTERED)
90009 FORMAT (1H ,15X,I5,13H TESTS PASSED)
90010 FORMAT (1H ,15X,I5,14H TESTS DELETED)
C
C FORMAT STATEMENTS FOR TEST RESULTS
80001 FORMAT (1H ,4X,I5,7X,4HPASS)
80002 FORMAT (1H ,4X,I5,7X,4HFAIL)
80003 FORMAT (1H ,4X,I5,7X,7HDELETED)
80004 FORMAT (1H ,4X,I5,7X,4HFAIL,10X,I6,9X,I6)
80005 FORMAT (1H ,4X,I5,7X,4HFAIL,4X,E12.5,3X,E12.5)
C
90007 FORMAT (1H ,20X,20HEND OF PROGRAM FM026)
END
*HEADER,FORTR,FM026,SUBRTN,FM027
SUBROUTINE FS027(IVON01)
C COMMENT SECTION
C
C FS027
C
C THIS SUBROUTINE IS CALLED BY THE MAIN PROGRAM FM026. THE
C SUBROUTINE ARGUMENT IS INCREMENTED BY 1 AND CONTROL RETURNED
C TO THE CALLING PROGRAM.
C
C REFERENCES
C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN,
C X3.9-1978
C
C SECTION 15.6, SUBROUTINES
C SECTION 15.8, RETURN STATEMENT
C
C TEST SECTION
C
C SUBROUTINE SUBPROGRAM
C
C INCREMENT ARGUMENT BY 1 AND RETURN TO CALLING PROGRAM.
C
IVON02 = IVON01
IVON02 = IVON02 + 1
IVON01 = IVON02
IVON02 = 300
RETURN
END
*END-OF,FM026
FM028.f 480976004 170 2 100666 7851 `
*HEADER,FORTR,FM028
*FILES1,FORTR,FM028
C COMMENT SECTION
C
C FM028
C
C THIS ROUTINE CONTAINS THE EXTERNAL FUNCTION REFERENCE TESTS.
C THE FUNCTION SUBPROGRAM FF029 IS CALLED BY THIS PROGRAM. THE
C FUNCTION SUBPROGRAM FF029 INCREMENTS THE CALLING ARGUMENT BY 1
C AND RETURNS TO THE CALLING PROGRAM.
C
C EXECUTION OF AN EXTERNAL FUNCTION REFERENCE RESULTS IN AN
C ASSOCIATION OF ACTUAL ARGUMENTS WITH ALL APPEARANCES OF DUMMY
C ARGUMENTS IN THE DEFINING SUBPROGRAM. FOLLOWING THESE
C ASSOCIATIONS, EXECUTION OF THE FIRST EXECUTABLE STATEMENT OF THE
C DEFINING SUBPROGRAM IS UNDERTAKEN.
C
C REFERENCES
C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN,
C X3.9-1978
C
C SECTION 15.5.2, REFERENCING AN EXTERNAL FUNCTION
C
INTEGER FF029
C
C
C **********************************************************
C
C A COMPILER VALIDATION SYSTEM FOR THE FORTRAN LANGUAGE
C BASED ON SPECIFICATIONS AS DEFINED IN AMERICAN NATIONAL STANDARD
C PROGRAMMING LANGUAGE FORTRAN X3.9-1978, HAS BEEN DEVELOPED BY THE
C FEDERAL COBOL COMPILER TESTING SERVICE. THE FORTRAN COMPILER
C VALIDATION SYSTEM (FCVS) CONSISTS OF AUDIT ROUTINES, THEIR RELATED
C DATA, AND AN EXECUTIVE SYSTEM. EACH AUDIT ROUTINE IS A FORTRAN
C PROGRAM, SUBPROGRAM OR FUNCTION WHICH INCLUDES TESTS OF SPECIFIC
C LANGUAGE ELEMENTS AND SUPPORTING PROCEDURES INDICATING THE RESULT
C OF EXECUTING THESE TESTS.
C
C THIS PARTICULAR PROGRAM/SUBPROGRAM/FUNCTION CONTAINS FEATURES
C FOUND ONLY IN THE SUBSET AS DEFINED IN X3.9-1978.
C
C SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO -
C
C DEPARTMENT OF THE NAVY
C FEDERAL COBOL COMPILER TESTING SERVICE
C WASHINGTON, D.C. 20376
C
C **********************************************************
C
C
C
C INITIALIZATION SECTION
C
C INITIALIZE CONSTANTS
C **************
C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER.
I01 = 5
C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER.
I02 = 6
C SYSTEM ENVIRONMENT SECTION
C
CX010 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-010 CONTROL CARD.
C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5
C (UNIT NUMBER FOR CARD READER).
CX011 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-011 CONTROL CARD.
C THE CX011 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL
C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX010 ABOVE.
C
CX020 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-020 CONTROL CARD.
C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02 = 6
C (UNIT NUMBER FOR PRINTER).
CX021 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-021 CONTROL CARD.
C THE CX021 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL
C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX020 ABOVE.
C
IVPASS=0
IVFAIL=0
IVDELE=0
ICZERO=0
C
C WRITE PAGE HEADERS
WRITE (I02,90000)
WRITE (I02,90001)
WRITE (I02,90002)
WRITE (I02, 90002)
WRITE (I02,90003)
WRITE (I02,90002)
WRITE (I02,90004)
WRITE (I02,90002)
WRITE (I02,90011)
WRITE (I02,90002)
WRITE (I02,90002)
WRITE (I02,90005)
WRITE (I02,90006)
WRITE (I02,90002)
C
C TEST SECTION
C
C EXTERNAL FUNCTION REFERENCE
C
C EXTERNAL FUNCTION REFERENCE - ARGUMENT NAME SAME AS SUBPROGRAM
C ARGUMENT NAME.
6701 CONTINUE
IVTNUM = 670
C
C **** TEST 670 ****
C
IF (ICZERO) 36700,6700,36700
6700 CONTINUE
IVON01 = 0
IVCOMP = FF029(IVON01)
GO TO 46700
36700 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 46700,6711,46700
46700 IF (IVCOMP - 1) 26700,16700,26700
16700 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 6711
26700 IVFAIL = IVFAIL + 1
IVCORR = 1
WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR
6711 CONTINUE
IVTNUM = 671
C
C **** TEST 671 ****
C
C EXTERNAL FUNCTION REFERENCE - ARGUMENT NAME SAME AS INTERNAL
C VARIABLE IN FUNCTION SUBPROGRAM.
C
IF (ICZERO) 36710,6710,36710
6710 CONTINUE
IVON02 = 2
IVON01 = 5
IVCOMP = FF029(IVON02)
GO TO 46710
36710 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 46710,6721,46710
46710 IF (IVCOMP - 3) 26710,16710,26710
16710 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 6721
26710 IVFAIL = IVFAIL + 1
IVCORR = 3
WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR
6721 CONTINUE
IVTNUM = 672
C
C **** TEST 672 ****
C
C EXTERNAL FUNCTION REFERENCE - ARGUMENT NAME DIFFERENT FROM
C FUNCTION SUBPROGRAM ARGUMENT AND INTERNAL VARIABLE.
C
IF (ICZERO) 36720,6720,36720
6720 CONTINUE
IVON01 = 7
IVON03 = -12
IVCOMP = FF029(IVON03)
GO TO 46720
36720 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 46720,6731,46720
46720 IF (IVCOMP + 11) 26720,16720,26720
16720 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 6731
26720 IVFAIL = IVFAIL + 1
IVCORR = -11
WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR
6731 CONTINUE
IVTNUM = 673
C
C **** TEST 673 ****
C
C REPEATED EXTERNAL FUNCTION REFERENCE IN A DO LOOP.
C
IF (ICZERO) 36730,6730,36730
6730 CONTINUE
IVON01 = -7
IVCOMP = 0
DO 6732 IVON04 = 1,5
IVCOMP = FF029(IVCOMP)
6732 CONTINUE
GO TO 46730
36730 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 46730,6741,46730
46730 IF (IVCOMP - 5) 26730,16730,26730
16730 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 6741
26730 IVFAIL = IVFAIL + 1
IVCORR = 5
WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR
6741 CONTINUE
C
C WRITE PAGE FOOTINGS AND RUN SUMMARIES
99999 CONTINUE
WRITE (I02,90002)
WRITE (I02,90006)
WRITE (I02,90002)
WRITE (I02,90002)
WRITE (I02,90007)
WRITE (I02,90002)
WRITE (I02,90008) IVFAIL
WRITE (I02,90009) IVPASS
WRITE (I02,90010) IVDELE
C
C
C TERMINATE ROUTINE EXECUTION
STOP
C
C FORMAT STATEMENTS FOR PAGE HEADERS
90000 FORMAT (1H1)
90002 FORMAT (1H )
90001 FORMAT (1H ,10X,34HFORTRAN COMPILER VALIDATION SYSTEM)
90003 FORMAT (1H ,21X,11HVERSION 1.0)
90004 FORMAT (1H ,10X,38HFOR OFFICIAL USE ONLY - COPYRIGHT 1978)
90005 FORMAT (1H ,5X,4HTEST,5X,9HPASS/FAIL, 5X,8HCOMPUTED,8X,7HCORRECT)
90006 FORMAT (1H ,5X,46H----------------------------------------------)
90011 FORMAT (1H ,18X,17HSUBSET LEVEL TEST)
C
C FORMAT STATEMENTS FOR RUN SUMMARIES
90008 FORMAT (1H ,15X,I5,19H ERRORS ENCOUNTERED)
90009 FORMAT (1H ,15X,I5,13H TESTS PASSED)
90010 FORMAT (1H ,15X,I5,14H TESTS DELETED)
C
C FORMAT STATEMENTS FOR TEST RESULTS
80001 FORMAT (1H ,4X,I5,7X,4HPASS)
80002 FORMAT (1H ,4X,I5,7X,4HFAIL)
80003 FORMAT (1H ,4X,I5,7X,7HDELETED)
80004 FORMAT (1H ,4X,I5,7X,4HFAIL,10X,I6,9X,I6)
80005 FORMAT (1H ,4X,I5,7X,4HFAIL,4X,E12.5,3X,E12.5)
C
90007 FORMAT (1H ,20X,20HEND OF PROGRAM FM028)
END
*HEADER,FORTR,FM028,SUBRTN,FM029
INTEGER FUNCTION FF029(IVON01)
C
C COMMENT SECTION
C FF029
C
C THIS FUNCTION SUBPROGRAM IS CALLED BY THE MAIN PROGRAM FM028.
C THE FUNCTION ARGUMENT IS INCREMENTED BY 1 AND CONTROL RETURNED
C TO THE CALLING PROGRAM.
C
C REFERENCES
C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN,
C X3.9-1978
C
C SECTION 15.5.1, DEFINING FUNCTION SUBPROGRAMS AND FUNCTION
C STATEMENTS
C SECTION 15.8, RETURN STATEMENT
C
C TEST SECTION
C
C FUNCTION SUBPROGRAM
C
C INCREMENT ARGUMENT BY 1 AND RETURN TO CALLING PROGRAM.
C
IVON02 = IVON01
FF029 = IVON02 + 1
IVON02 = 500
RETURN
END
*END-OF,FM028
FM030.f 480976007 170 2 100666 22365 `
*HEADER,FORTR,FM030
*FILES1,FORTR,FM030,X
C COMMENT SECTION.
C
C FM030
C
C THIS ROUTINE TESTS ARITHMETIC ASSIGNMENT STATEMENTS OF THE
C FORM
C INTEGER VARIABLE = ARITHMETIC EXPRESSION
C WHERE THE ARITHMETIC EXPRESSION IS FORMED WITH THE ARITHMETIC
C OPERATOR -, INTEGER CONSTANTS AND INTEGER VARIABLES.
C SOME OF THE TESTS USE PARENTHESES TO GROUP ELEMENTS IN THE
C ARITHMETIC EXPRESSION.
C
C THERE ARE TESTS WHERE THE ARITHMETIC EXPRESSION CONTAINS
C (1) INTEGER CONSTANT - INTEGER CONSTANT
C (2) INTEGER CONSTANT - INTEGER CONSTANT - INTEGER CONSTANT
C (3) SAME AS (2) BUT WITH PARENTHESES TO GROUP ELEMENTS
C (4) INTEGER VARIABLE - INTEGER CONSTANT
C INTEGER CONSTANT - INTEGER VARIABLE
C
C REFERENCES
C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN,
C X3.9-1978
C
C SECTION 4.3, INTEGER TYPE
C SECTION 4.3.1, INTEGER CONSTANT
C SECTION 6.1, ARITHMETIC EXPRESSIONS
C SECTION 10.1, ARITHMETIC ASSIGNMENT STATEMENT
C
C
C **********************************************************
C
C A COMPILER VALIDATION SYSTEM FOR THE FORTRAN LANGUAGE
C BASED ON SPECIFICATIONS AS DEFINED IN AMERICAN NATIONAL STANDARD
C PROGRAMMING LANGUAGE FORTRAN X3.9-1978, HAS BEEN DEVELOPED BY THE
C FEDERAL COBOL COMPILER TESTING SERVICE. THE FORTRAN COMPILER
C VALIDATION SYSTEM (FCVS) CONSISTS OF AUDIT ROUTINES, THEIR RELATED
C DATA, AND AN EXECUTIVE SYSTEM. EACH AUDIT ROUTINE IS A FORTRAN
C PROGRAM, SUBPROGRAM OR FUNCTION WHICH INCLUDES TESTS OF SPECIFIC
C LANGUAGE ELEMENTS AND SUPPORTING PROCEDURES INDICATING THE RESULT
C OF EXECUTING THESE TESTS.
C
C THIS PARTICULAR PROGRAM/SUBPROGRAM/FUNCTION CONTAINS FEATURES
C FOUND ONLY IN THE SUBSET AS DEFINED IN X3.9-1978.
C
C SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO -
C
C DEPARTMENT OF THE NAVY
C FEDERAL COBOL COMPILER TESTING SERVICE
C WASHINGTON, D.C. 20376
C
C **********************************************************
C
C
C
C INITIALIZATION SECTION
C
C INITIALIZE CONSTANTS
C **************
C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER.
I01 = 5
C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER.
I02 = 6
C SYSTEM ENVIRONMENT SECTION
C
CX010 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-010 CONTROL CARD.
C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5
C (UNIT NUMBER FOR CARD READER).
CX011 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-011 CONTROL CARD.
C THE CX011 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL
C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX010 ABOVE.
C
CX020 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-020 CONTROL CARD.
C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02 = 6
C (UNIT NUMBER FOR PRINTER).
CX021 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-021 CONTROL CARD.
C THE CX021 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL
C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX020 ABOVE.
C
IVPASS=0
IVFAIL=0
IVDELE=0
ICZERO=0
C
C WRITE PAGE HEADERS
WRITE (I02,90000)
WRITE (I02,90001)
WRITE (I02,90002)
WRITE (I02, 90002)
WRITE (I02,90003)
WRITE (I02,90002)
WRITE (I02,90004)
WRITE (I02,90002)
WRITE (I02,90011)
WRITE (I02,90002)
WRITE (I02,90002)
WRITE (I02,90005)
WRITE (I02,90006)
WRITE (I02,90002)
C TEST SECTION
C
C ARITHMETIC ASSIGNMENT STATEMENT
C
C TEST 265 THROUGH TEST 270 CONTAIN TWO INTEGER CONSTANTS AND
C OPERATOR - IN AN ARITHMETIC EXPRESSION. THE FORM TESTED IS
C INTEGER VARIABLE = INTEGER CONSTANT - INTEGER CONSTANT
C
2651 CONTINUE
IVTNUM = 265
C
C **** TEST 265 ****
C
IF (ICZERO) 32650, 2650, 32650
2650 CONTINUE
IVCOMP = 3-2
GO TO 42650
32650 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 42650, 2661, 42650
42650 IF (IVCOMP - 1) 22650,12650,22650
12650 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 2661
22650 IVFAIL = IVFAIL + 1
IVCORR = 1
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
2661 CONTINUE
IVTNUM = 266
C
C **** TEST 266 ****
C
IF (ICZERO) 32660, 2660, 32660
2660 CONTINUE
IVCOMP = 51 - 52
GO TO 42660
32660 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 42660, 2671, 42660
42660 IF (IVCOMP +1) 22660,12660,22660
12660 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 2671
22660 IVFAIL = IVFAIL + 1
IVCORR = -1
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
2671 CONTINUE
IVTNUM = 267
C
C **** TEST 267 ***
C
IF (ICZERO) 32670, 2670, 32670
2670 CONTINUE
IVCOMP = 865 - 189
GO TO 42670
32670 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 42670, 2681, 42670
42670 IF (IVCOMP -676) 22670,12670,22670
12670 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 2681
22670 IVFAIL = IVFAIL + 1
IVCORR = 676
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
2681 CONTINUE
IVTNUM = 268
C
C **** TEST 268 ****
C
IF (ICZERO) 32680, 2680, 32680
2680 CONTINUE
IVCOMP =1358-9359
GO TO 42680
32680 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 42680, 2691, 42680
42680 IF (IVCOMP+8001) 22680,12680,22680
12680 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 2691
22680 IVFAIL = IVFAIL + 1
IVCORR = -8001
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
2691 CONTINUE
IVTNUM = 269
C
C **** TEST 269 ****
C
IF (ICZERO) 32690, 2690, 32690
2690 CONTINUE
IVCOMP =21113-10001
GO TO 42690
32690 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 42690, 2701, 42690
42690 IF (IVCOMP-11112) 22690,12690,22690
12690 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 2701
22690 IVFAIL = IVFAIL + 1
IVCORR=11112
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
2701 CONTINUE
IVTNUM = 270
C
C **** TEST 270 ****
C
IF (ICZERO) 32700, 2700, 32700
2700 CONTINUE
IVCOMP = 32767-1
GO TO 42700
32700 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 42700, 2711, 42700
42700 IF (IVCOMP -32766) 22700,12700,22700
12700 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 2711
22700 IVFAIL = IVFAIL + 1
IVCORR = 32766
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
C
C TEST 271 THROUGH TEST 274 CONTAIN THREE INTEGER CONSTANTS
C AND OPERATOR - IN AN ARITHMETIC EXPRESSION. THE FORM TESTED IS
C IV = IC - IC - IC
C
2711 CONTINUE
IVTNUM = 271
C
C **** TEST 271 ****
C
IF (ICZERO) 32710, 2710, 32710
2710 CONTINUE
IVCOMP=9-4-3
GO TO 42710
32710 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 42710, 2721, 42710
42710 IF (IVCOMP -2) 22710,12710,22710
12710 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 2721
22710 IVFAIL = IVFAIL + 1
IVCORR =2
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
2721 CONTINUE
IVTNUM = 272
C
C **** TEST 272 ****
C
IF (ICZERO) 32720, 2720, 32720
2720 CONTINUE
IVCOMP = 51-52-53
GO TO 42720
32720 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 42720, 2731, 42720
42720 IF (IVCOMP +54) 22720,12720,22720
12720 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 2731
22720 IVFAIL = IVFAIL + 1
IVCORR = -54
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
2731 CONTINUE
IVTNUM = 273
C
C **** TEST 273 ****
C
IF (ICZERO) 32730, 2730, 32730
2730 CONTINUE
IVCOMP = 966 -676 -189
GO TO 42730
32730 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 42730, 2741, 42730
42730 IF (IVCOMP -101) 22730,12730,22730
12730 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 2741
22730 IVFAIL = IVFAIL + 1
IVCORR = 101
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
2741 CONTINUE
IVTNUM = 274
C
C **** TEST 274 ****
C
IF (ICZERO) 32740, 2740, 32740
2740 CONTINUE
IVCOMP = 1358-8001-2188
GO TO 42740
32740 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 42740, 2751, 42740
42740 IF (IVCOMP + 8831) 22740,12740,22740
12740 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 2751
22740 IVFAIL = IVFAIL + 1
IVCORR = -8831
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
C
C TEST 275 THROUGH TEST 282 ARE THE SAME AS TESTS 271-274 EXCEPT
C PARENTHESES ARE USED TO GROUP THE CONSTANTS.
C
2751 CONTINUE
IVTNUM = 275
C
C **** TEST 275 ****
C
IF (ICZERO) 32750, 2750, 32750
2750 CONTINUE
IVCOMP =(9-4)-3
GO TO 42750
32750 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 42750, 2761, 42750
42750 IF (IVCOMP -2) 22750,12750,22750
12750 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 2761
22750 IVFAIL = IVFAIL + 1
IVCORR = 2
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
2761 CONTINUE
IVTNUM = 276
C
C **** TEST 276 ****
C
IF (ICZERO) 32760, 2760, 32760
2760 CONTINUE
IVCOMP =9-(4-3)
GO TO 42760
32760 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 42760, 2771, 42760
42760 IF (IVCOMP -8) 22760,12760,22760
12760 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 2771
22760 IVFAIL = IVFAIL + 1
IVCORR =8
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
2771 CONTINUE
IVTNUM = 277
C
C **** TEST 277 ****
C
IF (ICZERO) 32770, 2770, 32770
2770 CONTINUE
IVCOMP =(51-52)-53
GO TO 42770
32770 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 42770, 2781, 42770
42770 IF (IVCOMP +54) 22770,12770,22770
12770 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 2781
22770 IVFAIL = IVFAIL + 1
IVCORR = -54
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
2781 CONTINUE
IVTNUM = 278
C
C **** TEST 278 ****
C
IF (ICZERO) 32780, 2780, 32780
2780 CONTINUE
IVCOMP=51-(52-53)
GO TO 42780
32780 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 42780, 2791, 42780
42780 IF (IVCOMP-52) 22780,12780,22780
12780 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 2791
22780 IVFAIL = IVFAIL + 1
IVCORR = 52
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
2791 CONTINUE
IVTNUM = 279
C
C **** TEST 279 ****
C
IF (ICZERO) 32790, 2790, 32790
2790 CONTINUE
IVCOMP =(966-676)-189
GO TO 42790
32790 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 42790, 2801, 42790
42790 IF (IVCOMP - 101) 22790,12790,22790
12790 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 2801
22790 IVFAIL = IVFAIL + 1
IVCORR = 101
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
2801 CONTINUE
IVTNUM = 280
C
C **** TEST 280 ****
C
IF (ICZERO) 32800, 2800, 32800
2800 CONTINUE
IVCOMP =966-(676-189)
GO TO 42800
32800 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 42800, 2811, 42800
42800 IF (IVCOMP - 479) 22800,12800,22800
12800 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 2811
22800 IVFAIL = IVFAIL + 1
IVCORR = 479
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
2811 CONTINUE
IVTNUM = 281
C
C **** TEST 281 ****
C
IF (ICZERO) 32810, 2810, 32810
2810 CONTINUE
IVCOMP = (1358-8001)-2188
GO TO 42810
32810 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 42810, 2821, 42810
42810 IF (IVCOMP + 8831) 22810,12810,22810
12810 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 2821
22810 IVFAIL = IVFAIL + 1
IVCORR = -8831
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
2821 CONTINUE
IVTNUM = 282
C
C **** TEST 282 ****
C
IF (ICZERO) 32820, 2820, 32820
2820 CONTINUE
IVCOMP = 1358-(8001-2188)
GO TO 42820
32820 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 42820, 2831, 42820
42820 IF (IVCOMP + 4455) 22820,12820,22820
12820 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 2831
22820 IVFAIL = IVFAIL + 1
IVCORR = -4455
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
C
C TEST 283 THROUGH TEST 299 CONTAIN INTEGER VARIABLE, INTEGER
C CONSTANT AND OPERATOR - IN ARITHMETIC EXPRESSION. THE INTEGER
C VARIABLE CONTAINS BOTH POSITIVE AND NEGATIVE VALUES.
C THE FORMS TESTED ARE
C INTEGER VARIABLE = INTEGER VARIABLE - INTEGER CONSTANT
C INTEGER VARIABLE = INTEGER CONSTANT - INTEGER VARIABLE
C
2831 CONTINUE
IVTNUM = 283
C
C **** TEST 283 ****
C
IF (ICZERO) 32830, 2830, 32830
2830 CONTINUE
IVON01 = 3
IVCOMP = IVON01 - 2
GO TO 42830
32830 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 42830, 2841, 42830
42830 IF (IVCOMP - 1) 22830,12830,22830
12830 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 2841
22830 IVFAIL = IVFAIL + 1
IVCORR = 1
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
2841 CONTINUE
IVTNUM = 284
C
C **** TEST 284 ****
C
IF (ICZERO) 32840, 2840, 32840
2840 CONTINUE
IVON01 = 2
IVCOMP = IVON01 -3
GO TO 42840
32840 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 42840, 2851, 42840
42840 IF (IVCOMP +1) 22840,12840,22840
12840 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 2851
22840 IVFAIL = IVFAIL + 1
IVCORR = -1
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
2851 CONTINUE
IVTNUM = 285
C
C **** TEST 285 ****
C
IF (ICZERO) 32850, 2850, 32850
2850 CONTINUE
IVON01 =-3
IVCOMP = IVON01 -2
GO TO 42850
32850 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 42850, 2861, 42850
42850 IF (IVCOMP +5) 22850,12850,22850
12850 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 2861
22850 IVFAIL = IVFAIL + 1
IVCORR =-5
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
2861 CONTINUE
IVTNUM = 286
C
C **** TEST 286 ****
C
IF (ICZERO) 32860, 2860, 32860
2860 CONTINUE
IVON02 =2
IVCOMP = 3 - IVON02
GO TO 42860
32860 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 42860, 2871, 42860
42860 IF (IVCOMP -1) 22860,12860,22860
12860 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 2871
22860 IVFAIL = IVFAIL + 1
IVCORR = 1
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
2871 CONTINUE
IVTNUM = 287
C
C **** TEST 287 ****
C
IF (ICZERO) 32870, 2870, 32870
2870 CONTINUE
IVON02 =3
IVCOMP = 2 -IVON02
GO TO 42870
32870 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 42870, 2881, 42870
42870 IF (IVCOMP +1) 22870,12870,22870
12870 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 2881
22870 IVFAIL = IVFAIL + 1
IVCORR =-1
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
2881 CONTINUE
IVTNUM = 288
C
C **** TEST 288 ****
C
IF (ICZERO) 32880, 2880, 32880
2880 CONTINUE
IVON02 = -2
IVCOMP = 3 - IVON02
GO TO 42880
32880 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 42880, 2891, 42880
42880 IF (IVCOMP -5) 22880,12880,22880
12880 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 2891
22880 IVFAIL = IVFAIL + 1
IVCORR =5
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
2891 CONTINUE
IVTNUM = 289
C
C **** TEST 289 ****
C
IF (ICZERO) 32890, 2890, 32890
2890 CONTINUE
IVON01 =51
IVCOMP = IVON01 - 52
GO TO 42890
32890 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 42890, 2901, 42890
42890 IF (IVCOMP + 1) 22890,12890,22890
12890 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 2901
22890 IVFAIL = IVFAIL + 1
IVCORR = -1
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
2901 CONTINUE
IVTNUM = 290
C
C **** TEST 290 ****
C
IF (ICZERO) 32900, 2900, 32900
2900 CONTINUE
IVON01 =51
IVCOMP = IVON01 -51
GO TO 42900
32900 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 42900, 2911, 42900
42900 IF (IVCOMP) 22900,12900,22900
12900 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 2911
22900 IVFAIL = IVFAIL + 1
IVCORR =0
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
2911 CONTINUE
IVTNUM = 291
C
C **** TEST 291 ****
C
IF (ICZERO) 32910, 2910, 32910
2910 CONTINUE
IVON01 =53
IVCOMP =IVON01 -52
GO TO 42910
32910 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 42910, 2921, 42910
42910 IF (IVCOMP -1) 22910,12910,22910
12910 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 2921
22910 IVFAIL = IVFAIL + 1
IVCORR = 1
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
2921 CONTINUE
IVTNUM = 292
C
C **** TEST 292 ****
C
IF (ICZERO) 32920, 2920, 32920
2920 CONTINUE
IVON02 = 676
IVCOMP = 189 - IVON02
GO TO 42920
32920 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 42920, 2931, 42920
42920 IF (IVCOMP + 487) 22920,12920,22920
12920 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 2931
22920 IVFAIL = IVFAIL + 1
IVCORR = -487
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
2931 CONTINUE
IVTNUM = 293
C
C **** TEST 293 ****
C
IF (ICZERO) 32930, 2930, 32930
2930 CONTINUE
IVON02 = -676
IVCOMP = 189 - IVON02
GO TO 42930
32930 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 42930, 2941, 42930
42930 IF (IVCOMP - 865) 22930,12930,22930
12930 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 2941
22930 IVFAIL = IVFAIL + 1
IVCORR = 865
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
2941 CONTINUE
IVTNUM = 294
C
C **** TEST 294 ****
C
IF (ICZERO) 32940, 2940, 32940
2940 CONTINUE
IVON01 = 1358
IVCOMP = IVON01 - 8001
GO TO 42940
32940 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 42940, 2951, 42940
42940 IF (IVCOMP + 6643) 22940,12940,22940
12940 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 2951
22940 IVFAIL = IVFAIL + 1
IVCORR = -6643
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
2951 CONTINUE
IVTNUM = 295
C
C **** TEST 295 ****
C
IF (ICZERO) 32950, 2950, 32950
2950 CONTINUE
IVON01 = -1358
IVCOMP = IVON01 - 8001
GO TO 42950
32950 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 42950, 2961, 42950
42950 IF (IVCOMP + 9359) 22950,12950,22950
12950 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 2961
22950 IVFAIL = IVFAIL + 1
IVCORR = -9359
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
2961 CONTINUE
IVTNUM = 296
C
C **** TEST 296 ****
C
IF (ICZERO) 32960, 2960, 32960
2960 CONTINUE
IVON01 = 15
IVCOMP = IVON01 - 32752
GO TO 42960
32960 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 42960, 2971, 42960
42960 IF (IVCOMP + 32737) 22960,12960,22960
12960 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 2971
22960 IVFAIL = IVFAIL + 1
IVCORR = -32737
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
2971 CONTINUE
IVTNUM = 297
C
C **** TEST 297 ****
C
IF (ICZERO) 32970, 2970, 32970
2970 CONTINUE
IVON01 =-32751
IVCOMP = IVON01 - 15
GO TO 42970
32970 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 42970, 2981, 42970
42970 IF (IVCOMP + 32766) 22970,12970,22970
12970 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 2981
22970 IVFAIL = IVFAIL + 1
IVCORR = -32766
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
2981 CONTINUE
IVTNUM = 298
C
C **** TEST 298 ****
C
IF (ICZERO) 32980, 2980, 32980
2980 CONTINUE
IVON02 = -32752
IVCOMP = 15 - IVON02
GO TO 42980
32980 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 42980, 2991, 42980
42980 IF (IVCOMP - 32767) 22980,12980,22980
12980 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 2991
22980 IVFAIL = IVFAIL + 1
IVCORR = 32767
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
2991 CONTINUE
IVTNUM = 299
C
C **** TEST 299 ****
C
IF (ICZERO) 32990, 2990, 32990
2990 CONTINUE
IVON02 = 15
IVCOMP = 32752 - IVON02
GO TO 42990
32990 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 42990, 3001, 42990
42990 IF (IVCOMP - 32737) 22990,12990,22990
12990 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 3001
22990 IVFAIL = IVFAIL + 1
IVCORR = 32737
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
3001 CONTINUE
C
C WRITE PAGE FOOTINGS AND RUN SUMMARIES
99999 CONTINUE
WRITE (I02,90002)
WRITE (I02,90006)
WRITE (I02,90002)
WRITE (I02,90002)
WRITE (I02,90007)
WRITE (I02,90002)
WRITE (I02,90008) IVFAIL
WRITE (I02,90009) IVPASS
WRITE (I02,90010) IVDELE
C
C
C TERMINATE ROUTINE EXECUTION
STOP
C
C FORMAT STATEMENTS FOR PAGE HEADERS
90000 FORMAT (1H1)
90002 FORMAT (1H )
90001 FORMAT (1H ,10X,34HFORTRAN COMPILER VALIDATION SYSTEM)
90003 FORMAT (1H ,21X,11HVERSION 1.0)
90004 FORMAT (1H ,10X,38HFOR OFFICIAL USE ONLY - COPYRIGHT 1978)
90005 FORMAT (1H ,5X,4HTEST,5X,9HPASS/FAIL, 5X,8HCOMPUTED,8X,7HCORRECT)
90006 FORMAT (1H ,5X,46H----------------------------------------------)
90011 FORMAT (1H ,18X,17HSUBSET LEVEL TEST)
C
C FORMAT STATEMENTS FOR RUN SUMMARIES
90008 FORMAT (1H ,15X,I5,19H ERRORS ENCOUNTERED)
90009 FORMAT (1H ,15X,I5,13H TESTS PASSED)
90010 FORMAT (1H ,15X,I5,14H TESTS DELETED)
C
C FORMAT STATEMENTS FOR TEST RESULTS
80001 FORMAT (1H ,4X,I5,7X,4HPASS)
80002 FORMAT (1H ,4X,I5,7X,4HFAIL)
80003 FORMAT (1H ,4X,I5,7X,7HDELETED)
80004 FORMAT (1H ,4X,I5,7X,4HFAIL,10X,I6,9X,I6)
80005 FORMAT (1H ,4X,I5,7X,4HFAIL,4X,E12.5,3X,E12.5)
C
90007 FORMAT (1H ,20X,20HEND OF PROGRAM FM030)
END
*END-OF,FM030
FM031.f 480976010 170 2 100666 20222 `
*HEADER,FORTR,FM031
*FILES1,FORTR,FM031,X
C COMMENT SECTION
C
C FM031
C
C THIS ROUTINE TESTS ARITHMETIC ASSIGNMENT STATEMENTS OF THE
C FORM
C INTEGER VARIABLE = ARITHMETIC EXPRESSION
C WHERE THE ARITHMETIC EXPRESSION IS FORMED WITH THE ARITHMETIC
C OPERATOR -, INTEGER CONSTANTS AND INTEGER VARIABLES. SOME OF THE
C TESTS USE PARENTHESES TO GROUP ELEMENTS IN AN ARITHMETIC
C EXPRESSION.
C
C THERE ARE TESTS WHERE THE ARITHMETIC EXPRESSION CONTAINS
C (1) INTEGER CONSTANT-INTEGER CONSTANT-INTEGER VARIABLE
C INTEGER CONSTANT-INTEGER VARIABLE-INTEGER CONSTANT
C INTEGER VARIABLE-INTEGER CONSTANT-INTEGER CONSTANT
C (2) SAME AS (1) BUT WITH PARENTHESES TO GROUP ELEMENTS
C IN ARITHMETIC EXPRESSION.
C (3) INTEGER VARIABLE - INTEGER VARIABLE
C
C REFERENCES
C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN,
C X3.9-1978
C
C SECTION 4.3, INTEGER TYPE
C SECTION 4.3.1, INTEGER CONSTANT
C SECTION 6.1, ARITHMETIC EXPRESSIONS
C SECTION 10.1, ARITHMETIC ASSIGNMENT STATEMENT
C
C **********************************************************
C
C A COMPILER VALIDATION SYSTEM FOR THE FORTRAN LANGUAGE
C BASED ON SPECIFICATIONS AS DEFINED IN AMERICAN NATIONAL STANDARD
C PROGRAMMING LANGUAGE FORTRAN X3.9-1978, HAS BEEN DEVELOPED BY THE
C FEDERAL COBOL COMPILER TESTING SERVICE. THE FORTRAN COMPILER
C VALIDATION SYSTEM (FCVS) CONSISTS OF AUDIT ROUTINES, THEIR RELATED
C DATA, AND AN EXECUTIVE SYSTEM. EACH AUDIT ROUTINE IS A FORTRAN
C PROGRAM, SUBPROGRAM OR FUNCTION WHICH INCLUDES TESTS OF SPECIFIC
C LANGUAGE ELEMENTS AND SUPPORTING PROCEDURES INDICATING THE RESULT
C OF EXECUTING THESE TESTS.
C
C THIS PARTICULAR PROGRAM/SUBPROGRAM/FUNCTION CONTAINS FEATURES
C FOUND ONLY IN THE SUBSET AS DEFINED IN X3.9-1978.
C
C SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO -
C
C DEPARTMENT OF THE NAVY
C FEDERAL COBOL COMPILER TESTING SERVICE
C WASHINGTON, D.C. 20376
C
C **********************************************************
C
C
C
C INITIALIZATION SECTION
C
C INITIALIZE CONSTANTS
C **************
C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER.
I01 = 5
C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER.
I02 = 6
C SYSTEM ENVIRONMENT SECTION
C
CX010 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-010 CONTROL CARD.
C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5
C (UNIT NUMBER FOR CARD READER).
CX011 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-011 CONTROL CARD.
C THE CX011 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL
C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX010 ABOVE.
C
CX020 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-020 CONTROL CARD.
C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02 = 6
C (UNIT NUMBER FOR PRINTER).
CX021 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-021 CONTROL CARD.
C THE CX021 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL
C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX020 ABOVE.
C
IVPASS=0
IVFAIL=0
IVDELE=0
ICZERO=0
C
C WRITE PAGE HEADERS
WRITE (I02,90000)
WRITE (I02,90001)
WRITE (I02,90002)
WRITE (I02, 90002)
WRITE (I02,90003)
WRITE (I02,90002)
WRITE (I02,90004)
WRITE (I02,90002)
WRITE (I02,90011)
WRITE (I02,90002)
WRITE (I02,90002)
WRITE (I02,90005)
WRITE (I02,90006)
WRITE (I02,90002)
C
C TEST SECTION
C
C TEST 300 THROUGH TEST 309 CONTAIN 2 INTEGER CONSTANTS, AN INTEGER
C VARIABLE AND OPERATOR - IN AN ARITHMETIC EXPRESSION.
C
3001 CONTINUE
IVTNUM = 300
C
C **** TEST 300 ****
C
IF (ICZERO) 33000, 3000, 33000
3000 CONTINUE
IVON01 = 9
IVCOMP =IVON01 -3 -4
GO TO 43000
33000 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 43000, 3011, 43000
43000 IF (IVCOMP-2) 23000,13000,23000
13000 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 3011
23000 IVFAIL = IVFAIL + 1
IVCORR =2
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
3011 CONTINUE
IVTNUM = 301
C
C **** TEST 301 ****
C
IF (ICZERO) 33010, 3010, 33010
3010 CONTINUE
IVON02 =3
IVCOMP =9-IVON02-4
GO TO 43010
33010 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 43010, 3021, 43010
43010 IF (IVCOMP-2) 23010,13010,23010
13010 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 3021
23010 IVFAIL = IVFAIL + 1
IVCORR =2
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
3021 CONTINUE
IVTNUM = 302
C
C **** TEST 302 ****
C
IF (ICZERO) 33020, 3020, 33020
3020 CONTINUE
IVON03 = 4
IVCOMP = 9-3-IVON03
GO TO 43020
33020 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 43020, 3031, 43020
43020 IF (IVCOMP-2) 23020,13020,23020
13020 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 3031
23020 IVFAIL = IVFAIL + 1
IVCORR =2
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
3031 CONTINUE
IVTNUM = 303
C
C **** TEST 303 ****
C
IF (ICZERO) 33030, 3030, 33030
3030 CONTINUE
IVON01 = 57
IVCOMP = IVON01 -25-22
GO TO 43030
33030 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 43030, 3041, 43030
43030 IF (IVCOMP-10) 23030,13030,23030
13030 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 3041
23030 IVFAIL = IVFAIL + 1
IVCORR = 10
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
3041 CONTINUE
IVTNUM = 304
C
C **** TEST 304 ****
C
IF (ICZERO) 33040, 3040, 33040
3040 CONTINUE
IVON02 =683
IVCOMP = 101-IVON02-156
GO TO 43040
33040 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 43040, 3051, 43040
43040 IF (IVCOMP+738) 23040,13040,23040
13040 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 3051
23040 IVFAIL = IVFAIL + 1
IVCORR = -738
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
3051 CONTINUE
IVTNUM = 305
C
C **** TEST 305 ****
C
IF (ICZERO) 33050, 3050, 33050
3050 CONTINUE
IVON03 = 1289
IVCOMP = 8542-1122-IVON03
GO TO 43050
33050 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 43050, 3061, 43050
43050 IF (IVCOMP-6131) 23050,13050,23050
13050 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 3061
23050 IVFAIL = IVFAIL + 1
IVCORR = 6131
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
3061 CONTINUE
IVTNUM = 306
C
C **** TEST 306 ****
C
IF (ICZERO) 33060, 3060, 33060
3060 CONTINUE
IVON03 = 11111
IVCOMP = 32333-11111-IVON03
GO TO 43060
33060 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 43060, 3071, 43060
43060 IF (IVCOMP-10111) 23060,13060,23060
13060 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 3071
23060 IVFAIL = IVFAIL + 1
IVCORR =10111
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
3071 CONTINUE
IVTNUM = 307
C
C **** TEST 307 ****
C
IF (ICZERO) 33070, 3070, 33070
3070 CONTINUE
IVON01 = -3
IVCOMP = IVON01-2-4
GO TO 43070
33070 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 43070, 3081, 43070
43070 IF (IVCOMP +9) 23070,13070,23070
13070 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 3081
23070 IVFAIL = IVFAIL + 1
IVCORR =-9
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
3081 CONTINUE
IVTNUM = 308
C
C **** TEST 308 ****
C
IF (ICZERO) 33080, 3080, 33080
3080 CONTINUE
IVON02 =-9
IVCOMP =1-IVON02-4
GO TO 43080
33080 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 43080, 3091, 43080
43080 IF (IVCOMP-6) 23080,13080,23080
13080 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 3091
23080 IVFAIL = IVFAIL + 1
IVCORR = 6
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
3091 CONTINUE
IVTNUM = 309
C
C **** TEST 309 ****
C
IF (ICZERO) 33090, 3090, 33090
3090 CONTINUE
IVON03 = -8542
IVCOMP = 100-3-IVON03
GO TO 43090
33090 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 43090, 3101, 43090
43090 IF (IVCOMP-8639) 23090,13090,23090
13090 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 3101
23090 IVFAIL = IVFAIL + 1
IVCORR = 8639
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
C
C TEST 310 THROUGH TEST 319 CONTAIN 2 INTEGER CONSTANTS, AN INTEGER
C VARIABLE AND OPERATOR - IN AN ARITHMETIC EXPRESSION. PARENTHESES
C ARE USED TO GROUP ELEMENTS IN THE ARITHMETIC EXPRESSION.
C
3101 CONTINUE
IVTNUM = 310
C
C **** TEST 310 ****
C
IF (ICZERO) 33100, 3100, 33100
3100 CONTINUE
IVON01 =9
IVCOMP = IVON01-(3-4)
GO TO 43100
33100 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 43100, 3111, 43100
43100 IF (IVCOMP-10) 23100,13100,23100
13100 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 3111
23100 IVFAIL = IVFAIL + 1
IVCORR=10
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
3111 CONTINUE
IVTNUM = 311
C
C **** TEST 311 ****
C
IF (ICZERO) 33110, 3110, 33110
3110 CONTINUE
IVON01=9
IVCOMP=(IVON01-3)-4
GO TO 43110
33110 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 43110, 3121, 43110
43110 IF (IVCOMP-2) 23110,13110,23110
13110 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 3121
23110 IVFAIL = IVFAIL + 1
IVCORR =2
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
3121 CONTINUE
IVTNUM = 312
C
C **** TEST 312 ****
C
IF (ICZERO) 33120, 3120, 33120
3120 CONTINUE
IVON02 = 3
IVCOMP = 9-(IVON02-4)
GO TO 43120
33120 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 43120, 3131, 43120
43120 IF (IVCOMP-10) 23120,13120,23120
13120 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 3131
23120 IVFAIL = IVFAIL + 1
IVCORR = 10
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
3131 CONTINUE
IVTNUM = 313
C
C **** TEST 313 ****
C
IF (ICZERO) 33130, 3130, 33130
3130 CONTINUE
IVON02 = 3
IVCOMP = (9-IVON02) -4
GO TO 43130
33130 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 43130, 3141, 43130
43130 IF (IVCOMP-2) 23130,13130,23130
13130 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 3141
23130 IVFAIL = IVFAIL + 1
IVCORR = 2
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
3141 CONTINUE
IVTNUM = 314
C
C **** TEST 314 ****
C
IF (ICZERO) 33140, 3140, 33140
3140 CONTINUE
IVON03 = 4
IVCOMP = 9 -(3-IVON03)
GO TO 43140
33140 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 43140, 3151, 43140
43140 IF (IVCOMP-10) 23140,13140,23140
13140 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 3151
23140 IVFAIL = IVFAIL + 1
IVCORR = 10
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
3151 CONTINUE
IVTNUM = 315
C
C **** TEST 315 ****
C
IF (ICZERO) 33150, 3150, 33150
3150 CONTINUE
IVON03 = 4
IVCOMP = (9-3)-IVON03
GO TO 43150
33150 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 43150, 3161, 43150
43150 IF (IVCOMP-2) 23150,13150,23150
13150 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 3161
23150 IVFAIL = IVFAIL + 1
IVCORR = 2
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
3161 CONTINUE
IVTNUM = 316
C
C **** TEST 316 ****
C
IF (ICZERO) 33160, 3160, 33160
3160 CONTINUE
IVON01 = -9
IVCOMP = (IVON01-3)-4
GO TO 43160
33160 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 43160, 3171, 43160
43160 IF (IVCOMP +16) 23160,13160,23160
13160 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 3171
23160 IVFAIL = IVFAIL + 1
IVCORR = -16
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
3171 CONTINUE
IVTNUM = 317
C
C **** TEST 317 ****
C
IF (ICZERO) 33170, 3170, 33170
3170 CONTINUE
IVON02 = -3
IVCOMP = 9-(IVON02-4)
GO TO 43170
33170 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 43170, 3181, 43170
43170 IF (IVCOMP-16) 23170,13170,23170
13170 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 3181
23170 IVFAIL = IVFAIL + 1
IVCORR = 16
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
3181 CONTINUE
IVTNUM = 318
C
C **** TEST 318 ****
C
IF (ICZERO) 33180, 3180, 33180
3180 CONTINUE
IVON03 = +4
IVCOMP = 9 - (3 - IVON03)
GO TO 43180
33180 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 43180, 3191, 43180
43180 IF (IVCOMP - 10) 23180,13180,23180
13180 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 3191
23180 IVFAIL = IVFAIL + 1
IVCORR= 10
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
3191 CONTINUE
IVTNUM = 319
C
C **** TEST 319 ****
C
IF (ICZERO) 33190, 3190, 33190
3190 CONTINUE
IVON02 = 11111
IVCOMP = (32333-IVON02) -11111
GO TO 43190
33190 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 43190, 3201, 43190
43190 IF (IVCOMP - 10111) 23190,13190,23190
13190 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 3201
23190 IVFAIL = IVFAIL + 1
IVCORR = 10111
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
C
C TEST 320 THROUGH TEST 329 CONTAIN 2 INTEGER VARIABLES AND
C OPERATOR - IN AN ARITHMETIC EXPRESSION. THE INTEGER VARIABLES
C CONTAIN POSITIVE AND NEGATIVE VALUES.
C
3201 CONTINUE
IVTNUM = 320
C
C **** TEST 320 ****
C
IF (ICZERO) 33200, 3200, 33200
3200 CONTINUE
IVON01 = 3
IVON02 = 2
IVCOMP = IVON01 - IVON02
GO TO 43200
33200 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 43200, 3211, 43200
43200 IF (IVCOMP - 1) 23200,13200,23200
13200 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 3211
23200 IVFAIL = IVFAIL + 1
IVCORR = 1
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
3211 CONTINUE
IVTNUM = 321
C
C **** TEST 321 ****
C
IF (ICZERO) 33210, 3210, 33210
3210 CONTINUE
IVON01 =2
IVON02 =3
IVCOMP = IVON01 - IVON02
GO TO 43210
33210 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 43210, 3221, 43210
43210 IF (IVCOMP +1) 23210,13210,23210
13210 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 3221
23210 IVFAIL = IVFAIL + 1
IVCORR = -1
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
3221 CONTINUE
IVTNUM = 322
C
C **** TEST 322 ****
C
IF (ICZERO) 33220, 3220, 33220
3220 CONTINUE
IVON01 = -2
IVON02 = 3
IVCOMP = IVON01 - IVON02
GO TO 43220
33220 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 43220, 3231, 43220
43220 IF (IVCOMP +5) 23220,13220,23220
13220 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 3231
23220 IVFAIL = IVFAIL + 1
IVCORR =-5
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
3231 CONTINUE
IVTNUM = 323
C
C **** TEST 323 ****
C
IF (ICZERO) 33230, 3230, 33230
3230 CONTINUE
IVON01 = -2
IVON02 = -3
IVCOMP = IVON01 - IVON02
GO TO 43230
33230 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 43230, 3241, 43230
43230 IF (IVCOMP -1) 23230,13230,23230
13230 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 3241
23230 IVFAIL = IVFAIL + 1
IVCORR = 1
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
3241 CONTINUE
IVTNUM = 324
C
C **** TEST 324 ****
C
IF (ICZERO) 33240, 3240, 33240
3240 CONTINUE
IVON01 = 51
IVON02 = 52
IVCOMP = IVON01 - IVON02
GO TO 43240
33240 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 43240, 3251, 43240
43240 IF (IVCOMP + 1) 23240,13240,23240
13240 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 3251
23240 IVFAIL = IVFAIL + 1
IVCORR = -1
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
3251 CONTINUE
IVTNUM = 325
C
C **** TEST 325 ****
C
IF (ICZERO) 33250, 3250, 33250
3250 CONTINUE
IVON01 = 676
IVON02 =-189
IVCOMP = IVON01 - IVON02
GO TO 43250
33250 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 43250, 3261, 43250
43250 IF (IVCOMP - 865) 23250,13250,23250
13250 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 3261
23250 IVFAIL = IVFAIL + 1
IVCORR = 865
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
3261 CONTINUE
IVTNUM = 326
C
C **** TEST 326 ****
C
IF (ICZERO) 33260, 3260, 33260
3260 CONTINUE
IVON01 = 1358
IVON02 = -8001
IVCOMP = IVON01 - IVON02
GO TO 43260
33260 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 43260, 3271, 43260
43260 IF (IVCOMP - 9359) 23260,13260,23260
13260 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 3271
23260 IVFAIL = IVFAIL + 1
IVCORR = 9359
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
3271 CONTINUE
IVTNUM = 327
C
C **** TEST 327 ****
C
IF (ICZERO) 33270, 3270, 33270
3270 CONTINUE
IVON01 =-16383
IVON02 = 16383
IVCOMP = IVON01 - IVON02
GO TO 43270
33270 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 43270, 3281, 43270
43270 IF (IVCOMP + 32766) 23270,13270,23270
13270 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 3281
23270 IVFAIL = IVFAIL + 1
IVCORR = -32766
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
3281 CONTINUE
IVTNUM = 328
C
C **** TEST 328 ****
C
IF (ICZERO) 33280, 3280, 33280
3280 CONTINUE
IVON01 = 9876
IVON02 = 189
IVCOMP = IVON01 - IVON02
GO TO 43280
33280 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 43280, 3291, 43280
43280 IF (IVCOMP - 9687) 23280,13280,23280
13280 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 3291
23280 IVFAIL = IVFAIL + 1
IVCORR = 9687
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
3291 CONTINUE
IVTNUM = 329
C
C **** TEST 329 ****
C
IF (ICZERO) 33290, 3290, 33290
3290 CONTINUE
IVON01 = 11112
IVON02 = 11112
IVCOMP = IVON01 - IVON02
GO TO 43290
33290 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 43290, 3301, 43290
43290 IF (IVCOMP) 23290,13290,23290
13290 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 3301
23290 IVFAIL = IVFAIL + 1
IVCORR = 0
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
C
C **** END OF TESTS ****
3301 CONTINUE
C
C WRITE PAGE FOOTINGS AND RUN SUMMARIES
99999 CONTINUE
WRITE (I02,90002)
WRITE (I02,90006)
WRITE (I02,90002)
WRITE (I02,90002)
WRITE (I02,90007)
WRITE (I02,90002)
WRITE (I02,90008) IVFAIL
WRITE (I02,90009) IVPASS
WRITE (I02,90010) IVDELE
C
C
C TERMINATE ROUTINE EXECUTION
STOP
C
C FORMAT STATEMENTS FOR PAGE HEADERS
90000 FORMAT (1H1)
90002 FORMAT (1H )
90001 FORMAT (1H ,10X,34HFORTRAN COMPILER VALIDATION SYSTEM)
90003 FORMAT (1H ,21X,11HVERSION 1.0)
90004 FORMAT (1H ,10X,38HFOR OFFICIAL USE ONLY - COPYRIGHT 1978)
90005 FORMAT (1H ,5X,4HTEST,5X,9HPASS/FAIL, 5X,8HCOMPUTED,8X,7HCORRECT)
90006 FORMAT (1H ,5X,46H----------------------------------------------)
90011 FORMAT (1H ,18X,17HSUBSET LEVEL TEST)
C
C FORMAT STATEMENTS FOR RUN SUMMARIES
90008 FORMAT (1H ,15X,I5,19H ERRORS ENCOUNTERED)
90009 FORMAT (1H ,15X,I5,13H TESTS PASSED)
90010 FORMAT (1H ,15X,I5,14H TESTS DELETED)
C
C FORMAT STATEMENTS FOR TEST RESULTS
80001 FORMAT (1H ,4X,I5,7X,4HPASS)
80002 FORMAT (1H ,4X,I5,7X,4HFAIL)
80003 FORMAT (1H ,4X,I5,7X,7HDELETED)
80004 FORMAT (1H ,4X,I5,7X,4HFAIL,10X,I6,9X,I6)
80005 FORMAT (1H ,4X,I5,7X,4HFAIL,4X,E12.5,3X,E12.5)
C
90007 FORMAT (1H ,20X,20HEND OF PROGRAM FM031)
END
*END-OF,FM031
FM032.f 480976016 170 2 100666 20839 `
*HEADER,FORTR,FM032
*FILES1,FORTR,FM032,X
C COMMENT SECTION
C
C FM032
C
C THIS ROUTINE TESTS ARITHMETIC ASSIGNMENT STATEMENTS OF THE
C FORM
C INTEGER VARIABLE = ARITHMETIC EXPRESSION
C WHERE THE ARITHMETIC EXPRESSION IS FORMED WITH THE ARITHMETIC
C OPERATOR -, INTEGER CONSTANTS AND INTEGER VARIABLES. SOME OF THE
C TESTS USE PARENTHESES TO GROUP ELEMENTS IN AN ARITHMETIC
C EXPRESSION.
C
C THERE ARE TESTS WHERE THE ARITHMETIC EXPRESSION CONTAINS
C (1) INTEGER VAR.= INT. VAR. - INT.VAR.-INT.CON
C = INT. VAR. - INT.CON.-INT.VAR
C = INT. CON. - INT.VAR -INT.VAR.
C (2) SAME FORMS AS (1) BUT WITH PARENTHESES TO GROUP ELEMENTS
C IN ARITHMETIC EXPRESSION.
C
C REFERENCES
C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN,
C X3.9-1978
C
C SECTION 4.3, INTEGER TYPE
C SECTION 4.3.1, INTEGER CONSTANT
C SECTION 6.1, ARITHMETIC EXPRESSIONS
C SECTION 10.1, ARITHMETIC ASSIGNMENT STATEMENT
C
C
C **********************************************************
C
C A COMPILER VALIDATION SYSTEM FOR THE FORTRAN LANGUAGE
C BASED ON SPECIFICATIONS AS DEFINED IN AMERICAN NATIONAL STANDARD
C PROGRAMMING LANGUAGE FORTRAN X3.9-1978, HAS BEEN DEVELOPED BY THE
C FEDERAL COBOL COMPILER TESTING SERVICE. THE FORTRAN COMPILER
C VALIDATION SYSTEM (FCVS) CONSISTS OF AUDIT ROUTINES, THEIR RELATED
C DATA, AND AN EXECUTIVE SYSTEM. EACH AUDIT ROUTINE IS A FORTRAN
C PROGRAM, SUBPROGRAM OR FUNCTION WHICH INCLUDES TESTS OF SPECIFIC
C LANGUAGE ELEMENTS AND SUPPORTING PROCEDURES INDICATING THE RESULT
C OF EXECUTING THESE TESTS.
C
C THIS PARTICULAR PROGRAM/SUBPROGRAM/FUNCTION CONTAINS FEATURES
C FOUND ONLY IN THE SUBSET AS DEFINED IN X3.9-1978.
C
C SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO -
C
C DEPARTMENT OF THE NAVY
C FEDERAL COBOL COMPILER TESTING SERVICE
C WASHINGTON, D.C. 20376
C
C **********************************************************
C
C
C
C INITIALIZATION SECTION
C
C INITIALIZE CONSTANTS
C **************
C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER.
I01 = 5
C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER.
I02 = 6
C SYSTEM ENVIRONMENT SECTION
C
CX010 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-010 CONTROL CARD.
C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5
C (UNIT NUMBER FOR CARD READER).
CX011 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-011 CONTROL CARD.
C THE CX011 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL
C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX010 ABOVE.
C
CX020 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-020 CONTROL CARD.
C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02 = 6
C (UNIT NUMBER FOR PRINTER).
CX021 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-021 CONTROL CARD.
C THE CX021 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL
C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX020 ABOVE.
C
IVPASS=0
IVFAIL=0
IVDELE=0
ICZERO=0
C
C WRITE PAGE HEADERS
WRITE (I02,90000)
WRITE (I02,90001)
WRITE (I02,90002)
WRITE (I02, 90002)
WRITE (I02,90003)
WRITE (I02,90002)
WRITE (I02,90004)
WRITE (I02,90002)
WRITE (I02,90011)
WRITE (I02,90002)
WRITE (I02,90002)
WRITE (I02,90005)
WRITE (I02,90006)
WRITE (I02,90002)
C TEST SECTION
C
C ARITHMETIC ASSIGNMENT STATEMENT
C
C TEST 330 THROUGH TEST 347 CONTAIN TWO INTEGER VARIABLES, AN
C INTEGER CONSTANT AND OPERATOR - IN AN ARITHMETIC EXPRESSION. THE
C INTEGER VARIABLES CONTAIN POSITIVE AND NEGATIVE VALUES.
C
C TEST 330 THROUGH TEST 337 IV = IV -IV -IC
C
3301 CONTINUE
IVTNUM = 330
C
C **** TEST 330 ****
C
IF (ICZERO) 33300, 3300, 33300
3300 CONTINUE
IVON01 =9
IVON02 =4
IVCOMP = IVON01-IVON02-2
GO TO 43300
33300 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 43300, 3311, 43300
43300 IF (IVCOMP-3) 23300,13300,23300
13300 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 3311
23300 IVFAIL = IVFAIL + 1
IVCORR= 3
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
3311 CONTINUE
IVTNUM = 331
C
C **** TEST 331 ****
C
IF (ICZERO) 33310, 3310, 33310
3310 CONTINUE
IVON01 =-9
IVON02 = 4
IVCOMP = IVON01-IVON02-2
GO TO 43310
33310 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 43310, 3321, 43310
43310 IF (IVCOMP +15) 23310,13310,23310
13310 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 3321
23310 IVFAIL = IVFAIL + 1
IVCORR = -15
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
3321 CONTINUE
IVTNUM = 332
C
C **** TEST 332 ****
C
IF (ICZERO) 33320, 3320, 33320
3320 CONTINUE
IVON01 =9
IVON02 =-4
IVCOMP =IVON01-IVON02-2
GO TO 43320
33320 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 43320, 3331, 43320
43320 IF (IVCOMP-11) 23320,13320,23320
13320 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 3331
23320 IVFAIL = IVFAIL + 1
IVCORR = 11
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
3331 CONTINUE
IVTNUM = 333
C
C **** TEST 333 ****
C
IF (ICZERO) 33330, 3330, 33330
3330 CONTINUE
IVON01 =57
IVON02 =25
IVCOMP=IVON01-IVON02-22
GO TO 43330
33330 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 43330, 3341, 43330
43330 IF (IVCOMP -10) 23330,13330,23330
13330 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 3341
23330 IVFAIL = IVFAIL + 1
IVCORR = 10
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
3341 CONTINUE
IVTNUM = 334
C
C **** TEST 334 ****
C
IF (ICZERO) 33340, 3340, 33340
3340 CONTINUE
IVON01 = 101
IVON02 = 683
IVCOMP = IVON01 - IVON02 - 156
GO TO 43340
33340 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 43340, 3351, 43340
43340 IF (IVCOMP +738) 23340,13340,23340
13340 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 3351
23340 IVFAIL = IVFAIL + 1
IVCORR = -738
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
3351 CONTINUE
IVTNUM = 335
C
C **** TEST 335 ****
C
IF (ICZERO) 33350, 3350, 33350
3350 CONTINUE
IVON01=8542
IVON02=1122
IVCOMP=IVON01-IVON02-1289
GO TO 43350
33350 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 43350, 3361, 43350
43350 IF (IVCOMP -6131) 23350,13350,23350
13350 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 3361
23350 IVFAIL = IVFAIL + 1
IVCORR = 6131
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
3361 CONTINUE
IVTNUM = 336
C
C **** TEST 336 ****
C
IF (ICZERO) 33360, 3360, 33360
3360 CONTINUE
IVON01 = 31333
IVON02 = 11111
IVCOMP = IVON01-IVON02-10111
GO TO 43360
33360 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 43360, 3371, 43360
43360 IF (IVCOMP -10111) 23360,13360,23360
13360 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 3371
23360 IVFAIL = IVFAIL + 1
IVCORR = 10111
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
3371 CONTINUE
IVTNUM = 337
C
C **** TEST 337 ****
C
IF (ICZERO) 33370, 3370, 33370
3370 CONTINUE
IVON01 = -31444
IVON02 = +1001
IVCOMP = IVON01-IVON02-300
GO TO 43370
33370 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 43370, 3381, 43370
43370 IF (IVCOMP +32745) 23370,13370,23370
13370 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 3381
23370 IVFAIL = IVFAIL + 1
IVCORR = -32745
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
C
C TEST 338 THROUGH TEST 343 IV=IV-IC-IV
C
3381 CONTINUE
IVTNUM = 338
C
C **** TEST 338 ****
C
IF (ICZERO) 33380, 3380, 33380
3380 CONTINUE
IVON01 =9
IVON03 =2
IVCOMP = IVON01-4-IVON03
GO TO 43380
33380 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 43380, 3391, 43380
43380 IF (IVCOMP -3) 23380,13380,23380
13380 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 3391
23380 IVFAIL = IVFAIL + 1
IVCORR = 3
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
3391 CONTINUE
IVTNUM = 339
C
C **** TEST 339 ****
C
IF (ICZERO) 33390, 3390, 33390
3390 CONTINUE
IVON01 = -9
IVON03 = 2
IVCOMP = IVON01-4-IVON03
GO TO 43390
33390 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 43390, 3401, 43390
43390 IF (IVCOMP+15) 23390,13390,23390
13390 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 3401
23390 IVFAIL = IVFAIL + 1
IVCORR = -15
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
3401 CONTINUE
IVTNUM = 340
C
C **** TEST 340 ****
C
IF (ICZERO) 33400, 3400, 33400
3400 CONTINUE
IVON01 = 9
IVON03 =-2
IVCOMP =IVON01-4-IVON03
GO TO 43400
33400 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 43400, 3411, 43400
43400 IF (IVCOMP-7) 23400,13400,23400
13400 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 3411
23400 IVFAIL = IVFAIL + 1
IVCORR=7
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
3411 CONTINUE
IVTNUM = 341
C
C **** TEST 341 ****
C
IF (ICZERO) 33410, 3410, 33410
3410 CONTINUE
IVON01=-57
IVON03=22
IVCOMP=IVON01-25-IVON03
GO TO 43410
33410 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 43410, 3421, 43410
43410 IF (IVCOMP+104) 23410,13410,23410
13410 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 3421
23410 IVFAIL = IVFAIL + 1
IVCORR = -104
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
3421 CONTINUE
IVTNUM = 342
C
C **** TEST 342 ****
C
IF (ICZERO) 33420, 3420, 33420
3420 CONTINUE
IVON01=8542
IVON03=3
IVCOMP=IVON01-125-IVON03
GO TO 43420
33420 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 43420, 3431, 43420
43420 IF (IVCOMP-8414) 23420,13420,23420
13420 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 3431
23420 IVFAIL = IVFAIL + 1
IVCORR = 8414
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
3431 CONTINUE
IVTNUM = 343
C
C **** TEST 343 ****
C
IF (ICZERO) 33430, 3430, 33430
3430 CONTINUE
IVON01 = -32111
IVON03 = -111
IVCOMP = IVON01-111-IVON03
GO TO 43430
33430 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 43430, 3441, 43430
43430 IF (IVCOMP + 32111) 23430,13430,23430
13430 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 3441
23430 IVFAIL = IVFAIL + 1
IVCORR = -32111
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
C
C TEST 344 THROUGH TEST 347 IV=IC-IV-IV
C
3441 CONTINUE
IVTNUM = 344
C
C **** TEST 344 ****
C
IF (ICZERO) 33440, 3440, 33440
3440 CONTINUE
IVON02=4
IVON03=2
IVCOMP=9-IVON02-IVON03
GO TO 43440
33440 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 43440, 3451, 43440
43440 IF (IVCOMP -3) 23440,13440,23440
13440 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 3451
23440 IVFAIL = IVFAIL + 1
IVCORR = 3
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
3451 CONTINUE
IVTNUM = 345
C
C **** TEST 345 ****
C
IF (ICZERO) 33450, 3450, 33450
3450 CONTINUE
IVON02=-4
IVON03= 2
IVCOMP= 9-IVON02-IVON03
GO TO 43450
33450 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 43450, 3461, 43450
43450 IF (IVCOMP -11) 23450,13450,23450
13450 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 3461
23450 IVFAIL = IVFAIL + 1
IVCORR =11
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
3461 CONTINUE
IVTNUM = 346
C
C **** TEST 346 ****
C
IF (ICZERO) 33460, 3460, 33460
3460 CONTINUE
IVON02 = 683
IVON03 = 156
IVCOMP = 101 -IVON02-IVON03
GO TO 43460
33460 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 43460, 3471, 43460
43460 IF (IVCOMP +738) 23460,13460,23460
13460 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 3471
23460 IVFAIL = IVFAIL + 1
IVCORR = -738
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
3471 CONTINUE
IVTNUM = 347
C
C **** TEST 347 ****
C
IF (ICZERO) 33470, 3470, 33470
3470 CONTINUE
IVON02 = 15687
IVON03 = 387
IVCOMP = 8542-IVON02-IVON03
GO TO 43470
33470 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 43470, 3481, 43470
43470 IF (IVCOMP + 7532) 23470,13470,23470
13470 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 3481
23470 IVFAIL = IVFAIL + 1
IVCORR = -7532
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
C
C TEST 348 THROUGH TEST 359 CONTAIN TWO INTEGER VARIABLES, AN
C INTEGER CONSTANT AND OPERATOR - IN AN ARITHMETIC EXPRESSION.
C PARENTHESES ARE USED TO GROUP THE ELEMENTS IN THE ARITHMETIC
C EXPRESSION. THE INTEGER VARIABLES CONTAIN POSITIVE AND NEGATIVE
C VALUES.
C
3481 CONTINUE
IVTNUM = 348
C
C **** TEST 348 ****
C
IF (ICZERO) 33480, 3480, 33480
3480 CONTINUE
IVON01= 9
IVON02= 4
IVCOMP=(IVON01-IVON02)-2
GO TO 43480
33480 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 43480, 3491, 43480
43480 IF (IVCOMP - 3) 23480,13480,23480
13480 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 3491
23480 IVFAIL = IVFAIL + 1
IVCORR = 3
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
3491 CONTINUE
IVTNUM = 349
C
C **** TEST 349 ****
C
IF (ICZERO) 33490, 3490, 33490
3490 CONTINUE
IVON01=9
IVON02=4
IVCOMP=IVON01-(IVON02-2)
GO TO 43490
33490 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 43490, 3501, 43490
43490 IF (IVCOMP -7) 23490,13490,23490
13490 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 3501
23490 IVFAIL = IVFAIL + 1
IVCORR=7
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
3501 CONTINUE
IVTNUM = 350
C
C **** TEST 350 ****
C
IF (ICZERO) 33500, 3500, 33500
3500 CONTINUE
IVON01 = 9
IVON02 = -4
IVCOMP = (IVON01-IVON02) -2
GO TO 43500
33500 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 43500, 3511, 43500
43500 IF (IVCOMP -11) 23500,13500,23500
13500 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 3511
23500 IVFAIL = IVFAIL + 1
IVCORR = 11
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
3511 CONTINUE
IVTNUM = 351
C
C **** TEST 351 ****
C
IF (ICZERO) 33510, 3510, 33510
3510 CONTINUE
IVON01 = 9
IVON02 = -4
IVCOMP = IVON01-(IVON02-2)
GO TO 43510
33510 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 43510, 3521, 43510
43510 IF (IVCOMP - 15) 23510,13510,23510
13510 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 3521
23510 IVFAIL = IVFAIL + 1
IVCORR = 15
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
3521 CONTINUE
IVTNUM = 352
C
C **** TEST 352 ****
C
IF (ICZERO) 33520, 3520, 33520
3520 CONTINUE
IVON01 = 683
IVON03 = 156
IVCOMP = (IVON01-101)-IVON03
GO TO 43520
33520 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 43520, 3531, 43520
43520 IF (IVCOMP - 426) 23520,13520,23520
13520 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 3531
23520 IVFAIL = IVFAIL + 1
IVCORR = 426
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
3531 CONTINUE
IVTNUM = 353
C
C **** TEST 353 ****
C
IF (ICZERO) 33530, 3530, 33530
3530 CONTINUE
IVON01 = 683
IVON03 = 156
IVCOMP = IVON01 -(101-IVON03)
GO TO 43530
33530 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 43530, 3541, 43530
43530 IF (IVCOMP -738) 23530,13530,23530
13530 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 3541
23530 IVFAIL = IVFAIL + 1
IVCORR = 738
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
3541 CONTINUE
IVTNUM = 354
C
C **** TEST 354 ****
C
IF (ICZERO) 33540, 3540, 33540
3540 CONTINUE
IVON01 = 683
IVON03 =-156
IVCOMP = IVON01 -(101-IVON03)
GO TO 43540
33540 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 43540, 3551, 43540
43540 IF (IVCOMP -426) 23540,13540,23540
13540 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 3551
23540 IVFAIL = IVFAIL + 1
IVCORR = 426
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
3551 CONTINUE
IVTNUM = 355
C
C **** TEST 355 ****
C
IF (ICZERO) 33550, 3550, 33550
3550 CONTINUE
IVON01 = -683
IVON03 = -156
IVCOMP = (IVON01-101)-IVON03
GO TO 43550
33550 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 43550, 3561, 43550
43550 IF (IVCOMP +628) 23550,13550,23550
13550 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 3561
23550 IVFAIL = IVFAIL + 1
IVCORR = -628
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
3561 CONTINUE
IVTNUM = 356
C
C **** TEST 356 ****
C
IF (ICZERO) 33560, 3560, 33560
3560 CONTINUE
IVON02 = 15687
IVON03 = 387
IVCOMP = (8542-IVON02)-IVON03
GO TO 43560
33560 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 43560, 3571, 43560
43560 IF (IVCOMP +7532) 23560,13560,23560
13560 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 3571
23560 IVFAIL = IVFAIL + 1
IVCORR = -7532
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
3571 CONTINUE
IVTNUM = 357
C
C **** TEST 357 ****
C
IF (ICZERO) 33570, 3570, 33570
3570 CONTINUE
IVON02= 15687
IVON03= 387
IVCOMP= 8542-(IVON02-IVON03)
GO TO 43570
33570 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 43570, 3581, 43570
43570 IF (IVCOMP + 6758) 23570,13570,23570
13570 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 3581
23570 IVFAIL = IVFAIL + 1
IVCORR = -6758
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
3581 CONTINUE
IVTNUM = 358
C
C **** TEST 358 ****
C
IF (ICZERO) 33580, 3580, 33580
3580 CONTINUE
IVON02 = -15687
IVON03 = 387
IVCOMP =(8542-IVON02)-IVON03
GO TO 43580
33580 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 43580, 3591, 43580
43580 IF (IVCOMP - 23842) 23580,13580,23580
13580 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 3591
23580 IVFAIL = IVFAIL + 1
IVCORR =23842
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
3591 CONTINUE
IVTNUM = 359
C
C **** TEST 359 ****
C
IF (ICZERO) 33590, 3590, 33590
3590 CONTINUE
IVON02 = -15687
IVON03 = 387
IVCOMP = 8542-(IVON02-IVON03)
GO TO 43590
33590 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 43590, 3601, 43590
43590 IF (IVCOMP - 24616) 23590,13590,23590
13590 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 3601
23590 IVFAIL = IVFAIL + 1
IVCORR = 24616
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
C **** END OF TESTS ****
3601 CONTINUE
C
C WRITE PAGE FOOTINGS AND RUN SUMMARIES
99999 CONTINUE
WRITE (I02,90002)
WRITE (I02,90006)
WRITE (I02,90002)
WRITE (I02,90002)
WRITE (I02,90007)
WRITE (I02,90002)
WRITE (I02,90008) IVFAIL
WRITE (I02,90009) IVPASS
WRITE (I02,90010) IVDELE
C
C
C TERMINATE ROUTINE EXECUTION
STOP
C
C FORMAT STATEMENTS FOR PAGE HEADERS
90000 FORMAT (1H1)
90002 FORMAT (1H )
90001 FORMAT (1H ,10X,34HFORTRAN COMPILER VALIDATION SYSTEM)
90003 FORMAT (1H ,21X,11HVERSION 1.0)
90004 FORMAT (1H ,10X,38HFOR OFFICIAL USE ONLY - COPYRIGHT 1978)
90005 FORMAT (1H ,5X,4HTEST,5X,9HPASS/FAIL, 5X,8HCOMPUTED,8X,7HCORRECT)
90006 FORMAT (1H ,5X,46H----------------------------------------------)
90011 FORMAT (1H ,18X,17HSUBSET LEVEL TEST)
C
C FORMAT STATEMENTS FOR RUN SUMMARIES
90008 FORMAT (1H ,15X,I5,19H ERRORS ENCOUNTERED)
90009 FORMAT (1H ,15X,I5,13H TESTS PASSED)
90010 FORMAT (1H ,15X,I5,14H TESTS DELETED)
C
C FORMAT STATEMENTS FOR TEST RESULTS
80001 FORMAT (1H ,4X,I5,7X,4HPASS)
80002 FORMAT (1H ,4X,I5,7X,4HFAIL)
80003 FORMAT (1H ,4X,I5,7X,7HDELETED)
80004 FORMAT (1H ,4X,I5,7X,4HFAIL,10X,I6,9X,I6)
80005 FORMAT (1H ,4X,I5,7X,4HFAIL,4X,E12.5,3X,E12.5)
C
90007 FORMAT (1H ,20X,20HEND OF PROGRAM FM032)
END
*END-OF,FM032
FM033.f 480976018 170 2 100666 21917 `
*HEADER,FORTR,FM033
*FILES1,FORTR,FM033,X
C COMMENT SECTION
C
C FM033
C
C THIS ROUTINE TESTS ARITHMETIC ASSIGNMENT STATEMENTS OF THE
C FORM
C INTEGER VARIABLE = ARITHMETIC EXPRESSION
C WHERE THE ARITHMETIC EXPRESSION IS FORMED WITH THE ARITHMETIC
C OPERATOR * AND INTEGER CONSTANTS. SOME OF THE TESTS USE PARENS
C TO GROUP ELEMENTS IN THE EXPRESSION AND TO ALLOW THE USE OF
C NEGATIVE CONSTANTS FOLLOWING THE * OPERATOR.
C
C THERE ARE TESTS WHERE THE ARITHMETIC EXPRESSION CONTAINS
C (1) INTEGER CONSTANT * INTEGER CONSTANT
C (2) INTEGER CONSTANT * INTEGER CONSTANT * INTEGER CONSTANT
C (3) SAME AS (2) BUT WITH PARENS TO GROUP ELEMENTS
C
C REFERENCES
C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN,
C X3.9-1978
C
C SECTION 4.3, INTEGER TYPE
C SECTION 4.3.1, INTEGER CONSTANT
C SECTION 6.1, ARITHMETIC EXPRESSIONS
C SECTION 10.1, ARITHMETIC ASSIGNMENT STATEMENT
C
C **********************************************************
C
C A COMPILER VALIDATION SYSTEM FOR THE FORTRAN LANGUAGE
C BASED ON SPECIFICATIONS AS DEFINED IN AMERICAN NATIONAL STANDARD
C PROGRAMMING LANGUAGE FORTRAN X3.9-1978, HAS BEEN DEVELOPED BY THE
C FEDERAL COBOL COMPILER TESTING SERVICE. THE FORTRAN COMPILER
C VALIDATION SYSTEM (FCVS) CONSISTS OF AUDIT ROUTINES, THEIR RELATED
C DATA, AND AN EXECUTIVE SYSTEM. EACH AUDIT ROUTINE IS A FORTRAN
C PROGRAM, SUBPROGRAM OR FUNCTION WHICH INCLUDES TESTS OF SPECIFIC
C LANGUAGE ELEMENTS AND SUPPORTING PROCEDURES INDICATING THE RESULT
C OF EXECUTING THESE TESTS.
C
C THIS PARTICULAR PROGRAM/SUBPROGRAM/FUNCTION CONTAINS FEATURES
C FOUND ONLY IN THE SUBSET AS DEFINED IN X3.9-1978.
C
C SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO -
C
C DEPARTMENT OF THE NAVY
C FEDERAL COBOL COMPILER TESTING SERVICE
C WASHINGTON, D.C. 20376
C
C **********************************************************
C
C
C
C INITIALIZATION SECTION
C
C INITIALIZE CONSTANTS
C **************
C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER.
I01 = 5
C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER.
I02 = 6
C SYSTEM ENVIRONMENT SECTION
C
CX010 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-010 CONTROL CARD.
C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5
C (UNIT NUMBER FOR CARD READER).
CX011 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-011 CONTROL CARD.
C THE CX011 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL
C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX010 ABOVE.
C
CX020 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-020 CONTROL CARD.
C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02 = 6
C (UNIT NUMBER FOR PRINTER).
CX021 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-021 CONTROL CARD.
C THE CX021 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL
C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX020 ABOVE.
C
IVPASS=0
IVFAIL=0
IVDELE=0
ICZERO=0
C
C WRITE PAGE HEADERS
WRITE (I02,90000)
WRITE (I02,90001)
WRITE (I02,90002)
WRITE (I02, 90002)
WRITE (I02,90003)
WRITE (I02,90002)
WRITE (I02,90004)
WRITE (I02,90002)
WRITE (I02,90011)
WRITE (I02,90002)
WRITE (I02,90002)
WRITE (I02,90005)
WRITE (I02,90006)
WRITE (I02,90002)
C
C TEST SECTION
C
C ARITHMETIC ASSIGNMENT STATEMENT
C
C TEST 360 THROUGH TEST 376 CONTAIN TWO INTEGER CONSTANTS AND
C OPERATOR * IN AN ARITHMETIC EXPRESSION.
C IV = IC * IC
C
C TEST 360 THROUGH TEST 365 - INTEGER CONSTANTS ARE POSITIVE
C
3601 CONTINUE
IVTNUM = 360
C
C **** TEST 360 ****
C
IF (ICZERO) 33600, 3600, 33600
3600 CONTINUE
IVCOMP = 2 * 3
GO TO 43600
33600 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 43600, 3611, 43600
43600 IF (IVCOMP - 6) 23600,13600,23600
13600 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 3611
23600 IVFAIL = IVFAIL + 1
IVCORR=6
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
3611 CONTINUE
IVTNUM = 361
C
C **** TEST 361 ****
C
IF (ICZERO) 33610, 3610, 33610
3610 CONTINUE
IVCOMP = 3*2
GO TO 43610
33610 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 43610, 3621, 43610
43610 IF (IVCOMP-6) 23610,13610,23610
13610 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 3621
23610 IVFAIL = IVFAIL + 1
IVCORR=6
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
3621 CONTINUE
IVTNUM = 362
C
C **** TEST 362 ****
C
IF (ICZERO) 33620, 3620, 33620
3620 CONTINUE
IVCOMP=13*11
GO TO 43620
33620 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 43620, 3631, 43620
43620 IF (IVCOMP-143) 23620,13620,23620
13620 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 3631
23620 IVFAIL = IVFAIL + 1
IVCORR=143
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
3631 CONTINUE
IVTNUM = 363
C
C **** TEST 363 ****
C
IF (ICZERO) 33630, 3630, 33630
3630 CONTINUE
IVCOMP = 223*99
GO TO 43630
33630 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 43630, 3641, 43630
43630 IF (IVCOMP-22077) 23630,13630,23630
13630 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 3641
23630 IVFAIL = IVFAIL + 1
IVCORR=22077
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
3641 CONTINUE
IVTNUM = 364
C
C **** TEST 364 ****
C
IF (ICZERO) 33640, 3640, 33640
3640 CONTINUE
IVCOMP=11235*2
GO TO 43640
33640 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 43640, 3651, 43640
43640 IF (IVCOMP-22470) 23640,13640,23640
13640 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 3651
23640 IVFAIL = IVFAIL + 1
IVCORR=22470
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
3651 CONTINUE
IVTNUM = 365
C
C **** TEST 365 ****
C
IF (ICZERO) 33650, 3650, 33650
3650 CONTINUE
IVCOMP = 2*16383
GO TO 43650
33650 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 43650, 3661, 43650
43650 IF (IVCOMP-32766) 23650,13650,23650
13650 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 3661
23650 IVFAIL = IVFAIL + 1
IVCORR = 32766
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
C
C TEST 366 THROUGH TEST 371
C ONE POSITIVE AND ONE NEGATIVE CONSTANT
C
3661 CONTINUE
IVTNUM = 366
C
C **** TEST 366 ****
C
IF (ICZERO) 33660, 3660, 33660
3660 CONTINUE
IVCOMP =2*(-3)
GO TO 43660
33660 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 43660, 3671, 43660
43660 IF (IVCOMP+6) 23660,13660,23660
13660 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 3671
23660 IVFAIL = IVFAIL + 1
IVCORR = -6
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
3671 CONTINUE
IVTNUM = 367
C
C **** TEST 367 ****
C
IF (ICZERO) 33670, 3670, 33670
3670 CONTINUE
IVCOMP=(-2)*3
GO TO 43670
33670 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 43670, 3681, 43670
43670 IF (IVCOMP+6)23670,13670,23670
13670 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 3681
23670 IVFAIL = IVFAIL + 1
IVCORR =-6
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
3681 CONTINUE
IVTNUM = 368
C
C **** TEST 368 ****
C
IF (ICZERO) 33680, 3680, 33680
3680 CONTINUE
IVCOMP= -2*3
GO TO 43680
33680 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 43680, 3691, 43680
43680 IF (IVCOMP +6) 23680,13680,23680
13680 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 3691
23680 IVFAIL = IVFAIL + 1
IVCORR=-6
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
3691 CONTINUE
IVTNUM = 369
C
C **** TEST 369 ****
C
IF (ICZERO) 33690, 3690, 33690
3690 CONTINUE
IVCOMP = (-13)*11
GO TO 43690
33690 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 43690, 3701, 43690
43690 IF (IVCOMP+143) 23690,13690,23690
13690 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 3701
23690 IVFAIL = IVFAIL + 1
IVCORR=-143
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
3701 CONTINUE
IVTNUM = 370
C
C **** TEST 370 ****
C
IF (ICZERO) 33700, 3700, 33700
3700 CONTINUE
IVCOMP = 223 * (-99)
GO TO 43700
33700 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 43700, 3711, 43700
43700 IF (IVCOMP + 22077) 23700,13700,23700
13700 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 3711
23700 IVFAIL = IVFAIL + 1
IVCORR =-22077
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
3711 CONTINUE
IVTNUM = 371
C
C **** TEST 371 ****
C
IF (ICZERO) 33710, 3710, 33710
3710 CONTINUE
IVCOMP= -2 * 16383
GO TO 43710
33710 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 43710, 3721, 43710
43710 IF (IVCOMP+32766) 23710,13710,23710
13710 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 3721
23710 IVFAIL = IVFAIL + 1
IVCORR= -32766
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
C
C TEST 372 THROUGH TEST 376 - TWO NEGATIVE CONSTANTS
C
3721 CONTINUE
IVTNUM = 372
C
C **** TEST 372 ****
C
IF (ICZERO) 33720, 3720, 33720
3720 CONTINUE
IVCOMP=(-2)*(-3)
GO TO 43720
33720 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 43720, 3731, 43720
43720 IF (IVCOMP-6) 23720,13720,23720
13720 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 3731
23720 IVFAIL = IVFAIL + 1
IVCORR=6
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
3731 CONTINUE
IVTNUM = 373
C
C **** TEST 373 ****
C
IF (ICZERO) 33730, 3730, 33730
3730 CONTINUE
IVCOMP = -2*(-3)
GO TO 43730
33730 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 43730, 3741, 43730
43730 IF (IVCOMP-6) 23730,13730,23730
13730 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 3741
23730 IVFAIL = IVFAIL + 1
IVCORR=6
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
3741 CONTINUE
IVTNUM = 374
C
C **** TEST 374 ****
C
IF (ICZERO) 33740, 3740, 33740
3740 CONTINUE
IVCOMP=(-13)*(-11)
GO TO 43740
33740 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 43740, 3751, 43740
43740 IF (IVCOMP-143) 23740,13740,23740
13740 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 3751
23740 IVFAIL = IVFAIL + 1
IVCORR = 143
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
3751 CONTINUE
IVTNUM = 375
C
C **** TEST 375 ****
C
IF (ICZERO) 33750, 3750, 33750
3750 CONTINUE
IVCOMP= -223 *(-99)
GO TO 43750
33750 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 43750, 3761, 43750
43750 IF (IVCOMP - 22077) 23750,13750,23750
13750 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 3761
23750 IVFAIL = IVFAIL + 1
IVCORR = 22077
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
3761 CONTINUE
IVTNUM = 376
C
C **** TEST 376 ****
C
IF (ICZERO) 33760, 3760, 33760
3760 CONTINUE
IVCOMP = (-16383)*(-2)
GO TO 43760
33760 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 43760, 3771, 43760
43760 IF (IVCOMP - 32766) 23760,13760,23760
13760 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 3771
23760 IVFAIL = IVFAIL + 1
IVCORR =32766
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
C
C TEST 377 THROUGH TEST 394 CONTAIN THREE INTEGER CONSTANTS AND
C OPERATOR * IN AN ARITHMETIC EXPRESSION.
C IV = IC * IC * IC
C
C TEST 377 THROUGH TEST 382 - CONSTANTS ARE POSITIVE
C
3771 CONTINUE
IVTNUM = 377
C
C **** TEST 377 ****
C
IF (ICZERO) 33770, 3770, 33770
3770 CONTINUE
IVCOMP =2*3*4
GO TO 43770
33770 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 43770, 3781, 43770
43770 IF (IVCOMP-24) 23770,13770,23770
13770 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 3781
23770 IVFAIL = IVFAIL + 1
IVCORR = 24
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
3781 CONTINUE
IVTNUM = 378
C
C **** TEST 378 ****
C
IF (ICZERO) 33780, 3780, 33780
3780 CONTINUE
IVCOMP = 2*3*55
GO TO 43780
33780 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 43780, 3791, 43780
43780 IF (IVCOMP-330) 23780,13780,23780
13780 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 3791
23780 IVFAIL = IVFAIL + 1
IVCORR = 330
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
3791 CONTINUE
IVTNUM = 379
C
C **** TEST 379 ****
C
IF (ICZERO) 33790, 3790, 33790
3790 CONTINUE
IVCOMP = 23*51*13
GO TO 43790
33790 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 43790, 3801, 43790
43790 IF (IVCOMP-15249) 23790,13790,23790
13790 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 3801
23790 IVFAIL = IVFAIL + 1
IVCORR = 15249
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
3801 CONTINUE
IVTNUM = 380
C
C **** TEST 380 ****
C
IF (ICZERO) 33800, 3800, 33800
3800 CONTINUE
IVCOMP = 3* 5461* 2
GO TO 43800
33800 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 43800, 3811, 43800
43800 IF (IVCOMP - 32766) 23800,13800,23800
13800 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 3811
23800 IVFAIL = IVFAIL + 1
IVCORR = 32766
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
3811 CONTINUE
IVTNUM = 381
C
C **** TEST 381 ****
C
IF (ICZERO) 33810, 3810, 33810
3810 CONTINUE
IVCOMP = 16383*2*1
GO TO 43810
33810 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 43810, 3821, 43810
43810 IF (IVCOMP-32766) 23810,13810,23810
13810 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 3821
23810 IVFAIL = IVFAIL + 1
IVCORR = 32766
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
3821 CONTINUE
IVTNUM = 382
C
C **** TEST 382 ****
C
IF (ICZERO) 33820, 3820, 33820
3820 CONTINUE
IVCOMP = 3*53*157
GO TO 43820
33820 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 43820, 3831, 43820
43820 IF (IVCOMP-24963) 23820,13820,23820
13820 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 3831
23820 IVFAIL = IVFAIL + 1
IVCORR = 24963
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
C
C TEST 383 THROUGH TEST 386
C THREE POSITIVE INTEGER CONSTANTS GROUPED WITH PARENS.
C
3831 CONTINUE
IVTNUM = 383
C
C **** TEST 383 ****
C
IF (ICZERO) 33830, 3830, 33830
3830 CONTINUE
IVCOMP = (2*3)*4
GO TO 43830
33830 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 43830, 3841, 43830
43830 IF (IVCOMP-24) 23830,13830,23830
13830 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 3841
23830 IVFAIL = IVFAIL + 1
IVCORR = 24
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
3841 CONTINUE
IVTNUM = 384
C
C **** TEST 384 ****
C
IF (ICZERO) 33840, 3840, 33840
3840 CONTINUE
IVCOMP = 2*(3*4)
GO TO 43840
33840 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 43840, 3851, 43840
43840 IF (IVCOMP-24) 23840,13840,23840
13840 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 3851
23840 IVFAIL = IVFAIL + 1
IVCORR = 24
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
3851 CONTINUE
IVTNUM = 385
C
C **** TEST 385 ****
C
IF (ICZERO) 33850, 3850, 33850
3850 CONTINUE
IVCOMP = (3*(+53)) * (+157)
GO TO 43850
33850 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 43850, 3861, 43850
43850 IF (IVCOMP-24963) 23850,13850,23850
13850 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 3861
23850 IVFAIL = IVFAIL + 1
IVCORR = 24963
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
3861 CONTINUE
IVTNUM = 386
C
C **** TEST 386 ****
C
IF (ICZERO) 33860, 3860, 33860
3860 CONTINUE
IVCOMP = 3 *((+53)*157)
GO TO 43860
33860 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 43860, 3871, 43860
43860 IF (IVCOMP-24963) 23860,13860,23860
13860 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 3871
23860 IVFAIL = IVFAIL + 1
IVCORR=24963
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
C
C TEST 387 THROUGH TEST 391
C BOTH POSITIVE AND NEGATIVE CONSTANTS IN ARITHMETIC EXPRESSION.
C
3871 CONTINUE
IVTNUM = 387
C
C **** TEST 387 ****
C
IF (ICZERO) 33870, 3870, 33870
3870 CONTINUE
IVCOMP = 2*3*(-4)
GO TO 43870
33870 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 43870, 3881, 43870
43870 IF (IVCOMP + 24) 23870,13870,23870
13870 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 3881
23870 IVFAIL = IVFAIL + 1
IVCORR = -24
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
3881 CONTINUE
IVTNUM = 388
C
C **** TEST 388 ****
C
IF (ICZERO) 33880, 3880, 33880
3880 CONTINUE
IVCOMP = 2*(-3)*(+4)
GO TO 43880
33880 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 43880, 3891, 43880
43880 IF (IVCOMP + 24) 23880,13880,23880
13880 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 3891
23880 IVFAIL = IVFAIL + 1
IVCORR = -24
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
3891 CONTINUE
IVTNUM = 389
C
C **** TEST 389 ****
C
IF (ICZERO) 33890, 3890, 33890
3890 CONTINUE
IVCOMP = (-2)*3*4
GO TO 43890
33890 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 43890, 3901, 43890
43890 IF (IVCOMP+24) 23890,13890,23890
13890 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 3901
23890 IVFAIL = IVFAIL + 1
IVCORR = -24
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
3901 CONTINUE
IVTNUM = 390
C
C **** TEST 390 ****
C
IF (ICZERO) 33900, 3900, 33900
3900 CONTINUE
IVCOMP = -2*3*4
GO TO 43900
33900 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 43900, 3911, 43900
43900 IF (IVCOMP+24) 23900,13900,23900
13900 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 3911
23900 IVFAIL = IVFAIL + 1
IVCORR = -24
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
3911 CONTINUE
IVTNUM = 391
C
C **** TEST 391 ****
C
IF (ICZERO) 33910, 3910, 33910
3910 CONTINUE
IVCOMP = +2 * (-3) * (-4)
GO TO 43910
33910 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 43910, 3921, 43910
43910 IF (IVCOMP - 24) 23910,13910,23910
13910 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 3921
23910 IVFAIL = IVFAIL + 1
IVCORR = 24
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
C
C TEST 392 THROUGH TEST 394
C ALL CONSTANTS ARE NEGATIVE.
C
3921 CONTINUE
IVTNUM = 392
C
C **** TEST 392 ****
C
IF (ICZERO) 33920, 3920, 33920
3920 CONTINUE
IVCOMP = (-2)*(-3)*(-4)
GO TO 43920
33920 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 43920, 3931, 43920
43920 IF (IVCOMP+24) 23920,13920,23920
13920 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 3931
23920 IVFAIL = IVFAIL + 1
IVCORR = -24
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
3931 CONTINUE
IVTNUM = 393
C
C **** TEST 393 ****
C
IF (ICZERO) 33930, 3930, 33930
3930 CONTINUE
IVCOMP = (-23)*(-51)*(-13)
GO TO 43930
33930 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 43930, 3941, 43930
43930 IF (IVCOMP + 15249) 23930,13930,23930
13930 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 3941
23930 IVFAIL = IVFAIL + 1
IVCORR = -15249
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
3941 CONTINUE
IVTNUM = 394
C
C **** TEST 394 ****
C
IF (ICZERO) 33940, 3940, 33940
3940 CONTINUE
IVCOMP = -3 * (-53)*( -157)
GO TO 43940
33940 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 43940, 3951, 43940
43940 IF (IVCOMP +24963) 23940,13940,23940
13940 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 3951
23940 IVFAIL = IVFAIL + 1
IVCORR = -24963
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
C **** END OF TESTS ****
3951 CONTINUE
C
C WRITE PAGE FOOTINGS AND RUN SUMMARIES
99999 CONTINUE
WRITE (I02,90002)
WRITE (I02,90006)
WRITE (I02,90002)
WRITE (I02,90002)
WRITE (I02,90007)
WRITE (I02,90002)
WRITE (I02,90008) IVFAIL
WRITE (I02,90009) IVPASS
WRITE (I02,90010) IVDELE
C
C
C TERMINATE ROUTINE EXECUTION
STOP
C
C FORMAT STATEMENTS FOR PAGE HEADERS
90000 FORMAT (1H1)
90002 FORMAT (1H )
90001 FORMAT (1H ,10X,34HFORTRAN COMPILER VALIDATION SYSTEM)
90003 FORMAT (1H ,21X,11HVERSION 1.0)
90004 FORMAT (1H ,10X,38HFOR OFFICIAL USE ONLY - COPYRIGHT 1978)
90005 FORMAT (1H ,5X,4HTEST,5X,9HPASS/FAIL, 5X,8HCOMPUTED,8X,7HCORRECT)
90006 FORMAT (1H ,5X,46H----------------------------------------------)
90011 FORMAT (1H ,18X,17HSUBSET LEVEL TEST)
C
C FORMAT STATEMENTS FOR RUN SUMMARIES
90008 FORMAT (1H ,15X,I5,19H ERRORS ENCOUNTERED)
90009 FORMAT (1H ,15X,I5,13H TESTS PASSED)
90010 FORMAT (1H ,15X,I5,14H TESTS DELETED)
C
C FORMAT STATEMENTS FOR TEST RESULTS
80001 FORMAT (1H ,4X,I5,7X,4HPASS)
80002 FORMAT (1H ,4X,I5,7X,4HFAIL)
80003 FORMAT (1H ,4X,I5,7X,7HDELETED)
80004 FORMAT (1H ,4X,I5,7X,4HFAIL,10X,I6,9X,I6)
80005 FORMAT (1H ,4X,I5,7X,4HFAIL,4X,E12.5,3X,E12.5)
C
90007 FORMAT (1H ,20X,20HEND OF PROGRAM FM033)
END
*END-OF,FM033
FM034.f 480976021 170 2 100666 23452 `
*HEADER,FORTR,FM034
*FILES1,FORTR,FM034,X
C COMMENT SECTION
C
C FM034
C
C THIS ROUTINE TESTS ARITHMETIC ASSIGNMENT STATEMENTS OF THE
C FORM
C INTEGER VARIABLE = ARITHMETIC EXPRESSION
C WHERE THE ARITHMETIC EXPRESSION IS FORMED WITH THE ARITHMETIC
C OPERATOR *, INTEGER VARIABLE AND INTEGER CONSTANT. SOME OF THE
C TESTS USE PARENTHESES TO GROUP ELEMENTS IN THE EXPRESSION AND TO
C ALLOW THE USE OF NEGATIVE CONSTANTS FOLLOWING THE * OPERATOR.
C THE INTEGER VARIABLES CONTAIN POSITIVE AND NEGATIVE VALUES.
C
C THERE ARE TESTS WHERE THE ARITHMETIC EXPRESSION CONTAINS
C (1) INTEGER VARIABLE * INTEGER CONSTANT
C INTEGER CONSTANT * INTEGER VARIABLE
C (2) INTEGER CONSTANT * INTEGER VARIABLE * INTEGER CONSTANT
C (3) SAME AS (2) BUT WITH PARENS TO GROUP ELEMENTS.
C
C REFERENCES
C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN,
C X3.9-1978
C
C SECTION 4.3, INTEGER TYPE
C SECTION 4.3.1, INTEGER CONSTANT
C SECTION 6.1, ARITHMETIC EXPRESSIONS
C SECTION 10.1, ARITHMETIC ASSIGNMENT STATEMENT
C
C **********************************************************
C
C A COMPILER VALIDATION SYSTEM FOR THE FORTRAN LANGUAGE
C BASED ON SPECIFICATIONS AS DEFINED IN AMERICAN NATIONAL STANDARD
C PROGRAMMING LANGUAGE FORTRAN X3.9-1978, HAS BEEN DEVELOPED BY THE
C FEDERAL COBOL COMPILER TESTING SERVICE. THE FORTRAN COMPILER
C VALIDATION SYSTEM (FCVS) CONSISTS OF AUDIT ROUTINES, THEIR RELATED
C DATA, AND AN EXECUTIVE SYSTEM. EACH AUDIT ROUTINE IS A FORTRAN
C PROGRAM, SUBPROGRAM OR FUNCTION WHICH INCLUDES TESTS OF SPECIFIC
C LANGUAGE ELEMENTS AND SUPPORTING PROCEDURES INDICATING THE RESULT
C OF EXECUTING THESE TESTS.
C
C THIS PARTICULAR PROGRAM/SUBPROGRAM/FUNCTION CONTAINS FEATURES
C FOUND ONLY IN THE SUBSET AS DEFINED IN X3.9-1978.
C
C SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO -
C
C DEPARTMENT OF THE NAVY
C FEDERAL COBOL COMPILER TESTING SERVICE
C WASHINGTON, D.C. 20376
C
C **********************************************************
C
C
C
C INITIALIZATION SECTION
C
C INITIALIZE CONSTANTS
C **************
C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER.
I01 = 5
C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER.
I02 = 6
C SYSTEM ENVIRONMENT SECTION
C
CX010 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-010 CONTROL CARD.
C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5
C (UNIT NUMBER FOR CARD READER).
CX011 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-011 CONTROL CARD.
C THE CX011 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL
C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX010 ABOVE.
C
CX020 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-020 CONTROL CARD.
C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02 = 6
C (UNIT NUMBER FOR PRINTER).
CX021 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-021 CONTROL CARD.
C THE CX021 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL
C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX020 ABOVE.
C
IVPASS=0
IVFAIL=0
IVDELE=0
ICZERO=0
C
C WRITE PAGE HEADERS
WRITE (I02,90000)
WRITE (I02,90001)
WRITE (I02,90002)
WRITE (I02, 90002)
WRITE (I02,90003)
WRITE (I02,90002)
WRITE (I02,90004)
WRITE (I02,90002)
WRITE (I02,90011)
WRITE (I02,90002)
WRITE (I02,90002)
WRITE (I02,90005)
WRITE (I02,90006)
WRITE (I02,90002)
C
C TEST SECTION
C
C ARITHMETIC ASSIGNMENT STATEMENT
C
C TEST 395 THROUGH TEST 414 CONTAIN AN INTEGER VARIABLE, AN INTEGER
C CONSTANT, AND OPERATOR * IN AN ARITHMETIC EXPRESSION.
C
C TEST 395 THROUGH TEST 406 - IV= IV * IC
C
C TEST 395 THROUGH TEST 398
C POSITIVE INTEGER VARIABLE, POSITIVE INTEGER CONSTANT
C
3951 CONTINUE
IVTNUM = 395
C
C **** TEST 395 ****
C
IF (ICZERO) 33950, 3950, 33950
3950 CONTINUE
IVON01 = 2
IVCOMP = IVON01 * 3
GO TO 43950
33950 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 43950, 3961, 43950
43950 IF (IVCOMP -6) 23950,13950,23950
13950 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 3961
23950 IVFAIL = IVFAIL + 1
IVCORR =6
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
3961 CONTINUE
IVTNUM = 396
C
C **** TEST 396 ****
C
IF (ICZERO) 33960, 3960, 33960
3960 CONTINUE
IVON01 = 13
IVCOMP = IVON01 * 11
GO TO 43960
33960 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 43960, 3971, 43960
43960 IF (IVCOMP - 143) 23960,13960,23960
13960 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 3971
23960 IVFAIL = IVFAIL + 1
IVCORR = 143
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
3971 CONTINUE
IVTNUM = 397
C
C **** TEST 397 ****
C
IF (ICZERO) 33970, 3970, 33970
3970 CONTINUE
IVON01 = 223
IVCOMP = IVON01 * 99
GO TO 43970
33970 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 43970, 3981, 43970
43970 IF (IVCOMP - 22077) 23970,13970,23970
13970 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 3981
23970 IVFAIL = IVFAIL + 1
IVCORR = 22077
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
3981 CONTINUE
IVTNUM = 398
C
C **** TEST 398 ****
C
IF (ICZERO) 33980, 3980, 33980
3980 CONTINUE
IVON01 = 11235
IVCOMP = IVON01 * 2
GO TO 43980
33980 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 43980, 3991, 43980
43980 IF (IVCOMP - 22470) 23980,13980,23980
13980 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 3991
23980 IVFAIL = IVFAIL + 1
IVCORR = 22470
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
C
C TEST 399 THROUGH TEST 402
C NEGATIVE INTEGER VARIABLE, POSITIVE INTEGER CONSTANT
C
3991 CONTINUE
IVTNUM = 399
C
C **** TEST 399 ****
C
IF (ICZERO) 33990, 3990, 33990
3990 CONTINUE
IVON01 = -2
IVCOMP = IVON01 * 3
GO TO 43990
33990 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 43990, 4001, 43990
43990 IF (IVCOMP +6) 23990,13990,23990
13990 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 4001
23990 IVFAIL = IVFAIL + 1
IVCORR = -6
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
4001 CONTINUE
IVTNUM = 400
C
C **** TEST 400 ****
C
IF (ICZERO) 34000, 4000, 34000
4000 CONTINUE
IVON01 = -13
IVCOMP =IVON01*11
GO TO 44000
34000 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 44000, 4011, 44000
44000 IF (IVCOMP +143) 24000,14000,24000
14000 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 4011
24000 IVFAIL = IVFAIL + 1
IVCORR = -143
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
4011 CONTINUE
IVTNUM = 401
C
C **** TEST 401 ****
C
IF (ICZERO) 34010, 4010, 34010
4010 CONTINUE
IVON01 = -223
IVCOMP = IVON01*99
GO TO 44010
34010 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 44010, 4021, 44010
44010 IF (IVCOMP + 22077) 24010,14010,24010
14010 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 4021
24010 IVFAIL = IVFAIL + 1
IVCORR = -22077
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
4021 CONTINUE
IVTNUM = 402
C
C **** TEST 402 ****
C
IF (ICZERO) 34020, 4020, 34020
4020 CONTINUE
IVON01 = -11235
IVCOMP = IVON01*2
GO TO 44020
34020 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 44020, 4031, 44020
44020 IF (IVCOMP+22470) 24020,14020,24020
14020 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 4031
24020 IVFAIL = IVFAIL + 1
IVCORR = -22470
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
C
C TEST 403 AND TEST 404
C NEGATIVE INTEGER VARIABLE, NEGATIVE INTEGER CONSTANT
C
4031 CONTINUE
IVTNUM = 403
C
C **** TEST 403 ****
C
IF (ICZERO) 34030, 4030, 34030
4030 CONTINUE
IVON01=-2
IVCOMP = IVON01*(-3)
GO TO 44030
34030 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 44030, 4041, 44030
44030 IF (IVCOMP -6) 24030,14030,24030
14030 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 4041
24030 IVFAIL = IVFAIL + 1
IVCORR =6
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
4041 CONTINUE
IVTNUM = 404
C
C **** TEST 404 ****
C
IF (ICZERO) 34040, 4040, 34040
4040 CONTINUE
IVON01 = -13
IVCOMP = IVON01 * (-11)
GO TO 44040
34040 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 44040, 4051, 44040
44040 IF (IVCOMP -143) 24040,14040,24040
14040 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 4051
24040 IVFAIL = IVFAIL + 1
IVCORR = 143
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
C
C TEST 405 AND TEST 406
C POSITIVE INTEGER VARIABLE, NEGATIVE INTEGER CONSTANT
C
4051 CONTINUE
IVTNUM = 405
C
C **** TEST 405 ****
C
IF (ICZERO) 34050, 4050, 34050
4050 CONTINUE
IVON01 = 223
IVCOMP = IVON01 * (-99)
GO TO 44050
34050 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 44050, 4061, 44050
44050 IF (IVCOMP + 22077) 24050,14050,24050
14050 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 4061
24050 IVFAIL = IVFAIL + 1
IVCORR = -22077
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
4061 CONTINUE
IVTNUM = 406
C
C **** TEST 406 ****
C
IF (ICZERO) 34060, 4060, 34060
4060 CONTINUE
IVON01 = 11235
IVCOMP = IVON01 * (-2)
GO TO 44060
34060 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 44060, 4071, 44060
44060 IF (IVCOMP + 22470) 24060,14060,24060
14060 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 4071
24060 IVFAIL = IVFAIL + 1
IVCORR = -22470
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
C
C TEST 407 THROUGH TEST 414 - IV = IC * IV
C
C TEST 407 AND TEST 408
C POSITIVE INTEGER CONSTANT, POSITIVE INTEGER VARIABLE
C
4071 CONTINUE
IVTNUM = 407
C
C **** TEST 407 ****
C
IF (ICZERO) 34070, 4070, 34070
4070 CONTINUE
IVON02 = 11
IVCOMP = 13*IVON02
GO TO 44070
34070 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 44070, 4081, 44070
44070 IF (IVCOMP - 143) 24070,14070,24070
14070 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 4081
24070 IVFAIL = IVFAIL + 1
IVCORR = 143
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
4081 CONTINUE
IVTNUM = 408
C
C **** TEST 408 ****
C
IF (ICZERO) 34080, 4080, 34080
4080 CONTINUE
IVON02 = +11
IVCOMP = +13 * IVON02
GO TO 44080
34080 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 44080, 4091, 44080
44080 IF (IVCOMP - 143) 24080,14080,24080
14080 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 4091
24080 IVFAIL = IVFAIL + 1
IVCORR = 143
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
C
C TEST 409 AND TEST 410
C POSITIVE INTEGER CONSTANT, NEGATIVE INTEGER VARIABLE
C
4091 CONTINUE
IVTNUM = 409
C
C **** TEST 409 ****
C
IF (ICZERO) 34090, 4090, 34090
4090 CONTINUE
IVON02 = -99
IVCOMP = 223 * IVON02
GO TO 44090
34090 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 44090, 4101, 44090
44090 IF (IVCOMP + 22077) 24090,14090,24090
14090 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 4101
24090 IVFAIL = IVFAIL + 1
IVCORR =-22077
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
4101 CONTINUE
IVTNUM = 410
C
C **** TEST 410 ****
C
IF (ICZERO) 34100, 4100, 34100
4100 CONTINUE
IVON02 = -99
IVCOMP = +223*IVON02
GO TO 44100
34100 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 44100, 4111, 44100
44100 IF (IVCOMP + 22077) 24100,14100,24100
14100 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 4111
24100 IVFAIL = IVFAIL + 1
IVCORR = -22077
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
C
C TEST 411 AND TEST 412
C NEGATIVE INTEGER CONSTANT, POSITIVE INTEGER VARIABLE
C
4111 CONTINUE
IVTNUM = 411
C
C **** TEST 411 ****
C
IF (ICZERO) 34110, 4110, 34110
4110 CONTINUE
IVON02 = 2
IVCOMP = (-11235) * IVON02
GO TO 44110
34110 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 44110, 4121, 44110
44110 IF (IVCOMP + 22470) 24110,14110,24110
14110 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 4121
24110 IVFAIL = IVFAIL + 1
IVCORR = -22470
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
4121 CONTINUE
IVTNUM = 412
C
C **** TEST 412 ****
C
IF (ICZERO) 34120, 4120, 34120
4120 CONTINUE
IVON02 = +2
IVCOMP = -11235 * IVON02
GO TO 44120
34120 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 44120, 4131, 44120
44120 IF (IVCOMP + 22470) 24120,14120,24120
14120 IVPASS=IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 4131
24120 IVFAIL = IVFAIL + 1
IVCORR = -22470
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
C
C TEST 413 AND TEST 414
C NEGATIVE INTEGER CONSTANT, NEGATIVE INTEGER VARIABLE
C
4131 CONTINUE
IVTNUM = 413
C
C **** TEST 413 ****
C
IF (ICZERO) 34130, 4130, 34130
4130 CONTINUE
IVON02 = -3
IVCOMP = (-2) * IVON02
GO TO 44130
34130 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 44130, 4141, 44130
44130 IF (IVCOMP - 6) 24130,14130,24130
14130 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 4141
24130 IVFAIL = IVFAIL + 1
IVCORR = 6
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
4141 CONTINUE
IVTNUM = 414
C
C **** TEST 414 ****
C
IF (ICZERO) 34140, 4140, 34140
4140 CONTINUE
IVON02 = -3
IVCOMP = -2 * IVON02
GO TO 44140
34140 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 44140, 4151, 44140
44140 IF (IVCOMP - 6) 24140,14140,24140
14140 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 4151
24140 IVFAIL = IVFAIL + 1
IVCORR = 6
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
C
C TEST 415 THROUGH TEST 429 CONTAIN TWO INTEGER CONSTANTS,
C ONE INTEGER VARIABLE AND OPERATOR * IN ARITHMETIC EXPRESSION.
C
4151 CONTINUE
IVTNUM = 415
C
C **** TEST 415 ****
C
IF (ICZERO) 34150, 4150, 34150
4150 CONTINUE
IVON01 = 2
IVCOMP = IVON01 * 3 * 4
GO TO 44150
34150 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 44150, 4161, 44150
44150 IF (IVCOMP - 24) 24150,14150,24150
14150 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 4161
24150 IVFAIL = IVFAIL + 1
IVCORR = 24
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
4161 CONTINUE
IVTNUM = 416
C
C **** TEST 416 ****
C
IF (ICZERO) 34160, 4160, 34160
4160 CONTINUE
IVON01 = -2
IVCOMP = IVON01 *3*4
GO TO 44160
34160 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 44160, 4171, 44160
44160 IF (IVCOMP +24) 24160,14160,24160
14160 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 4171
24160 IVFAIL = IVFAIL + 1
IVCORR = -24
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
4171 CONTINUE
IVTNUM = 417
C
C **** TEST 417 ****
C
IF (ICZERO) 34170, 4170, 34170
4170 CONTINUE
IVON01 = -2
IVCOMP = IVON01*3*(-4)
GO TO 44170
34170 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 44170, 4181, 44170
44170 IF (IVCOMP -24) 24170,14170,24170
14170 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 4181
24170 IVFAIL = IVFAIL + 1
IVCORR = 24
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
4181 CONTINUE
IVTNUM = 418
C
C **** TEST 418 ****
C
IF (ICZERO) 34180, 4180, 34180
4180 CONTINUE
IVON01 = -2
IVCOMP = IVON01*(-3)*(-4)
GO TO 44180
34180 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 44180, 4191, 44180
44180 IF (IVCOMP +24) 24180,14180,24180
14180 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 4191
24180 IVFAIL = IVFAIL + 1
IVCORR = -24
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
4191 CONTINUE
IVTNUM = 419
C
C **** TEST 419 ****
C
IF (ICZERO) 34190, 4190, 34190
4190 CONTINUE
IVON02 = 51
IVCOMP = 23*IVON02*13
GO TO 44190
34190 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 44190, 4201, 44190
44190 IF (IVCOMP-15249) 24190,14190,24190
14190 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 4201
24190 IVFAIL = IVFAIL + 1
IVCORR = 15249
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
4201 CONTINUE
IVTNUM = 420
C
C **** TEST 420 ****
C
IF (ICZERO) 34200, 4200, 34200
4200 CONTINUE
IVON02 = -51
IVCOMP = 23*IVON02*(-13)
GO TO 44200
34200 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 44200, 4211, 44200
44200 IF (IVCOMP - 15249) 24200,14200,24200
14200 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 4211
24200 IVFAIL = IVFAIL + 1
IVCORR = 15249
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
4211 CONTINUE
IVTNUM = 421
C
C **** TEST 421 ****
C
IF (ICZERO) 34210, 4210, 34210
4210 CONTINUE
IVON02 = -51
IVCOMP = 23*IVON02*13
GO TO 44210
34210 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 44210, 4221, 44210
44210 IF (IVCOMP+15249) 24210,14210,24210
14210 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 4221
24210 IVFAIL = IVFAIL + 1
IVCORR = -15249
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
4221 CONTINUE
IVTNUM = 422
C
C **** TEST 422 ****
C
IF (ICZERO) 34220, 4220, 34220
4220 CONTINUE
IVON02 = -51
IVCOMP =(-23)*IVON02*(-13)
GO TO 44220
34220 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 44220, 4231, 44220
44220 IF (IVCOMP+15249) 24220,14220,24220
14220 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 4231
24220 IVFAIL = IVFAIL + 1
IVCORR = -15249
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
4231 CONTINUE
IVTNUM = 423
C
C **** TEST 423 ****
C
IF (ICZERO) 34230, 4230, 34230
4230 CONTINUE
IVON03 = 5461
IVCOMP = 2*3*IVON03
GO TO 44230
34230 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 44230, 4241, 44230
44230 IF (IVCOMP - 32766) 24230,14230,24230
14230 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 4241
24230 IVFAIL = IVFAIL + 1
IVCORR = 32766
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
4241 CONTINUE
IVTNUM = 424
C
C **** TEST 424 ****
C
IF (ICZERO) 34240, 4240, 34240
4240 CONTINUE
IVON03 = -5461
IVCOMP = 2*3*IVON03
GO TO 44240
34240 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 44240, 4251, 44240
44240 IF (IVCOMP +32766) 24240,14240,24240
14240 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 4251
24240 IVFAIL = IVFAIL + 1
IVCORR = -32766
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
4251 CONTINUE
IVTNUM = 425
C
C **** TEST 425 ****
C
IF (ICZERO) 34250, 4250, 34250
4250 CONTINUE
IVON03 = -5461
IVCOMP = -2*3*IVON03
GO TO 44250
34250 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 44250, 4261, 44250
44250 IF (IVCOMP - 32766) 24250,14250,24250
14250 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 4261
24250 IVFAIL = IVFAIL + 1
IVCORR = 32766
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
C
C TEST 426 THROUGH TEST 429 USE PARENTHESES TO GROUP ELEMENTS
C IN ARITHMETIC EXPRESSION.
C
4261 CONTINUE
IVTNUM = 426
C
C **** TEST 426 ****
C
IF (ICZERO) 34260, 4260, 34260
4260 CONTINUE
IVON02 = 51
IVCOMP = (23*IVON02)*13
GO TO 44260
34260 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 44260, 4271, 44260
44260 IF (IVCOMP -15249) 24260,14260,24260
14260 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 4271
24260 IVFAIL = IVFAIL + 1
IVCORR = 15249
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
4271 CONTINUE
IVTNUM = 427
C
C **** TEST 427 ****
C
IF (ICZERO) 34270, 4270, 34270
4270 CONTINUE
IVON02 = 51
IVCOMP = 23*(IVON02*13)
GO TO 44270
34270 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 44270, 4281, 44270
44270 IF (IVCOMP-15249) 24270,14270,24270
14270 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 4281
24270 IVFAIL = IVFAIL + 1
IVCORR = 15249
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
4281 CONTINUE
IVTNUM = 428
C
C **** TEST 428 ****
C
IF (ICZERO) 34280, 4280, 34280
4280 CONTINUE
IVON02 = -51
IVCOMP = -23 * (IVON02*(+13))
GO TO 44280
34280 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 44280, 4291, 44280
44280 IF (IVCOMP - 15249)24280,14280,24280
14280 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 4291
24280 IVFAIL = IVFAIL + 1
IVCORR = 15249
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
4291 CONTINUE
IVTNUM = 429
C
C **** TEST 429 ****
C
IF (ICZERO) 34290, 4290, 34290
4290 CONTINUE
IVON02 = -51
IVCOMP = (-23)*(IVON02*(-13))
GO TO 44290
34290 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 44290, 4301, 44290
44290 IF (IVCOMP + 15249) 24290,14290,24290
14290 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 4301
24290 IVFAIL = IVFAIL + 1
IVCORR = -15249
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
C **** END OF TESTS ****
4301 CONTINUE
C
C WRITE PAGE FOOTINGS AND RUN SUMMARIES
99999 CONTINUE
WRITE (I02,90002)
WRITE (I02,90006)
WRITE (I02,90002)
WRITE (I02,90002)
WRITE (I02,90007)
WRITE (I02,90002)
WRITE (I02,90008) IVFAIL
WRITE (I02,90009) IVPASS
WRITE (I02,90010) IVDELE
C
C
C TERMINATE ROUTINE EXECUTION
STOP
C
C FORMAT STATEMENTS FOR PAGE HEADERS
90000 FORMAT (1H1)
90002 FORMAT (1H )
90001 FORMAT (1H ,10X,34HFORTRAN COMPILER VALIDATION SYSTEM)
90003 FORMAT (1H ,21X,11HVERSION 1.0)
90004 FORMAT (1H ,10X,38HFOR OFFICIAL USE ONLY - COPYRIGHT 1978)
90005 FORMAT (1H ,5X,4HTEST,5X,9HPASS/FAIL, 5X,8HCOMPUTED,8X,7HCORRECT)
90006 FORMAT (1H ,5X,46H----------------------------------------------)
90011 FORMAT (1H ,18X,17HSUBSET LEVEL TEST)
C
C FORMAT STATEMENTS FOR RUN SUMMARIES
90008 FORMAT (1H ,15X,I5,19H ERRORS ENCOUNTERED)
90009 FORMAT (1H ,15X,I5,13H TESTS PASSED)
90010 FORMAT (1H ,15X,I5,14H TESTS DELETED)
C
C FORMAT STATEMENTS FOR TEST RESULTS
80001 FORMAT (1H ,4X,I5,7X,4HPASS)
80002 FORMAT (1H ,4X,I5,7X,4HFAIL)
80003 FORMAT (1H ,4X,I5,7X,7HDELETED)
80004 FORMAT (1H ,4X,I5,7X,4HFAIL,10X,I6,9X,I6)
80005 FORMAT (1H ,4X,I5,7X,4HFAIL,4X,E12.5,3X,E12.5)
C
90007 FORMAT (1H ,20X,20HEND OF PROGRAM FM034)
END
*END-OF,FM034
FM035.f 480976025 170 2 100666 22435 `
*HEADER,FORTR,FM035
*FILES1,FORTR,FM035,X
C COMMENT SECTION
C
C FM035
C
C THIS ROUTINE TESTS ARITHMETIC ASSIGNMENT STATEMENTS OF THE
C FORM
C INTEGER VARIABLE = ARITHMETIC EXPRESSION
C WHERE THE ARITHMETIC EXPRESSION IS FORMED WITH THE ARITHMETIC
C OPERATOR *, INTEGER VARIABLES AND INTEGER CONSTANT. SOME OF THE
C TESTS USE PARENTHESES TO GROUP ELEMENTS IN THE EXPRESSION AND TO
C ALLOW THE USE OF NEGATIVE CONSTANTS FOLLOWING THE * OPERATOR.
C THE INTEGER VARIABLES CONTAIN POSITIVE AND NEGATIVE VALUES.
C
C THERE ARE TESTS WHERE THE ARITHMETIC EXPRESSION CONTAINS
C (1) INTEGER VARIABLE * INTEGER VARIABLE
C (2) INTEGER VARIABLE * INTEGER VARIABLE * INTEGER CONSTANT
C INTEGER VARIABLE * INTEGER CONSTANT * INTEGER VARIABLE
C INTEGER CONSTANT * INTEGER VARIABLE * INTEGER VARIABLE
C (3) SAME AS (2) BUT WITH PARENTHESES TO GROUP ELEMENTS.
C
C REFERENCES
C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN,
C X3.9-1978
C
C SECTION 4.3, INTEGER TYPE
C SECTION 4.3.1, INTEGER CONSTANT
C SECTION 6.1, ARITHMETIC EXPRESSIONS
C SECTION 10.1, ARITHMETIC ASSIGNMENT STATEMENT
C
C **********************************************************
C
C A COMPILER VALIDATION SYSTEM FOR THE FORTRAN LANGUAGE
C BASED ON SPECIFICATIONS AS DEFINED IN AMERICAN NATIONAL STANDARD
C PROGRAMMING LANGUAGE FORTRAN X3.9-1978, HAS BEEN DEVELOPED BY THE
C FEDERAL COBOL COMPILER TESTING SERVICE. THE FORTRAN COMPILER
C VALIDATION SYSTEM (FCVS) CONSISTS OF AUDIT ROUTINES, THEIR RELATED
C DATA, AND AN EXECUTIVE SYSTEM. EACH AUDIT ROUTINE IS A FORTRAN
C PROGRAM, SUBPROGRAM OR FUNCTION WHICH INCLUDES TESTS OF SPECIFIC
C LANGUAGE ELEMENTS AND SUPPORTING PROCEDURES INDICATING THE RESULT
C OF EXECUTING THESE TESTS.
C
C THIS PARTICULAR PROGRAM/SUBPROGRAM/FUNCTION CONTAINS FEATURES
C FOUND ONLY IN THE SUBSET AS DEFINED IN X3.9-1978.
C
C SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO -
C
C DEPARTMENT OF THE NAVY
C FEDERAL COBOL COMPILER TESTING SERVICE
C WASHINGTON, D.C. 20376
C
C **********************************************************
C
C
C
C INITIALIZATION SECTION
C
C INITIALIZE CONSTANTS
C **************
C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER.
I01 = 5
C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER.
I02 = 6
C SYSTEM ENVIRONMENT SECTION
C
CX010 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-010 CONTROL CARD.
C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5
C (UNIT NUMBER FOR CARD READER).
CX011 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-011 CONTROL CARD.
C THE CX011 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL
C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX010 ABOVE.
C
CX020 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-020 CONTROL CARD.
C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02 = 6
C (UNIT NUMBER FOR PRINTER).
CX021 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-021 CONTROL CARD.
C THE CX021 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL
C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX020 ABOVE.
C
IVPASS=0
IVFAIL=0
IVDELE=0
ICZERO=0
C
C WRITE PAGE HEADERS
WRITE (I02,90000)
WRITE (I02,90001)
WRITE (I02,90002)
WRITE (I02, 90002)
WRITE (I02,90003)
WRITE (I02,90002)
WRITE (I02,90004)
WRITE (I02,90002)
WRITE (I02,90011)
WRITE (I02,90002)
WRITE (I02,90002)
WRITE (I02,90005)
WRITE (I02,90006)
WRITE (I02,90002)
C
C TEST SECTION
C
C ARITHMETIC ASSIGNMENT STATEMENT
C
C TEST 430 THROUGH TEST 441 CONTAIN TWO INTEGER VARIABLES AND
C OPERATOR * IN AN ARITHMETIC EXPRESSION.
C THE FORM IS IV = IV * IV
C
C TEST 430 THROUGH TEST 433 - TWO POSITIVE VARIABLES
C
4301 CONTINUE
IVTNUM = 430
C
C **** TEST 430 ****
C
IF (ICZERO) 34300, 4300, 34300
4300 CONTINUE
IVON01 = 2
IVON02 = 3
IVCOMP = IVON01 * IVON02
GO TO 44300
34300 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 44300, 4311, 44300
44300 IF (IVCOMP - 6) 24300,14300,24300
14300 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 4311
24300 IVFAIL = IVFAIL + 1
IVCORR = 6
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
4311 CONTINUE
IVTNUM = 431
C
C **** TEST 431 ****
C
IF (ICZERO) 34310, 4310, 34310
4310 CONTINUE
IVON01 = 13
IVON02 = 11
IVCOMP = IVON01 * IVON02
GO TO 44310
34310 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 44310, 4321, 44310
44310 IF (IVCOMP - 143) 24310,14310,24310
14310 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 4321
24310 IVFAIL = IVFAIL + 1
IVCORR = 143
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
4321 CONTINUE
IVTNUM = 432
C
C **** TEST 432 ****
C
IF (ICZERO) 34320, 4320, 34320
4320 CONTINUE
IVON01 = 223
IVON02 = 99
IVCOMP = IVON01 * IVON02
GO TO 44320
34320 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 44320, 4331, 44320
44320 IF (IVCOMP - 22077) 24320,14320,24320
14320 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 4331
24320 IVFAIL = IVFAIL + 1
IVCORR = 22077
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
4331 CONTINUE
IVTNUM = 433
C
C **** TEST 433 ****
C
IF (ICZERO) 34330, 4330, 34330
4330 CONTINUE
IVON01 = 11235
IVON02 = 2
IVCOMP = IVON01*IVON02
GO TO 44330
34330 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 44330, 4341, 44330
44330 IF (IVCOMP - 22470) 24330,14330,24330
14330 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 4341
24330 IVFAIL = IVFAIL + 1
IVCORR = 22470
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
C
C TEST 434 THROUGH TEST 437
C ONE NEGATIVE VARIABLE, ONE POSITIVE VARIABLE
C
4341 CONTINUE
IVTNUM = 434
C
C **** TEST 434 ****
C
IF (ICZERO) 34340, 4340, 34340
4340 CONTINUE
IVON01 = -2
IVON02 = 3
IVCOMP = IVON01 * IVON02
GO TO 44340
34340 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 44340, 4351, 44340
44340 IF (IVCOMP +6) 24340,14340,24340
14340 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 4351
24340 IVFAIL = IVFAIL + 1
IVCORR = -6
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
4351 CONTINUE
IVTNUM = 435
C
C **** TEST 435 ****
C
IF (ICZERO) 34350, 4350, 34350
4350 CONTINUE
IVON01 = -13
IVON02 = +11
IVCOMP = IVON01*IVON02
GO TO 44350
34350 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 44350, 4361, 44350
44350 IF (IVCOMP + 143) 24350,14350,24350
14350 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 4361
24350 IVFAIL = IVFAIL + 1
IVCORR = -143
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
4361 CONTINUE
IVTNUM = 436
C
C **** TEST 436 ****
C
IF (ICZERO) 34360, 4360, 34360
4360 CONTINUE
IVON01 = -223
IVON02 = 99
IVCOMP = IVON01 * IVON02
GO TO 44360
34360 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 44360, 4371, 44360
44360 IF (IVCOMP + 22077) 24360,14360,24360
14360 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 4371
24360 IVFAIL = IVFAIL + 1
IVCORR = -22077
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
4371 CONTINUE
IVTNUM = 437
C
C **** TEST 437 ****
C
IF (ICZERO) 34370, 4370, 34370
4370 CONTINUE
IVON01 = -11235
IVON02 = 2
IVCOMP = IVON01 * IVON02
GO TO 44370
34370 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 44370, 4381, 44370
44370 IF (IVCOMP + 22470) 24370,14370,24370
14370 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 4381
24370 IVFAIL = IVFAIL + 1
IVCORR = -22470
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
C
C TEST 438 THROUGH TEST 441 - TWO NEGATIVE VARIABLES
4381 CONTINUE
IVTNUM = 438
C
C **** TEST 438 ****
C
IF (ICZERO) 34380, 4380, 34380
4380 CONTINUE
IVON01 = -2
IVON02 = -3
IVCOMP = IVON01 * IVON02
GO TO 44380
34380 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 44380, 4391, 44380
44380 IF (IVCOMP - 6) 24380,14380,24380
14380 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 4391
24380 IVFAIL = IVFAIL + 1
IVCORR = 6
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
4391 CONTINUE
IVTNUM = 439
C
C **** TEST 439 ****
C
IF (ICZERO) 34390, 4390, 34390
4390 CONTINUE
IVON01 = -13
IVON02 = -11
IVCOMP = IVON01 * IVON02
GO TO 44390
34390 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 44390, 4401, 44390
44390 IF (IVCOMP - 143) 24390,14390,24390
14390 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 4401
24390 IVFAIL = IVFAIL + 1
IVCORR = 143
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
4401 CONTINUE
IVTNUM = 440
C
C **** TEST 440 ****
C
IF (ICZERO) 34400, 4400, 34400
4400 CONTINUE
IVON01 = -223
IVON02 = -99
IVCOMP = IVON01*IVON02
GO TO 44400
34400 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 44400, 4411, 44400
44400 IF (IVCOMP - 22077) 24400,14400,24400
14400 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 4411
24400 IVFAIL = IVFAIL + 1
IVCORR = 22077
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
4411 CONTINUE
IVTNUM = 441
C
C **** TEST 441 ****
C
IF (ICZERO) 34410, 4410, 34410
4410 CONTINUE
IVON01 = -5461
IVON02 = -6
IVCOMP = IVON01 * IVON02
GO TO 44410
34410 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 44410, 4421, 44410
44410 IF (IVCOMP - 32766) 24410, 14410, 24410
14410 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 4421
24410 IVFAIL = IVFAIL + 1
IVCORR = 32766
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
C
C TEST 442 THROUGH TEST 445 CONTAIN SIGNED INTEGER VARIABLES AND
C OPERATOR * IN AN ARITHMETIC EXPRESSION.
4421 CONTINUE
IVTNUM = 442
C
C **** TEST 442 ****
C FORM IS IV = -IV*IV
C
IF (ICZERO) 34420, 4420, 34420
4420 CONTINUE
IVON01 = 2
IVON02 = 3
IVCOMP = -IVON01 * IVON02
GO TO 44420
34420 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 44420, 4431, 44420
44420 IF (IVCOMP + 6) 24420,14420,24420
14420 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 4431
24420 IVFAIL = IVFAIL + 1
IVCORR = -6
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
4431 CONTINUE
IVTNUM = 443
C
C **** TEST 443 ****
C FORM IS IV = IV*(-IV)
C
IF (ICZERO) 34430, 4430, 34430
4430 CONTINUE
IVON01 = 2
IVON02 = 3
IVCOMP = IVON01 * (-IVON02)
GO TO 44430
34430 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 44430, 4441, 44430
44430 IF (IVCOMP +6) 24430,14430,24430
14430 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 4441
24430 IVFAIL = IVFAIL + 1
IVCORR = -6
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
4441 CONTINUE
IVTNUM = 444
C
C **** TEST 444 ****
C FORM IS IV = (-IV)*(-IV)
C
IF (ICZERO) 34440, 4440, 34440
4440 CONTINUE
IVON01 = 2
IVON02 = 3
IVCOMP = (-IVON01) * (-IVON02)
GO TO 44440
34440 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 44440, 4451, 44440
44440 IF (IVCOMP - 6) 24440,14440,24440
14440 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 4451
24440 IVFAIL = IVFAIL + 1
IVCORR = 6
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
4451 CONTINUE
IVTNUM = 445
C
C **** TEST 445 ****
C FORM IS IV = -IV * IV
C
IF (ICZERO) 34450, 4450, 34450
4450 CONTINUE
IVON01 = -11235
IVON02 = -2
IVCOMP = -IVON01 * IVON02
GO TO 44450
34450 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 44450, 4461, 44450
44450 IF (IVCOMP + 22470) 24450,14450,24450
14450 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 4461
24450 IVFAIL = IVFAIL + 1
IVCORR = -22470
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
C
C TEST 446 THROUGH TEST 452 CONTAIN TWO INTEGER VARIABLES, AN
C INTEGER CONSTANT AND OPERATOR * IN AN ARITHMETIC EXPRESSION.
C
4461 CONTINUE
IVTNUM = 446
C
C **** TEST 446 ****
C
IF (ICZERO) 34460, 4460, 34460
4460 CONTINUE
IVON01 = 2
IVON02 = 3
IVCOMP = IVON01 * IVON02 * 4
GO TO 44460
34460 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 44460, 4471, 44460
44460 IF (IVCOMP -24) 24460,14460,24460
14460 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 4471
24460 IVFAIL = IVFAIL + 1
IVCORR = 24
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
4471 CONTINUE
IVTNUM = 447
C
C **** TEST 447 ****
C
IF (ICZERO) 34470, 4470, 34470
4470 CONTINUE
IVON01 = -2
IVON02 = 3
IVCOMP = IVON01 * IVON02 * 4
GO TO 44470
34470 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 44470, 4481, 44470
44470 IF (IVCOMP +24) 24470,14470,24470
14470 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 4481
24470 IVFAIL = IVFAIL + 1
IVCORR = -24
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
4481 CONTINUE
IVTNUM = 448
C
C **** TEST 448 ****
C
IF (ICZERO) 34480, 4480, 34480
4480 CONTINUE
IVON01 = -2
IVON02 = 3
IVCOMP = IVON01 * IVON02 * (-4)
GO TO 44480
34480 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 44480, 4491, 44480
44480 IF (IVCOMP -24) 24480,14480,24480
14480 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 4491
24480 IVFAIL = IVFAIL + 1
IVCORR = 24
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
4491 CONTINUE
IVTNUM = 449
C
C **** TEST 449 ****
C
IF (ICZERO) 34490, 4490, 34490
4490 CONTINUE
IVON01 = 51
IVON03 = 13
IVCOMP = IVON01 * 23 * IVON03
GO TO 44490
34490 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 44490, 4501, 44490
44490 IF (IVCOMP - 15249) 24490,14490,24490
14490 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 4501
24490 IVFAIL = IVFAIL + 1
IVCORR = 15249
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
4501 CONTINUE
IVTNUM = 450
C
C **** TEST 450 ****
C
IF (ICZERO) 34500, 4500, 34500
4500 CONTINUE
IVON02 = 2
IVON03 = 5461
IVCOMP = 3 * IVON02 * IVON03
GO TO 44500
34500 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 44500, 4511, 44500
44500 IF (IVCOMP -32766) 24500,14500,24500
14500 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 4511
24500 IVFAIL = IVFAIL + 1
IVCORR = 32766
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
4511 CONTINUE
IVTNUM = 451
C
C **** TEST 451 ****
C
IF (ICZERO) 34510, 4510, 34510
4510 CONTINUE
IVON01 = -51
IVON03 = 13
IVCOMP = IVON01 * 23 * (-IVON03)
GO TO 44510
34510 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 44510, 4521, 44510
44510 IF (IVCOMP - 15249) 24510,14510,24510
14510 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 4521
24510 IVFAIL = IVFAIL + 1
IVCORR = 15249
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
4521 CONTINUE
IVTNUM = 452
C
C **** TEST 452 ****
C
IF (ICZERO) 34520, 4520, 34520
4520 CONTINUE
IVON01 = -5461
IVON03 = 2
IVCOMP = IVON01 * (-3) * IVON03
GO TO 44520
34520 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 44520, 4531, 44520
44520 IF (IVCOMP - 32766) 24520,14520,24520
14520 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 4531
24520 IVFAIL = IVFAIL + 1
IVCORR = 32766
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
C
C TEST 453 THROUGH TEST 461 CONTAIN TWO INTEGER VARIABLES AND ONE
C INTEGER CONSTANT IN AN ARITHMETIC EXPRESSION. PARENTHESES ARE
C USED TO GROUP ELEMENTS IN THE ARITHMETIC EXPRESSIONS IN THESE
C TESTS.
C
4531 CONTINUE
IVTNUM = 453
C
C **** TEST 453 ****
C
IF (ICZERO) 34530, 4530, 34530
4530 CONTINUE
IVON01 = 2
IVON02 = 3
IVCOMP = IVON01 * (IVON02 * 4)
GO TO 44530
34530 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 44530, 4541, 44530
44530 IF (IVCOMP - 24) 24530,14530,24530
14530 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 4541
24530 IVFAIL = IVFAIL + 1
IVCORR = 24
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
4541 CONTINUE
IVTNUM = 454
C
C **** TEST 454 ****
C
IF (ICZERO) 34540, 4540, 34540
4540 CONTINUE
IVON01 = 2
IVON02 = 3
IVCOMP = (IVON01 * IVON02) * 4
GO TO 44540
34540 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 44540, 4551, 44540
44540 IF (IVCOMP -24) 24540,14540,24540
14540 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 4551
24540 IVFAIL = IVFAIL + 1
IVCORR = 24
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
4551 CONTINUE
IVTNUM = 455
C
C **** TEST 455 ****
C
IF (ICZERO) 34550, 4550, 34550
4550 CONTINUE
IVON01 = -2
IVON02 = 3
IVCOMP = IVON01 *(IVON02 * (-4))
GO TO 44550
34550 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 44550, 4561, 44550
44550 IF (IVCOMP - 24) 24550,14550,24550
14550 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 4561
24550 IVFAIL = IVFAIL + 1
IVCORR = 24
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
4561 CONTINUE
IVTNUM = 456
C
C **** TEST 456 ****
C
IF (ICZERO) 34560, 4560, 34560
4560 CONTINUE
IVON01 = -2
IVON02 = -3
IVCOMP = IVON01 * (IVON02 * 4)
GO TO 44560
34560 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 44560, 4571, 44560
44560 IF (IVCOMP -24) 24560,14560,24560
14560 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 4571
24560 IVFAIL = IVFAIL + 1
IVCORR = 24
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
4571 CONTINUE
IVTNUM = 457
C
C **** TEST 457 ****
C
IF (ICZERO) 34570, 4570, 34570
4570 CONTINUE
IVON01 = -2
IVON02 = -3
IVCOMP = (IVON01*IVON02) * (-4)
GO TO 44570
34570 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 44570, 4581, 44570
44570 IF (IVCOMP +24) 24570,14570,24570
14570 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 4581
24570 IVFAIL = IVFAIL + 1
IVCORR = -24
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
4581 CONTINUE
IVTNUM = 458
C
C **** TEST 458 ****
C
IF (ICZERO) 34580, 4580, 34580
4580 CONTINUE
IVON01 = 23
IVON03 = 13
IVCOMP = IVON01 * (51 * IVON03)
GO TO 44580
34580 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 44580, 4591, 44580
44580 IF (IVCOMP -15249) 24580,14580,24580
14580 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 4591
24580 IVFAIL = IVFAIL + 1
IVCORR = 15249
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
4591 CONTINUE
IVTNUM = 459
C
C **** TEST 459 ****
C
IF (ICZERO) 34590, 4590, 34590
4590 CONTINUE
IVON02 = 51
IVON03 = 13
IVCOMP = (23 * IVON02) * IVON03
GO TO 44590
34590 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 44590, 4601, 44590
44590 IF (IVCOMP - 15249) 24590,14590,24590
14590 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 4601
24590 IVFAIL = IVFAIL + 1
IVCORR = 15249
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
4601 CONTINUE
IVTNUM = 460
C
C **** TEST 460 ****
C
IF (ICZERO) 34600, 4600, 34600
4600 CONTINUE
IVON01 = -23
IVON03 = 13
IVCOMP = (IVON01 * (-51)) * (-IVON03)
GO TO 44600
34600 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 44600, 4611, 44600
44600 IF (IVCOMP + 15249) 24600,14600,24600
14600 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 4611
24600 IVFAIL = IVFAIL + 1
IVCORR = -15249
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
4611 CONTINUE
IVTNUM = 461
C
C **** TEST 461 ****
C
IF (ICZERO) 34610, 4610, 34610
4610 CONTINUE
IVON02 = 51
IVON03 = 13
IVCOMP = -23 * (IVON02*IVON03)
GO TO 44610
34610 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 44610, 4621, 44610
44610 IF (IVCOMP + 15249) 24610,14610,24610
14610 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 4621
24610 IVFAIL = IVFAIL + 1
IVCORR = -15249
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
C **** END OF TESTS ****
4621 CONTINUE
C
C WRITE PAGE FOOTINGS AND RUN SUMMARIES
99999 CONTINUE
WRITE (I02,90002)
WRITE (I02,90006)
WRITE (I02,90002)
WRITE (I02,90002)
WRITE (I02,90007)
WRITE (I02,90002)
WRITE (I02,90008) IVFAIL
WRITE (I02,90009) IVPASS
WRITE (I02,90010) IVDELE
C
C
C TERMINATE ROUTINE EXECUTION
STOP
C
C FORMAT STATEMENTS FOR PAGE HEADERS
90000 FORMAT (1H1)
90002 FORMAT (1H )
90001 FORMAT (1H ,10X,34HFORTRAN COMPILER VALIDATION SYSTEM)
90003 FORMAT (1H ,21X,11HVERSION 1.0)
90004 FORMAT (1H ,10X,38HFOR OFFICIAL USE ONLY - COPYRIGHT 1978)
90005 FORMAT (1H ,5X,4HTEST,5X,9HPASS/FAIL, 5X,8HCOMPUTED,8X,7HCORRECT)
90006 FORMAT (1H ,5X,46H----------------------------------------------)
90011 FORMAT (1H ,18X,17HSUBSET LEVEL TEST)
C
C FORMAT STATEMENTS FOR RUN SUMMARIES
90008 FORMAT (1H ,15X,I5,19H ERRORS ENCOUNTERED)
90009 FORMAT (1H ,15X,I5,13H TESTS PASSED)
90010 FORMAT (1H ,15X,I5,14H TESTS DELETED)
C
C FORMAT STATEMENTS FOR TEST RESULTS
80001 FORMAT (1H ,4X,I5,7X,4HPASS)
80002 FORMAT (1H ,4X,I5,7X,4HFAIL)
80003 FORMAT (1H ,4X,I5,7X,7HDELETED)
80004 FORMAT (1H ,4X,I5,7X,4HFAIL,10X,I6,9X,I6)
80005 FORMAT (1H ,4X,I5,7X,4HFAIL,4X,E12.5,3X,E12.5)
C
90007 FORMAT (1H ,20X,20HEND OF PROGRAM FM035)
END
*END-OF,FM035
FM036.f 480976027 170 2 100666 19256 `
*HEADER,FORTR,FM036
*FILES1,FORTR,FM036,X
C COMMENT SECTION
C
C FM036
C
C THIS ROUTINE TESTS ARITHMETIC ASIGNMENT STATEMENTS OF THE
C FORM
C INTEGER VARIABLE = ARITHMETIC EXPRESSION
C WHERE THE ARITHMETIC EXPRESSION IS FORMED WITH THE ARITHMETIC
C OPERATOR / AND INTEGER CONSTANTS. BOTH POSITIVE AND NEGATIVE
C CONSTANTS ARE USED IN THE ARITHMETIC EXPRESSION.
C
C THERE ARE TESTS WHICH REQUIRE NO TRUNCATION OF THE RESULT
C AND TESTS WHERE THE RESULT MUST BE TRUNCATED BEFORE BEING STORED
C IN THE RESULTANT INTEGER VARIABLE. THE STANDARD STATES 'THE VALUE
C OF AN INTEGER FACTOR OR TERM IS THE NEAREST INTEGER WHOSE
C MAGNITUDE DOES NOT EXCEED THE MAGNITUDE OF THE MATHEMATICAL VALUE
C REPRESENTED BY THAT FACTOR OR TERM.'
C
C THERE ARE TESTS WHERE THE ARITHMETIC EXPRESSION CONTAINS
C (1) INTEGER CONSTANT/INTEGER CONSTANT
C NO TRUNCATION REQUIRED,
C (2) INTEGER CONSTANT/INTEGER CONSTANT
C TRUNCATION REQUIRED.
C
C REFERENCES
C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN,
C X3.9-1978
C
C SECTION 4.3, INTEGER TYPE
C SECTION 4.3.1, INTEGER CONSTANT
C SECTION 6.1, ARITHMETIC EXPRESSIONS
C SECTION 6.6, EVALUATION OF EXPRESSIONS
C SECTION 10.1, ARITHMETIC ASSIGNMENT STATEMENT
C
C **********************************************************
C
C A COMPILER VALIDATION SYSTEM FOR THE FORTRAN LANGUAGE
C BASED ON SPECIFICATIONS AS DEFINED IN AMERICAN NATIONAL STANDARD
C PROGRAMMING LANGUAGE FORTRAN X3.9-1978, HAS BEEN DEVELOPED BY THE
C FEDERAL COBOL COMPILER TESTING SERVICE. THE FORTRAN COMPILER
C VALIDATION SYSTEM (FCVS) CONSISTS OF AUDIT ROUTINES, THEIR RELATED
C DATA, AND AN EXECUTIVE SYSTEM. EACH AUDIT ROUTINE IS A FORTRAN
C PROGRAM, SUBPROGRAM OR FUNCTION WHICH INCLUDES TESTS OF SPECIFIC
C LANGUAGE ELEMENTS AND SUPPORTING PROCEDURES INDICATING THE RESULT
C OF EXECUTING THESE TESTS.
C
C THIS PARTICULAR PROGRAM/SUBPROGRAM/FUNCTION CONTAINS FEATURES
C FOUND ONLY IN THE SUBSET AS DEFINED IN X3.9-1978.
C
C SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO -
C
C DEPARTMENT OF THE NAVY
C FEDERAL COBOL COMPILER TESTING SERVICE
C WASHINGTON, D.C. 20376
C
C **********************************************************
C
C
C
C INITIALIZATION SECTION
C
C INITIALIZE CONSTANTS
C **************
C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER.
I01 = 5
C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER.
I02 = 6
C SYSTEM ENVIRONMENT SECTION
C
CX010 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-010 CONTROL CARD.
C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5
C (UNIT NUMBER FOR CARD READER).
CX011 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-011 CONTROL CARD.
C THE CX011 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL
C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX010 ABOVE.
C
CX020 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-020 CONTROL CARD.
C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02 = 6
C (UNIT NUMBER FOR PRINTER).
CX021 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-021 CONTROL CARD.
C THE CX021 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL
C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX020 ABOVE.
C
IVPASS=0
IVFAIL=0
IVDELE=0
ICZERO=0
C
C WRITE PAGE HEADERS
WRITE (I02,90000)
WRITE (I02,90001)
WRITE (I02,90002)
WRITE (I02, 90002)
WRITE (I02,90003)
WRITE (I02,90002)
WRITE (I02,90004)
WRITE (I02,90002)
WRITE (I02,90011)
WRITE (I02,90002)
WRITE (I02,90002)
WRITE (I02,90005)
WRITE (I02,90006)
WRITE (I02,90002)
C
C TEST SECTION
C ARITHMETIC ASSIGNMENT STATEMENT
C
C TEST 462 THROUGH TEST 490 CONTAIN TWO INTEGER CONSTANTS AND
C OPERATOR / IN AN ARITHMETIC EXPRESSION. THE FORM TESTED IS
C INTEGER VARIABLE = INTEGER CONSTANT/INTEGER CONSTANT
C
C TEST 462 THROUGH TEST 469 - POSITIVE CONSTANTS
C NO TRUNCATION REQUIRED
C
4621 CONTINUE
IVTNUM = 462
C
C **** TEST 462 ****
C
IF (ICZERO) 34620, 4620, 34620
4620 CONTINUE
IVCOMP = 4/2
GO TO 44620
34620 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 44620, 4631, 44620
44620 IF (IVCOMP - 2) 24620,14620,24620
14620 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 4631
24620 IVFAIL = IVFAIL + 1
IVCORR = 2
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
4631 CONTINUE
IVTNUM = 463
C
C **** TEST 463 ****
C
IF (ICZERO) 34630, 4630, 34630
4630 CONTINUE
IVCOMP = 75 / 25
GO TO 44630
34630 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 44630, 4641, 44630
44630 IF (IVCOMP - 3) 24630,14630,24630
14630 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 4641
24630 IVFAIL = IVFAIL + 1
IVCORR = 3
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
4641 CONTINUE
IVTNUM = 464
C
C **** TEST 464 ****
C
IF (ICZERO) 34640, 4640, 34640
4640 CONTINUE
IVCOMP = 3575/143
GO TO 44640
34640 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 44640, 4651, 44640
44640 IF (IVCOMP - 25) 24640,14640,24640
14640 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 4651
24640 IVFAIL = IVFAIL + 1
IVCORR = 25
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
4651 CONTINUE
IVTNUM = 465
C
C **** TEST 465 ****
C
IF (ICZERO) 34650, 4650, 34650
4650 CONTINUE
IVCOMP = 3575/25
GO TO 44650
34650 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 44650, 4661, 44650
44650 IF (IVCOMP - 143) 24650,14650,24650
14650 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 4661
24650 IVFAIL = IVFAIL + 1
IVCORR = 143
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
4661 CONTINUE
IVTNUM = 466
C
C **** TEST 466 ****
C
IF (ICZERO) 34660, 4660, 34660
4660 CONTINUE
IVCOMP = 6170/1234
GO TO 44660
34660 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 44660, 4671, 44660
44660 IF (IVCOMP - 5) 24660,14660,24660
14660 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 4671
24660 IVFAIL = IVFAIL + 1
IVCORR = 5
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
4671 CONTINUE
IVTNUM = 467
C
C **** TEST 467 ****
C
IF (ICZERO) 34670, 4670, 34670
4670 CONTINUE
IVCOMP = 28600/8
GO TO 44670
34670 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 44670, 4681, 44670
44670 IF (IVCOMP - 3575) 24670,14670,24670
14670 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 4681
24670 IVFAIL = IVFAIL + 1
IVCORR = 3575
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
4681 CONTINUE
IVTNUM = 468
C
C **** TEST 468 ****
C
IF (ICZERO) 34680, 4680, 34680
4680 CONTINUE
IVCOMP = 32766/2
GO TO 44680
34680 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 44680, 4691, 44680
44680 IF (IVCOMP - 16383) 24680,14680,24680
14680 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 4691
24680 IVFAIL = IVFAIL + 1
IVCORR = 16383
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
4691 CONTINUE
IVTNUM = 469
C
C **** TEST 469 ****
C
IF (ICZERO) 34690, 4690, 34690
4690 CONTINUE
IVCOMP = 32767/1
GO TO 44690
34690 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 44690, 4701, 44690
44690 IF (IVCOMP - 32767) 24690,14690,24690
14690 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 4701
24690 IVFAIL = IVFAIL + 1
IVCORR = 32767
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
C
C TEST 470 THROUGH TEST 478 - POSITIVE CONSTANTS
C TRUNCATION REQUIRED
C
4701 CONTINUE
IVTNUM = 470
C
C **** TEST 470 ****
C
IF (ICZERO) 34700, 4700, 34700
4700 CONTINUE
IVCOMP = 5/2
GO TO 44700
34700 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 44700, 4711, 44700
44700 IF (IVCOMP - 2) 24700,14700,24700
14700 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 4711
24700 IVFAIL = IVFAIL + 1
IVCORR = 2
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
4711 CONTINUE
IVTNUM = 471
C
C **** TEST 471 ****
C
IF (ICZERO) 34710, 4710, 34710
4710 CONTINUE
IVCOMP = 2/3
GO TO 44710
34710 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 44710, 4721, 44710
44710 IF (IVCOMP - 0) 24710,14710,24710
14710 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 4721
24710 IVFAIL = IVFAIL + 1
IVCORR = 0
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
4721 CONTINUE
IVTNUM = 472
C
C **** TEST 472 ****
C
IF (ICZERO) 34720, 4720, 34720
4720 CONTINUE
IVCOMP = 80/15
GO TO 44720
34720 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 44720, 4731, 44720
44720 IF (IVCOMP - 5) 24720,14720,24720
14720 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 4731
24720 IVFAIL = IVFAIL + 1
IVCORR = 5
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
4731 CONTINUE
IVTNUM = 473
C
C **** TEST 473 ****
C
IF (ICZERO) 34730, 4730, 34730
4730 CONTINUE
IVCOMP = 959/120
GO TO 44730
34730 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 44730, 4741, 44730
44730 IF (IVCOMP - 7) 24730,14730,24730
14730 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 4741
24730 IVFAIL = IVFAIL + 1
IVCORR = 7
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
4741 CONTINUE
IVTNUM = 474
C
C **** TEST 474 ****
C
IF (ICZERO) 34740, 4740, 34740
4740 CONTINUE
IVCOMP = 959 / 12
GO TO 44740
34740 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 44740, 4751, 44740
44740 IF (IVCOMP - 79) 24740,14740,24740
14740 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 4751
24740 IVFAIL = IVFAIL + 1
IVCORR = 79
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
4751 CONTINUE
IVTNUM = 475
C
C **** TEST 475 ****
C
IF (ICZERO) 34750, 4750, 34750
4750 CONTINUE
IVCOMP = 959/6
GO TO 44750
34750 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 44750, 4761, 44750
44750 IF (IVCOMP - 159) 24750,14750,24750
14750 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 4761
24750 IVFAIL = IVFAIL + 1
IVCORR = 159
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
4761 CONTINUE
IVTNUM = 476
C
C **** TEST 476 ****
C
IF (ICZERO) 34760, 4760, 34760
4760 CONTINUE
IVCOMP = 28606/8
GO TO 44760
34760 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 44760, 4771, 44760
44760 IF (IVCOMP - 3575) 24760,14760,24760
14760 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 4771
24760 IVFAIL = IVFAIL + 1
IVCORR = 3575
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
4771 CONTINUE
IVTNUM = 477
C
C **** TEST 477 ****
C
IF (ICZERO) 34770, 4770, 34770
4770 CONTINUE
IVCOMP = 25603/2
GO TO 44770
34770 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 44770, 4781, 44770
44770 IF (IVCOMP - 12801) 24770,14770,24770
14770 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 4781
24770 IVFAIL = IVFAIL + 1
IVCORR = 12801
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
4781 CONTINUE
IVTNUM = 478
C
C **** TEST 478 ****
C
IF (ICZERO) 34780, 4780, 34780
4780 CONTINUE
IVCOMP = 25603/10354
GO TO 44780
34780 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 44780, 4791, 44780
44780 IF (IVCOMP - 2) 24780,14780,24780
14780 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 4791
24780 IVFAIL = IVFAIL + 1
IVCORR = 2
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
C
C TEST 479 THROUGH TEST 482 - NEGATIVE CONSTANTS INCLUDED
C NO TRUNCATION REQUIRED
C
4791 CONTINUE
IVTNUM = 479
C
C **** TEST 479 ****
C
IF (ICZERO) 34790, 4790, 34790
4790 CONTINUE
IVCOMP = -4/2
GO TO 44790
34790 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 44790, 4801, 44790
44790 IF (IVCOMP + 2) 24790,14790,24790
14790 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 4801
24790 IVFAIL = IVFAIL + 1
IVCORR = -2
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
4801 CONTINUE
IVTNUM = 480
C
C **** TEST 480 ****
C
IF (ICZERO) 34800, 4800, 34800
4800 CONTINUE
IVCOMP = 75 / (-25)
GO TO 44800
34800 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 44800, 4811, 44800
44800 IF (IVCOMP + 3) 24800,14800,24800
14800 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 4811
24800 IVFAIL = IVFAIL + 1
IVCORR = -3
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
4811 CONTINUE
IVTNUM = 481
C
C **** TEST 481 ****
C
IF (ICZERO) 34810, 4810, 34810
4810 CONTINUE
IVCOMP= (-6170) / (-1234)
GO TO 44810
34810 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 44810, 4821, 44810
44810 IF (IVCOMP - 5) 24810,14810,24810
14810 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 4821
24810 IVFAIL = IVFAIL + 1
IVCORR = 5
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
4821 CONTINUE
IVTNUM = 482
C
C **** TEST 482 ****
C
IF (ICZERO) 34820, 4820, 34820
4820 CONTINUE
IVCOMP = -32766/(-2)
GO TO 44820
34820 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 44820, 4831, 44820
44820 IF (IVCOMP - 16383) 24820,14820,24820
14820 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 4831
24820 IVFAIL = IVFAIL + 1
IVCORR = 16383
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
C
C TEST 483 THROUGH TEST 490 - NEGATIVE CONSTANTS INCLUDED
C TRUNCATION REQUIRED
C
4831 CONTINUE
IVTNUM = 483
C
C **** TEST 483 ****
C
IF (ICZERO) 34830, 4830, 34830
4830 CONTINUE
IVCOMP = -5/2
GO TO 44830
34830 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 44830, 4841, 44830
44830 IF (IVCOMP +2) 24830,14830,24830
14830 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 4841
24830 IVFAIL = IVFAIL + 1
IVCORR = -2
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
4841 CONTINUE
IVTNUM = 484
C
C **** TEST 484 ****
C
IF (ICZERO) 34840, 4840, 34840
4840 CONTINUE
IVCOMP = -2/3
GO TO 44840
34840 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 44840, 4851, 44840
44840 IF (IVCOMP) 24840,14840,24840
14840 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 4851
24840 IVFAIL = IVFAIL + 1
IVCORR = 0
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
4851 CONTINUE
IVTNUM = 485
C
C **** TEST 485 ****
C
IF (ICZERO) 34850, 4850, 34850
4850 CONTINUE
IVCOMP = 80/(-15)
GO TO 44850
34850 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 44850, 4861, 44850
44850 IF (IVCOMP +5) 24850,14850,24850
14850 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 4861
24850 IVFAIL = IVFAIL + 1
IVCORR = -5
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
4861 CONTINUE
IVTNUM = 486
C
C **** TEST 486 ****
C
IF (ICZERO) 34860, 4860, 34860
4860 CONTINUE
IVCOMP = -959/(-120)
GO TO 44860
34860 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 44860, 4871, 44860
44860 IF (IVCOMP - 7) 24860,14860,24860
14860 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 4871
24860 IVFAIL = IVFAIL + 1
IVCORR = 7
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
4871 CONTINUE
IVTNUM = 487
C
C **** TEST 487 ****
C
IF (ICZERO) 34870, 4870, 34870
4870 CONTINUE
IVCOMP = -959/6
GO TO 44870
34870 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 44870, 4881, 44870
44870 IF (IVCOMP + 159) 24870,14870,24870
14870 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 4881
24870 IVFAIL = IVFAIL + 1
IVCORR = -159
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
4881 CONTINUE
IVTNUM = 488
C
C **** TEST 488 ****
C
IF (ICZERO) 34880, 4880, 34880
4880 CONTINUE
IVCOMP = -28606/(-8)
GO TO 44880
34880 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 44880, 4891, 44880
44880 IF (IVCOMP - 3575) 24880,14880,24880
14880 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 4891
24880 IVFAIL = IVFAIL + 1
IVCORR = 3575
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
4891 CONTINUE
IVTNUM = 489
C
C **** TEST 489 ****
C
IF (ICZERO) 34890, 4890, 34890
4890 CONTINUE
IVCOMP = -25603/2
GO TO 44890
34890 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 44890, 4901, 44890
44890 IF (IVCOMP + 12801) 24890,14890,24890
14890 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 4901
24890 IVFAIL = IVFAIL + 1
IVCORR = -12801
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
4901 CONTINUE
IVTNUM = 490
C
C **** TEST 490 ****
C
IF (ICZERO) 34900, 4900, 34900
4900 CONTINUE
IVCOMP = -25603/(-10354)
GO TO 44900
34900 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 44900, 4911, 44900
44900 IF (IVCOMP - 2) 24900,14900,24900
14900 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 4911
24900 IVFAIL = IVFAIL + 1
IVCORR = 2
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
C
C **** END OF TESTS ****
4911 CONTINUE
C
C WRITE PAGE FOOTINGS AND RUN SUMMARIES
99999 CONTINUE
WRITE (I02,90002)
WRITE (I02,90006)
WRITE (I02,90002)
WRITE (I02,90002)
WRITE (I02,90007)
WRITE (I02,90002)
WRITE (I02,90008) IVFAIL
WRITE (I02,90009) IVPASS
WRITE (I02,90010) IVDELE
C
C
C TERMINATE ROUTINE EXECUTION
STOP
C
C FORMAT STATEMENTS FOR PAGE HEADERS
90000 FORMAT (1H1)
90002 FORMAT (1H )
90001 FORMAT (1H ,10X,34HFORTRAN COMPILER VALIDATION SYSTEM)
90003 FORMAT (1H ,21X,11HVERSION 1.0)
90004 FORMAT (1H ,10X,38HFOR OFFICIAL USE ONLY - COPYRIGHT 1978)
90005 FORMAT (1H ,5X,4HTEST,5X,9HPASS/FAIL, 5X,8HCOMPUTED,8X,7HCORRECT)
90006 FORMAT (1H ,5X,46H----------------------------------------------)
90011 FORMAT (1H ,18X,17HSUBSET LEVEL TEST)
C
C FORMAT STATEMENTS FOR RUN SUMMARIES
90008 FORMAT (1H ,15X,I5,19H ERRORS ENCOUNTERED)
90009 FORMAT (1H ,15X,I5,13H TESTS PASSED)
90010 FORMAT (1H ,15X,I5,14H TESTS DELETED)
C
C FORMAT STATEMENTS FOR TEST RESULTS
80001 FORMAT (1H ,4X,I5,7X,4HPASS)
80002 FORMAT (1H ,4X,I5,7X,4HFAIL)
80003 FORMAT (1H ,4X,I5,7X,7HDELETED)
80004 FORMAT (1H ,4X,I5,7X,4HFAIL,10X,I6,9X,I6)
80005 FORMAT (1H ,4X,I5,7X,4HFAIL,4X,E12.5,3X,E12.5)
C
90007 FORMAT (1H ,20X,20HEND OF PROGRAM FM036)
END
*END-OF,FM036
FM037.f 480976030 170 2 100666 19838 `
*HEADER,FORTR,FM037
*FILES1,FORTR,FM037,X
C COMMENT SECTION
C
C FM037
C
C THIS ROUTINE TESTS ARITHMETIC ASSIGNMENT STATEMENTS OF THE
C FORM
C INTEGER VARIABLE = ARITHMETIC EXPRESSION
C WHERE THE ARITHMETIC EXPRESSION IS FORMED WITH THREE INTEGER
C CONSTANTS AND THE ARITHMETIC OPERATOR /. BOTH POSITIVE AND NEGA-
C TIVE CONSTANTS ARE USED IN THE ARITHMETIC EXPRESSION.
C
C THERE ARE TESTS WHICH REQUIRE NO TRUNCATION OF THE RESULT
C AND TESTS WHERE THE RESULT MUST BE TRUNCATED BEFORE BEING STORED
C IN THE RESULTANT INTEGER VARIABLE. THE STANDARD STATES 'THE VALUE
C OF AN INTEGER FACTOR OR TERM IS THE NEAREST INTEGER WHOSE MAGNI-
C TUDE DOES NOT EXCEED THE MAGNITUDE OF THE MATHEMATICAL VALUE
C REPRESENTED BY THAT FACTOR OR TERM. THE ASSOCIATIVE AND COMMUTA-
C TIVE LAWS DO NOT APPLY IN THE EVALUATION OF INTEGER TERMS CON-
C TAINING DIVISION, HENCE THE EVALUATION OF SUCH TERMS MUST EFFEC-
C TIVELY PROCEED FROM LEFT TO RIGHT.'
C
C THERE ARE TESTS WHERE THE ARITHMETIC EXPRESSION CONTAINS
C (1) INTEGER CONSTANT/INTEGER CONSTANT/INTEGER CONSTANT
C NO TRUNCATION REQUIRED
C (2) INTEGER CONSTANT/INTEGER CONSTANT/INTEGER CONSTANT
C TRUNCATION REQUIRED
C
C REFERENCES
C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN,
C X3.9-1978
C
C SECTION 4.3, INTEGER TYPE
C SECTION 4.3.1, INTEGER CONSTANT
C SECTION 6.1, ARITHMETIC EXPRESSIONS
C SECTION 6.6, EVALUATION OF EXPRESSIONS
C SECTION 10.1, ARITHMETIC ASSIGNMENT STATEMENT
C
C **********************************************************
C
C A COMPILER VALIDATION SYSTEM FOR THE FORTRAN LANGUAGE
C BASED ON SPECIFICATIONS AS DEFINED IN AMERICAN NATIONAL STANDARD
C PROGRAMMING LANGUAGE FORTRAN X3.9-1978, HAS BEEN DEVELOPED BY THE
C FEDERAL COBOL COMPILER TESTING SERVICE. THE FORTRAN COMPILER
C VALIDATION SYSTEM (FCVS) CONSISTS OF AUDIT ROUTINES, THEIR RELATED
C DATA, AND AN EXECUTIVE SYSTEM. EACH AUDIT ROUTINE IS A FORTRAN
C PROGRAM, SUBPROGRAM OR FUNCTION WHICH INCLUDES TESTS OF SPECIFIC
C LANGUAGE ELEMENTS AND SUPPORTING PROCEDURES INDICATING THE RESULT
C OF EXECUTING THESE TESTS.
C
C THIS PARTICULAR PROGRAM/SUBPROGRAM/FUNCTION CONTAINS FEATURES
C FOUND ONLY IN THE SUBSET AS DEFINED IN X3.9-1978.
C
C SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO -
C
C DEPARTMENT OF THE NAVY
C FEDERAL COBOL COMPILER TESTING SERVICE
C WASHINGTON, D.C. 20376
C
C **********************************************************
C
C
C
C INITIALIZATION SECTION
C
C INITIALIZE CONSTANTS
C **************
C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER.
I01 = 5
C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER.
I02 = 6
C SYSTEM ENVIRONMENT SECTION
C
CX010 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-010 CONTROL CARD.
C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5
C (UNIT NUMBER FOR CARD READER).
CX011 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-011 CONTROL CARD.
C THE CX011 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL
C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX010 ABOVE.
C
CX020 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-020 CONTROL CARD.
C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02 = 6
C (UNIT NUMBER FOR PRINTER).
CX021 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-021 CONTROL CARD.
C THE CX021 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL
C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX020 ABOVE.
C
IVPASS=0
IVFAIL=0
IVDELE=0
ICZERO=0
C
C WRITE PAGE HEADERS
WRITE (I02,90000)
WRITE (I02,90001)
WRITE (I02,90002)
WRITE (I02, 90002)
WRITE (I02,90003)
WRITE (I02,90002)
WRITE (I02,90004)
WRITE (I02,90002)
WRITE (I02,90011)
WRITE (I02,90002)
WRITE (I02,90002)
WRITE (I02,90005)
WRITE (I02,90006)
WRITE (I02,90002)
C
C TEST SECTION
C
C ARITHMETIC ASSIGNMENT STATEMENT
C
C TEST 491 THROUGH TEST 519 CONTAIN THREE INTEGER CONSTANTS AND
C OPERATOR / IN AN ARITHMETIC EXPRESSION. THE FORM TESTED IS
C INTEGER VARIABLE = INTEGER CONSTANT/INTEGER CONSTANT/INT.CON.
C
C
C TEST 491 THROUGH TEST 496 - POSITIVE INTEGER CONSTANTS
C NO TRUNCATION REQUIRED
C
4911 CONTINUE
IVTNUM = 491
C
C **** TEST 491 ****
C
IF (ICZERO) 34910, 4910, 34910
4910 CONTINUE
IVCOMP = 24/3/4
GO TO 44910
34910 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 44910, 4921, 44910
44910 IF (IVCOMP - 2) 24910,14910,24910
14910 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 4921
24910 IVFAIL = IVFAIL + 1
IVCORR = 2
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
4921 CONTINUE
IVTNUM = 492
C
C **** TEST 492 ****
C
IF (ICZERO) 34920, 4920, 34920
4920 CONTINUE
IVCOMP = 330/3/2
GO TO 44920
34920 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 44920, 4931, 44920
44920 IF (IVCOMP - 55) 24920,14920,24920
14920 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 4931
24920 IVFAIL = IVFAIL + 1
IVCORR = 55
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
4931 CONTINUE
IVTNUM = 493
C
C **** TEST 493 ****
C
IF (ICZERO) 34930, 4930, 34930
4930 CONTINUE
IVCOMP = 15249/13/51
GO TO 44930
34930 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 44930, 4941, 44930
44930 IF (IVCOMP - 23) 24930,14930,24930
14930 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 4941
24930 IVFAIL = IVFAIL + 1
IVCORR = 23
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
4941 CONTINUE
IVTNUM = 494
C
C **** TEST 494 ****
C
IF (ICZERO) 34940, 4940, 34940
4940 CONTINUE
IVCOMP = 7150/2/25
GO TO 44940
34940 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 44940, 4951, 44940
44940 IF (IVCOMP - 143) 24940,14940,24940
14940 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 4951
24940 IVFAIL = IVFAIL + 1
IVCORR = 143
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
4951 CONTINUE
IVTNUM = 495
C
C **** TEST 495 ****
C
IF (ICZERO) 34950, 4950, 34950
4950 CONTINUE
IVCOMP = 32766/2/3
GO TO 44950
34950 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 44950, 4961, 44950
44950 IF (IVCOMP - 5461) 24950,14950,24950
14950 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 4961
24950 IVFAIL = IVFAIL + 1
IVCORR = 5461
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
4961 CONTINUE
IVTNUM = 496
C
C **** TEST 496 ****
C
IF (ICZERO) 34960, 4960, 34960
4960 CONTINUE
IVCOMP = 32766/1/1
GO TO 44960
34960 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 44960, 4971, 44960
44960 IF (IVCOMP - 32766) 24960,14960,24960
14960 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 4971
24960 IVFAIL = IVFAIL + 1
IVCORR = 32766
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
C
C TEST 497 THROUGH TEST 502 - POSITIVE INTEGER CONSTANTS
C TRUNCATION REQUIRED
C
4971 CONTINUE
IVTNUM = 497
C
C **** TEST 497 ****
C
IF (ICZERO) 34970, 4970, 34970
4970 CONTINUE
IVCOMP = 24/3/3
GO TO 44970
34970 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 44970, 4981, 44970
44970 IF (IVCOMP -2) 24970,14970,24970
14970 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 4981
24970 IVFAIL = IVFAIL + 1
IVCORR = 2
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
4981 CONTINUE
IVTNUM = 498
C
C **** TEST 498 ****
C
IF (ICZERO) 34980, 4980, 34980
4980 CONTINUE
IVCOMP = 230/2/3
GO TO 44980
34980 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 44980, 4991, 44980
44980 IF (IVCOMP - 38) 24980,14980,24980
14980 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 4991
24980 IVFAIL = IVFAIL + 1
IVCORR = 38
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
4991 CONTINUE
IVTNUM = 499
C
C **** TEST 499 ****
C
IF (ICZERO) 34990, 4990, 34990
4990 CONTINUE
IVCOMP = 7151/3/10
GO TO 44990
34990 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 44990, 5001, 44990
44990 IF (IVCOMP - 238) 24990,14990,24990
14990 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 5001
24990 IVFAIL = IVFAIL + 1
IVCORR = 238
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
5001 CONTINUE
IVTNUM = 500
C
C **** TEST 500 ****
C
IF (ICZERO) 35000, 5000, 35000
5000 CONTINUE
IVCOMP = 15248/51/13
GO TO 45000
35000 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 45000, 5011, 45000
45000 IF (IVCOMP - 22) 25000,15000,25000
15000 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 5011
25000 IVFAIL = IVFAIL + 1
IVCORR = 22
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
5011 CONTINUE
IVTNUM = 501
C
C **** TEST 501 ****
C
IF (ICZERO) 35010, 5010, 35010
5010 CONTINUE
IVCOMP = 27342/4/3
GO TO 45010
35010 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 45010, 5021, 45010
45010 IF (IVCOMP - 2278) 25010,15010,25010
15010 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 5021
25010 IVFAIL = IVFAIL + 1
IVCORR = 2278
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
5021 CONTINUE
IVTNUM = 502
C
C **** TEST 502 ****
C
IF (ICZERO) 35020, 5020, 35020
5020 CONTINUE
IVCOMP = 32767/2/1
GO TO 45020
35020 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 45020, 5031, 45020
45020 IF (IVCOMP - 16383) 25020,15020,25020
15020 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 5031
25020 IVFAIL = IVFAIL + 1
IVCORR = 16383
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
C
C TEST 503 THROUGH TEST 507 - NEGATIVE INTEGER CONSTANTS INCLUDED
C NO TRUNCATION REQUIRED
C
5031 CONTINUE
IVTNUM = 503
C
C **** TEST 503 ****
C
IF (ICZERO) 35030, 5030, 35030
5030 CONTINUE
IVCOMP = -24/3/4
GO TO 45030
35030 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 45030, 5041, 45030
45030 IF (IVCOMP +2) 25030,15030,25030
15030 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 5041
25030 IVFAIL = IVFAIL + 1
IVCORR = -2
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
5041 CONTINUE
IVTNUM = 504
C
C **** TEST 504 ****
C
IF (ICZERO) 35040, 5040, 35040
5040 CONTINUE
IVCOMP = 330/(-3)/2
GO TO 45040
35040 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 45040, 5051, 45040
45040 IF (IVCOMP + 55) 25040,15040,25040
15040 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 5051
25040 IVFAIL = IVFAIL + 1
IVCORR = -55
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
5051 CONTINUE
IVTNUM = 505
C
C **** TEST 505 ****
C
IF (ICZERO) 35050, 5050, 35050
5050 CONTINUE
IVCOMP = 15249/(-13)/(-51)
GO TO 45050
35050 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 45050, 5061, 45050
45050 IF (IVCOMP - 23) 25050,15050,25050
15050 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 5061
25050 IVFAIL = IVFAIL + 1
IVCORR = 23
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
5061 CONTINUE
IVTNUM = 506
C
C **** TEST 506 ****
C
IF (ICZERO) 35060, 5060, 35060
5060 CONTINUE
IVCOMP = -7150/(-2)/(-25)
GO TO 45060
35060 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 45060, 5071, 45060
45060 IF (IVCOMP + 143) 25060,15060,25060
15060 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 5071
25060 IVFAIL = IVFAIL + 1
IVCORR = -143
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
5071 CONTINUE
IVTNUM = 507
C
C **** TEST 507 ****
C
IF (ICZERO) 35070, 5070, 35070
5070 CONTINUE
IVCOMP = (-32766)/(-2)/(-3)
GO TO 45070
35070 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 45070, 5081, 45070
45070 IF (IVCOMP + 5461) 25070,15070,25070
15070 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 5081
25070 IVFAIL = IVFAIL + 1
IVCORR = -5461
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
C
C TEST 508 THROUGH TEST 513 - NEGATIVE INTEGER CONSTANTS INCLUDED
C TRUNCATION REQUIRED
C
5081 CONTINUE
IVTNUM = 508
C
C **** TEST 508 ****
C
IF (ICZERO) 35080, 5080, 35080
5080 CONTINUE
IVCOMP = -24/3/3
GO TO 45080
35080 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 45080, 5091, 45080
45080 IF (IVCOMP + 2) 25080,15080,25080
15080 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 5091
25080 IVFAIL = IVFAIL + 1
IVCORR = -2
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
5091 CONTINUE
IVTNUM = 509
C
C **** TEST 509 ****
C
IF (ICZERO) 35090, 5090, 35090
5090 CONTINUE
IVCOMP = 230/(-2)/3
GO TO 45090
35090 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 45090, 5101, 45090
45090 IF (IVCOMP + 38) 25090,15090,25090
15090 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 5101
25090 IVFAIL = IVFAIL + 1
IVCORR = -38
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
5101 CONTINUE
IVTNUM = 510
C
C **** TEST 510 ****
C
IF (ICZERO) 35100, 5100, 35100
5100 CONTINUE
IVCOMP = 7151/(-3)/(-10)
GO TO 45100
35100 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 45100, 5111, 45100
45100 IF (IVCOMP - 238) 25100,15100,25100
15100 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 5111
25100 IVFAIL = IVFAIL + 1
IVCORR = 238
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
5111 CONTINUE
IVTNUM = 511
C
C **** TEST 511 ****
C
IF (ICZERO) 35110, 5110, 35110
5110 CONTINUE
IVCOMP = -15248/(-51)/(-13)
GO TO 45110
35110 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 45110, 5121, 45110
45110 IF (IVCOMP + 22) 25110,15110,25110
15110 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 5121
25110 IVFAIL = IVFAIL + 1
IVCORR = -22
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
5121 CONTINUE
IVTNUM = 512
C
C **** TEST 512 ****
C
IF (ICZERO) 35120, 5120, 35120
5120 CONTINUE
IVCOMP = (-27342)/(-4)/(-3)
GO TO 45120
35120 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 45120, 5131, 45120
45120 IF (IVCOMP + 2278) 25120,15120,25120
15120 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 5131
25120 IVFAIL = IVFAIL + 1
IVCORR = -2278
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
5131 CONTINUE
IVTNUM = 513
C
C **** TEST 513 ****
C
IF (ICZERO) 35130, 5130, 35130
5130 CONTINUE
IVCOMP = 32767/2/(-1)
GO TO 45130
35130 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 45130, 5141, 45130
45130 IF (IVCOMP + 16383) 25130,15130,25130
15130 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 5141
25130 IVFAIL = IVFAIL + 1
IVCORR = -16383
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
C
C TEST 514 THROUGH TEST 519 - POSITIVE AND NEGATIVE SIGNED INTEGER
C CONSTANTS IN ARITHMETIC EXPRESSION.
C
5141 CONTINUE
IVTNUM = 514
C
C **** TEST 514 ****
C
IF (ICZERO) 35140, 5140, 35140
5140 CONTINUE
IVCOMP = +24/(-3)/4
GO TO 45140
35140 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 45140, 5151, 45140
45140 IF (IVCOMP +2) 25140,15140,25140
15140 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 5151
25140 IVFAIL = IVFAIL + 1
IVCORR = -2
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
5151 CONTINUE
IVTNUM = 515
C
C **** TEST 515 ****
C
IF (ICZERO) 35150, 5150, 35150
5150 CONTINUE
IVCOMP = 24/(+3)/(-4)
GO TO 45150
35150 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 45150, 5161, 45150
45150 IF (IVCOMP +2) 25150,15150,25150
15150 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 5161
25150 IVFAIL = IVFAIL + 1
IVCORR = -2
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
5161 CONTINUE
IVTNUM = 516
C
C **** TEST 516 ****
C
IF (ICZERO) 35160, 5160, 35160
5160 CONTINUE
IVCOMP = -24/(-3)/(+4)
GO TO 45160
35160 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 45160, 5171, 45160
45160 IF (IVCOMP -2) 25160,15160,25160
15160 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 5171
25160 IVFAIL = IVFAIL + 1
IVCORR = 2
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
5171 CONTINUE
IVTNUM = 517
C
C **** TEST 517 ****
C
IF (ICZERO) 35170, 5170, 35170
5170 CONTINUE
IVCOMP = -16811/(-16812)/(+1)
GO TO 45170
35170 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 45170, 5181, 45170
45170 IF (IVCOMP - 0) 25170,15170,25170
15170 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 5181
25170 IVFAIL = IVFAIL + 1
IVCORR = 0
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
5181 CONTINUE
IVTNUM = 518
C
C **** TEST 518 ****
C
IF (ICZERO) 35180, 5180, 35180
5180 CONTINUE
IVCOMP = (-16811) / (+16811) / (+1)
GO TO 45180
35180 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 45180, 5191, 45180
45180 IF (IVCOMP +1) 25180,15180,25180
15180 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 5191
25180 IVFAIL = IVFAIL + 1
IVCORR = -1
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
5191 CONTINUE
IVTNUM = 519
C
C **** TEST 519 ****
C
IF (ICZERO) 35190, 5190, 35190
5190 CONTINUE
IVCOMP = (-335)/(+168)/(+1)
GO TO 45190
35190 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 45190, 5201, 45190
45190 IF (IVCOMP + 1) 25190,15190,25190
15190 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 5201
25190 IVFAIL = IVFAIL + 1
IVCORR = -1
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
C **** END OF TESTS ****
5201 CONTINUE
C
C WRITE PAGE FOOTINGS AND RUN SUMMARIES
99999 CONTINUE
WRITE (I02,90002)
WRITE (I02,90006)
WRITE (I02,90002)
WRITE (I02,90002)
WRITE (I02,90007)
WRITE (I02,90002)
WRITE (I02,90008) IVFAIL
WRITE (I02,90009) IVPASS
WRITE (I02,90010) IVDELE
C
C
C TERMINATE ROUTINE EXECUTION
STOP
C
C FORMAT STATEMENTS FOR PAGE HEADERS
90000 FORMAT (1H1)
90002 FORMAT (1H )
90001 FORMAT (1H ,10X,34HFORTRAN COMPILER VALIDATION SYSTEM)
90003 FORMAT (1H ,21X,11HVERSION 1.0)
90004 FORMAT (1H ,10X,38HFOR OFFICIAL USE ONLY - COPYRIGHT 1978)
90005 FORMAT (1H ,5X,4HTEST,5X,9HPASS/FAIL, 5X,8HCOMPUTED,8X,7HCORRECT)
90006 FORMAT (1H ,5X,46H----------------------------------------------)
90011 FORMAT (1H ,18X,17HSUBSET LEVEL TEST)
C
C FORMAT STATEMENTS FOR RUN SUMMARIES
90008 FORMAT (1H ,15X,I5,19H ERRORS ENCOUNTERED)
90009 FORMAT (1H ,15X,I5,13H TESTS PASSED)
90010 FORMAT (1H ,15X,I5,14H TESTS DELETED)
C
C FORMAT STATEMENTS FOR TEST RESULTS
80001 FORMAT (1H ,4X,I5,7X,4HPASS)
80002 FORMAT (1H ,4X,I5,7X,4HFAIL)
80003 FORMAT (1H ,4X,I5,7X,7HDELETED)
80004 FORMAT (1H ,4X,I5,7X,4HFAIL,10X,I6,9X,I6)
80005 FORMAT (1H ,4X,I5,7X,4HFAIL,4X,E12.5,3X,E12.5)
C
90007 FORMAT (1H ,20X,20HEND OF PROGRAM FM037)
END
*END-OF,FM037
FM038.f 480976033 170 2 100666 21554 `
*HEADER,FORTR,FM038
*FILES1,FORTR,FM038,X
C COMMENT SECTION
C
C FM038
C
C THIS ROUTINE TESTS ARITHMETIC ASSIGNMENT STATEMENTS OF THE
C FORM INTEGER VARIABLE = ARITHMETIC EXPRESSION
C WHERE THE ARITHMETIC EXPRESSION IS FORMED WITH THE ARITHMETIC
C OPERATOR /, INTEGER CONSTANTS AND AN INTEGER VARIABLE. BOTH
C POSITIVE AND NEGATIVE VALUES ARE USED FOR THE INTEGER CONSTANTS
C AND THE INTEGER VARIABLE.
C
C THERE ARE TESTS WHICH REQUIRE NO TRUNCATION OF THE RESULT
C AND TESTS WHERE THE RESULT MUST BE TRUNCATED BEFORE BEING STORED
C IN THE RESULTANT INTEGER VARIABLE. SOME OF THE TESTS USE PARENS
C TO GROUP ELEMENTS IN THE ARITHMETIC EXPRESSION.
C
C THERE ARE TESTS WHERE THE ARITHMETIC EXPRESSION CONTAINS
C (1) (INTEGER CONSTANT/INTEGER CONSTANT)/INTEGER CONSTANT
C (2) INTEGER CONSTANT/(INTEGER CONSTANT/INTEGER CONSTANT)
C (3) INTEGER VARIABLE/INTEGER CONSTANT
C (4) INTEGER CONSTANT/INTEGER VARIABLE
C
C REFERENCES
C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN,
C X3.9-1978
C
C SECTION 4.3, INTEGER TYPE
C SECTION 4.3.1, INTEGER CONSTANT
C SECTION 6.1, ARITHMETIC EXPRESSIONS
C SECTION 6.6, EVALUATION OF EXPRESSIONS
C SECTION 10.1, ARITHMETIC ASSIGNMENT STATEMENT
C
C **********************************************************
C
C A COMPILER VALIDATION SYSTEM FOR THE FORTRAN LANGUAGE
C BASED ON SPECIFICATIONS AS DEFINED IN AMERICAN NATIONAL STANDARD
C PROGRAMMING LANGUAGE FORTRAN X3.9-1978, HAS BEEN DEVELOPED BY THE
C FEDERAL COBOL COMPILER TESTING SERVICE. THE FORTRAN COMPILER
C VALIDATION SYSTEM (FCVS) CONSISTS OF AUDIT ROUTINES, THEIR RELATED
C DATA, AND AN EXECUTIVE SYSTEM. EACH AUDIT ROUTINE IS A FORTRAN
C PROGRAM, SUBPROGRAM OR FUNCTION WHICH INCLUDES TESTS OF SPECIFIC
C LANGUAGE ELEMENTS AND SUPPORTING PROCEDURES INDICATING THE RESULT
C OF EXECUTING THESE TESTS.
C
C THIS PARTICULAR PROGRAM/SUBPROGRAM/FUNCTION CONTAINS FEATURES
C FOUND ONLY IN THE SUBSET AS DEFINED IN X3.9-1978.
C
C SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO -
C
C DEPARTMENT OF THE NAVY
C FEDERAL COBOL COMPILER TESTING SERVICE
C WASHINGTON, D.C. 20376
C
C **********************************************************
C
C
C
C INITIALIZATION SECTION
C
C INITIALIZE CONSTANTS
C **************
C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER.
I01 = 5
C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER.
I02 = 6
C SYSTEM ENVIRONMENT SECTION
C
CX010 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-010 CONTROL CARD.
C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5
C (UNIT NUMBER FOR CARD READER).
CX011 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-011 CONTROL CARD.
C THE CX011 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL
C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX010 ABOVE.
C
CX020 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-020 CONTROL CARD.
C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02 = 6
C (UNIT NUMBER FOR PRINTER).
CX021 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-021 CONTROL CARD.
C THE CX021 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL
C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX020 ABOVE.
C
IVPASS=0
IVFAIL=0
IVDELE=0
ICZERO=0
C
C WRITE PAGE HEADERS
WRITE (I02,90000)
WRITE (I02,90001)
WRITE (I02,90002)
WRITE (I02, 90002)
WRITE (I02,90003)
WRITE (I02,90002)
WRITE (I02,90004)
WRITE (I02,90002)
WRITE (I02,90011)
WRITE (I02,90002)
WRITE (I02,90002)
WRITE (I02,90005)
WRITE (I02,90006)
WRITE (I02,90002)
C
C TEST SECTION
C
C ARITHMETIC ASSIGNMENT STATEMENT
C
C TEST 520 THROUGH TEST 525 CONTAIN ARITHMETIC ASSIGNMENT STATEMENTS
C OF THE FORM INTEGER VARIABLE = (INT.CON./INT.CON.)/INT.CON.
C NO TRUNCATION OF THE RESULT IS REQUIRED. BOTH POSITIVE AND
C NEGATIVE CONSTANTS ARE INCLUDED.
C
5201 CONTINUE
IVTNUM = 520
C
C **** TEST 520 ****
C
IF (ICZERO) 35200, 5200, 35200
5200 CONTINUE
IVCOMP = (24/3)/4
GO TO 45200
35200 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 45200, 5211, 45200
45200 IF (IVCOMP - 2) 25200,15200,25200
15200 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 5211
25200 IVFAIL = IVFAIL + 1
IVCORR = 2
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
5211 CONTINUE
IVTNUM = 521
C
C **** TEST 521 ****
C
IF (ICZERO) 35210, 5210, 35210
5210 CONTINUE
IVCOMP = (7150/2)/25
GO TO 45210
35210 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 45210, 5221, 45210
45210 IF (IVCOMP - 143) 25210,15210,25210
15210 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 5221
25210 IVFAIL = IVFAIL + 1
IVCORR = 143
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
5221 CONTINUE
IVTNUM = 522
C
C **** TEST 522 ****
C
IF (ICZERO) 35220, 5220, 35220
5220 CONTINUE
IVCOMP = (-24/3)/4
GO TO 45220
35220 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 45220, 5231, 45220
45220 IF (IVCOMP + 2) 25220,15220,25220
15220 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 5231
25220 IVFAIL = IVFAIL + 1
IVCORR = -2
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
5231 CONTINUE
IVTNUM = 523
C
C **** TEST 523 ****
C
IF (ICZERO) 35230, 5230, 35230
5230 CONTINUE
IVCOMP = (330/(-3))/2
GO TO 45230
35230 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 45230, 5241, 45230
45230 IF (IVCOMP + 55) 25230,15230,25230
15230 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 5241
25230 IVFAIL = IVFAIL + 1
IVCORR = -55
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
5241 CONTINUE
IVTNUM = 524
C
C **** TEST 524 ****
C
IF (ICZERO) 35240, 5240, 35240
5240 CONTINUE
IVCOMP = ((-7150)/(-2))/(-25)
GO TO 45240
35240 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 45240, 5251, 45240
45240 IF (IVCOMP + 143) 25240,15240,25240
15240 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 5251
25240 IVFAIL = IVFAIL + 1
IVCORR = -143
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
5251 CONTINUE
IVTNUM = 525
C
C **** TEST 525 ****
C
IF (ICZERO) 35250, 5250, 35250
5250 CONTINUE
IVCOMP = (15249/(-13))/(-51)
GO TO 45250
35250 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 45250, 5261, 45250
45250 IF (IVCOMP - 23) 25250,15250,25250
15250 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 5261
25250 IVFAIL = IVFAIL + 1
IVCORR = 23
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
C
C TEST 526 THROUGH TEST 531 CONTAIN ARITHMETIC ASSIGNMENT STATEMENTS
C OF THE FORM IV = (IC/IC)/IC.
C TRUNCATION OF THE RESULT IS REQUIRED. BOTH POSITIVE AND
C NEGATIVE CONSTANTS ARE INCLUDED.
C
5261 CONTINUE
IVTNUM = 526
C
C **** TEST 526 ****
C
IF (ICZERO) 35260, 5260, 35260
5260 CONTINUE
IVCOMP = (24/3)/3
GO TO 45260
35260 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 45260, 5271, 45260
45260 IF (IVCOMP - 2) 25260,15260,25260
15260 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 5271
25260 IVFAIL = IVFAIL + 1
IVCORR = 2
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
5271 CONTINUE
IVTNUM = 527
C
C **** TEST 527 ****
C
IF (ICZERO) 35270, 5270, 35270
5270 CONTINUE
IVCOMP = (7151/3)/10
GO TO 45270
35270 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 45270, 5281, 45270
45270 IF (IVCOMP - 238) 25270,15270,25270
15270 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 5281
25270 IVFAIL = IVFAIL + 1
IVCORR = 238
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
5281 CONTINUE
IVTNUM = 528
C
C **** TEST 528 ****
C
IF (ICZERO) 35280, 5280, 35280
5280 CONTINUE
IVCOMP = (-24/3)/3
GO TO 45280
35280 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 45280, 5291, 45280
45280 IF (IVCOMP + 2) 25280,15280,25280
15280 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 5291
25280 IVFAIL = IVFAIL + 1
IVCORR = -2
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
5291 CONTINUE
IVTNUM = 529
C
C **** TEST 529 ****
C
IF (ICZERO) 35290, 5290, 35290
5290 CONTINUE
IVCOMP = (7151/(-3))/10
GO TO 45290
35290 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 45290, 5301, 45290
45290 IF (IVCOMP + 238) 25290,15290,25290
15290 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 5301
25290 IVFAIL = IVFAIL + 1
IVCORR = -238
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
5301 CONTINUE
IVTNUM = 530
C
C **** TEST 530 ****
C
IF (ICZERO) 35300, 5300, 35300
5300 CONTINUE
IVCOMP = (15248/(-51))/(-23)
GO TO 45300
35300 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 45300, 5311, 45300
45300 IF (IVCOMP - 12) 25300,15300,25300
15300 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 5311
25300 IVFAIL = IVFAIL + 1
IVCORR = 12
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
5311 CONTINUE
IVTNUM = 531
C
C **** TEST 531 ****
C
IF (ICZERO) 35310, 5310, 35310
5310 CONTINUE
IVCOMP = ((-27342)/(-4))/(-3)
GO TO 45310
35310 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 45310, 5321, 45310
45310 IF (IVCOMP + 2278) 25310,15310,25310
15310 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 5321
25310 IVFAIL = IVFAIL + 1
IVCORR = -2278
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
C
C TEST 532 THROUGH TEST 537 CONTAIN ARITHMETIC ASSIGNMENT STATEMENTS
C OF THE FORM IV = IC/(IC/IC).
C NO TRUNCATION OF THE RESULT IS REQUIRED. BOTH POSITIVE AND
C NEGATIVE CONSTANTS ARE INCLUDED.
C
5321 CONTINUE
IVTNUM = 532
C
C **** TEST 532 ****
C
IF (ICZERO) 35320, 5320, 35320
5320 CONTINUE
IVCOMP = 24/(8/4)
GO TO 45320
35320 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 45320, 5331, 45320
45320 IF (IVCOMP - 12) 25320,15320,25320
15320 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 5331
25320 IVFAIL = IVFAIL + 1
IVCORR = 12
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
5331 CONTINUE
IVTNUM = 533
C
C **** TEST 533 ****
C
IF (ICZERO) 35330, 5330, 35330
5330 CONTINUE
IVCOMP = 7150/(25/5)
GO TO 45330
35330 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 45330, 5341, 45330
45330 IF (IVCOMP - 1430) 25330,15330,25330
15330 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 5341
25330 IVFAIL = IVFAIL + 1
IVCORR = 1430
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
5341 CONTINUE
IVTNUM = 534
C
C **** TEST 534 ****
C
IF (ICZERO) 35340, 5340, 35340
5340 CONTINUE
IVCOMP = -24/(8/4)
GO TO 45340
35340 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 45340, 5351, 45340
45340 IF (IVCOMP + 12) 25340,15340,25340
15340 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 5351
25340 IVFAIL = IVFAIL + 1
IVCORR = -12
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
5351 CONTINUE
IVTNUM = 535
C
C **** TEST 535 ****
C
IF (ICZERO) 35350, 5350, 35350
5350 CONTINUE
IVCOMP = 24/((-8)/4)
GO TO 45350
35350 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 45350, 5361, 45350
45350 IF (IVCOMP + 12) 25350,15350,25350
15350 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 5361
25350 IVFAIL = IVFAIL + 1
IVCORR = -12
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
5361 CONTINUE
IVTNUM = 536
C
C **** TEST 536 ****
C
IF (ICZERO) 35360, 5360, 35360
5360 CONTINUE
IVCOMP = (-7150)/((-25)/(-5))
GO TO 45360
35360 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 45360, 5371, 45360
45360 IF (IVCOMP + 1430) 25360,15360,25360
15360 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 5371
25360 IVFAIL = IVFAIL + 1
IVCORR = -1430
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
5371 CONTINUE
IVTNUM = 537
C
C **** TEST 537 ****
C
IF (ICZERO) 35370, 5370, 35370
5370 CONTINUE
IVCOMP = -7150/(25/(-5))
GO TO 45370
35370 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 45370, 5381, 45370
45370 IF (IVCOMP - 1430) 25370,15370,25370
15370 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 5381
25370 IVFAIL = IVFAIL + 1
IVCORR = 1430
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
C
C TEST 538 THROUGH TEST 543 CONTAIN ARITHMETIC ASSIGMMENT STATEMENTS
C OF THE FORM IV = IC/(IC/IC).
C TRUNCATION OF THE RESULT IS REQUIRED. BOTH POSITIVE AND
C NEGATIVE CONSTANTS ARE INCLUDED.
C
5381 CONTINUE
IVTNUM = 538
C
C **** TEST 538 ****
C
IF (ICZERO) 35380, 5380, 35380
5380 CONTINUE
IVCOMP = 29/(5/2)
GO TO 45380
35380 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 45380, 5391, 45380
45380 IF (IVCOMP - 14) 25380,15380,25380
15380 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 5391
25380 IVFAIL = IVFAIL + 1
IVCORR = 14
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
5391 CONTINUE
IVTNUM = 539
C
C **** TEST 539 ****
C
IF (ICZERO) 35390, 5390, 35390
5390 CONTINUE
IVCOMP = 7154/(26/5)
GO TO 45390
35390 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 45390, 5401, 45390
45390 IF (IVCOMP - 1430) 25390,15390,25390
15390 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 5401
25390 IVFAIL = IVFAIL + 1
IVCORR = 1430
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
5401 CONTINUE
IVTNUM = 540
C
C **** TEST 540 ****
C
IF (ICZERO) 35400, 5400, 35400
5400 CONTINUE
IVCOMP = -7154/(26/5)
GO TO 45400
35400 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 45400, 5411, 45400
45400 IF (IVCOMP + 1430) 25400,15400,25400
15400 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 5411
25400 IVFAIL = IVFAIL + 1
IVCORR = -1430
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
5411 CONTINUE
IVTNUM = 541
C
C **** TEST 541 ****
C
IF (ICZERO) 35410, 5410, 35410
5410 CONTINUE
IVCOMP = (-7154)/((-26)/5)
GO TO 45410
35410 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 45410, 5421, 45410
45410 IF (IVCOMP - 1430) 25410,15410,25410
15410 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 5421
25410 IVFAIL = IVFAIL + 1
IVCORR = 1430
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
5421 CONTINUE
IVTNUM = 542
C
C **** TEST 542 ****
C
IF (ICZERO) 35420, 5420, 35420
5420 CONTINUE
IVCOMP = 7154/((-26)/(-5))
GO TO 45420
35420 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 45420, 5431, 45420
45420 IF (IVCOMP - 1430) 25420,15420,25420
15420 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 5431
25420 IVFAIL = IVFAIL + 1
IVCORR = 1430
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
5431 CONTINUE
IVTNUM = 543
C
C **** TEST 543 ****
C
IF (ICZERO) 35430, 5430, 35430
5430 CONTINUE
IVCOMP = (-7154)/((-26)/(-5))
GO TO 45430
35430 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 45430, 5441, 45430
45430 IF (IVCOMP + 1430) 25430,15430,25430
15430 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 5441
25430 IVFAIL = IVFAIL + 1
IVCORR = -1430
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
C
C TEST 544 THROUGH TEST 547 CONTAIN ARITHMETIC ASSIGNMENT STATEMENTS
C OF THE FORM INTEGER VARIABLE = INTEGER VARIABLE/INTEGER CONSTANT
C
5441 CONTINUE
IVTNUM = 544
C
C **** TEST 544 ****
C
IF (ICZERO) 35440, 5440, 35440
5440 CONTINUE
IVON01 = 75
IVCOMP = IVON01/25
GO TO 45440
35440 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 45440, 5451, 45440
45440 IF (IVCOMP - 3) 25440,15440,25440
15440 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 5451
25440 IVFAIL = IVFAIL + 1
IVCORR = 3
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
5451 CONTINUE
IVTNUM = 545
C
C **** TEST 545 ****
C
IF (ICZERO) 35450, 5450, 35450
5450 CONTINUE
IVON01 = -3575
IVCOMP = IVON01/25
GO TO 45450
35450 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 45450, 5461, 45450
45450 IF (IVCOMP + 143) 25450,15450,25450
15450 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 5461
25450 IVFAIL = IVFAIL + 1
IVCORR = -143
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
5461 CONTINUE
IVTNUM = 546
C
C **** TEST 546 ****
C
IF (ICZERO) 35460, 5460, 35460
5460 CONTINUE
IVON01 = 3575
IVCOMP = IVON01/(-143)
GO TO 45460
35460 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 45460, 5471, 45460
45460 IF (IVCOMP + 25) 25460,15460,25460
15460 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 5471
25460 IVFAIL = IVFAIL + 1
IVCORR = -25
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
5471 CONTINUE
IVTNUM = 547
C
C **** TEST 547 ****
C
IF (ICZERO) 35470, 5470, 35470
5470 CONTINUE
IVON01 = 959
IVCOMP = IVON01/120
GO TO 45470
35470 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 45470, 5481, 45470
45470 IF (IVCOMP -7) 25470,15470,25470
15470 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 5481
25470 IVFAIL = IVFAIL + 1
IVCORR = 7
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
C
C TEST 548 THROUGH TEST 551 CONTAIN ARITHMETIC ASSIGNMENT STATEMENTS
C OF THE FORM INTEGER VARIABLE =INTEGER CONSTANT/INTEGER VARIABLE.
C
5481 CONTINUE
IVTNUM = 548
C
C **** TEST 548 ****
C
IF (ICZERO) 35480, 5480, 35480
5480 CONTINUE
IVON02 = 25
IVCOMP = 75/IVON02
GO TO 45480
35480 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 45480, 5491, 45480
45480 IF (IVCOMP - 3) 25480,15480,25480
15480 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 5491
25480 IVFAIL = IVFAIL + 1
IVCORR = 3
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
5491 CONTINUE
IVTNUM = 549
C
C **** TEST 549 ****
C
IF (ICZERO) 35490, 5490, 35490
5490 CONTINUE
IVON02 = -25
IVCOMP = 3579/IVON02
GO TO 45490
35490 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 45490, 5501, 45490
45490 IF (IVCOMP + 143) 25490,15490,25490
15490 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 5501
25490 IVFAIL = IVFAIL + 1
IVCORR = -143
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
5501 CONTINUE
IVTNUM = 550
C
C **** TEST 550 ****
C
IF (ICZERO) 35500, 5500, 35500
5500 CONTINUE
IVON02 = -143
IVCOMP = (-3575)/IVON02
GO TO 45500
35500 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 45500, 5511, 45500
45500 IF (IVCOMP - 25) 25500,15500,25500
15500 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 5511
25500 IVFAIL = IVFAIL + 1
IVCORR = 25
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
5511 CONTINUE
IVTNUM = 551
C
C **** TEST 551 ****
C
IF (ICZERO) 35510, 5510, 35510
5510 CONTINUE
IVON02 = 120
IVCOMP = -959/IVON02
GO TO 45510
35510 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 45510, 5521, 45510
45510 IF (IVCOMP + 7) 25510,15510,25510
15510 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 5521
25510 IVFAIL = IVFAIL + 1
IVCORR = -7
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
C **** END OF TESTS ****
5521 CONTINUE
C
C WRITE PAGE FOOTINGS AND RUN SUMMARIES
99999 CONTINUE
WRITE (I02,90002)
WRITE (I02,90006)
WRITE (I02,90002)
WRITE (I02,90002)
WRITE (I02,90007)
WRITE (I02,90002)
WRITE (I02,90008) IVFAIL
WRITE (I02,90009) IVPASS
WRITE (I02,90010) IVDELE
C
C
C TERMINATE ROUTINE EXECUTION
STOP
C
C FORMAT STATEMENTS FOR PAGE HEADERS
90000 FORMAT (1H1)
90002 FORMAT (1H )
90001 FORMAT (1H ,10X,34HFORTRAN COMPILER VALIDATION SYSTEM)
90003 FORMAT (1H ,21X,11HVERSION 1.0)
90004 FORMAT (1H ,10X,38HFOR OFFICIAL USE ONLY - COPYRIGHT 1978)
90005 FORMAT (1H ,5X,4HTEST,5X,9HPASS/FAIL, 5X,8HCOMPUTED,8X,7HCORRECT)
90006 FORMAT (1H ,5X,46H----------------------------------------------)
90011 FORMAT (1H ,18X,17HSUBSET LEVEL TEST)
C
C FORMAT STATEMENTS FOR RUN SUMMARIES
90008 FORMAT (1H ,15X,I5,19H ERRORS ENCOUNTERED)
90009 FORMAT (1H ,15X,I5,13H TESTS PASSED)
90010 FORMAT (1H ,15X,I5,14H TESTS DELETED)
C
C FORMAT STATEMENTS FOR TEST RESULTS
80001 FORMAT (1H ,4X,I5,7X,4HPASS)
80002 FORMAT (1H ,4X,I5,7X,4HFAIL)
80003 FORMAT (1H ,4X,I5,7X,7HDELETED)
80004 FORMAT (1H ,4X,I5,7X,4HFAIL,10X,I6,9X,I6)
80005 FORMAT (1H ,4X,I5,7X,4HFAIL,4X,E12.5,3X,E12.5)
C
90007 FORMAT (1H ,20X,20HEND OF PROGRAM FM038)
END
*END-OF,FM038
FM039.f 480976036 170 2 100666 20638 `
*HEADER,FORTR,FM039
*FILES1,FORTR,FM039,X
C COMMENT SECTION
C
C FM039
C
C THIS ROUTINE TESTS ARITHMETIC ASSIGNMENT STATEMENTS OF THE
C FORM INTEGER VARIABLE = ARITHMETIC EXPRESSION
C WHERE THE ARITHMETIC EXPRESSION IS FORMED WITH THE ARITHMETIC
C OPERATOR /, INTEGER CONSTANTS AND AN INTEGER VARIABLE. BOTH
C POSITIVE AND NEGATIVE VALUES ARE USED FOR THE INTEGER CONSTANTS
C AND THE INTEGER VARIABLE.
C
C THERE ARE TESTS WHICH REQUIRE NO TRUNCATION OF THE RESULT
C AND TESTS WHERE THE RESULT MUST BE TRUNCATED BEFORE BEING STORED
C IN THE RESULTANT INTEGER VARIABLE. SOME OF THE TESTS USE PARENS
C TO GROUP ELEMENTS IN THE ARITHMETIC EXPRESSION.
C
C THERE ARE TESTS WHERE THE ARITHMETIC EXPRESSION CONTAINS
C (1) INTEGER VARIABLE/INTEGER CONSTANT/INTEGER CONSTANT
C INTEGER CONSTANT/INTEGER VARIABLE/INTEGER CONSTANT
C INTEGER CONSTANT/INTEGER CONSTANT/INTEGER VARIABLE
C (2) SAME AS (1) BUT WITH PARENTHESES TO GROUP ELEMENTS
C IN THE ARITHMETIC EXPRESSION.
C
C REFERENCES
C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN,
C X3.9-1978
C
C SECTION 4.3, INTEGER TYPE
C SECTION 4.3.1, INTEGER CONSTANT
C SECTION 6.1, ARITHMETIC EXPRESSIONS
C SECTION 6.6, EVALUATION OF EXPRESSIONS
C SECTION 10.1, ARITHMETIC ASSIGNMENT STATEMENT
C
C **********************************************************
C
C A COMPILER VALIDATION SYSTEM FOR THE FORTRAN LANGUAGE
C BASED ON SPECIFICATIONS AS DEFINED IN AMERICAN NATIONAL STANDARD
C PROGRAMMING LANGUAGE FORTRAN X3.9-1978, HAS BEEN DEVELOPED BY THE
C FEDERAL COBOL COMPILER TESTING SERVICE. THE FORTRAN COMPILER
C VALIDATION SYSTEM (FCVS) CONSISTS OF AUDIT ROUTINES, THEIR RELATED
C DATA, AND AN EXECUTIVE SYSTEM. EACH AUDIT ROUTINE IS A FORTRAN
C PROGRAM, SUBPROGRAM OR FUNCTION WHICH INCLUDES TESTS OF SPECIFIC
C LANGUAGE ELEMENTS AND SUPPORTING PROCEDURES INDICATING THE RESULT
C OF EXECUTING THESE TESTS.
C
C THIS PARTICULAR PROGRAM/SUBPROGRAM/FUNCTION CONTAINS FEATURES
C FOUND ONLY IN THE SUBSET AS DEFINED IN X3.9-1978.
C
C SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO -
C
C DEPARTMENT OF THE NAVY
C FEDERAL COBOL COMPILER TESTING SERVICE
C WASHINGTON, D.C. 20376
C
C **********************************************************
C
C
C
C INITIALIZATION SECTION
C
C INITIALIZE CONSTANTS
C **************
C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER.
I01 = 5
C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER.
I02 = 6
C SYSTEM ENVIRONMENT SECTION
C
CX010 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-010 CONTROL CARD.
C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5
C (UNIT NUMBER FOR CARD READER).
CX011 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-011 CONTROL CARD.
C THE CX011 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL
C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX010 ABOVE.
C
CX020 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-020 CONTROL CARD.
C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02 = 6
C (UNIT NUMBER FOR PRINTER).
CX021 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-021 CONTROL CARD.
C THE CX021 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL
C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX020 ABOVE.
C
IVPASS=0
IVFAIL=0
IVDELE=0
ICZERO=0
C
C WRITE PAGE HEADERS
WRITE (I02,90000)
WRITE (I02,90001)
WRITE (I02,90002)
WRITE (I02, 90002)
WRITE (I02,90003)
WRITE (I02,90002)
WRITE (I02,90004)
WRITE (I02,90002)
WRITE (I02,90011)
WRITE (I02,90002)
WRITE (I02,90002)
WRITE (I02,90005)
WRITE (I02,90006)
WRITE (I02,90002)
C
C TEST SECTION
C
C ARITHMETIC ASSIGNMENT STATEMENT
C
C TEST 552 THROUGH TEST 557 CONTAIN ARITHMETIC ASSIGNMENT STATEMENTS
C OF THE FORM IV = IV/IC/IC.
C
5521 CONTINUE
IVTNUM = 552
C
C **** TEST 552 ****
C
IF (ICZERO) 35520, 5520, 35520
5520 CONTINUE
IVON01 = 24
IVCOMP = IVON01/3/4
GO TO 45520
35520 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 45520, 5531, 45520
45520 IF (IVCOMP - 2) 25520,15520,25520
15520 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 5531
25520 IVFAIL = IVFAIL + 1
IVCORR = 2
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
5531 CONTINUE
IVTNUM = 553
C
C **** TEST 553 ****
C
IF (ICZERO) 35530, 5530, 35530
5530 CONTINUE
IVON01 = 7151
IVCOMP = IVON01/3/10
GO TO 45530
35530 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 45530, 5541, 45530
45530 IF (IVCOMP - 238) 25530,15530,25530
15530 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 5541
25530 IVFAIL = IVFAIL + 1
IVCORR = 238
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
5541 CONTINUE
IVTNUM = 554
C
C **** TEST 554 ****
C
IF (ICZERO) 35540, 5540, 35540
5540 CONTINUE
IVON01 = -330
IVCOMP = IVON01/3/2
GO TO 45540
35540 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 45540, 5551, 45540
45540 IF (IVCOMP + 55) 25540,15540,25540
15540 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 5551
25540 IVFAIL = IVFAIL + 1
IVCORR = -55
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
5551 CONTINUE
IVTNUM = 555
C
C **** TEST 555 ****
C
IF (ICZERO) 35550, 5550, 35550
5550 CONTINUE
IVON01 = 15249
IVCOMP = IVON01/(-13)/51
GO TO 45550
35550 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 45550, 5561, 45550
45550 IF (IVCOMP + 23) 25550,15550,25550
15550 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 5561
25550 IVFAIL = IVFAIL + 1
IVCORR = -23
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
5561 CONTINUE
IVTNUM = 556
C
C **** TEST 556 ****
C
IF (ICZERO) 35560, 5560, 35560
5560 CONTINUE
IVON01 = -27342
IVCOMP = IVON01/(-4)/(-3)
GO TO 45560
35560 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 45560, 5571, 45560
45560 IF (IVCOMP + 2278) 25560,15560,25560
15560 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 5571
25560 IVFAIL = IVFAIL + 1
IVCORR = -2278
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
5571 CONTINUE
IVTNUM = 557
C
C **** TEST 557 ****
C
IF (ICZERO) 35570, 5570, 35570
5570 CONTINUE
IVON01 = -27342
IVCOMP = -IVON01/4/(-3)
GO TO 45570
35570 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 45570, 5581, 45570
45570 IF (IVCOMP + 2278) 25570,15570,25570
15570 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 5581
25570 IVFAIL = IVFAIL + 1
IVCORR = -2278
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
C
C TEST 558 THROUGH TEST 563 CONTAIN ARITHMETIC ASSIGNMENT STATEMENTS
C OF THE FORM IV=IC/IV/IC.
C
5581 CONTINUE
IVTNUM = 558
C
C **** TEST 558 ****
C
IF (ICZERO) 35580, 5580, 35580
5580 CONTINUE
IVON02 = 3
IVCOMP = 24/IVON02/4
GO TO 45580
35580 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 45580, 5591, 45580
45580 IF (IVCOMP - 2) 25580,15580,25580
15580 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 5591
25580 IVFAIL = IVFAIL + 1
IVCORR = 2
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
5591 CONTINUE
IVTNUM = 559
C
C **** TEST 559 ****
C
IF (ICZERO) 35590, 5590, 35590
5590 CONTINUE
IVON02 = 3
IVCOMP = 7151/IVON02/10
GO TO 45590
35590 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 45590, 5601, 45590
45590 IF (IVCOMP - 238) 25590,15590,25590
15590 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 5601
25590 IVFAIL = IVFAIL + 1
IVCORR = 238
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
5601 CONTINUE
IVTNUM = 560
C
C **** TEST 560 ****
C
IF (ICZERO) 35600, 5600, 35600
5600 CONTINUE
IVON02 = -3
IVCOMP = 330/IVON02/2
GO TO 45600
35600 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 45600, 5611, 45600
45600 IF (IVCOMP +55) 25600,15600,25600
15600 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 5611
25600 IVFAIL = IVFAIL + 1
IVCORR = -55
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
5611 CONTINUE
IVTNUM = 561
C
C **** TEST 561 ****
C
IF (ICZERO) 35610, 5610, 35610
5610 CONTINUE
IVON02 = +13
IVCOMP = 15249/IVON02/(-51)
GO TO 45610
35610 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 45610, 5621, 45610
45610 IF (IVCOMP + 23) 25610,15610,25610
15610 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 5621
25610 IVFAIL = IVFAIL + 1
IVCORR = -23
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
5621 CONTINUE
IVTNUM = 562
C
C **** TEST 562 ****
C
IF (ICZERO) 35620, 5620, 35620
5620 CONTINUE
IVON02 = -4
IVCOMP = (-27342)/IVON02/(-3)
GO TO 45620
35620 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 45620, 5631, 45620
45620 IF (IVCOMP + 2278) 25620,15620,25620
15620 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 5631
25620 IVFAIL = IVFAIL + 1
IVCORR = -2278
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
5631 CONTINUE
IVTNUM = 563
C
C **** TEST 563 ****
C
IF (ICZERO) 35630, 5630, 35630
5630 CONTINUE
IVON02 = -4
IVCOMP = -27342/(-IVON02)/(-3)
GO TO 45630
35630 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 45630, 5641, 45630
45630 IF (IVCOMP - 2278) 25630,15630,25630
15630 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 5641
25630 IVFAIL = IVFAIL + 1
IVCORR = 2278
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
C
C TEST 564 THROUGH TEST 569 CONTAIN ARITHMETIC ASSIGNMENT STATEMENTS
C OF THE FORM IV = IC/IC/IV.
C
5641 CONTINUE
IVTNUM = 564
C
C **** TEST 564 ****
C
IF (ICZERO) 35640, 5640, 35640
5640 CONTINUE
IVON03 = 4
IVCOMP = 24/3/IVON03
GO TO 45640
35640 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 45640, 5651, 45640
45640 IF (IVCOMP -2) 25640,15640,25640
15640 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 5651
25640 IVFAIL = IVFAIL + 1
IVCORR = 2
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
5651 CONTINUE
IVTNUM = 565
C
C **** TEST 565 ****
C
IF (ICZERO) 35650, 5650, 35650
5650 CONTINUE
IVON03 = 10
IVCOMP = 7151/3/IVON03
GO TO 45650
35650 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 45650, 5661, 45650
45650 IF (IVCOMP - 238) 25650,15650,25650
15650 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 5661
25650 IVFAIL = IVFAIL + 1
IVCORR = 238
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
5661 CONTINUE
IVTNUM = 566
C
C **** TEST 566 ****
C
IF (ICZERO) 35660, 5660, 35660
5660 CONTINUE
IVON03 = -2
IVCOMP = 330/3/IVON03
GO TO 45660
35660 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 45660, 5671, 45660
45660 IF (IVCOMP + 55) 25660,15660,25660
15660 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 5671
25660 IVFAIL = IVFAIL + 1
IVCORR = -55
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
5671 CONTINUE
IVTNUM = 567
C
C **** TEST 567 ****
C
IF (ICZERO) 35670, 5670, 35670
5670 CONTINUE
IVON03 = +51
IVCOMP = 15249/(-13)/IVON03
GO TO 45670
35670 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 45670, 5681, 45670
45670 IF (IVCOMP + 23) 25670,15670,25670
15670 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 5681
25670 IVFAIL = IVFAIL + 1
IVCORR = -23
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
5681 CONTINUE
IVTNUM = 568
C
C **** TEST 568 ****
C
IF (ICZERO) 35680, 5680, 35680
5680 CONTINUE
IVON03 = -3
IVCOMP = (-27342)/(-4)/IVON03
GO TO 45680
35680 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 45680, 5691, 45680
45680 IF (IVCOMP + 2278) 25680,15680,25680
15680 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 5691
25680 IVFAIL = IVFAIL + 1
IVCORR = -2278
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
5691 CONTINUE
IVTNUM = 569
C
C **** TEST 569 ****
C
IF (ICZERO) 35690, 5690, 35690
5690 CONTINUE
IVON03 = -3
IVCOMP = -27342/(-4)/(-IVON03)
GO TO 45690
35690 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 45690, 5701, 45690
45690 IF (IVCOMP - 2278) 25690,15690,25690
15690 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 5701
25690 IVFAIL = IVFAIL + 1
IVCORR = 2278
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
C
C TEST 570 AND TEST 571 - IV =(IV/IC)/IC
C
5701 CONTINUE
IVTNUM = 570
C
C **** TEST 570 ****
C
IF (ICZERO) 35700, 5700, 35700
5700 CONTINUE
IVON01 = 24
IVCOMP = (IVON01/3)/4
GO TO 45700
35700 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 45700, 5711, 45700
45700 IF (IVCOMP -2) 25700,15700,25700
15700 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 5711
25700 IVFAIL = IVFAIL + 1
IVCORR = 2
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
5711 CONTINUE
IVTNUM = 571
C
C **** TEST 571 ****
C
IF (ICZERO) 35710, 5710, 35710
5710 CONTINUE
IVON01 = -330
IVCOMP = (IVON01/(-3))/4
GO TO 45710
35710 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 45710, 5721, 45710
45710 IF (IVCOMP - 27) 25710,15710,25710
15710 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 5721
25710 IVFAIL = IVFAIL + 1
IVCORR = 27
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
C
C TEST 572 AND TEST 573 - IV= IV/(IC/IC)
C
5721 CONTINUE
IVTNUM = 572
C
C **** TEST 572 ****
C
IF (ICZERO) 35720, 5720, 35720
5720 CONTINUE
IVON01 = 24
IVCOMP = IVON01/(8/4)
GO TO 45720
35720 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 45720, 5731, 45720
45720 IF (IVCOMP - 12) 25720,15720,25720
15720 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 5731
25720 IVFAIL = IVFAIL + 1
IVCORR = 12
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
5731 CONTINUE
IVTNUM = 573
C
C **** TEST 573 ****
C
IF (ICZERO) 35730, 5730, 35730
5730 CONTINUE
IVON01 = -7154
IVCOMP = -IVON01/((-26)/5)
GO TO 45730
35730 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 45730, 5741, 45730
45730 IF (IVCOMP + 1430) 25730,15730,25730
15730 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 5741
25730 IVFAIL = IVFAIL + 1
IVCORR = -1430
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
C
C TEST 574 AND TEST 575 - IV=(IC/IV)/IC
C
5741 CONTINUE
IVTNUM = 574
C
C **** TEST 574 ****
C
IF (ICZERO) 35740, 5740, 35740
5740 CONTINUE
IVON02 = 3
IVCOMP = (24/IVON02)/4
GO TO 45740
35740 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 45740, 5751, 45740
45740 IF (IVCOMP -2) 25740,15740,25740
15740 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 5751
25740 IVFAIL = IVFAIL + 1
IVCORR = 2
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
5751 CONTINUE
IVTNUM = 575
C
C **** TEST 575 ****
C
IF (ICZERO) 35750, 5750, 35750
5750 CONTINUE
IVON02 = -3
IVCOMP = (-330/IVON02)/(-4)
GO TO 45750
35750 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 45750, 5761, 45750
45750 IF (IVCOMP + 27) 25750,15750,25750
15750 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 5761
25750 IVFAIL = IVFAIL + 1
IVCORR = -27
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
C
C TEST 576 AND TEST 577 - IV=IC/(IV/IC)
C
5761 CONTINUE
IVTNUM = 576
C
C **** TEST 576 ****
C
IF (ICZERO) 35760, 5760, 35760
5760 CONTINUE
IVON02 = 8
IVCOMP = 24/(IVON02/4)
GO TO 45760
35760 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 45760, 5771, 45760
45760 IF (IVCOMP - 12) 25760,15760,25760
15760 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 5771
25760 IVFAIL = IVFAIL + 1
IVCORR = 12
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
5771 CONTINUE
IVTNUM = 577
C
C **** TEST 577 ****
C
IF (ICZERO) 35770, 5770, 35770
5770 CONTINUE
IVON02 = -26
IVCOMP = 7154/((-IVON02)/(-5))
GO TO 45770
35770 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 45770, 5781, 45770
45770 IF (IVCOMP + 1430) 25770,15770,25770
15770 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 5781
25770 IVFAIL = IVFAIL + 1
IVCORR = -1430
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
C
C TEST 578 AND TEST 579 - IV=(IC/IC)/IV
C
5781 CONTINUE
IVTNUM = 578
C
C **** TEST 578 ****
C
IF (ICZERO) 35780, 5780, 35780
5780 CONTINUE
IVON03 = 4
IVCOMP = (24/3)/IVON03
GO TO 45780
35780 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 45780, 5791, 45780
45780 IF (IVCOMP - 2) 25780,15780,25780
15780 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 5791
25780 IVFAIL = IVFAIL + 1
IVCORR = 2
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
5791 CONTINUE
IVTNUM = 579
C
C **** TEST 579 ****
C
IF (ICZERO) 35790, 5790, 35790
5790 CONTINUE
IVON03 = -4
IVCOMP = (330/(-3))/IVON03
GO TO 45790
35790 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 45790, 5801, 45790
45790 IF (IVCOMP - 27) 25790,15790,25790
15790 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 5801
25790 IVFAIL = IVFAIL + 1
IVCORR = 27
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
C
C TEST 580 AND TEST 581 - IV= IC/(IC/IV)
C
5801 CONTINUE
IVTNUM = 580
C
C **** TEST 580 ****
C
IF (ICZERO) 35800, 5800, 35800
5800 CONTINUE
IVON03 = 4
IVCOMP = 24/(8/IVON03)
GO TO 45800
35800 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 45800, 5811, 45800
45800 IF (IVCOMP - 12) 25800,15800,25800
15800 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 5811
25800 IVFAIL = IVFAIL + 1
IVCORR = 12
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
5811 CONTINUE
IVTNUM = 581
C
C **** TEST 581 ****
C
IF (ICZERO) 35810, 5810, 35810
5810 CONTINUE
IVON03 = -5
IVCOMP = -7154/((-26)/IVON03)
GO TO 45810
35810 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 45810, 5821, 45810
45810 IF (IVCOMP + 1430) 25810,15810,25810
15810 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 5821
25810 IVFAIL = IVFAIL + 1
IVCORR = -1430
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
C
C **** END OF TESTS ****
5821 CONTINUE
C
C WRITE PAGE FOOTINGS AND RUN SUMMARIES
99999 CONTINUE
WRITE (I02,90002)
WRITE (I02,90006)
WRITE (I02,90002)
WRITE (I02,90002)
WRITE (I02,90007)
WRITE (I02,90002)
WRITE (I02,90008) IVFAIL
WRITE (I02,90009) IVPASS
WRITE (I02,90010) IVDELE
C
C
C TERMINATE ROUTINE EXECUTION
STOP
C
C FORMAT STATEMENTS FOR PAGE HEADERS
90000 FORMAT (1H1)
90002 FORMAT (1H )
90001 FORMAT (1H ,10X,34HFORTRAN COMPILER VALIDATION SYSTEM)
90003 FORMAT (1H ,21X,11HVERSION 1.0)
90004 FORMAT (1H ,10X,38HFOR OFFICIAL USE ONLY - COPYRIGHT 1978)
90005 FORMAT (1H ,5X,4HTEST,5X,9HPASS/FAIL, 5X,8HCOMPUTED,8X,7HCORRECT)
90006 FORMAT (1H ,5X,46H----------------------------------------------)
90011 FORMAT (1H ,18X,17HSUBSET LEVEL TEST)
C
C FORMAT STATEMENTS FOR RUN SUMMARIES
90008 FORMAT (1H ,15X,I5,19H ERRORS ENCOUNTERED)
90009 FORMAT (1H ,15X,I5,13H TESTS PASSED)
90010 FORMAT (1H ,15X,I5,14H TESTS DELETED)
C
C FORMAT STATEMENTS FOR TEST RESULTS
80001 FORMAT (1H ,4X,I5,7X,4HPASS)
80002 FORMAT (1H ,4X,I5,7X,4HFAIL)
80003 FORMAT (1H ,4X,I5,7X,7HDELETED)
80004 FORMAT (1H ,4X,I5,7X,4HFAIL,10X,I6,9X,I6)
80005 FORMAT (1H ,4X,I5,7X,4HFAIL,4X,E12.5,3X,E12.5)
C
90007 FORMAT (1H ,20X,20HEND OF PROGRAM FM039)
END
*END-OF,FM039
FM040.f 480976039 170 2 100666 23544 `
*HEADER,FORTR,FM040
*FILES1,FORTR,FM040,X
C COMMENT SECTION
C
C FM040
C
C THIS ROUTINE TESTS ARITHMETIC ASSIGNMENT STATEMENTS OF THE
C FORM INTEGER VARIABLE = ARITHMETIC EXPRESSION
C WHERE THE ARITHMETIC EXPRESSION IS FORMED WITH THE ARITHMETIC
C OPERATOR /, INTEGER VARIABLES AND AN INTEGER CONSTANT. BOTH
C POSITIVE AND NEGATIVE VALUES ARE USED FOR THE INTEGER VARIABLES
C AND THE INTEGER CONSTANT.
C
C THERE ARE TESTS WHICH REQUIRE NO TRUNCATION OF THE RESULT AND
C TESTS WHERE THE RESULT MUST BE TRUNCATED BEFORE BEING STORED IN
C THE RESULTANT INTEGER VARIABLE. SOME OF THE TESTS USE PARENS
C TO GROUP ELEMENTS IN THE ARITHMETIC EXPRESSION.
C
C THERE ARE TESTS WHERE THE ARITHMETIC EXPRESSION CONTAINS
C (1) INTEGER VARIABLE/INTEGER VARIABLE
C (2) INTEGER VARIABLE/INTEGER VARIABLE/INTEGER CONSTANT
C INTEGER VARIABLE/INTEGER CONSTANT/INTEGER VARIABLE
C INTEGER CONSTANT/INTEGER VARIABLE/INTEGER VARIABLE
C (3) SAME AS (2) BUT WITH PARENTHESES TO GROUP ELEMENTS
C IN THE ARITHMETIC EXPRESSION.
C
C REFERENCES
C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN,
C X3.9-1978
C
C SECTION 4.3, INTEGER TYPE
C SECTION 4.3.1, INTEGER CONSTANT
C SECTION 6.1, ARITHMETIC EXPRESSIONS
C SECTION 6.6, EVALUATION OF EXPRESSIONS
C SECTION 10.1, ARITHMETIC ASSIGNMENT STATEMENT
C
C **********************************************************
C
C A COMPILER VALIDATION SYSTEM FOR THE FORTRAN LANGUAGE
C BASED ON SPECIFICATIONS AS DEFINED IN AMERICAN NATIONAL STANDARD
C PROGRAMMING LANGUAGE FORTRAN X3.9-1978, HAS BEEN DEVELOPED BY THE
C FEDERAL COBOL COMPILER TESTING SERVICE. THE FORTRAN COMPILER
C VALIDATION SYSTEM (FCVS) CONSISTS OF AUDIT ROUTINES, THEIR RELATED
C DATA, AND AN EXECUTIVE SYSTEM. EACH AUDIT ROUTINE IS A FORTRAN
C PROGRAM, SUBPROGRAM OR FUNCTION WHICH INCLUDES TESTS OF SPECIFIC
C LANGUAGE ELEMENTS AND SUPPORTING PROCEDURES INDICATING THE RESULT
C OF EXECUTING THESE TESTS.
C
C THIS PARTICULAR PROGRAM/SUBPROGRAM/FUNCTION CONTAINS FEATURES
C FOUND ONLY IN THE SUBSET AS DEFINED IN X3.9-1978.
C
C SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO -
C
C DEPARTMENT OF THE NAVY
C FEDERAL COBOL COMPILER TESTING SERVICE
C WASHINGTON, D.C. 20376
C
C **********************************************************
C
C
C
C INITIALIZATION SECTION
C
C INITIALIZE CONSTANTS
C **************
C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER.
I01 = 5
C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER.
I02 = 6
C SYSTEM ENVIRONMENT SECTION
C
CX010 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-010 CONTROL CARD.
C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5
C (UNIT NUMBER FOR CARD READER).
CX011 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-011 CONTROL CARD.
C THE CX011 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL
C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX010 ABOVE.
C
CX020 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-020 CONTROL CARD.
C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02 = 6
C (UNIT NUMBER FOR PRINTER).
CX021 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-021 CONTROL CARD.
C THE CX021 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL
C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX020 ABOVE.
C
IVPASS=0
IVFAIL=0
IVDELE=0
ICZERO=0
C
C WRITE PAGE HEADERS
WRITE (I02,90000)
WRITE (I02,90001)
WRITE (I02,90002)
WRITE (I02, 90002)
WRITE (I02,90003)
WRITE (I02,90002)
WRITE (I02,90004)
WRITE (I02,90002)
WRITE (I02,90011)
WRITE (I02,90002)
WRITE (I02,90002)
WRITE (I02,90005)
WRITE (I02,90006)
WRITE (I02,90002)
C
C TEST SECTION
C
C ARITHMETIC ASSIGNMENT STATEMENT
C
C TEST 582 THROUGH TEST 597 CONTAIN ARITHMETIC ASSIGNMENT STATEMENTS
C OF THE FORM INTEGER VARIABLE=INTEGER VARIABLE/INTEGER VAR.
C
C TEST 582 THROUGH TEST 585 - POSITIVE VALUES
C NO TRUNCATION REQUIRED
C
5821 CONTINUE
IVTNUM = 582
C
C **** TEST 582 ****
C
IF (ICZERO) 35820, 5820, 35820
5820 CONTINUE
IVON01 = 4
IVON02 = 2
IVCOMP = IVON01 / IVON02
GO TO 45820
35820 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 45820, 5831, 45820
45820 IF (IVCOMP -2) 25820,15820,25820
15820 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 5831
25820 IVFAIL = IVFAIL + 1
IVCORR = 2
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
5831 CONTINUE
IVTNUM = 583
C
C **** TEST 583 ****
C
IF (ICZERO) 35830, 5830, 35830
5830 CONTINUE
IVON01 = 3575
IVON02 = 25
IVCOMP = IVON01/IVON02
GO TO 45830
35830 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 45830, 5841, 45830
45830 IF (IVCOMP - 143) 25830,15830,25830
15830 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 5841
25830 IVFAIL = IVFAIL + 1
IVCORR = 143
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
5841 CONTINUE
IVTNUM = 584
C
C **** TEST 584 ****
C
IF (ICZERO) 35840, 5840, 35840
5840 CONTINUE
IVON01 = 6170
IVON02 = 1234
IVCOMP = IVON01/IVON02
GO TO 45840
35840 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 45840, 5851, 45840
45840 IF (IVCOMP - 5) 25840,15840,25840
15840 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 5851
25840 IVFAIL = IVFAIL + 1
IVCORR = 5
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
5851 CONTINUE
IVTNUM = 585
C
C **** TEST 585 ****
C
IF (ICZERO) 35850, 5850, 35850
5850 CONTINUE
IVON01 = 32767
IVON02 = 1
IVCOMP = IVON01/IVON02
GO TO 45850
35850 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 45850, 5861, 45850
45850 IF (IVCOMP - 32767) 25850,15850,25850
15850 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 5861
25850 IVFAIL = IVFAIL + 1
IVCORR = 32767
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
C
C TEST 586 THROUGH TEST 589 - POSITIVE VALUES
C TRUNCATION OF RESULT REQUIRED
C
5861 CONTINUE
IVTNUM = 586
C
C **** TEST 586 ****
C
IF (ICZERO) 35860, 5860, 35860
5860 CONTINUE
IVON01 = 2
IVON02 = 3
IVCOMP = IVON01/IVON02
GO TO 45860
35860 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 45860, 5871, 45860
45860 IF (IVCOMP) 25860,15860,25860
15860 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 5871
25860 IVFAIL = IVFAIL + 1
IVCORR = 0
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
5871 CONTINUE
IVTNUM = 587
C
C **** TEST 587 ****
C
IF (ICZERO) 35870, 5870, 35870
5870 CONTINUE
IVON01 = 959
IVON02 = 120
IVCOMP = IVON01/IVON02
GO TO 45870
35870 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 45870, 5881, 45870
45870 IF (IVCOMP - 7) 25870,15870,25870
15870 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 5881
25870 IVFAIL = IVFAIL + 1
IVCORR = 7
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
5881 CONTINUE
IVTNUM = 588
C
C **** TEST 588 ****
C
IF (ICZERO) 35880, 5880, 35880
5880 CONTINUE
IVON01 = 26606
IVON02 = 8
IVCOMP = IVON01/IVON02
GO TO 45880
35880 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 45880, 5891, 45880
45880 IF (IVCOMP - 3325) 25880,15880,25880
15880 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 5891
25880 IVFAIL = IVFAIL + 1
IVCORR = 3325
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
5891 CONTINUE
IVTNUM = 589
C
C **** TEST 589 ****
C
IF (ICZERO) 35890, 5890, 35890
5890 CONTINUE
IVON01 = 25603
IVON02 = 10354
IVCOMP = IVON01/IVON02
GO TO 45890
35890 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 45890, 5901, 45890
45890 IF (IVCOMP - 2) 25890,15890,25890
15890 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 5901
25890 IVFAIL = IVFAIL + 1
IVCORR = 2
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
C
C TEST 590 THROUGH TEST 593 - NEGATIVE VALUES INCLUDED
C NO TRUNCATION REQUIRED
C
5901 CONTINUE
IVTNUM = 590
C
C **** TEST 590 ****
C
IF (ICZERO) 35900, 5900, 35900
5900 CONTINUE
IVON01 = 75
IVON02 = -25
IVCOMP = IVON01/IVON02
GO TO 45900
35900 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 45900, 5911, 45900
45900 IF (IVCOMP + 3) 25900,15900,25900
15900 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 5911
25900 IVFAIL = IVFAIL + 1
IVCORR = -3
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
5911 CONTINUE
IVTNUM = 591
C
C **** TEST 591 ****
C
IF (ICZERO) 35910, 5910, 35910
5910 CONTINUE
IVON01 = -6170
IVON02 = -1234
IVCOMP = IVON01/IVON02
GO TO 45910
35910 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 45910, 5921, 45910
45910 IF (IVCOMP -5) 25910,15910,25910
15910 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 5921
25910 IVFAIL = IVFAIL + 1
IVCORR = 5
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
5921 CONTINUE
IVTNUM = 592
C
C **** TEST 592 ****
C
IF (ICZERO) 35920, 5920, 35920
5920 CONTINUE
IVON01 = 32766
IVON02 = -2
IVCOMP =-IVON01/IVON02
GO TO 45920
35920 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 45920, 5931, 45920
45920 IF (IVCOMP - 16383) 25920,15920,25920
15920 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 5931
25920 IVFAIL = IVFAIL + 1
IVCORR = 16383
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
5931 CONTINUE
IVTNUM = 593
C
C **** TEST 593 ****
C
IF (ICZERO) 35930, 5930, 35930
5930 CONTINUE
IVON01 = 4
IVON02 = 2
IVCOMP = IVON01/(-IVON02)
GO TO 45930
35930 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 45930, 5941, 45930
45930 IF (IVCOMP + 2) 25930,15930,25930
15930 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 5941
25930 IVFAIL = IVFAIL + 1
IVCORR = -2
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
C
C TEST 594 THROUGH TEST 597 - NEGATIVE VALUES INCLUDED
C TRUNCATION OF RESULT REQUIRED
C
5941 CONTINUE
IVTNUM = 594
C
C **** TEST 594 ****
C
IF (ICZERO) 35940, 5940, 35940
5940 CONTINUE
IVON01 = -5
IVON02 = 2
IVCOMP = IVON01/IVON02
GO TO 45940
35940 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 45940, 5951, 45940
45940 IF (IVCOMP + 2) 25940,15940,25940
15940 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 5951
25940 IVFAIL = IVFAIL + 1
IVCORR = -2
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
5951 CONTINUE
IVTNUM = 595
C
C **** TEST 595 ****
C
IF (ICZERO) 35950, 5950, 35950
5950 CONTINUE
IVON01 = -25603
IVON02 = -10354
IVCOMP = IVON01/IVON02
GO TO 45950
35950 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 45950, 5961, 45950
45950 IF (IVCOMP -2) 25950,15950,25950
15950 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 5961
25950 IVFAIL = IVFAIL + 1
IVCORR =2
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
5961 CONTINUE
IVTNUM = 596
C
C **** TEST 596 ****
C
IF (ICZERO) 35960, 5960, 35960
5960 CONTINUE
IVON01 = 25603
IVON02 = 10354
IVCOMP = -IVON01/IVON02
GO TO 45960
35960 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 45960, 5971, 45960
45960 IF (IVCOMP +2) 25960,15960,25960
15960 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 5971
25960 IVFAIL = IVFAIL + 1
IVCORR = -2
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
5971 CONTINUE
IVTNUM = 597
C
C **** TEST 597 ****
C
IF (ICZERO) 35970, 5970, 35970
5970 CONTINUE
IVON01 = 25603
IVON02 = -2
IVCOMP = -(IVON01/IVON02)
GO TO 45970
35970 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 45970, 5981, 45970
45970 IF (IVCOMP - 12801) 25970,15970,25970
15970 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 5981
25970 IVFAIL = IVFAIL + 1
IVCORR = 12801
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
C
C TEST 598 THROUGH TEST 614 CONTAIN TWO INTEGER VARIABLES, AN
C INTEGER CONSTANT AND OPERATOR / IN AN ARITHMETIC EXPRESSION.
C
C TEST 598 THROUGH TEST 603 - NO PARENS TO GROUP ELEMENTS BUT
C THERE ARE PARENS SURROUNDING NEGATIVE CONSTANTS
C
C TEST 598 AND TEST 599 - IV = IV/IV/IC.
C
5981 CONTINUE
IVTNUM = 598
C
C **** TEST 598 ****
C
IF (ICZERO) 35980, 5980, 35980
5980 CONTINUE
IVON01 = 32766
IVON02 = 2
IVCOMP = IVON01/IVON02/3
GO TO 45980
35980 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 45980, 5991, 45980
45980 IF (IVCOMP - 5461) 25980,15980,25980
15980 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 5991
25980 IVFAIL = IVFAIL + 1
IVCORR = 5461
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
5991 CONTINUE
IVTNUM = 599
C
C **** TEST 599 ****
C
IF (ICZERO) 35990, 5990, 35990
5990 CONTINUE
IVON01 = 7151
IVON02 = 3
IVCOMP = IVON01/IVON02/10
GO TO 45990
35990 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 45990, 6001, 45990
45990 IF (IVCOMP -238) 25990,15990,25990
15990 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 6001
25990 IVFAIL = IVFAIL + 1
IVCORR = 238
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
C
C TEST 600 AND TEST 601 - IV= IV/IC/IV.
C
6001 CONTINUE
IVTNUM = 600
C
C **** TEST 600 ****
C
IF (ICZERO) 36000, 6000, 36000
6000 CONTINUE
IVON01 = -7150
IVON03 = -25
IVCOMP = IVON01/(-2)/IVON03
GO TO 46000
36000 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 46000, 6011, 46000
46000 IF (IVCOMP + 143) 26000,16000,26000
16000 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 6011
26000 IVFAIL = IVFAIL + 1
IVCORR = -143
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
6011 CONTINUE
IVTNUM = 601
C
C **** TEST 601 ****
C
IF (ICZERO) 36010, 6010, 36010
6010 CONTINUE
IVON01 = 32767
IVON03 = -1
IVCOMP = IVON01/2/IVON03
GO TO 46010
36010 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 46010, 6021, 46010
46010 IF (IVCOMP + 16383) 26010,16010,26010
16010 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 6021
26010 IVFAIL = IVFAIL + 1
IVCORR = -16383
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
6021 CONTINUE
IVTNUM = 602
C
C **** TEST 602 ****
C
C TEST 602 AND TEST 603 - IV=IC/IV/IV
C
C
IF (ICZERO) 36020, 6020, 36020
6020 CONTINUE
IVON02 = 13
IVON03 = 51
IVCOMP = 15249/IVON02/IVON03
GO TO 46020
36020 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 46020, 6031, 46020
46020 IF (IVCOMP - 23) 26020,16020,26020
16020 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 6031
26020 IVFAIL = IVFAIL + 1
IVCORR = 23
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
6031 CONTINUE
IVTNUM = 603
C
C **** TEST 603 ****
C
IF (ICZERO) 36030, 6030, 36030
6030 CONTINUE
IVON02 = -13
IVON03 = -51
IVCOMP = -15249/IVON02/IVON03
GO TO 46030
36030 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 46030, 6041, 46030
46030 IF (IVCOMP +23) 26030,16030,26030
16030 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 6041
26030 IVFAIL = IVFAIL + 1
IVCORR = -23
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
C
C TEST 604 THROUGH TEST 614 - PARENTHESES ARE USED TO GROUP
C ELEMENTS IN THE ARITHMETIC EXPRESSIONS.
C
C TEST 604 AND TEST 605 - IV=(IV/IV)/IC.
C
6041 CONTINUE
IVTNUM = 604
C
C **** TEST 604 ****
C
IF (ICZERO) 36040, 6040, 36040
6040 CONTINUE
IVON01 = 32766
IVON02 = 2
IVCOMP =(IVON01/IVON02)/3
GO TO 46040
36040 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 46040, 6051, 46040
46040 IF (IVCOMP -5461) 26040,16040,26040
16040 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 6051
26040 IVFAIL = IVFAIL + 1
IVCORR = 5461
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
6051 CONTINUE
IVTNUM = 605
C
C **** TEST 605 ****
C
IF (ICZERO) 36050, 6050, 36050
6050 CONTINUE
IVON01 = 7151
IVON02 = 3
IVCOMP = (IVON01/IVON02)/10
GO TO 46050
36050 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 46050, 6061, 46050
46050 IF (IVCOMP - 238) 26050,16050,26050
16050 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 6061
26050 IVFAIL = IVFAIL + 1
IVCORR = 238
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
C
C TEST 606 AND TEST 607 - IV=IV/(IV/IC).
C
6061 CONTINUE
IVTNUM = 606
C
C **** TEST 606 ****
C
IF (ICZERO) 36060, 6060, 36060
6060 CONTINUE
IVON01 = -7154
IVON02 = 26
IVCOMP = IVON01/(IVON02/5)
GO TO 46060
36060 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 46060, 6071, 46060
46060 IF (IVCOMP + 1430) 26060,16060,26060
16060 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 6071
26060 IVFAIL = IVFAIL + 1
IVCORR = -1430
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
6071 CONTINUE
IVTNUM = 607
C
C **** TEST 607 ****
C
IF (ICZERO) 36070, 6070, 36070
6070 CONTINUE
IVON01 = 29
IVON02 = -5
IVCOMP = IVON01/(IVON02/2)
GO TO 46070
36070 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 46070, 6081, 46070
46070 IF (IVCOMP + 14) 26070,16070,26070
16070 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 6081
26070 IVFAIL = IVFAIL + 1
IVCORR = -14
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
C
C TEST 608 AND TEST 609 - IV = (IV/IC)/IV.
C
6081 CONTINUE
IVTNUM = 608
C
C **** TEST 608 ****
C
IF (ICZERO) 36080, 6080, 36080
6080 CONTINUE
IVON01 = 24
IVON03 = 3
IVCOMP = (IVON01/3)/IVON03
GO TO 46080
36080 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 46080, 6091, 46080
46080 IF (IVCOMP -2) 26080,16080,26080
16080 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 6091
26080 IVFAIL = IVFAIL + 1
IVCORR = 2
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
6091 CONTINUE
IVTNUM = 609
C
C **** TEST 609 ****
C
IF (ICZERO) 36090, 6090, 36090
6090 CONTINUE
IVON01 = 7151
IVON03 = 10
IVCOMP = (IVON01/(-3))/IVON03
GO TO 46090
36090 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 46090, 6101, 46090
46090 IF (IVCOMP + 238) 26090,16090,26090
16090 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 6101
26090 IVFAIL = IVFAIL + 1
IVCORR = -238
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
C
C TEST 610 AND TEST 611 - IV=IV(IC/IV)
C
6101 CONTINUE
IVTNUM = 610
C
C **** TEST 610 ****
C
IF (ICZERO) 36100, 6100, 36100
6100 CONTINUE
IVON01 = -7154
IVON03 = -5
IVCOMP = IVON01/((-26)/IVON03)
GO TO 46100
36100 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 46100, 6111, 46100
46100 IF (IVCOMP + 1430) 26100,16100,26100
16100 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 6111
26100 IVFAIL = IVFAIL + 1
IVCORR = -1430
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
6111 CONTINUE
IVTNUM = 611
C
C **** TEST 611 ****
C
IF (ICZERO) 36110, 6110, 36110
6110 CONTINUE
IVON01 = 7150
IVON03 = 5
IVCOMP = IVON01/((+25)/IVON03)
GO TO 46110
36110 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 46110, 6121, 46110
46110 IF (IVCOMP -1430) 26110,16110,26110
16110 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 6121
26110 IVFAIL = IVFAIL + 1
IVCORR = 1430
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
6121 CONTINUE
IVTNUM = 612
C
C **** TEST 612 ****
C TEST 612 - IV= (IC/IV)/IV
C
IF (ICZERO) 36120, 6120, 36120
6120 CONTINUE
IVON02 = -3
IVON03 = -10
IVCOMP = (-7154/IVON02)/IVON03
GO TO 46120
36120 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 46120, 6131, 46120
46120 IF (IVCOMP + 238) 26120,16120,26120
16120 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 6131
26120 IVFAIL = IVFAIL + 1
IVCORR = -238
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
C
C TEST 613 AND TEST 614 - IV=IC/(IV/IV)
C
6131 CONTINUE
IVTNUM = 613
C
C **** TEST 613 ****
C
IF (ICZERO) 36130, 6130, 36130
6130 CONTINUE
IVON02 = 8
IVON03 = 4
IVCOMP = 24/(IVON02/IVON03)
GO TO 46130
36130 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 46130, 6141, 46130
46130 IF (IVCOMP - 12) 26130,16130,26130
16130 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 6141
26130 IVFAIL = IVFAIL + 1
IVCORR = 12
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
6141 CONTINUE
IVTNUM = 614
C
C **** TEST 614 ****
C
IF (ICZERO) 36140, 6140, 36140
6140 CONTINUE
IVON02 = 25
IVON03 = 5
IVCOMP = 7150/(-(IVON02/IVON03))
GO TO 46140
36140 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 46140, 6151, 46140
46140 IF (IVCOMP + 1430) 26140,16140,26140
16140 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 6151
26140 IVFAIL = IVFAIL + 1
IVCORR = -1430
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
C **** END OF TESTS ****
6151 CONTINUE
C
C WRITE PAGE FOOTINGS AND RUN SUMMARIES
99999 CONTINUE
WRITE (I02,90002)
WRITE (I02,90006)
WRITE (I02,90002)
WRITE (I02,90002)
WRITE (I02,90007)
WRITE (I02,90002)
WRITE (I02,90008) IVFAIL
WRITE (I02,90009) IVPASS
WRITE (I02,90010) IVDELE
C
C
C TERMINATE ROUTINE EXECUTION
STOP
C
C FORMAT STATEMENTS FOR PAGE HEADERS
90000 FORMAT (1H1)
90002 FORMAT (1H )
90001 FORMAT (1H ,10X,34HFORTRAN COMPILER VALIDATION SYSTEM)
90003 FORMAT (1H ,21X,11HVERSION 1.0)
90004 FORMAT (1H ,10X,38HFOR OFFICIAL USE ONLY - COPYRIGHT 1978)
90005 FORMAT (1H ,5X,4HTEST,5X,9HPASS/FAIL, 5X,8HCOMPUTED,8X,7HCORRECT)
90006 FORMAT (1H ,5X,46H----------------------------------------------)
90011 FORMAT (1H ,18X,17HSUBSET LEVEL TEST)
C
C FORMAT STATEMENTS FOR RUN SUMMARIES
90008 FORMAT (1H ,15X,I5,19H ERRORS ENCOUNTERED)
90009 FORMAT (1H ,15X,I5,13H TESTS PASSED)
90010 FORMAT (1H ,15X,I5,14H TESTS DELETED)
C
C FORMAT STATEMENTS FOR TEST RESULTS
80001 FORMAT (1H ,4X,I5,7X,4HPASS)
80002 FORMAT (1H ,4X,I5,7X,4HFAIL)
80003 FORMAT (1H ,4X,I5,7X,7HDELETED)
80004 FORMAT (1H ,4X,I5,7X,4HFAIL,10X,I6,9X,I6)
80005 FORMAT (1H ,4X,I5,7X,4HFAIL,4X,E12.5,3X,E12.5)
C
90007 FORMAT (1H ,20X,20HEND OF PROGRAM FM040)
END
*END-OF,FM040
FM041.f 480976042 170 2 100666 22277 `
*HEADER,FORTR,FM041
*FILES1,FORTR,FM041,X
C COMMENT SECTION
C
C FM041
C
C THIS ROUTINE TESTS ARITHMETIC ASSIGNMENTS OF THE
C FORM INTEGER VARIABLE = PRIMARY ** PRIMARY
C WHERE THE FIRST OF TWO PRIMARIES IS AN INTEGER VARIABLE OR AN
C INTEGER CONSTANT AND THE SECOND PRIMARY IS AN INTEGER CONSTANT.
C
C REFERENCES
C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN,
C X3.9-1978
C
C SECTION 4.3, INTEGER TYPE
C SECTION 4.3.1, INTEGER CONSTANT
C SECTION 6.1, ARITHMETIC EXPRESSIONS
C SECTION 10.1, ARITHMETIC ASSIGNMENT STATEMENT
C
C
C **********************************************************
C
C A COMPILER VALIDATION SYSTEM FOR THE FORTRAN LANGUAGE
C BASED ON SPECIFICATIONS AS DEFINED IN AMERICAN NATIONAL STANDARD
C PROGRAMMING LANGUAGE FORTRAN X3.9-1978, HAS BEEN DEVELOPED BY THE
C FEDERAL COBOL COMPILER TESTING SERVICE. THE FORTRAN COMPILER
C VALIDATION SYSTEM (FCVS) CONSISTS OF AUDIT ROUTINES, THEIR RELATED
C DATA, AND AN EXECUTIVE SYSTEM. EACH AUDIT ROUTINE IS A FORTRAN
C PROGRAM, SUBPROGRAM OR FUNCTION WHICH INCLUDES TESTS OF SPECIFIC
C LANGUAGE ELEMENTS AND SUPPORTING PROCEDURES INDICATING THE RESULT
C OF EXECUTING THESE TESTS.
C
C THIS PARTICULAR PROGRAM/SUBPROGRAM/FUNCTION CONTAINS FEATURES
C FOUND ONLY IN THE SUBSET AS DEFINED IN X3.9-1978.
C
C SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO -
C
C DEPARTMENT OF THE NAVY
C FEDERAL COBOL COMPILER TESTING SERVICE
C WASHINGTON, D.C. 20376
C
C **********************************************************
C
C
C
C INITIALIZATION SECTION
C
C INITIALIZE CONSTANTS
C **************
C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER.
I01 = 5
C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER.
I02 = 6
C SYSTEM ENVIRONMENT SECTION
C
CX010 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-010 CONTROL CARD.
C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5
C (UNIT NUMBER FOR CARD READER).
CX011 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-011 CONTROL CARD.
C THE CX011 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL
C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX010 ABOVE.
C
CX020 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-020 CONTROL CARD.
C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02 = 6
C (UNIT NUMBER FOR PRINTER).
CX021 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-021 CONTROL CARD.
C THE CX021 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL
C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX020 ABOVE.
C
IVPASS=0
IVFAIL=0
IVDELE=0
ICZERO=0
C
C WRITE PAGE HEADERS
WRITE (I02,90000)
WRITE (I02,90001)
WRITE (I02,90002)
WRITE (I02, 90002)
WRITE (I02,90003)
WRITE (I02,90002)
WRITE (I02,90004)
WRITE (I02,90002)
WRITE (I02,90011)
WRITE (I02,90002)
WRITE (I02,90002)
WRITE (I02,90005)
WRITE (I02,90006)
WRITE (I02,90002)
C
C TEST SECTION
C
C ARITHMETIC ASSIGNMENT STATEMENT
C
C TEST 615 THROUGH TEST 631 CONTAIN ARITHMETIC ASSIGNMENT STATEMENTS
C OF THE FORM INTEGER VARIABLE = INTEGER CONSTANT ** INTEGER CON.
C
C TEST 632 THROUGH TEST 648 CONTAIN ARITHMETIC ASSIGNMENT STATEMENTS
C OF THE FORM INTEGER VARIABLE = INTEGER VARIABLE ** INTEGER CON.
C
C
IVTNUM = 615
C
C **** TEST 615 ****
C TEST 615 - SMALL NUMBER BASE; ZERO EXPONENT
C
IF (ICZERO) 36150, 6150, 36150
6150 CONTINUE
IVCOMP = 1 ** 0
GO TO 46150
36150 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 46150, 6161, 46150
46150 IF (IVCOMP - 1) 26150,16150,26150
16150 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 6161
26150 IVFAIL = IVFAIL + 1
IVCORR = 1
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
6161 CONTINUE
IVTNUM = 616
C
C **** TEST 616 ****
C TEST 616 - ZERO BASE TO FIRST POWER
C
IF (ICZERO) 36160, 6160, 36160
6160 CONTINUE
IVCOMP = 0 ** 1
GO TO 46160
36160 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 46160, 6171, 46160
46160 IF (IVCOMP) 26160,16160,26160
16160 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 6171
26160 IVFAIL = IVFAIL + 1
IVCORR = 0
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
6171 CONTINUE
IVTNUM = 617
C
C **** TEST 617 ****
C TEST 617 - BASE =1; EXPONENT = 1
C
IF (ICZERO) 36170, 6170, 36170
6170 CONTINUE
IVCOMP = 1 ** 1
GO TO 46170
36170 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 46170, 6181, 46170
46170 IF (IVCOMP - 1) 26170,16170,26170
16170 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 6181
26170 IVFAIL = IVFAIL + 1
IVCORR = 1
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
6181 CONTINUE
IVTNUM = 618
C
C **** TEST 618 ****
C TEST 618 - LARGE NUMBER BASE; EXPONENT = 1
C
IF (ICZERO) 36180, 6180, 36180
6180 CONTINUE
IVCOMP = 32767 ** 1
GO TO 46180
36180 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 46180, 6191, 46180
46180 IF (IVCOMP - 32767) 26180,16180,26180
16180 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 6191
26180 IVFAIL = IVFAIL + 1
IVCORR = 32767
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
6191 CONTINUE
IVTNUM = 619
C
C **** TEST 619 ****
C TEST 619 - LARGE EXPONENT
C
IF (ICZERO) 36190, 6190, 36190
6190 CONTINUE
IVCOMP = 1 ** 32767
GO TO 46190
36190 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 46190, 6201, 46190
46190 IF (IVCOMP - 1) 26190,16190,26190
16190 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 6201
26190 IVFAIL = IVFAIL + 1
IVCORR = 1
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
6201 CONTINUE
IVTNUM = 620
C
C **** TEST 620 ****
C TEST 620 - ZERO BASE; LARGE NUMBER EXPONENT
C
IF (ICZERO) 36200, 6200, 36200
6200 CONTINUE
IVCOMP = 0 ** 32767
GO TO 46200
36200 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 46200, 6211, 46200
46200 IF (IVCOMP) 26200,16200,26200
16200 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 6211
26200 IVFAIL = IVFAIL + 1
IVCORR = 0
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
6211 CONTINUE
IVTNUM = 621
C
C **** TEST 621 ****
C TEST 621 -LARGE NUMBER BASE; ZERO EXPONENT
C
IF (ICZERO) 36210, 6210, 36210
6210 CONTINUE
IVCOMP = 32767 ** 0
GO TO 46210
36210 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 46210, 6221, 46210
46210 IF (IVCOMP - 1) 26210,16210,26210
16210 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 6221
26210 IVFAIL = IVFAIL + 1
IVCORR = 1
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
6221 CONTINUE
IVTNUM = 622
C
C **** TEST 622 ****
C TEST 622 -EXPONENT IS POWER OF TWO
C
IF (ICZERO) 36220, 6220, 36220
6220 CONTINUE
IVCOMP = 181 ** 2
GO TO 46220
36220 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 46220, 6231, 46220
46220 IF (IVCOMP - 32761) 26220,16220,26220
16220 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 6231
26220 IVFAIL = IVFAIL + 1
IVCORR = 32761
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
6231 CONTINUE
IVTNUM = 623
C
C **** TEST 623 ****
C TEST 623 - BASE AND EXPONENT ARE BOTH POWERS OF TWO
C
IF (ICZERO) 36230, 6230, 36230
6230 CONTINUE
IVCOMP = 2 ** 8
GO TO 46230
36230 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 46230, 6241, 46230
46230 IF (IVCOMP - 256) 26230,16230,26230
16230 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 6241
26230 IVFAIL = IVFAIL + 1
IVCORR = 256
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
6241 CONTINUE
C
C TESTS 624 AND 625 TEST TO ENSURE EXPONENTIATION OPERATOR IS
C NOT COMMUTATIVE
C
IVTNUM = 624
C
C **** TEST 624 ****
C
IF (ICZERO) 36240, 6240, 36240
6240 CONTINUE
IVCOMP = 3 ** 9
GO TO 46240
36240 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 46240, 6251, 46240
46240 IF (IVCOMP - 19683) 26240,16240,26240
16240 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 6251
26240 IVFAIL = IVFAIL + 1
IVCORR = 19683
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
6251 CONTINUE
IVTNUM = 625
C
C **** TEST 625 ****
C
IF (ICZERO) 36250, 6250, 36250
6250 CONTINUE
IVCOMP = 9 ** 3
GO TO 46250
36250 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 46250, 6261, 46250
46250 IF (IVCOMP - 729) 26250,16250,26250
16250 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 6261
26250 IVFAIL = IVFAIL + 1
IVCORR = 729
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
6261 CONTINUE
C
C TESTS 626 THROUGH 631 TEST POSITIVE AND NEGATIVE BASES TO POSITIVE
C ODD AND EVEN NUMBER POWERS CHECKING THE SIGN
C OF THE RESULTS
C
IVTNUM = 626
C
C **** TEST 626 ****
C
IF (ICZERO) 36260, 6260, 36260
6260 CONTINUE
IVCOMP = 1 ** 2
GO TO 46260
36260 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 46260, 6271, 46260
46260 IF (IVCOMP - 1) 26260,16260,26260
16260 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 6271
26260 IVFAIL = IVFAIL + 1
IVCORR = 1
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
6271 CONTINUE
IVTNUM = 627
C
C **** TEST 627 ****
C
IF (ICZERO) 36270, 6270, 36270
6270 CONTINUE
IVCOMP= (-1) ** 2
GO TO 46270
36270 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 46270, 6281, 46270
46270 IF (IVCOMP - 1) 26270,16270,26270
16270 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 6281
26270 IVFAIL = IVFAIL + 1
IVCORR = 1
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
6281 CONTINUE
IVTNUM = 628
C
C **** TEST 628 ****
C
IF (ICZERO) 36280, 6280, 36280
6280 CONTINUE
IVCOMP = 7 ** 3
GO TO 46280
36280 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 46280, 6291, 46280
46280 IF (IVCOMP - 343) 26280,16280,26280
16280 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 6291
26280 IVFAIL = IVFAIL + 1
IVCORR = 343
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
6291 CONTINUE
IVTNUM = 629
C
C **** TEST 629 ****
C
IF (ICZERO) 36290, 6290, 36290
6290 CONTINUE
IVCOMP = (-7) ** 3
GO TO 46290
36290 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 46290, 6301, 46290
46290 IF (IVCOMP + 343) 26290,16290,26290
16290 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 6301
26290 IVFAIL = IVFAIL + 1
IVCORR = -343
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
6301 CONTINUE
IVTNUM = 630
C
C **** TEST 630 ****
C
IF (ICZERO) 36300, 6300, 36300
6300 CONTINUE
IVCOMP = 7 ** 4
GO TO 46300
36300 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 46300, 6311, 46300
46300 IF (IVCOMP - 2401) 26300,16300,26300
16300 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 6311
26300 IVFAIL = IVFAIL + 1
IVCORR = 2401
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
6311 CONTINUE
IVTNUM = 631
C
C **** TEST 631 ****
C
IF (ICZERO) 36310, 6310, 36310
6310 CONTINUE
IVCOMP = (-7) ** 4
GO TO 46310
36310 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 46310, 6321, 46310
46310 IF (IVCOMP - 2401) 26310,16310,26310
16310 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 6321
26310 IVFAIL = IVFAIL + 1
IVCORR = 2401
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
6321 CONTINUE
IVTNUM = 632
C
C **** TEST 632 ****
C TEST 632 - SMALL NUMBER BASE; ZERO EXPONENT
C
IF (ICZERO) 36320, 6320, 36320
6320 CONTINUE
IVON01 = 1
IVCOMP = IVON01 ** 1
GO TO 46320
36320 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 46320, 6331, 46320
46320 IF (IVCOMP - 1) 26320,16320,26320
16320 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 6331
26320 IVFAIL = IVFAIL + 1
IVCORR = 1
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
6331 CONTINUE
IVTNUM = 633
C
C **** TEST 633 ****
C TEST 633 - ZERO BASE TO FIRST POWER
C
IF (ICZERO) 36330, 6330, 36330
6330 CONTINUE
IVON01 = 0
IVCOMP = IVON01 ** 1
GO TO 46330
36330 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 46330, 6341, 46330
46330 IF (IVCOMP) 26330,16330,26330
16330 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 6341
26330 IVFAIL = IVFAIL + 1
IVCORR = 0
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
6341 CONTINUE
IVTNUM = 634
C
C **** TEST 634 ****
C TEST 634 - BASE =1; EXPONENT = 1
C
IF (ICZERO) 36340, 6340, 36340
6340 CONTINUE
IVON01 = 1
IVCOMP = IVON01 ** 1
GO TO 46340
36340 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 46340, 6351, 46340
46340 IF (IVCOMP - 1) 26340,16340,26340
16340 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 6351
26340 IVFAIL = IVFAIL + 1
IVCORR = 1
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
6351 CONTINUE
IVTNUM = 635
C
C **** TEST 635 ****
C TEST 635 - LARGE EXPONENT
C
IF (ICZERO) 36350, 6350, 36350
6350 CONTINUE
IVON01 = 1
IVCOMP = IVON01 ** 32767
GO TO 46350
36350 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 46350, 6361, 46350
46350 IF (IVCOMP - 1) 26350,16350,26350
16350 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 6361
26350 IVFAIL = IVFAIL + 1
IVCORR = 1
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
6361 CONTINUE
IVTNUM = 636
C
C **** TEST 636 ****
C TEST 636 - LARGE NUMBER BASE; EXPONENT = 1
C
IF (ICZERO) 36360, 6360, 36360
6360 CONTINUE
IVON01 = 32767
IVCOMP = IVON01 ** 1
GO TO 46360
36360 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 46360, 6371, 46360
46360 IF (IVCOMP - 32767) 26360,16360,26360
16360 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 6371
26360 IVFAIL = IVFAIL + 1
IVCORR = 32767
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
6371 CONTINUE
IVTNUM = 637
C
C **** TEST 637 ****
C TEST 637 - ZERO BASE; LARGE NUMBER EXPONENT
C
IF (ICZERO) 36370, 6370, 36370
6370 CONTINUE
IVON01 = 0
IVCOMP = IVON01 ** 32767
GO TO 46370
36370 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 46370, 6381, 46370
46370 IF (IVCOMP) 26370,16370,26370
16370 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 6381
26370 IVFAIL = IVFAIL +1
IVCORR = 0
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
6381 CONTINUE
IVTNUM = 638
C
C **** TEST 638 ****
C TEST 638 -LARGE NUMBER BASE; ZERO EXPONENT
C
IF (ICZERO) 36380, 6380, 36380
6380 CONTINUE
IVON01 = 32767
IVCOMP = IVON01 ** 0
GO TO 46380
36380 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 46380, 6391, 46380
46380 IF (IVCOMP - 1) 26380,16380,26380
16380 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 6391
26380 IVFAIL = IVFAIL + 1
IVCORR = 1
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
6391 CONTINUE
IVTNUM = 639
C
C **** TEST 639 ****
C TEST 639 -EXPONENT IS POWER OF TWO
C
IF (ICZERO) 36390, 6390, 36390
6390 CONTINUE
IVON01 = 181
IVCOMP = IVON01 ** 2
GO TO 46390
36390 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 46390, 6401, 46390
46390 IF (IVCOMP - 32761) 26390,16390,26390
16390 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 6401
26390 IVFAIL = IVFAIL + 1
IVCORR = 32761
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
6401 CONTINUE
IVTNUM = 640
C
C **** TEST 640 ****
C TEST 640 - BASE AND EXPONENT ARE BOTH POWERS OF TWO
C
IF (ICZERO) 36400, 6400, 36400
6400 CONTINUE
IVON01 = 2
IVCOMP = IVON01 ** 8
GO TO 46400
36400 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 46400, 6411, 46400
46400 IF (IVCOMP - 256) 26400,16400,26400
16400 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 6411
26400 IVFAIL = IVFAIL + 1
IVCORR = 256
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
6411 CONTINUE
C
C TESTS 641 AND 642 TEST TO ENSURE EXPONENTIATION OPERATOR IS
C NOT COMMUTATIVE
C
IVTNUM = 641
C
C **** TEST 641 ****
C
IF (ICZERO) 36410, 6410, 36410
6410 CONTINUE
IVON01 = 3
IVCOMP = IVON01 ** 9
GO TO 46410
36410 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 46410, 6421, 46410
46410 IF (IVCOMP - 19683) 26410,16410,26410
16410 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 6421
26410 IVFAIL = IVFAIL + 1
IVCORR = 19683
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
6421 CONTINUE
IVTNUM = 642
C
C **** TEST 642 ****
C
IF (ICZERO) 36420, 6420, 36420
6420 CONTINUE
IVON01 = 9
IVCOMP = IVON01 ** 3
GO TO 46420
36420 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 46420, 6431, 46420
46420 IF (IVCOMP - 729) 26420,16420,26420
16420 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 6431
26420 IVFAIL = IVFAIL + 1
IVCORR = 729
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
6431 CONTINUE
C
C TESTS 643 THROUGH 648 TEST POSITIVE AND NEGATIVE BASES TO POSITIVE
C ODD AND EVEN NUMBER POWERS CHECKING THE SIGN
C OF THE RESULTS
C
IVTNUM = 643
C
C **** TEST 643 ****
C
IF (ICZERO) 36430, 6430, 36430
6430 CONTINUE
IVON01 = 1
IVCOMP = IVON01 ** 2
GO TO 46430
36430 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 46430, 6441, 46430
46430 IF (IVCOMP - 1) 26430,16430,26430
16430 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 6441
26430 IVFAIL = IVFAIL + 1
IVCORR = 1
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
6441 CONTINUE
IVTNUM = 644
C
C **** TEST 644 ****
C
IF (ICZERO) 36440, 6440, 36440
6440 CONTINUE
IVON01 = -1
IVCOMP = IVON01 ** 2
GO TO 46440
36440 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 46440, 6451, 46440
46440 IF (IVCOMP - 1) 26440,16440,26440
16440 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 6451
26440 IVFAIL = IVFAIL + 1
IVCORR = 1
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
6451 CONTINUE
IVTNUM = 645
C
C **** TEST 645 ****
C
IF (ICZERO) 36450, 6450, 36450
6450 CONTINUE
IVON01 = 7
IVCOMP = IVON01 ** 3
GO TO 46450
36450 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 46450, 6461, 46450
46450 IF (IVCOMP - 343) 26450,16450,26450
16450 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 6461
26450 IVFAIL = IVFAIL + 1
IVCORR = 343
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
6461 CONTINUE
IVTNUM = 646
C
C **** TEST 646 ****
C
IF (ICZERO) 36460, 6460, 36460
6460 CONTINUE
IVON01 = -7
IVCOMP = IVON01 ** 3
GO TO 46460
36460 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 46460, 6471, 46460
46460 IF (IVCOMP + 343) 26460,16460,26460
16460 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 6471
26460 IVFAIL = IVFAIL + 1
IVCORR = -343
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
6471 CONTINUE
IVTNUM = 647
C
C **** TEST 647 ****
C
IF (ICZERO) 36470, 6470, 36470
6470 CONTINUE
IVON01 = 7
IVCOMP = IVON01 ** 4
GO TO 46470
36470 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 46470, 6481, 46470
46470 IF (IVCOMP - 2401) 26470,16470,26470
16470 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 6481
26470 IVFAIL = IVFAIL + 1
IVCORR = 2401
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
6481 CONTINUE
IVTNUM = 648
C
C **** TEST 648 ****
C
IF (ICZERO) 36480, 6480, 36480
6480 CONTINUE
IVON01 = -7
IVCOMP = IVON01 ** 4
GO TO 46480
36480 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 46480, 6491, 46480
46480 IF (IVCOMP - 2401) 26480,16480,26480
16480 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 6491
26480 IVFAIL = IVFAIL + 1
IVCORR = 2401
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
6491 CONTINUE
C *** END OF TESTS ***
C
C WRITE PAGE FOOTINGS AND RUN SUMMARIES
99999 CONTINUE
WRITE (I02,90002)
WRITE (I02,90006)
WRITE (I02,90002)
WRITE (I02,90002)
WRITE (I02,90007)
WRITE (I02,90002)
WRITE (I02,90008) IVFAIL
WRITE (I02,90009) IVPASS
WRITE (I02,90010) IVDELE
C
C
C TERMINATE ROUTINE EXECUTION
STOP
C
C FORMAT STATEMENTS FOR PAGE HEADERS
90000 FORMAT (1H1)
90002 FORMAT (1H )
90001 FORMAT (1H ,10X,34HFORTRAN COMPILER VALIDATION SYSTEM)
90003 FORMAT (1H ,21X,11HVERSION 1.0)
90004 FORMAT (1H ,10X,38HFOR OFFICIAL USE ONLY - COPYRIGHT 1978)
90005 FORMAT (1H ,5X,4HTEST,5X,9HPASS/FAIL, 5X,8HCOMPUTED,8X,7HCORRECT)
90006 FORMAT (1H ,5X,46H----------------------------------------------)
90011 FORMAT (1H ,18X,17HSUBSET LEVEL TEST)
C
C FORMAT STATEMENTS FOR RUN SUMMARIES
90008 FORMAT (1H ,15X,I5,19H ERRORS ENCOUNTERED)
90009 FORMAT (1H ,15X,I5,13H TESTS PASSED)
90010 FORMAT (1H ,15X,I5,14H TESTS DELETED)
C
C FORMAT STATEMENTS FOR TEST RESULTS
80001 FORMAT (1H ,4X,I5,7X,4HPASS)
80002 FORMAT (1H ,4X,I5,7X,4HFAIL)
80003 FORMAT (1H ,4X,I5,7X,7HDELETED)
80004 FORMAT (1H ,4X,I5,7X,4HFAIL,10X,I6,9X,I6)
80005 FORMAT (1H ,4X,I5,7X,4HFAIL,4X,E12.5,3X,E12.5)
C
90007 FORMAT (1H ,20X,20HEND OF PROGRAM FM041)
END
*END-OF,FM041
FM042.f 480976044 170 2 100666 22985 `
*HEADER,FORTR,FM042
*FILES1,FORTR,FM042,X
C COMMENT SECTION
C
C FM042
C
C THIS ROUTINE TESTS ARITHMETIC ASSIGNMENTS OF THE
C FORM INTEGER VARIABLE = PRIMARY ** PRIMARY
C WHERE THE FIRST OF TWO PRIMARIES IS AN INTEGER VARIABLE OR AN
C INTEGER CONSTANT AND THE SECOND PRIMARY IS AN INTEGER VARIABLE.
C
C REFERENCES
C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN,
C X3.9-1978
C
C SECTION 4.3, INTEGER TYPE
C SECTION 4.3.1, INTEGER CONSTANT
C SECTION 6.1, ARITHMETIC EXPRESSIONS
C SECTION 10.1, ARITHMETIC ASSIGNMENT STATEMENT
C
C
C **********************************************************
C
C A COMPILER VALIDATION SYSTEM FOR THE FORTRAN LANGUAGE
C BASED ON SPECIFICATIONS AS DEFINED IN AMERICAN NATIONAL STANDARD
C PROGRAMMING LANGUAGE FORTRAN X3.9-1978, HAS BEEN DEVELOPED BY THE
C FEDERAL COBOL COMPILER TESTING SERVICE. THE FORTRAN COMPILER
C VALIDATION SYSTEM (FCVS) CONSISTS OF AUDIT ROUTINES, THEIR RELATED
C DATA, AND AN EXECUTIVE SYSTEM. EACH AUDIT ROUTINE IS A FORTRAN
C PROGRAM, SUBPROGRAM OR FUNCTION WHICH INCLUDES TESTS OF SPECIFIC
C LANGUAGE ELEMENTS AND SUPPORTING PROCEDURES INDICATING THE RESULT
C OF EXECUTING THESE TESTS.
C
C THIS PARTICULAR PROGRAM/SUBPROGRAM/FUNCTION CONTAINS FEATURES
C FOUND ONLY IN THE SUBSET AS DEFINED IN X3.9-1978.
C
C SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO -
C
C DEPARTMENT OF THE NAVY
C FEDERAL COBOL COMPILER TESTING SERVICE
C WASHINGTON, D.C. 20376
C
C **********************************************************
C
C
C
C INITIALIZATION SECTION
C
C INITIALIZE CONSTANTS
C **************
C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER.
I01 = 5
C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER.
I02 = 6
C SYSTEM ENVIRONMENT SECTION
C
CX010 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-010 CONTROL CARD.
C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5
C (UNIT NUMBER FOR CARD READER).
CX011 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-011 CONTROL CARD.
C THE CX011 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL
C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX010 ABOVE.
C
CX020 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-020 CONTROL CARD.
C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02 = 6
C (UNIT NUMBER FOR PRINTER).
CX021 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-021 CONTROL CARD.
C THE CX021 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL
C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX020 ABOVE.
C
IVPASS=0
IVFAIL=0
IVDELE=0
ICZERO=0
C
C WRITE PAGE HEADERS
WRITE (I02,90000)
WRITE (I02,90001)
WRITE (I02,90002)
WRITE (I02, 90002)
WRITE (I02,90003)
WRITE (I02,90002)
WRITE (I02,90004)
WRITE (I02,90002)
WRITE (I02,90011)
WRITE (I02,90002)
WRITE (I02,90002)
WRITE (I02,90005)
WRITE (I02,90006)
WRITE (I02,90002)
C
C TEST SECTION
C
C ARITHMETIC ASSIGNMENT STATEMENT
C
C TEST 649 THROUGH TEST 665 CONTAIN ARITHMETIC ASSIGNMENT STATEMENTS
C OF THE FORM INTEGER VARIABLE = INTEGER CONST. ** INTEGER VAR.
C
C TEST 666 THROUGH TEST 682 CONTAIN ARITHMETIC ASSIGNMENT STATEMENTS
C OF THE FORM INTEGER VARIABLE = INTEGER VAR. ** INTEGER VAR.
C
C
IVTNUM = 649
C
C **** TEST 649 ****
C TEST 649 - SMALL NUMBER BASE; ZERO EXPONENT
C
IF (ICZERO) 36490, 6490, 36490
6490 CONTINUE
IVON01 = 0
IVCOMP = 1 ** IVON01
GO TO 46490
36490 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 46490, 6501, 46490
46490 IF (IVCOMP - 1) 26490,16490,26490
16490 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 6501
26490 IVFAIL = IVFAIL + 1
IVCORR = 1
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
6501 CONTINUE
IVTNUM = 650
C
C **** TEST 650 ****
C TEST 650 - ZERO BASE TO FIRST POWER
C
IF (ICZERO) 36500, 6500, 36500
6500 CONTINUE
IVON01 = 1
IVCOMP = 0 ** IVON01
GO TO 46500
36500 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 46500, 6511, 46500
46500 IF (IVCOMP) 26500,16500,26500
16500 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 6511
26500 IVFAIL = IVFAIL + 1
IVCORR = 0
WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR
6511 CONTINUE
IVTNUM = 651
C
C **** TEST 651 ****
C TEST 651 - BASE =1; EXPONENT = 1
C
IF (ICZERO) 36510, 6510, 36510
6510 CONTINUE
IVON01 = 1
IVCOMP = 1 ** IVON01
GO TO 46510
36510 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 46510, 6521, 46510
46510 IF (IVCOMP - 1) 26510,16510,26510
16510 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 6521
26510 IVFAIL = IVFAIL + 1
IVCORR = 1
WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR
6521 CONTINUE
IVTNUM = 652
C
C **** TEST 652 ****
C TEST 652 - LARGE EXPONENT
C
IF (ICZERO) 36520, 6520, 36520
6520 CONTINUE
IVON01 = 32767
IVCOMP = 1 ** IVON01
GO TO 46520
36520 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 46520, 6531, 46520
46520 IF (IVCOMP - 1) 26520,16520,26520
16520 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 6531
26520 IVFAIL = IVFAIL + 1
IVCORR = 1
WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR
6531 CONTINUE
IVTNUM = 653
C
C **** TEST 653 ****
C TEST 653 - LARGE NUMBER BASE; EXPONENT = 1
C
IF (ICZERO) 36530, 6530, 36530
6530 CONTINUE
IVON01 = 1
IVCOMP = 32767 ** IVON01
GO TO 46530
36530 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 46530, 6541, 46530
46530 IF (IVCOMP - 32767) 26530,16530,26530
16530 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 6541
26530 IVFAIL = IVFAIL + 1
IVCORR = 32767
WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR
6541 CONTINUE
IVTNUM = 654
C
C **** TEST 654 ****
C TEST 654 - ZERO BASE; LARGE NUMBER EXPONENT
C
IF (ICZERO) 36540, 6540, 36540
6540 CONTINUE
IVON01 = 32767
IVCOMP = 0 ** IVON01
GO TO 46540
36540 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 46540, 6551, 46540
46540 IF (IVCOMP) 26540,16540,26540
16540 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 6551
26540 IVFAIL = IVFAIL + 1
IVCORR = 0
WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR
6551 CONTINUE
IVTNUM = 655
C
C **** TEST 655 ****
C TEST 655 -LARGE NUMBER BASE; ZERO EXPONENT
C
IF (ICZERO) 36550, 6550, 36550
6550 CONTINUE
IVON01 = 0
IVCOMP = 32767 ** IVON01
GO TO 46550
36550 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 46550, 6561, 46550
46550 IF (IVCOMP -1) 26550,16550,26550
16550 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 6561
26550 IVFAIL = IVFAIL + 1
IVCORR = 1
WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR
6561 CONTINUE
IVTNUM = 656
C
C **** TEST 656 ****
C TEST 656 -EXPONENT IS POWER OF TWO
C
IF (ICZERO) 36560, 6560, 36560
6560 CONTINUE
IVON01 = 2
IVCOMP = 181 ** IVON01
GO TO 46560
36560 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 46560, 6571, 46560
46560 IF (IVCOMP - 32761) 26560,16560,26560
16560 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 6571
26560 IVFAIL = IVFAIL + 1
IVCORR = 32761
WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR
6571 CONTINUE
IVTNUM = 657
C
C **** TEST 657 ****
C TEST 657 - BASE AND EXPONENT ARE BOTH POWERS OF TWO
C
IF (ICZERO) 36570, 6570, 36570
6570 CONTINUE
IVON01 = 8
IVCOMP = 2 ** IVON01
GO TO 46570
36570 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 46570, 6581, 46570
46570 IF (IVCOMP - 256) 26570,16570,26560
16570 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 6581
26570 IVFAIL = IVFAIL + 1
IVCORR = 256
WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR
6581 CONTINUE
C
C TESTS 658 AND 659 TEST TO ENSURE EXPONENTIATION OPERATOR IS
C NOT COMMUTATIVE
C
IVTNUM = 658
C
C **** TEST 658 ****
C
IF (ICZERO) 36580, 6580, 36580
6580 CONTINUE
IVON01 = 9
IVCOMP = 3 ** IVON01
GO TO 46580
36580 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 46580, 6591, 46580
46580 IF (IVCOMP - 19683) 26580,16580,26580
16580 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 6591
26580 IVFAIL = IVFAIL + 1
IVCORR = 19683
WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR
6591 CONTINUE
IVTNUM = 659
C
C **** TEST 659 ****
C
IF (ICZERO) 36590, 6590, 36590
6590 CONTINUE
IVON01 = 3
IVCOMP = 9 ** IVON01
GO TO 46590
36590 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 46590, 6601, 46590
46590 IF (IVCOMP - 729) 26590,16590,26590
16590 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 6601
26590 IVFAIL = IVFAIL + 1
IVCORR = 729
WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR
6601 CONTINUE
C
C TESTS 660 THROUGH 665 TEST POSITIVE AND NEGATIVE BASES TO POSITIVE
C ODD AND EVEN NUMBER POWERS CHECKING THE SIGN
C OF THE RESULTS
C
IVTNUM = 660
C
C **** TEST 660 ****
C
IF (ICZERO) 36600, 6600, 36600
6600 CONTINUE
IVON01 = 2
IVCOMP = 1 ** IVON01
GO TO 46600
36600 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 46600, 6611, 46600
46600 IF (IVCOMP - 1) 26600,16600,26600
16600 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 6611
26600 IVFAIL = IVFAIL + 1
IVCORR = 1
WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR
6611 CONTINUE
IVTNUM = 661
C
C **** TEST 661 ****
C
IF (ICZERO) 36610, 6610, 36610
6610 CONTINUE
IVON01 = 2
IVCOMP = ( -1) ** IVON01
GO TO 46610
36610 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 46610, 6621, 46610
46610 IF (IVCOMP - 1) 26610,16610,26610
16610 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 6621
26610 IVFAIL = IVFAIL + 1
IVCORR = 1
WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR
6621 CONTINUE
IVTNUM = 662
C
C **** TEST 662 ****
C
IF (ICZERO) 36620, 6620, 36620
6620 CONTINUE
IVON01 = 3
IVCOMP = 7 ** IVON01
GO TO 46620
36620 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 46620, 6631, 46620
46620 IF (IVCOMP - 343) 26620,16620,26620
16620 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 6631
26620 IVFAIL = IVFAIL + 1
IVCORR = 343
WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR
6631 CONTINUE
IVTNUM = 663
C
C **** TEST 663 ****
C
IF (ICZERO) 36630, 6630, 36630
6630 CONTINUE
IVON01 = 3
IVCOMP = (-7) **IVON01
GO TO 46630
36630 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 46630, 6641, 46630
46630 IF (IVCOMP + 343) 26630,16630,26630
16630 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 6641
26630 IVFAIL = IVFAIL + 1
IVCORR = -343
WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR
6641 CONTINUE
IVTNUM = 664
C
C **** TEST 664 ****
C
IF (ICZERO) 36640, 6640, 36640
6640 CONTINUE
IVON01 = 4
IVCOMP = 7 ** IVON01
GO TO 46640
36640 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 46640, 6651, 46640
46640 IF (IVCOMP - 2401) 26640,16640,26640
16640 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 6651
26640 IVFAIL = IVFAIL + 1
IVCORR = 2401
WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR
6651 CONTINUE
IVTNUM = 665
C
C **** TEST 665 ****
C
IF (ICZERO) 36650, 6650, 36650
6650 CONTINUE
IVON01 = 4
IVCOMP = (-7) ** IVON01
GO TO 46650
36650 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 46650, 6661, 46650
46650 IF (IVCOMP - 2401) 26650,16650,26650
16650 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 6661
26650 IVFAIL = IVFAIL + 1
IVCORR = 2401
WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR
6661 CONTINUE
IVTNUM = 666
C
C **** TEST 666 ****
C TEST 666 - SMALL NUMBER BASE; ZERO EXPONENT
C
IF (ICZERO) 36660, 6660, 36660
6660 CONTINUE
IVON01 = 1
IVON02 = 0
IVCOMP = IVON01 ** IVON02
GO TO 46660
36660 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 46660, 6671, 46660
46660 IF (IVCOMP - 1) 26660,16660,26660
16660 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 6671
26660 IVFAIL = IVFAIL + 1
IVCORR = 1
WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR
6671 CONTINUE
IVTNUM = 667
C
C **** TEST 667 ****
C TEST 667 - ZERO BASE TO FIRST POWER
C
IF (ICZERO) 36670, 6670, 36670
6670 CONTINUE
IVON01 = 0
IVON02 = 1
IVCOMP = IVON01 ** IVON02
GO TO 46670
36670 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 46670, 6681, 46670
46670 IF (IVCOMP) 26670,16670,26670
16670 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 6681
26670 IVFAIL = IVFAIL + 1
IVCORR = 0
WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR
6681 CONTINUE
IVTNUM = 668
C
C **** TEST 668 ****
C TEST 668 - BASE =1; EXPONENT = 1
C
IF (ICZERO) 36680, 6680, 36680
6680 CONTINUE
IVON01 = 1
IVON02 = 1
IVCOMP = IVON01 ** IVON02
GO TO 46680
36680 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 46680, 6691, 46680
46680 IF (IVCOMP - 1) 26680,16680,26680
16680 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 6691
26680 IVFAIL = IVFAIL + 1
IVCORR = 1
WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR
6691 CONTINUE
IVTNUM = 669
C
C **** TEST 669 ****
C TEST 669 - LARGE EXPONENT
C
IF (ICZERO) 36690, 6690, 36690
6690 CONTINUE
IVON01 = 1
IVON02 = 32767
IVCOMP = IVON01 ** IVON02
GO TO 46690
36690 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 46690, 6701, 46690
46690 IF (IVCOMP - 1) 26690,16690,26690
16690 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 6701
26690 IVFAIL = IVFAIL + 1
IVCORR = 1
WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR
6701 CONTINUE
IVTNUM = 670
C
C **** TEST 670 ****
C TEST 670 - LARGE NUMBER BASE; EXPONENT = 1
C
IF (ICZERO) 36700, 6700, 36700
6700 CONTINUE
IVON01 = 32767
IVON02 = 1
IVCOMP = IVON01 ** IVON02
GO TO 46700
36700 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 46700, 6711, 46700
46700 IF (IVCOMP - 32767) 26700,16700,26700
16700 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 6711
26700 IVFAIL = IVFAIL + 1
IVCORR = 32767
WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR
6711 CONTINUE
IVTNUM = 671
C
C **** TEST 671 ****
C TEST 671 - ZERO BASE; LARGE NUMBER EXPONENT
C
IF (ICZERO) 36710, 6710, 36710
6710 CONTINUE
IVON01 = 0
IVON02 = 32767
IVCOMP = IVON01 ** IVON02
GO TO 46710
36710 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 46710, 6721, 46710
46710 IF (IVCOMP) 26710,16710,26710
16710 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 6721
26710 IVFAIL = IVFAIL + 1
IVCORR = 0
WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR
6721 CONTINUE
IVTNUM = 672
C
C **** TEST 672 ****
C TEST 672 -LARGE NUMBER BASE; ZERO EXPONENT
C
IF (ICZERO) 36720, 6720, 36720
6720 CONTINUE
IVON01 = 32767
IVON02 = 0
IVCOMP = IVON01 ** IVON02
GO TO 46720
36720 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 46720, 6731, 46720
46720 IF (IVCOMP -1) 26720,16720,26720
16720 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 6731
26720 IVFAIL = IVFAIL + 1
IVCORR = 1
WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR
6731 CONTINUE
IVTNUM = 673
C
C **** TEST 673 ****
C TEST 673 -EXPONENT IS POWER OF TWO
C
IF (ICZERO) 36730, 6730, 36730
6730 CONTINUE
IVON01 = 181
IVON02 = 2
IVCOMP = IVON01 ** IVON02
GO TO 46730
36730 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 46730, 6741, 46730
46730 IF (IVCOMP - 32761) 26730,16730,26730
16730 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 6741
26730 IVFAIL = IVFAIL + 1
IVCORR = 32761
WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR
6741 CONTINUE
IVTNUM = 674
C
C **** TEST 674 ****
C TEST 674 - BASE AND EXPONENT ARE BOTH POWERS OF TWO
C
IF (ICZERO) 36740, 6740, 36740
6740 CONTINUE
IVON01 = 2
IVON02 = 8
IVCOMP = IVON01 ** IVON02
GO TO 46740
36740 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 46740, 6751, 46740
46740 IF (IVCOMP - 256) 26740,16740,26740
16740 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 6751
26740 IVFAIL = IVFAIL + 1
IVCORR = 256
WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR
6751 CONTINUE
C
C TESTS 675 AND 676 TEST TO ENSURE EXPONENTIATION OPERATOR IS
C NOT COMMUTATIVE
C
IVTNUM = 675
C
C **** TEST 675 ****
C
IF (ICZERO) 36750, 6750, 36750
6750 CONTINUE
IVON01 = 3
IVON02 = 9
IVCOMP = IVON01 ** IVON02
GO TO 46750
36750 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 46750, 6761, 46750
46750 IF (IVCOMP - 19683) 26750,16750,26750
16750 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 6761
26750 IVFAIL = IVFAIL + 1
IVCORR = 19683
WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR
6761 CONTINUE
IVTNUM = 676
C
C **** TEST 676 ****
C
IF (ICZERO) 36760, 6760, 36760
6760 CONTINUE
IVON01 = 9
IVON02 = 3
IVCOMP = IVON01 ** IVON02
GO TO 46760
36760 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 46760, 6771, 46760
46760 IF (IVCOMP - 729) 26760,16760,26760
16760 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 6771
26760 IVFAIL = IVFAIL + 1
IVCORR = 729
WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR
6771 CONTINUE
C
C TESTS 677 THROUGH 682 TEST POSITIVE AND NEGATIVE BASES TO POSITIVE
C ODD AND EVEN NUMBER POWERS CHECKING THE SIGN
C OF THE RESULTS
C
IVTNUM = 677
C
C **** TEST 677 ****
C
IF (ICZERO) 36770, 6770, 36770
6770 CONTINUE
IVON01 = 1
IVON02 = 2
IVCOMP = IVON01 ** IVON02
GO TO 46770
36770 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 46770, 6781, 46770
46770 IF (IVCOMP - 1) 26770,16770,26770
16770 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 6781
26770 IVFAIL = IVFAIL + 1
IVCORR = 1
WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR
6781 CONTINUE
IVTNUM = 678
C
C **** TEST 678 ****
C
IF (ICZERO) 36780, 6780, 36780
6780 CONTINUE
IVON01 = -1
IVON02 = 2
IVCOMP = IVON01 ** IVON02
GO TO 46780
36780 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 46780, 6791, 46780
46780 IF (IVCOMP - 1) 26780,16780,26780
16780 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 6791
26780 IVFAIL = IVFAIL + 1
IVCORR = 1
WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR
6791 CONTINUE
IVTNUM = 679
C
C **** TEST 679 ****
C
IF (ICZERO) 36790, 6790, 36790
6790 CONTINUE
IVON01 = 7
IVON02 = 3
IVCOMP = IVON01 ** IVON02
GO TO 46790
36790 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 46790, 6801, 46790
46790 IF (IVCOMP - 343) 26790,16790,26790
16790 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 6801
26790 IVFAIL = IVFAIL + 1
IVCORR = 343
WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR
6801 CONTINUE
IVTNUM = 680
C
C **** TEST 680 ****
C
IF (ICZERO) 36800, 6800, 36800
6800 CONTINUE
IVON01 = -7
IVON02 = 3
IVCOMP = IVON01 ** IVON02
GO TO 46800
36800 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 46800, 6811, 46800
46800 IF (IVCOMP + 343) 26800,16800,26800
16800 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 6811
26800 IVFAIL = IVFAIL + 1
IVCORR = -343
WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR
6811 CONTINUE
IVTNUM = 681
C
C **** TEST 681 ****
C
IF (ICZERO) 36810, 6810, 36810
6810 CONTINUE
IVON01 = 7
IVON02 = 4
IVCOMP = IVON01 ** IVON02
GO TO 46810
36810 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 46810, 6821, 46810
46810 IF (IVCOMP - 2401) 26810,16810,26810
16810 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 6821
26810 IVFAIL = IVFAIL + 1
IVCORR = 2401
WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR
6821 CONTINUE
IVTNUM = 682
C
C **** TEST 682 ****
C
IF (ICZERO) 36820, 6820, 36820
6820 CONTINUE
IVON01 = -7
IVON02 = 4
IVCOMP = IVON01 ** IVON02
GO TO 46820
36820 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 46820, 6831, 46820
46820 IF (IVCOMP - 2401) 26820,16820,26820
16820 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 6831
26820 IVFAIL = IVFAIL + 1
IVCORR = 2401
WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR
6831 CONTINUE
C
C WRITE PAGE FOOTINGS AND RUN SUMMARIES
99999 CONTINUE
WRITE (I02,90002)
WRITE (I02,90006)
WRITE (I02,90002)
WRITE (I02,90002)
WRITE (I02,90007)
WRITE (I02,90002)
WRITE (I02,90008) IVFAIL
WRITE (I02,90009) IVPASS
WRITE (I02,90010) IVDELE
C
C
C TERMINATE ROUTINE EXECUTION
STOP
C
C FORMAT STATEMENTS FOR PAGE HEADERS
90000 FORMAT (1H1)
90002 FORMAT (1H )
90001 FORMAT (1H ,10X,34HFORTRAN COMPILER VALIDATION SYSTEM)
90003 FORMAT (1H ,21X,11HVERSION 1.0)
90004 FORMAT (1H ,10X,38HFOR OFFICIAL USE ONLY - COPYRIGHT 1978)
90005 FORMAT (1H ,5X,4HTEST,5X,9HPASS/FAIL, 5X,8HCOMPUTED,8X,7HCORRECT)
90006 FORMAT (1H ,5X,46H----------------------------------------------)
90011 FORMAT (1H ,18X,17HSUBSET LEVEL TEST)
C
C FORMAT STATEMENTS FOR RUN SUMMARIES
90008 FORMAT (1H ,15X,I5,19H ERRORS ENCOUNTERED)
90009 FORMAT (1H ,15X,I5,13H TESTS PASSED)
90010 FORMAT (1H ,15X,I5,14H TESTS DELETED)
C
C FORMAT STATEMENTS FOR TEST RESULTS
80001 FORMAT (1H ,4X,I5,7X,4HPASS)
80002 FORMAT (1H ,4X,I5,7X,4HFAIL)
80003 FORMAT (1H ,4X,I5,7X,7HDELETED)
80004 FORMAT (1H ,4X,I5,7X,4HFAIL,10X,I6,9X,I6)
80005 FORMAT (1H ,4X,I5,7X,4HFAIL,4X,E12.5,3X,E12.5)
C
90007 FORMAT (1H ,20X,20HEND OF PROGRAM FM042)
END
*END-OF,FM042
FM043.f 480976047 170 2 100666 24670 `
*HEADER,FORTR,FM043
*FILES1,FORTR,FM043,X
C COMMENT SECTION
C
C FM043
C
C THIS ROUTINE TESTS ARITHMETIC ASSIGNMENTS OF THE FORM
C
C INTEGER VAR. = INTEGER VAR. <OP1> INTEGER VAR. <OP2> INTEGER VAR.
C
C WHERE <OP1> AND <OP2> ARE ARITHMETIC OPERATORS, BUT <OP1> IS
C NOT THE SAME AS <OP2>.
C
C REFERENCES
C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN,
C X3.9-1978
C
C SECTION 4.3, INTEGER TYPE
C SECTION 4.3.1, INTEGER CONSTANT
C SECTION 6.1, ARITHMETIC EXPRESSIONS
C SECTION 6.6, EVALUATION OF EXPRESSIONS
C SECTION 10.1, ARITHMETIC ASSIGNMENT STATEMENT
C
C
C **********************************************************
C
C A COMPILER VALIDATION SYSTEM FOR THE FORTRAN LANGUAGE
C BASED ON SPECIFICATIONS AS DEFINED IN AMERICAN NATIONAL STANDARD
C PROGRAMMING LANGUAGE FORTRAN X3.9-1978, HAS BEEN DEVELOPED BY THE
C FEDERAL COBOL COMPILER TESTING SERVICE. THE FORTRAN COMPILER
C VALIDATION SYSTEM (FCVS) CONSISTS OF AUDIT ROUTINES, THEIR RELATED
C DATA, AND AN EXECUTIVE SYSTEM. EACH AUDIT ROUTINE IS A FORTRAN
C PROGRAM, SUBPROGRAM OR FUNCTION WHICH INCLUDES TESTS OF SPECIFIC
C LANGUAGE ELEMENTS AND SUPPORTING PROCEDURES INDICATING THE RESULT
C OF EXECUTING THESE TESTS.
C
C THIS PARTICULAR PROGRAM/SUBPROGRAM/FUNCTION CONTAINS FEATURES
C FOUND ONLY IN THE SUBSET AS DEFINED IN X3.9-1978.
C
C SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO -
C
C DEPARTMENT OF THE NAVY
C FEDERAL COBOL COMPILER TESTING SERVICE
C WASHINGTON, D.C. 20376
C
C **********************************************************
C
C
C
C INITIALIZATION SECTION
C
C INITIALIZE CONSTANTS
C **************
C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER.
I01 = 5
C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER.
I02 = 6
C SYSTEM ENVIRONMENT SECTION
C
CX010 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-010 CONTROL CARD.
C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5
C (UNIT NUMBER FOR CARD READER).
CX011 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-011 CONTROL CARD.
C THE CX011 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL
C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX010 ABOVE.
C
CX020 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-020 CONTROL CARD.
C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02 = 6
C (UNIT NUMBER FOR PRINTER).
CX021 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-021 CONTROL CARD.
C THE CX021 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL
C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX020 ABOVE.
C
IVPASS=0
IVFAIL=0
IVDELE=0
ICZERO=0
C
C WRITE PAGE HEADERS
WRITE (I02,90000)
WRITE (I02,90001)
WRITE (I02,90002)
WRITE (I02, 90002)
WRITE (I02,90003)
WRITE (I02,90002)
WRITE (I02,90004)
WRITE (I02,90002)
WRITE (I02,90011)
WRITE (I02,90002)
WRITE (I02,90002)
WRITE (I02,90005)
WRITE (I02,90006)
WRITE (I02,90002)
C
C TEST SECTION
C
C ARITHMETIC ASSIGNMENT STATEMENT
C
C TESTS 683 THROUGH 694 TEST STATEMENTS WHERE <OP1> IS '+' AND
C <OP2> VARIES.
C
C TEST 695 THROUGH 706 TEST STATEMENTS WHERE <OP1> IS '-' AND
C <OP2> VARIES.
C
C TESTS 707 THROUGH 718 TEST STATEMENTS WHERE <OP1> IS '*' AND
C <OP2> VARIES.
C
C
C
C TESTS 683 THROUGH 685 TEST '+' FOLLOWED BY '-'.
C
IVTNUM = 683
C
C **** TEST 683 ****
C
IF (ICZERO) 36830, 6830, 36830
6830 CONTINUE
IVON01 = 45
IVON02 = 9
IVON03 = 3
IVCOMP = IVON01 + IVON02 - IVON03
GO TO 46830
36830 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 46830, 6841, 46830
46830 IF (IVCOMP - 51) 26830,16830,26830
16830 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 6841
26830 IVFAIL = IVFAIL + 1
IVCORR = 51
WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR
6841 CONTINUE
IVTNUM = 684
C
C **** TEST 684 ****
C
IF (ICZERO) 36840, 6840, 36840
6840 CONTINUE
IVON01 = 45
IVON02 = 9
IVON03 = 3
IVCOMP = (IVON01 + IVON02) - IVON03
GO TO 46840
36840 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 46840, 6851, 46840
46840 IF (IVCOMP - 51) 26840,16840,26840
16840 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 6851
26840 IVFAIL = IVFAIL + 1
IVCORR = 51
WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR
6851 CONTINUE
IVTNUM = 685
C
C **** TEST 685 ****
C
IF (ICZERO) 36850, 6850, 36850
6850 CONTINUE
IVON01 = 45
IVON02 = 9
IVON03 = 3
IVCOMP = IVON01 + (IVON02 - IVON03)
GO TO 46850
36850 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 46850, 6861, 46850
46850 IF (IVCOMP - 51) 26850,16850,26850
16850 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 6861
26850 IVFAIL = IVFAIL + 1
IVCORR = 51
WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR
6861 CONTINUE
C
C TESTS 686 THROUGH 688 TEST '+' FOLLOWED BY '*'.
C
IVTNUM = 686
C
C **** TEST 686 ****
C
IF (ICZERO) 36860, 6860, 36860
6860 CONTINUE
IVON01 = 45
IVON02 = 9
IVON03 = 3
IVCOMP = IVON01 + IVON02 * IVON03
GO TO 46860
36860 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 46860, 6871, 46860
46860 IF (IVCOMP - 72) 26860,16860,26860
16860 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 6871
26860 IVFAIL = IVFAIL + 1
IVCORR = 72
WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR
6871 CONTINUE
IVTNUM = 687
C
C **** TEST 687 ****
C
IF (ICZERO) 36870, 6870, 36870
6870 CONTINUE
IVON01 = 45
IVON02 = 9
IVON03 = 3
IVCOMP = (IVON01 + IVON02) * IVON03
GO TO 46870
36870 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 46870, 6881, 46870
46870 IF (IVCOMP - 162) 26870,16870,26870
16870 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 6881
26870 IVFAIL = IVFAIL + 1
IVCORR = 162
WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR
6881 CONTINUE
IVTNUM = 688
C
C **** TEST 688 ****
C
IF (ICZERO) 36880, 6880, 36880
6880 CONTINUE
IVON01 = 45
IVON02 = 9
IVON03 = 3
IVCOMP = IVON01 + (IVON02 * IVON03)
GO TO 46880
36880 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 46880, 6891, 46880
46880 IF (IVCOMP - 72) 26880,16880,26880
16880 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 6891
26880 IVFAIL = IVFAIL + 1
IVCORR = 72
WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR
6891 CONTINUE
C
C TESTS 689 THROUGH 691 TEST '+' FOLLOWED BY '/'.
C
IVTNUM = 689
C
C **** TEST 689 ****
C
IF (ICZERO) 36890, 6890, 36890
6890 CONTINUE
IVON01 = 45
IVON02 = 9
IVON03 = 3
IVCOMP = IVON01 + IVON02 / IVON03
GO TO 46890
36890 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 46890, 6901, 46890
46890 IF (IVCOMP - 48) 26890,16890,26890
16890 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 6901
26890 IVFAIL = IVFAIL + 1
IVCORR = 48
WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR
6901 CONTINUE
IVTNUM = 690
C
C **** TEST 690 ****
C
IF (ICZERO) 36900, 6900, 36900
6900 CONTINUE
IVON01 = 45
IVON02 = 9
IVON03 = 3
IVCOMP = (IVON01 + IVON02) / IVON03
GO TO 46900
36900 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 46900, 6911, 46900
46900 IF (IVCOMP - 18) 26900,16900,26900
16900 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 6911
26900 IVFAIL = IVFAIL + 1
IVCORR = 18
WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR
6911 CONTINUE
IVTNUM = 691
C
C **** TEST 691 ****
C
IF (ICZERO) 36910, 6910, 36910
6910 CONTINUE
IVON01 = 45
IVON02 = 9
IVON03 = 3
IVCOMP = IVON01 + (IVON02 / IVON03)
GO TO 46910
36910 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 46910, 6921, 46910
46910 IF (IVCOMP - 48) 26910,16910,26910
16910 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 6921
26910 IVFAIL = IVFAIL + 1
IVCORR = 48
WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR
6921 CONTINUE
C
C TESTS 692 THROUGH 694 TEST '+' FOLLOWED BY '**'.
C
IVTNUM = 692
C
C **** TEST 692 ****
C
IF (ICZERO) 36920, 6920, 36920
6920 CONTINUE
IVON01 = 15
IVON02 = 9
IVON03 = 3
IVCOMP = IVON01 + IVON02 ** IVON03
GO TO 46920
36920 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 46920, 6931, 46920
46920 IF (IVCOMP - 744) 26920,16920,26920
16920 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 6931
26920 IVFAIL = IVFAIL + 1
IVCORR = 744
WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR
6931 CONTINUE
IVTNUM = 693
C
C **** TEST 693 ****
C
IF (ICZERO) 36930, 6930, 36930
6930 CONTINUE
IVON01 = 15
IVON02 = 9
IVON03 = 3
IVCOMP = (IVON01 + IVON02) ** IVON03
GO TO 46930
36930 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 46930, 6941, 46930
46930 IF (IVCOMP - 13824) 26930,16930,26930
16930 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 6941
26930 IVFAIL = IVFAIL + 1
IVCORR = 13824
WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR
6941 CONTINUE
IVTNUM = 694
C
C **** TEST 694 ****
C
IF (ICZERO) 36940, 6940, 36940
6940 CONTINUE
IVON01 = 15
IVON02 = 9
IVON03 = 3
IVCOMP = IVON01 + (IVON02 ** IVON03)
GO TO 46940
36940 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 46940, 6951, 46940
46940 IF (IVCOMP - 744) 26940,16940,26940
16940 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 6951
26940 IVFAIL = IVFAIL + 1
IVCORR = 744
WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR
6951 CONTINUE
C
C TESTS 695 THROUGH 697 TEST '-' FOLLOWED BY '+'.
C
IVTNUM = 695
C
C **** TEST 695 ****
C
IF (ICZERO) 36950, 6950, 36950
6950 CONTINUE
IVON01 = 45
IVON02 = 9
IVON03 = 3
IVCOMP = IVON01 - IVON02 + IVON03
GO TO 46950
36950 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 46950, 6961, 46950
46950 IF (IVCOMP - 39) 26950,16950,26950
16950 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 6961
26950 IVFAIL = IVFAIL + 1
IVCORR = 39
WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR
6961 CONTINUE
IVTNUM = 696
C
C **** TEST 696 ****
C
IF (ICZERO) 36960, 6960, 36960
6960 CONTINUE
IVON01 = 45
IVON02 = 9
IVON03 = 3
IVCOMP = (IVON01 - IVON02) + IVON03
GO TO 46960
36960 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 46960, 6971, 46960
46960 IF (IVCOMP - 39) 26960,16960,26960
16960 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 6971
26960 IVFAIL = IVFAIL + 1
IVCORR = 39
WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR
6971 CONTINUE
IVTNUM = 697
C
C **** TEST 697 ****
C
IF (ICZERO) 36970, 6970, 36970
6970 CONTINUE
IVON01 = 45
IVON02 = 9
IVON03 = 3
IVCOMP = IVON01 - (IVON02 + IVON03)
GO TO 46970
36970 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 46970, 6981, 46970
46970 IF (IVCOMP - 33) 26970,16970,26970
16970 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 6981
26970 IVFAIL = IVFAIL + 1
IVCORR = 33
WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR
6981 CONTINUE
C
C TESTS 698 THROUGH 700 TEST '-' FOLLOWED BY '*'.
C
IVTNUM = 698
C
C **** TEST 698 ****
C
IF (ICZERO) 36980, 6980, 36980
6980 CONTINUE
IVON01 = 45
IVON02 = 9
IVON03 = 3
IVCOMP = IVON01 - IVON02 * IVON03
GO TO 46980
36980 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 46980, 6991, 46980
46980 IF (IVCOMP - 18) 26980,16980,26980
16980 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 6991
26980 IVFAIL = IVFAIL + 1
IVCORR = 18
WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR
6991 CONTINUE
IVTNUM = 699
C
C **** TEST 699 ****
C
IF (ICZERO) 36990, 6990, 36990
6990 CONTINUE
IVON01 = 45
IVON02 = 9
IVON03 = 3
IVCOMP = (IVON01 - IVON02) * IVON03
GO TO 46990
36990 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 46990, 7001, 46990
46990 IF (IVCOMP - 108) 26990,16990,26990
16990 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 7001
26990 IVFAIL = IVFAIL + 1
IVCORR = 108
WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR
7001 CONTINUE
IVTNUM = 700
C
C **** TEST 700 ****
C
IF (ICZERO) 37000, 7000, 37000
7000 CONTINUE
IVON01 = 45
IVON02 = 9
IVON03 = 3
IVCOMP = IVON01 - (IVON02 * IVON03)
GO TO 47000
37000 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 47000, 7011, 47000
47000 IF (IVCOMP - 18) 27000,17000,27000
17000 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 7011
27000 IVFAIL = IVFAIL + 1
IVCORR = 18
WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR
7011 CONTINUE
C
C TESTS 701 THROUGH 703 TEST '-' FOLLOWED BY '/'.
C
IVTNUM = 701
C
C **** TEST 701 ****
C
IF (ICZERO) 37010, 7010, 37010
7010 CONTINUE
IVON01 = 45
IVON02 = 9
IVON03 = 3
IVCOMP = IVON01 - IVON02 / IVON03
GO TO 47010
37010 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 47010, 7021, 47010
47010 IF (IVCOMP - 42) 27010,17010,27010
17010 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 7021
27010 IVFAIL = IVFAIL + 1
IVCORR = 42
WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR
7021 CONTINUE
IVTNUM = 702
C
C **** TEST 702 ****
C
IF (ICZERO) 37020, 7020, 37020
7020 CONTINUE
IVON01 = 45
IVON02 = 9
IVON03 = 3
IVCOMP = (IVON01 - IVON02) / IVON03
GO TO 47020
37020 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 47020, 7031, 47020
47020 IF (IVCOMP - 12) 27020,17020,27020
17020 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 7031
27020 IVFAIL = IVFAIL + 1
IVCORR = 12
WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR
7031 CONTINUE
IVTNUM = 703
C
C **** TEST 703 ****
C
IF (ICZERO) 37030, 7030, 37030
7030 CONTINUE
IVON01 = 45
IVON02 = 9
IVON03 = 3
IVCOMP = IVON01 - (IVON02 / IVON03)
GO TO 47030
37030 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 47030, 7041, 47030
47030 IF (IVCOMP - 42) 27030,17030,27030
17030 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 7041
27030 IVFAIL = IVFAIL + 1
IVCORR = 42
WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR
7041 CONTINUE
C
C TESTS 704 THROUGH 706 TEST '-' FOLLOWED BY '**'.
C
IVTNUM = 704
C
C **** TEST 704 ****
C
IF (ICZERO) 37040, 7040, 37040
7040 CONTINUE
IVON01 = 35
IVON02 = 9
IVON03 = 3
IVCOMP = IVON01 - IVON02 ** IVON03
GO TO 47040
37040 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 47040, 7051, 47040
47040 IF (IVCOMP + 694) 27040,17040,27040
17040 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 7051
27040 IVFAIL = IVFAIL + 1
IVCORR = -694
WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR
7051 CONTINUE
IVTNUM = 705
C
C **** TEST 705 ****
C
IF (ICZERO) 37050, 7050, 37050
7050 CONTINUE
IVON01 = 35
IVON02 = 9
IVON03 = 3
IVCOMP = (IVON01 - IVON02) ** IVON03
GO TO 47050
37050 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 47050, 7061, 47050
47050 IF (IVCOMP - 17576) 27050,17050,27050
17050 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 7061
27050 IVFAIL = IVFAIL + 1
IVCORR = 17576
WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR
7061 CONTINUE
IVTNUM = 706
C
C **** TEST 706 ****
C
IF (ICZERO) 37060, 7060, 37060
7060 CONTINUE
IVON01 = 35
IVON02 = 9
IVON03 = 3
IVCOMP = IVON01 - (IVON02 ** IVON03)
GO TO 47060
37060 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 47060, 7071, 47060
47060 IF (IVCOMP + 694) 27060,17060,27060
17060 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 7071
27060 IVFAIL = IVFAIL + 1
IVCORR = -694
WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR
7071 CONTINUE
C
C TESTS 707 THROUGH 709 TEST '*' FOLLOWED BY '+'.
C
IVTNUM = 707
C
C **** TEST 707 ****
C
IF (ICZERO) 37070, 7070, 37070
7070 CONTINUE
IVON01 = 45
IVON02 = 9
IVON03 = 3
IVCOMP = IVON01 * IVON02 + IVON03
GO TO 47070
37070 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 47070, 7081, 47070
47070 IF (IVCOMP - 408) 27070,17070,27070
17070 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 7081
27070 IVFAIL = IVFAIL + 1
IVCORR = 408
WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR
7081 CONTINUE
IVTNUM = 708
C
C **** TEST 708 ****
C
IF (ICZERO) 37080, 7080, 37080
7080 CONTINUE
IVON01 = 45
IVON02 = 9
IVON03 = 3
IVCOMP = (IVON01 * IVON02) + IVON03
GO TO 47080
37080 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 47080, 7091, 47080
47080 IF (IVCOMP - 408) 27080,17080,27080
17080 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 7091
27080 IVFAIL = IVFAIL + 1
IVCORR = 408
WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR
7091 CONTINUE
IVTNUM = 709
C
C **** TEST 709 ****
C
IF (ICZERO) 37090, 7090, 37090
7090 CONTINUE
IVON01 = 45
IVON02 = 9
IVON03 = 3
IVCOMP = IVON01 * (IVON02 + IVON03)
GO TO 47090
37090 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 47090, 7101, 47090
47090 IF (IVCOMP - 540) 27090,17090,27090
17090 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 7101
27090 IVFAIL = IVFAIL + 1
IVCORR = 540
WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR
7101 CONTINUE
C
C TESTS 710 THROUGH 712 TEST '*' FOLLOWED BY '-'.
C
IVTNUM = 710
C
C **** TEST 710 ****
C
IF (ICZERO) 37100, 7100, 37100
7100 CONTINUE
IVON01 = 45
IVON02 = 9
IVON03 = 3
IVCOMP = IVON01 * IVON02 - IVON03
GO TO 47100
37100 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 47100, 7111, 47100
47100 IF (IVCOMP - 402) 27100,17100,27100
17100 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 7111
27100 IVFAIL = IVFAIL + 1
IVCORR = 402
WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR
7111 CONTINUE
IVTNUM = 711
C
C **** TEST 711 ****
C
IF (ICZERO) 37110, 7110, 37110
7110 CONTINUE
IVON01 = 45
IVON02 = 9
IVON03 = 3
IVCOMP = (IVON01 * IVON02) - IVON03
GO TO 47110
37110 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 47110, 7121, 47110
47110 IF (IVCOMP - 402) 27110,17110,27110
17110 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 7121
27110 IVFAIL = IVFAIL + 1
IVCORR = 402
WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR
7121 CONTINUE
IVTNUM = 712
C
C **** TEST 712 ****
C
IF (ICZERO) 37120, 7120, 37120
7120 CONTINUE
IVON01 = 45
IVON02 = 9
IVON03 = 3
IVCOMP = IVON01 * (IVON02 - IVON03)
GO TO 47120
37120 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 47120, 7131, 47120
47120 IF (IVCOMP - 270) 27120,17120,27120
17120 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 7131
27120 IVFAIL = IVFAIL + 1
IVCORR = 270
WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR
7131 CONTINUE
C
C TESTS 713 THROUGH 715 TEST '*' FOLLOWED BY '/'.
C
IVTNUM = 713
C
C **** TEST 713 ****
C
IF (ICZERO) 37130, 7130, 37130
7130 CONTINUE
IVON01 = 45
IVON02 = 9
IVON03 = 3
IVCOMP = IVON01 * IVON02 / IVON03
GO TO 47130
37130 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 47130, 7141, 47130
47130 IF (IVCOMP - 135) 27130,17130,27130
17130 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 7141
27130 IVFAIL = IVFAIL + 1
IVCORR = 135
WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR
7141 CONTINUE
IVTNUM = 714
C
C **** TEST 714 ****
C
IF (ICZERO) 37140, 7140, 37140
7140 CONTINUE
IVON01 = 45
IVON02 = 9
IVON03 = 3
IVCOMP = (IVON01 * IVON02) / IVON03
GO TO 47140
37140 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 47140, 7151, 47140
47140 IF (IVCOMP - 135) 27140,17140,27140
17140 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 7151
27140 IVFAIL = IVFAIL + 1
IVCORR = 135
WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR
7151 CONTINUE
IVTNUM = 715
C
C **** TEST 715 ****
C
IF (ICZERO) 37150, 7150, 37150
7150 CONTINUE
IVON01 = 45
IVON02 = 9
IVON03 = 3
IVCOMP = IVON01 * (IVON02 / IVON03)
GO TO 47150
37150 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 47150, 7161, 47150
47150 IF (IVCOMP - 135) 27150,17150,27150
17150 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 7161
27150 IVFAIL = IVFAIL + 1
IVCORR = 135
WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR
7161 CONTINUE
C
C TESTS 716 THROUGH 718 TEST '*' FOLLOWED BY '**'.
C
IVTNUM = 716
C
C **** TEST 716 ****
C
IF (ICZERO) 37160, 7160, 37160
7160 CONTINUE
IVON01 = 7
IVON02 = 3
IVON03 = 3
IVCOMP = IVON01 * IVON02 ** IVON03
GO TO 47160
37160 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 47160, 7171, 47160
47160 IF (IVCOMP - 189) 27160,17160,27160
17160 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 7171
27160 IVFAIL = IVFAIL + 1
IVCORR = 189
WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR
7171 CONTINUE
IVTNUM = 717
C
C **** TEST 717 ****
C
IF (ICZERO) 37170, 7170, 37170
7170 CONTINUE
IVON01 = 7
IVON02 = 3
IVON03 = 3
IVCOMP = (IVON01 * IVON02) ** IVON03
GO TO 47170
37170 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 47170, 7181, 47170
47170 IF (IVCOMP - 9261) 27170,17170,27170
17170 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 7181
27170 IVFAIL = IVFAIL + 1
IVCORR = 9261
WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR
7181 CONTINUE
IVTNUM = 718
C
C **** TEST 718 ****
C
IF (ICZERO) 37180, 7180, 37180
7180 CONTINUE
IVON01 = 7
IVON02 = 3
IVON03 = 3
IVCOMP = IVON01 * (IVON02 ** IVON03)
GO TO 47180
37180 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 47180, 7191, 47180
47180 IF (IVCOMP - 189) 27180,17180,27180
17180 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 7191
27180 IVFAIL = IVFAIL + 1
IVCORR = 189
WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR
7191 CONTINUE
C
C WRITE PAGE FOOTINGS AND RUN SUMMARIES
99999 CONTINUE
WRITE (I02,90002)
WRITE (I02,90006)
WRITE (I02,90002)
WRITE (I02,90002)
WRITE (I02,90007)
WRITE (I02,90002)
WRITE (I02,90008) IVFAIL
WRITE (I02,90009) IVPASS
WRITE (I02,90010) IVDELE
C
C
C TERMINATE ROUTINE EXECUTION
STOP
C
C FORMAT STATEMENTS FOR PAGE HEADERS
90000 FORMAT (1H1)
90002 FORMAT (1H )
90001 FORMAT (1H ,10X,34HFORTRAN COMPILER VALIDATION SYSTEM)
90003 FORMAT (1H ,21X,11HVERSION 1.0)
90004 FORMAT (1H ,10X,38HFOR OFFICIAL USE ONLY - COPYRIGHT 1978)
90005 FORMAT (1H ,5X,4HTEST,5X,9HPASS/FAIL, 5X,8HCOMPUTED,8X,7HCORRECT)
90006 FORMAT (1H ,5X,46H----------------------------------------------)
90011 FORMAT (1H ,18X,17HSUBSET LEVEL TEST)
C
C FORMAT STATEMENTS FOR RUN SUMMARIES
90008 FORMAT (1H ,15X,I5,19H ERRORS ENCOUNTERED)
90009 FORMAT (1H ,15X,I5,13H TESTS PASSED)
90010 FORMAT (1H ,15X,I5,14H TESTS DELETED)
C
C FORMAT STATEMENTS FOR TEST RESULTS
80001 FORMAT (1H ,4X,I5,7X,4HPASS)
80002 FORMAT (1H ,4X,I5,7X,4HFAIL)
80003 FORMAT (1H ,4X,I5,7X,7HDELETED)
80004 FORMAT (1H ,4X,I5,7X,4HFAIL,10X,I6,9X,I6)
80005 FORMAT (1H ,4X,I5,7X,4HFAIL,4X,E12.5,3X,E12.5)
C
90007 FORMAT (1H ,20X,20HEND OF PROGRAM FM043)
END
*END-OF,FM043
FM044.f 480976049 170 2 100666 20120 `
*HEADER,FORTR,FM044
*FILES1,FORTR,FM044,X
C COMMENT SECTION
C
C FM044
C
C THIS ROUTINE TESTS ARITHMETIC ASSIGNMENTS OF THE FORM
C INTEGER VAR. = INTEGER VAR. <OP1> INTEGER VAR. <OP2> INTEGER VAR.
C
C WHERE <OP1> AND <OP2> ARE ARITHMETIC OPERATORS.
C
C REFERENCES
C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN,
C X3.9-1978
C
C SECTION 4.3, INTEGER TYPE
C SECTION 4.3.1, INTEGER CONSTANT
C SECTION 6.1, ARITHMETIC EXPRESSIONS
C SECTION 6.6, EVALUATION OF EXPRESSIONS
C SECTION 10.1, ARITHMETIC ASSIGNMENT STATEMENT
C
C
C **********************************************************
C
C A COMPILER VALIDATION SYSTEM FOR THE FORTRAN LANGUAGE
C BASED ON SPECIFICATIONS AS DEFINED IN AMERICAN NATIONAL STANDARD
C PROGRAMMING LANGUAGE FORTRAN X3.9-1978, HAS BEEN DEVELOPED BY THE
C FEDERAL COBOL COMPILER TESTING SERVICE. THE FORTRAN COMPILER
C VALIDATION SYSTEM (FCVS) CONSISTS OF AUDIT ROUTINES, THEIR RELATED
C DATA, AND AN EXECUTIVE SYSTEM. EACH AUDIT ROUTINE IS A FORTRAN
C PROGRAM, SUBPROGRAM OR FUNCTION WHICH INCLUDES TESTS OF SPECIFIC
C LANGUAGE ELEMENTS AND SUPPORTING PROCEDURES INDICATING THE RESULT
C OF EXECUTING THESE TESTS.
C
C THIS PARTICULAR PROGRAM/SUBPROGRAM/FUNCTION CONTAINS FEATURES
C FOUND ONLY IN THE SUBSET AS DEFINED IN X3.9-1978.
C
C SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO -
C
C DEPARTMENT OF THE NAVY
C FEDERAL COBOL COMPILER TESTING SERVICE
C WASHINGTON, D.C. 20376
C
C **********************************************************
C
C
C
C INITIALIZATION SECTION
C
C INITIALIZE CONSTANTS
C **************
C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER.
I01 = 5
C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER.
I02 = 6
C SYSTEM ENVIRONMENT SECTION
C
CX010 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-010 CONTROL CARD.
C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5
C (UNIT NUMBER FOR CARD READER).
CX011 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-011 CONTROL CARD.
C THE CX011 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL
C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX010 ABOVE.
C
CX020 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-020 CONTROL CARD.
C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02 = 6
C (UNIT NUMBER FOR PRINTER).
CX021 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-021 CONTROL CARD.
C THE CX021 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL
C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX020 ABOVE.
C
IVPASS=0
IVFAIL=0
IVDELE=0
ICZERO=0
C
C WRITE PAGE HEADERS
WRITE (I02,90000)
WRITE (I02,90001)
WRITE (I02,90002)
WRITE (I02, 90002)
WRITE (I02,90003)
WRITE (I02,90002)
WRITE (I02,90004)
WRITE (I02,90002)
WRITE (I02,90011)
WRITE (I02,90002)
WRITE (I02,90002)
WRITE (I02,90005)
WRITE (I02,90006)
WRITE (I02,90002)
C
C TEST SECTION
C
C ARITHMETIC ASSIGNMENT STATEMENT
C
C TESTS 719 THROUGH 730 TEST STATEMENTS WHERE <OP1> IS '/' AND
C <OP2> VARIES.
C
C TESTS 731 THROUGH 746 TEST STATEMENTS WHERE <OP1> IS '**' AND
C <OP2> VARIES.
C
C
C TEST 719 THROUGH 721 TEST '/' FOLLOWED BY '+'.
C
IVTNUM = 719
C
C **** TEST 719 ****
C
IF (ICZERO) 37190, 7190, 37190
7190 CONTINUE
IVON01 = 108
IVON02 = 9
IVON03 = 3
IVCOMP = IVON01 / IVON02 + IVON03
GO TO 47190
37190 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 47190, 7201, 47190
47190 IF (IVCOMP - 15) 27190,17190,27190
17190 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 7201
27190 IVFAIL = IVFAIL + 1
IVCORR = 15
WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR
7201 CONTINUE
IVTNUM = 720
C
C **** TEST 720 ****
C
IF (ICZERO) 37200, 7200, 37200
7200 CONTINUE
IVON01 = 108
IVON02 = 9
IVON03 = 3
IVCOMP = (IVON01 / IVON02) + IVON03
GO TO 47200
37200 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 47200, 7211, 47200
47200 IF (IVCOMP - 15) 27200,17200,27200
17200 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 7211
27200 IVFAIL = IVFAIL + 1
IVCORR = 15
WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR
7211 CONTINUE
IVTNUM = 721
C
C **** TEST 721 ****
C
IF (ICZERO) 37210, 7210, 37210
7210 CONTINUE
IVON01 = 108
IVON02 = 9
IVON03 = 3
IVCOMP = IVON01 / (IVON02 + IVON03)
GO TO 47210
37210 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 47210, 7221, 47210
47210 IF (IVCOMP - 9) 27210,17210,27210
17210 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 7221
27210 IVFAIL = IVFAIL + 1
IVCORR = 9
WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR
7221 CONTINUE
C
C TEST 722 THROUGH 724 TEST '/' FOLLOWED BY '-'.
C
IVTNUM = 722
C
C **** TEST 722 ****
C
IF (ICZERO) 37220, 7220, 37220
7220 CONTINUE
IVON01 = 108
IVON02 = 9
IVON03 = 3
IVCOMP = IVON01 / IVON02 - IVON03
GO TO 47220
37220 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 47220, 7231, 47220
47220 IF (IVCOMP - 9) 27220,17220,27220
17220 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 7231
27220 IVFAIL = IVFAIL + 1
IVCORR = 9
WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR
7231 CONTINUE
IVTNUM = 723
C
C **** TEST 723 ****
C
IF (ICZERO) 37230, 7230, 37230
7230 CONTINUE
IVON01 = 108
IVON02 = 9
IVON03 = 3
IVCOMP = (IVON01 / IVON02) - IVON03
GO TO 47230
37230 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 47230, 7241, 47230
47230 IF (IVCOMP - 9) 27230,17230,27230
17230 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 7241
27230 IVFAIL = IVFAIL + 1
IVCORR = 9
WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR
7241 CONTINUE
IVTNUM = 724
C
C **** TEST 724 ****
C
IF (ICZERO) 37240, 7240, 37240
7240 CONTINUE
IVON01 = 108
IVON02 = 9
IVON03 = 3
IVCOMP = IVON01 / (IVON02 - IVON03)
GO TO 47240
37240 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 47240, 7251, 47240
47240 IF (IVCOMP - 18) 27240,17240,27240
17240 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 7251
27240 IVFAIL = IVFAIL + 1
IVCORR = 18
WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR
7251 CONTINUE
C
C TEST 725 THROUGH 727 TEST '/' FOLLOWED BY '*'.
C
IVTNUM = 725
C
C **** TEST 725 ****
C
IF (ICZERO) 37250, 7250, 37250
7250 CONTINUE
IVON01 = 108
IVON02 = 9
IVON03 = 3
IVCOMP = IVON01 / IVON02 * IVON03
GO TO 47250
37250 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 47250, 7261, 47250
47250 IF (IVCOMP - 36) 27250,17250,27250
17250 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 7261
27250 IVFAIL = IVFAIL + 1
IVCORR = 36
WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR
7261 CONTINUE
IVTNUM = 726
C
C **** TEST 726 ****
C
IF (ICZERO) 37260, 7260, 37260
7260 CONTINUE
IVON01 = 108
IVON02 = 9
IVON03 = 3
IVCOMP = (IVON01 / IVON02) * IVON03
GO TO 47260
37260 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 47260, 7271, 47260
47260 IF (IVCOMP - 36) 27260,17260,27260
17260 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 7271
27260 IVFAIL = IVFAIL + 1
IVCORR = 36
WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR
7271 CONTINUE
IVTNUM = 727
C
C **** TEST 727 ****
C
IF (ICZERO) 37270, 7270, 37270
7270 CONTINUE
IVON01 = 108
IVON02 = 9
IVON03 = 3
IVCOMP = IVON01 / (IVON02 * IVON03)
GO TO 47270
37270 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 47270, 7281, 47270
47270 IF (IVCOMP - 4) 27270,17270,27270
17270 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 7281
27270 IVFAIL = IVFAIL + 1
IVCORR = 4
WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR
7281 CONTINUE
C
C TEST 728 THROUGH 730 TEST '/' FOLLOWED BY '**'.
C
IVTNUM = 728
C
C **** TEST 728 ****
C
IF (ICZERO) 37280, 7280, 37280
7280 CONTINUE
IVON01 = 108
IVON02 = 3
IVON03 = 2
IVCOMP = IVON01 / IVON02 ** IVON03
GO TO 47280
37280 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 47280, 7291, 47280
47280 IF (IVCOMP - 12) 27280,17280,27280
17280 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 7291
27280 IVFAIL = IVFAIL + 1
IVCORR = 12
WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR
7291 CONTINUE
IVTNUM = 729
C
C **** TEST 729 ****
C
IF (ICZERO) 37290, 7290, 37290
7290 CONTINUE
IVON01 = 108
IVON02 = 3
IVON03 = 2
IVCOMP = (IVON01 / IVON02) ** IVON03
GO TO 47290
37290 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 47290, 7301, 47290
47290 IF (IVCOMP - 1296) 27290,17290,27290
17290 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 7301
27290 IVFAIL = IVFAIL + 1
IVCORR = 1296
WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR
7301 CONTINUE
IVTNUM = 730
C
C **** TEST 730 ****
C
IF (ICZERO) 37300, 7300, 37300
7300 CONTINUE
IVON01 = 108
IVON02 = 3
IVON03 = 2
IVCOMP = IVON01 / (IVON02 ** IVON03)
GO TO 47300
37300 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 47300, 7311, 47300
47300 IF (IVCOMP - 12) 27300,17300,27300
17300 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 7311
27300 IVFAIL = IVFAIL + 1
IVCORR = 12
WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR
7311 CONTINUE
C
C TEST 731 THROUGH 733 TEST '**' FOLLOWED BY '+'.
C
IVTNUM = 731
C
C **** TEST 731 ****
C
IF (ICZERO) 37310, 7310, 37310
7310 CONTINUE
IVON01 = 3
IVON02 = 5
IVON03 = 4
IVCOMP = IVON01 ** IVON02 + IVON03
GO TO 47310
37310 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 47310, 7321, 47310
47310 IF (IVCOMP - 247) 27310,17310,27310
17310 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 7321
27310 IVFAIL = IVFAIL + 1
IVCORR = 247
WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR
7321 CONTINUE
IVTNUM = 732
C
C **** TEST 732 ****
C
IF (ICZERO) 37320, 7320, 37320
7320 CONTINUE
IVON01 = 3
IVON02 = 5
IVON03 = 4
IVCOMP = (IVON01 ** IVON02) + IVON03
GO TO 47320
37320 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 47320, 7331, 47320
47320 IF (IVCOMP - 247) 27320,17320,27320
17320 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 7331
27320 IVFAIL = IVFAIL + 1
IVCORR = 247
WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR
7331 CONTINUE
IVTNUM = 733
C
C **** TEST 733 ****
C
IF (ICZERO) 37330, 7330, 37330
7330 CONTINUE
IVON01 = 3
IVON02 = 5
IVON03 = 4
IVCOMP = IVON01 ** (IVON02 + IVON03)
GO TO 47330
37330 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 47330, 7341, 47330
47330 IF (IVCOMP - 19683) 27330,17330,27330
17330 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 7341
27330 IVFAIL = IVFAIL + 1
IVCORR = 19683
WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR
7341 CONTINUE
C
C TEST 734 THROUGH 736 TEST '**' FOLLOWED BY '-'.
C
IVTNUM = 734
C
C **** TEST 734 ****
C
IF (ICZERO) 37340, 7340, 37340
7340 CONTINUE
IVON01 = 3
IVON02 = 7
IVON03 = 4
IVCOMP = IVON01 ** IVON02 - IVON03
GO TO 47340
37340 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 47340, 7351, 47340
47340 IF (IVCOMP - 2183) 27340,17340,27340
17340 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 7351
27340 IVFAIL = IVFAIL + 1
IVCORR = 2183
WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR
7351 CONTINUE
IVTNUM = 735
C
C **** TEST 735 ****
C
IF (ICZERO) 37350, 7350, 37350
7350 CONTINUE
IVON01 = 3
IVON02 = 7
IVON03 = 4
IVCOMP = (IVON01 ** IVON02) - IVON03
GO TO 47350
37350 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 47350, 7361, 47350
47350 IF (IVCOMP - 2183) 27350,17350,27350
17350 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 7361
27350 IVFAIL = IVFAIL + 1
IVCORR = 2183
WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR
7361 CONTINUE
IVTNUM = 736
C
C **** TEST 736 ****
C
IF (ICZERO) 37360, 7360, 37360
7360 CONTINUE
IVON01 = 3
IVON02 = 7
IVON03 = 4
IVCOMP = IVON01 ** (IVON02 - IVON03)
GO TO 47360
37360 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 47360, 7371, 47360
47360 IF (IVCOMP - 27) 27360,17360,27360
17360 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 7371
27360 IVFAIL = IVFAIL + 1
IVCORR = 27
WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR
7371 CONTINUE
C
C TEST 737 THROUGH 739 TEST '**' FOLLOWED BY '*'.
C
IVTNUM = 737
C
C **** TEST 737 ****
C
IF (ICZERO) 37370, 7370, 37370
7370 CONTINUE
IVON01 = 3
IVON02 = 3
IVON03 = 3
IVCOMP = IVON01 ** IVON02 * IVON03
GO TO 47370
37370 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 47370, 7381, 47370
47370 IF (IVCOMP - 81) 27370,17370,27370
17370 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 7381
27370 IVFAIL = IVFAIL + 1
IVCORR = 81
WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR
7381 CONTINUE
IVTNUM = 738
C
C **** TEST 738 ****
C
IF (ICZERO) 37380, 7380, 37380
7380 CONTINUE
IVON01 = 3
IVON02 = 3
IVON03 = 3
IVCOMP = (IVON01 ** IVON02) * IVON03
GO TO 47380
37380 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 47380, 7391, 47380
47380 IF (IVCOMP - 81) 27380,17380,27380
17380 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 7391
27380 IVFAIL = IVFAIL + 1
IVCORR = 81
WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR
7391 CONTINUE
IVTNUM = 739
C
C **** TEST 739 ****
C
IF (ICZERO) 37390, 7390, 37390
7390 CONTINUE
IVON01 = 3
IVON02 = 3
IVON03 = 3
IVCOMP = IVON01 ** (IVON02 * IVON03)
GO TO 47390
37390 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 47390, 7401, 47390
47390 IF (IVCOMP - 19683) 27390,17390,27390
17390 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 7401
27390 IVFAIL = IVFAIL + 1
IVCORR = 19683
WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR
7401 CONTINUE
C
C TEST 740 THROUGH 742 TEST '**' FOLLOWED BY '/'.
C
IVTNUM = 740
C
C **** TEST 740 ****
C
IF (ICZERO) 37400, 7400, 37400
7400 CONTINUE
IVON01 = 3
IVON02 = 9
IVON03 = 3
IVCOMP = IVON01 ** IVON02 / IVON03
GO TO 47400
37400 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 47400, 7411, 47400
47400 IF (IVCOMP - 6561) 27400,17400,27400
17400 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 7411
27400 IVFAIL = IVFAIL + 1
IVCORR = 6561
WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR
7411 CONTINUE
IVTNUM = 741
C
C **** TEST 741 ****
C
IF (ICZERO) 37410, 7410, 37410
7410 CONTINUE
IVON01 = 3
IVON02 = 9
IVON03 = 3
IVCOMP = (IVON01 ** IVON02) / IVON03
GO TO 47410
37410 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 47410, 7421, 47410
47410 IF (IVCOMP - 6561) 27410,17410,27410
17410 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 7421
27410 IVFAIL = IVFAIL + 1
IVCORR = 6561
WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR
7421 CONTINUE
IVTNUM = 742
C **** TEST 742 ****
C
IF (ICZERO) 37420, 7420, 37420
7420 CONTINUE
IVON01 = 3
IVON02 = 9
IVON03 = 3
IVCOMP = IVON01 ** (IVON02 / IVON03)
GO TO 47420
37420 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 47420, 7431, 47420
47420 IF (IVCOMP - 27) 27420,17420,27420
17420 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 7431
27420 IVFAIL = IVFAIL + 1
IVCORR = 27
WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR
7431 CONTINUE
C
C TEST 743 THROUGH 746 TEST '**' FOLLOWED BY '**'.
C
IVTNUM = 743
C
C **** TEST 743 ****
C
IF (ICZERO) 37430, 7430, 37430
7430 CONTINUE
IVON01 = 3
IVON02 = 3
IVON03 = 2
IVCOMP = (IVON01 ** IVON02) ** IVON03
GO TO 47430
37430 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 47430, 7441, 47430
47430 IF (IVCOMP - 729) 27430,17430,27430
17430 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 7441
27430 IVFAIL = IVFAIL + 1
IVCORR = 729
WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR
7441 CONTINUE
IVTNUM = 744
C
C **** TEST 744 ****
C
IF (ICZERO) 37440, 7440, 37440
7440 CONTINUE
IVON01 = 3
IVON02 = 3
IVON03 = 2
IVCOMP = IVON01 ** (IVON02 ** IVON03)
GO TO 47440
37440 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 47440, 7451, 47440
47440 IF (IVCOMP - 19683) 27440,17440,27440
17440 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 7451
27440 IVFAIL = IVFAIL + 1
IVCORR = 19683
WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR
7451 CONTINUE
IVTNUM = 745
C
C **** TEST 745 ****
C
IF (ICZERO) 37450, 7450, 37450
7450 CONTINUE
IVON01 = -3
IVON02 = 3
IVON03 = 2
IVCOMP = (IVON01 ** IVON02) ** IVON03
GO TO 47450
37450 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 47450, 7461, 47450
47450 IF (IVCOMP - 729) 27450,17450,27450
17450 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 7461
27450 IVFAIL = IVFAIL + 1
IVCORR = 729
WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR
7461 CONTINUE
IVTNUM = 746
C
C **** TEST 746 ****
C
IF (ICZERO) 37460, 7460, 37460
7460 CONTINUE
IVON01 = -3
IVON02 = 3
IVON03 = 2
IVCOMP = IVON01 ** (IVON02 ** IVON03)
GO TO 47460
37460 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 47460, 7471, 47460
47460 IF (IVCOMP + 19683) 27460,17460,27460
17460 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 7471
27460 IVFAIL = IVFAIL + 1
IVCORR = -19683
WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR
7471 CONTINUE
C
C
C WRITE PAGE FOOTINGS AND RUN SUMMARIES
99999 CONTINUE
WRITE (I02,90002)
WRITE (I02,90006)
WRITE (I02,90002)
WRITE (I02,90002)
WRITE (I02,90007)
WRITE (I02,90002)
WRITE (I02,90008) IVFAIL
WRITE (I02,90009) IVPASS
WRITE (I02,90010) IVDELE
C
C
C TERMINATE ROUTINE EXECUTION
STOP
C
C FORMAT STATEMENTS FOR PAGE HEADERS
90000 FORMAT (1H1)
90002 FORMAT (1H )
90001 FORMAT (1H ,10X,34HFORTRAN COMPILER VALIDATION SYSTEM)
90003 FORMAT (1H ,21X,11HVERSION 1.0)
90004 FORMAT (1H ,10X,38HFOR OFFICIAL USE ONLY - COPYRIGHT 1978)
90005 FORMAT (1H ,5X,4HTEST,5X,9HPASS/FAIL, 5X,8HCOMPUTED,8X,7HCORRECT)
90006 FORMAT (1H ,5X,46H----------------------------------------------)
90011 FORMAT (1H ,18X,17HSUBSET LEVEL TEST)
C
C FORMAT STATEMENTS FOR RUN SUMMARIES
90008 FORMAT (1H ,15X,I5,19H ERRORS ENCOUNTERED)
90009 FORMAT (1H ,15X,I5,13H TESTS PASSED)
90010 FORMAT (1H ,15X,I5,14H TESTS DELETED)
C
C FORMAT STATEMENTS FOR TEST RESULTS
80001 FORMAT (1H ,4X,I5,7X,4HPASS)
80002 FORMAT (1H ,4X,I5,7X,4HFAIL)
80003 FORMAT (1H ,4X,I5,7X,7HDELETED)
80004 FORMAT (1H ,4X,I5,7X,4HFAIL,10X,I6,9X,I6)
80005 FORMAT (1H ,4X,I5,7X,4HFAIL,4X,E12.5,3X,E12.5)
C
90007 FORMAT (1H ,20X,20HEND OF PROGRAM FM044)
END
*END-OF,FM044
FM045.f 480976051 170 2 100666 13207 `
*HEADER,FORTR,FM045
*FILES1,FORTR,FM045,X
C COMMENT SECTION
C
C FM045
C
C THIS ROUTINE TESTS ARITHMETIC ASSIGNMENTS USING INTEGER
C VARIABLES CONNECTED BY A SERIES OF ARITHMETIC OPERATORS.
C DIFFERENT COMBINATIONS OF PARENTHETICAL NOTATION ARE EXERCIZED.
C
C
C REFERENCES
C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN,
C X3.9-1978
C
C SECTION 4.3, INTEGER TYPE
C SECTION 4.3.1, INTEGER CONSTANT
C SECTION 6.1, ARITHMETIC EXPRESSIONS
C SECTION 6.6, EVALUATION OF EXPRESSIONS
C SECTION 10.1, ARITHMETIC ASSIGNMENT STATEMENT
C
C
C
C **********************************************************
C
C A COMPILER VALIDATION SYSTEM FOR THE FORTRAN LANGUAGE
C BASED ON SPECIFICATIONS AS DEFINED IN AMERICAN NATIONAL STANDARD
C PROGRAMMING LANGUAGE FORTRAN X3.9-1978, HAS BEEN DEVELOPED BY THE
C FEDERAL COBOL COMPILER TESTING SERVICE. THE FORTRAN COMPILER
C VALIDATION SYSTEM (FCVS) CONSISTS OF AUDIT ROUTINES, THEIR RELATED
C DATA, AND AN EXECUTIVE SYSTEM. EACH AUDIT ROUTINE IS A FORTRAN
C PROGRAM, SUBPROGRAM OR FUNCTION WHICH INCLUDES TESTS OF SPECIFIC
C LANGUAGE ELEMENTS AND SUPPORTING PROCEDURES INDICATING THE RESULT
C OF EXECUTING THESE TESTS.
C
C THIS PARTICULAR PROGRAM/SUBPROGRAM/FUNCTION CONTAINS FEATURES
C FOUND ONLY IN THE SUBSET AS DEFINED IN X3.9-1978.
C
C SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO -
C
C DEPARTMENT OF THE NAVY
C FEDERAL COBOL COMPILER TESTING SERVICE
C WASHINGTON, D.C. 20376
C
C **********************************************************
C
C
C
C INITIALIZATION SECTION
C
C INITIALIZE CONSTANTS
C **************
C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER.
I01 = 5
C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER.
I02 = 6
C SYSTEM ENVIRONMENT SECTION
C
CX010 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-010 CONTROL CARD.
C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5
C (UNIT NUMBER FOR CARD READER).
CX011 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-011 CONTROL CARD.
C THE CX011 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL
C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX010 ABOVE.
C
CX020 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-020 CONTROL CARD.
C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02 = 6
C (UNIT NUMBER FOR PRINTER).
CX021 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-021 CONTROL CARD.
C THE CX021 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL
C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX020 ABOVE.
C
IVPASS=0
IVFAIL=0
IVDELE=0
ICZERO=0
C
C WRITE PAGE HEADERS
WRITE (I02,90000)
WRITE (I02,90001)
WRITE (I02,90002)
WRITE (I02, 90002)
WRITE (I02,90003)
WRITE (I02,90002)
WRITE (I02,90004)
WRITE (I02,90002)
WRITE (I02,90011)
WRITE (I02,90002)
WRITE (I02,90002)
WRITE (I02,90005)
WRITE (I02,90006)
WRITE (I02,90002)
C
C
C TEST SECTION
C
C ARITHMETIC ASSIGNMENT STATEMENT
C
C
C TESTS 747 THROUGH 755 USE THE SAME STRING OF VARIABLES AND
C OPERATORS, BUT USE DIFFERENT COMBINATIONS OF PARENTHETICAL
C NOTATION TO ALTER PRIORITIES IN ORDER OF EVALUATION.
C
C TESTS 756 THROUGH 759 CHECK THE CAPABILITY TO ENCLOSE THE ENTIRE
C RIGHT HAND SIDE OF AN ASSIGNMENT STATEMENT IN PARENTHESES OR SETS
C OF NESTED PARENTHESES.
C
C
C
C
C
C
C
IVTNUM = 747
C
C **** TEST 747 ****
C
IF (ICZERO) 37470, 7470, 37470
7470 CONTINUE
IVON01 = 15
IVON02 = 9
IVON03 = 4
IVON04 = 18
IVON05 = 6
IVON06 = 2
IVCOMP = IVON01 + IVON02 - IVON03 * IVON04 / IVON05 ** IVON06
GO TO 47470
37470 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 47470, 7481, 47470
47470 IF (IVCOMP - 22) 27470,17470,27470
17470 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 7481
27470 IVFAIL = IVFAIL + 1
IVCORR = 22
WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR
7481 CONTINUE
IVTNUM = 748
C
C **** TEST 748 ****
C
IF (ICZERO) 37480, 7480, 37480
7480 CONTINUE
IVON01 = 15
IVON02 = 9
IVON03 = 4
IVON04 = 18
IVON05 = 6
IVON06 = 2
IVCOMP = ((((IVON01 + IVON02) - IVON03) * IVON04) / IVON05)
* ** IVON06
GO TO 47480
37480 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 47480, 7491, 47480
47480 IF (IVCOMP - 3600) 27480,17480,27480
17480 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 7491
27480 IVFAIL = IVFAIL + 1
IVCORR = 3600
WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR
7491 CONTINUE
IVTNUM = 749
C
C **** TEST 749 ****
C
IF (ICZERO) 37490, 7490, 37490
7490 CONTINUE
IVON01 = 15
IVON02 = 9
IVON03 = 4
IVON04 = 36
IVON05 = 6
IVON06 = 2
IVCOMP = (IVON01 + IVON02 - IVON03) * (IVON04 / IVON05 ** IVON06)
GO TO 47490
37490 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 47490, 7501, 47490
47490 IF (IVCOMP - 20) 27490,17490,27490
17490 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 7501
27490 IVFAIL = IVFAIL + 1
IVCORR = 20
WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR
7501 CONTINUE
IVTNUM = 750
C
C **** TEST 750 ****
C
IF (ICZERO) 37500, 7500, 37500
7500 CONTINUE
IVON01 = 15
IVON02 = 9
IVON03 = 4
IVON04 = 36
IVON05 = 6
IVON06 = 2
IVCOMP = (IVON01 + IVON02) - (IVON03 * IVON04) / (IVON05 **
* IVON06)
GO TO 47500
37500 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 47500, 7511, 47500
47500 IF (IVCOMP - 20) 27500,17500,27500
17500 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 7511
27500 IVFAIL = IVFAIL + 1
IVCORR = 20
WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR
7511 CONTINUE
IVTNUM = 751
C
C **** TEST 751 ****
C
IF (ICZERO) 37510, 7510, 37510
7510 CONTINUE
IVON01 = 15
IVON02 = 9
IVON03 = 4
IVON04 = 36
IVON05 = 6
IVON06 = 2
IVCOMP = ((IVON01 + IVON02) - (IVON03 * IVON04)) / (IVON05 **
* IVON06)
GO TO 47510
37510 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 47510, 7521, 47510
47510 IF (IVCOMP + 3) 27510,17510,27510
17510 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 7521
27510 IVFAIL = IVFAIL + 1
IVCORR = -3
C ACTUAL ANSWER IS -3.333333... TRUNCATION IS NECESSARY
WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR
7521 CONTINUE
IVTNUM = 752
C
C **** TEST 752 ****
C
IF (ICZERO) 37520, 7520, 37520
7520 CONTINUE
IVON01 = 15
IVON02 = 9
IVON03 = 4
IVON04 = 36
IVON05 = 6
IVON06 = 2
IVCOMP = (IVON01 + IVON02) - (IVON03 * IVON04 / IVON05) ** IVON06
GO TO 47520
37520 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 47520, 7531, 47520
47520 IF (IVCOMP + 552) 27520,17520,27520
17520 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 7531
27520 IVFAIL = IVFAIL + 1
IVCORR = -552
WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR
7531 CONTINUE
IVTNUM = 753
C
C **** TEST 753 ****
C
IF (ICZERO) 37530, 7530, 37530
7530 CONTINUE
IVON01 = 15
IVON02 = 9
IVON03 = 4
IVON04 = 36
IVON05 = 6
IVON06 = 2
IVCOMP = IVON01 + (IVON02 - IVON03 * IVON04) / IVON05 ** IVON06
GO TO 47530
37530 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 47530, 7541, 47530
47530 IF (IVCOMP - 12) 27530,17530,27530
17530 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 7541
27530 IVFAIL = IVFAIL + 1
IVCORR = 12
C ACTUAL ANSWER IS 11.25 TRUNCATION IS NECESSARY
C DURING AN INTERMEDIATE STEP
WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR
7541 CONTINUE
IVTNUM = 754
C
C **** TEST 754 ****
C
IF (ICZERO) 37540, 7540, 37540
7540 CONTINUE
IVON01 = 15
IVON02 = 9
IVON03 = 4
IVON04 = 36
IVON05 = 6
IVON06 = 2
IVCOMP = IVON01 + (IVON02 - IVON03) * (IVON04 / IVON05) ** IVON06
GO TO 47540
37540 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 47540, 7551, 47540
47540 IF (IVCOMP - 195) 27540,17540,27540
17540 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 7551
27540 IVFAIL = IVFAIL + 1
IVCORR = 195
WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR
7551 CONTINUE
IVTNUM = 755
C
C **** TEST 755 ****
C
IF (ICZERO) 37550, 7550, 37550
7550 CONTINUE
IVON01 = 15
IVON02 = 9
IVON03 = 4
IVON04 = 36
IVON05 = 6
IVON06 = 2
IVCOMP = ((IVON01 + (IVON02 - IVON03) * IVON04) / IVON05) **
* IVON06
GO TO 47550
37550 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 47550, 7561, 47550
47550 IF (IVCOMP - 1024) 27550,17550,27550
17550 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 7561
27550 IVFAIL = IVFAIL + 1
IVCORR = 1024
C ACTUAL ANSWER IS 1056.25 TRUNCATION IS NECESSARY
C DURING AN INTERMEDIATE STEP
WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR
7561 CONTINUE
IVTNUM = 756
C
C **** TEST 756 ****
C SINGLE PARENTHESES
C
IF (ICZERO) 37560, 7560, 37560
7560 CONTINUE
IVON01 = 13
IVON02 = 37
IVCOMP = (IVON01 + IVON02)
GO TO 47560
37560 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 47560, 7571, 47560
47560 IF (IVCOMP - 50) 27560,17560,27560
17560 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 7571
27560 IVFAIL = IVFAIL + 1
IVCORR = 50
WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR
7571 CONTINUE
IVTNUM = 757
C
C **** TEST 757 ****
C NESTED PARENTHESES (TWO SETS)
C
IF (ICZERO) 37570, 7570, 37570
7570 CONTINUE
IVON01 = 13
IVON02 = 37
IVCOMP = ((IVON01 - IVON02))
GO TO 47570
37570 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 47570, 7581, 47570
47570 IF (IVCOMP + 24) 27570,17570,27570
17570 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 7581
27570 IVFAIL = IVFAIL + 1
IVCORR = -24
WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR
7581 CONTINUE
IVTNUM = 758
C
C **** TEST 758 ****
C NESTED PARENTHESES (21 SETS - SAME LINE)
C
IF (ICZERO) 37580, 7580, 37580
7580 CONTINUE
IVON01 = 13
IVON02 = 37
IVCOMP = (((((((((((((((((((((IVON01 * IVON02)))))))))))))))))))))
GO TO 47580
37580 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 47580, 7591, 47580
47580 IF (IVCOMP - 481) 27580,17580,27580
17580 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 7591
27580 IVFAIL = IVFAIL + 1
IVCORR = 481
WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR
7591 CONTINUE
IVTNUM = 759
C
C **** TEST 759 ****
C NESTED PARENTHESES (57 SETS - MULTIPLE LINES)
C
IF (ICZERO) 37590, 7590, 37590
7590 CONTINUE
IVON01 = 13
IVON02 = 37
IVCOMP = (((((((((((((((((((((((((((((((((((((((((((((((((((((((((
* IVON01 / IVON02
* )))))))))))))))))))))))))))))))))))))))))))))))))))))))))
GO TO 47590
37590 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 47590, 7601, 47590
47590 IF (IVCOMP) 27590,17590,27590
17590 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 7601
27590 IVFAIL = IVFAIL + 1
IVCORR = 0
WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR
7601 CONTINUE
C
C WRITE PAGE FOOTINGS AND RUN SUMMARIES
99999 CONTINUE
WRITE (I02,90002)
WRITE (I02,90006)
WRITE (I02,90002)
WRITE (I02,90002)
WRITE (I02,90007)
WRITE (I02,90002)
WRITE (I02,90008) IVFAIL
WRITE (I02,90009) IVPASS
WRITE (I02,90010) IVDELE
C
C
C TERMINATE ROUTINE EXECUTION
STOP
C
C FORMAT STATEMENTS FOR PAGE HEADERS
90000 FORMAT (1H1)
90002 FORMAT (1H )
90001 FORMAT (1H ,10X,34HFORTRAN COMPILER VALIDATION SYSTEM)
90003 FORMAT (1H ,21X,11HVERSION 1.0)
90004 FORMAT (1H ,10X,38HFOR OFFICIAL USE ONLY - COPYRIGHT 1978)
90005 FORMAT (1H ,5X,4HTEST,5X,9HPASS/FAIL, 5X,8HCOMPUTED,8X,7HCORRECT)
90006 FORMAT (1H ,5X,46H----------------------------------------------)
90011 FORMAT (1H ,18X,17HSUBSET LEVEL TEST)
C
C FORMAT STATEMENTS FOR RUN SUMMARIES
90008 FORMAT (1H ,15X,I5,19H ERRORS ENCOUNTERED)
90009 FORMAT (1H ,15X,I5,13H TESTS PASSED)
90010 FORMAT (1H ,15X,I5,14H TESTS DELETED)
C
C FORMAT STATEMENTS FOR TEST RESULTS
80001 FORMAT (1H ,4X,I5,7X,4HPASS)
80002 FORMAT (1H ,4X,I5,7X,4HFAIL)
80003 FORMAT (1H ,4X,I5,7X,7HDELETED)
80004 FORMAT (1H ,4X,I5,7X,4HFAIL,10X,I6,9X,I6)
80005 FORMAT (1H ,4X,I5,7X,4HFAIL,4X,E12.5,3X,E12.5)
C
90007 FORMAT (1H ,20X,20HEND OF PROGRAM FM045)
END
*END-OF,FM045
FM050.f 480976054 170 2 100666 16213 `
*HEADER,FORTR,FM050
*FILES1,FORTR,FM050
C
C COMMENT SECTION
C
C FM050
C
C THIS ROUTINE CONTAINS BASIC SUBROUTINE AND FUNCTION REFERENCE
C TESTS. FOUR SUBROUTINES AND ONE FUNCTION ARE CALLED OR
C REFERENCED. FS051 IS CALLED TO TEST THE CALLING AND PASSING OF
C ARGUMENTS THROUGH UNLABELED COMMON. NO ARGUMENTS ARE SPECIFIED
C IN THE CALL LINE. FS052 IS IDENTICAL TO FS051 EXCEPT THAT SEVERAL
C RETURNS ARE USED. FS053 UTILIZES MANY ARGUMENTS ON THE CALL
C STATEMENT AND MANY RETURN STATEMENTS IN THE SUBROUTINE BODY.
C FF054 IS A FUNCTION SUBROUTINE IN WHICH MANY ARGUMENTS AND RETURN
C STATEMENTS ARE USED. AND FINALLY FS055 PASSES A ONE DIMENIONAL
C ARRAY BACK TO FM050.
C
C REFERENCES
C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN,
C X3.9-1978
C
C SECTION 15.5.2, REFERENCING AN EXTERNAL FUNCTION
C SECTION 15.6.2, SUBROUTINE REFERENCE
C
COMMON RVCN01,IVCN01,IVCN02,IACN11(20)
INTEGER FF054
C
C **********************************************************
C
C A COMPILER VALIDATION SYSTEM FOR THE FORTRAN LANGUAGE
C BASED ON SPECIFICATIONS AS DEFINED IN AMERICAN NATIONAL STANDARD
C PROGRAMMING LANGUAGE FORTRAN X3.9-1978, HAS BEEN DEVELOPED BY THE
C FEDERAL COBOL COMPILER TESTING SERVICE. THE FORTRAN COMPILER
C VALIDATION SYSTEM (FCVS) CONSISTS OF AUDIT ROUTINES, THEIR RELATED
C DATA, AND AN EXECUTIVE SYSTEM. EACH AUDIT ROUTINE IS A FORTRAN
C PROGRAM, SUBPROGRAM OR FUNCTION WHICH INCLUDES TESTS OF SPECIFIC
C LANGUAGE ELEMENTS AND SUPPORTING PROCEDURES INDICATING THE RESULT
C OF EXECUTING THESE TESTS.
C
C THIS PARTICULAR PROGRAM/SUBPROGRAM/FUNCTION CONTAINS FEATURES
C FOUND ONLY IN THE SUBSET AS DEFINED IN X3.9-1978.
C
C SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO -
C
C DEPARTMENT OF THE NAVY
C FEDERAL COBOL COMPILER TESTING SERVICE
C WASHINGTON, D.C. 20376
C
C **********************************************************
C
C
C
C INITIALIZATION SECTION
C
C INITIALIZE CONSTANTS
C **************
C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER.
I01 = 5
C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER.
I02 = 6
C SYSTEM ENVIRONMENT SECTION
C
CX010 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-010 CONTROL CARD.
C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5
C (UNIT NUMBER FOR CARD READER).
CX011 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-011 CONTROL CARD.
C THE CX011 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL
C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX010 ABOVE.
C
CX020 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-020 CONTROL CARD.
C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02 = 6
C (UNIT NUMBER FOR PRINTER).
CX021 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-021 CONTROL CARD.
C THE CX021 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL
C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX020 ABOVE.
C
IVPASS=0
IVFAIL=0
IVDELE=0
ICZERO=0
C
C WRITE PAGE HEADERS
WRITE (I02,90000)
WRITE (I02,90001)
WRITE (I02,90002)
WRITE (I02, 90002)
WRITE (I02,90003)
WRITE (I02,90002)
WRITE (I02,90004)
WRITE (I02,90002)
WRITE (I02,90011)
WRITE (I02,90002)
WRITE (I02,90002)
WRITE (I02,90005)
WRITE (I02,90006)
WRITE (I02,90002)
C TEST SECTION
C
C SUBROUTINE AND FUNCTION SUBPROGRAMS
C
4001 CONTINUE
IVTNUM = 400
C
C **** TEST 400 ****
C TEST 400 TESTS THE CALL TO A SUBROUTINE CONTAINING NO ARGUMENTS.
C ALL PARAMETERS ARE PASSED THROUGH UNLABELED COMMON.
C
IF (ICZERO) 34000, 4000, 34000
4000 CONTINUE
RVCN01 = 2.1654
CALL FS051
RVCOMP = RVCN01
GO TO 44000
34000 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 44000, 4011, 44000
44000 IF (RVCOMP - 3.1649) 24000,14000,44001
44001 IF (RVCOMP - 3.1659) 14000,14000,24000
14000 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 4011
24000 IVFAIL = IVFAIL + 1
RVCORR = 3.1654
WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR
4011 CONTINUE
C
C TEST 401 THROUGH TEST 403 TEST THE CALL TO SUBROUTINE FS052 WHICH
C CONTAINS NO ARGUMENTS. ALL PARAMETERS ARE PASSED THROUGH
C UNLABELED COMMON. SUBROUTINE FS052 CONTAIN SEVERAL RETURN
C STATEMENTS.
C
IVTNUM = 401
C
C **** TEST 401 ****
C
IF (ICZERO) 34010, 4010, 34010
4010 CONTINUE
IVCN01 = 5
IVCN02 = 1
CALL FS052
IVCOMP = IVCN01
GO TO 44010
34010 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 44010, 4021, 44010
44010 IF (IVCOMP - 6) 24010,14010,24010
14010 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 4021
24010 IVFAIL = IVFAIL + 1
IVCORR = 6
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
4021 CONTINUE
IVTNUM = 402
C
C **** TEST 402 ****
C
IF (ICZERO) 34020, 4020, 34020
4020 CONTINUE
IVCN01 = 10
IVCN02 = 5
CALL FS052
IVCOMP = IVCN01
GO TO 44020
34020 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 44020, 4031, 44020
44020 IF (IVCOMP - 15) 24020,14020,24020
14020 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 4031
24020 IVFAIL = IVFAIL + 1
IVCORR = 15
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
4031 CONTINUE
IVTNUM = 403
C
C **** TEST 403 ****
C
IF (ICZERO) 34030, 4030, 34030
4030 CONTINUE
IVCN01 = 30
IVCN02 = 3
CALL FS052
IVCOMP = IVCN01
GO TO 44030
34030 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 44030, 4041, 44030
44030 IF (IVCOMP - 33) 24030,14030,24030
14030 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 4041
24030 IVFAIL = IVFAIL + 1
IVCORR = 33
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
4041 CONTINUE
C
C TEST 404 THROUGH TEST 406 TEST THE CALL TO SUBROUTINE FS053 WHICH
C CONTAINS SEVERAL ARGUMENTS AND SEVERAL RETURN STATEMENTS.
C
IVTNUM = 404
C
C **** TEST 404 ****
C
IF (ICZERO) 34040, 4040, 34040
4040 CONTINUE
CALL FS053 (6,10,11,IVON04,1)
IVCOMP = IVON04
GO TO 44040
34040 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 44040, 4051, 44040
44040 IF (IVCOMP - 6) 24040,14040,24040
14040 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 4051
24040 IVFAIL = IVFAIL + 1
IVCORR = 6
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
4051 CONTINUE
IVTNUM = 405
C
C **** TEST 405 ****
C
IF (ICZERO) 34050, 4050, 34050
4050 CONTINUE
IVCN01 = 10
CALL FS053 (6,IVCN01,11,IVON04,2)
IVCOMP = IVON04
GO TO 44050
34050 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 44050, 4061, 44050
44050 IF (IVCOMP - 16) 24050,14050,24050
14050 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 4061
24050 IVFAIL = IVFAIL + 1
IVCORR = 16
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
4061 CONTINUE
IVTNUM = 406
C
C **** TEST 406 ****
C
IF (ICZERO) 34060, 4060, 34060
4060 CONTINUE
IVON01 = 6
IVON02 = 10
IVON03 = 11
IVON05 = 3
CALL FS053 (IVON01,IVON02,IVON03,IVON04,IVON05)
IVCOMP = IVON04
GO TO 44060
34060 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 44060, 4071, 44060
44060 IF (IVCOMP - 27) 24060,14060,24060
14060 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 4071
24060 IVFAIL = IVFAIL + 1
IVCORR = 27
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
4071 CONTINUE
C
C TEST 407 THROUGH 409 TEST THE REFERENCE TO FUNCTION FF054 WHICH
C CONTAINS SEVERAL ARGUMENTS AND SEVERAL RETURN STATEMENTS
C
IVTNUM = 407
C
C **** TEST 407 ****
C
IF (ICZERO) 34070, 4070, 34070
4070 CONTINUE
IVCOMP = FF054 (300,1,21,1)
GO TO 44070
34070 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 44070, 4081, 44070
44070 IF (IVCOMP - 300) 24070,14070,24070
14070 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 4081
24070 IVFAIL = IVFAIL + 1
IVCORR = 300
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
4081 CONTINUE
IVTNUM = 408
C
C **** TEST 408 ****
C
IF (ICZERO) 34080, 4080, 34080
4080 CONTINUE
IVON01 = 300
IVON04 = 2
IVCOMP = FF054 (IVON01,77,5,IVON04)
GO TO 44080
34080 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 44080, 4091, 44080
44080 IF (IVCOMP - 377) 24080,14080,24080
14080 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 4091
24080 IVFAIL = IVFAIL + 1
IVCORR = 377
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
4091 CONTINUE
IVTNUM = 409
C
C **** TEST 409 ****
C
IF (ICZERO) 34090, 4090, 34090
4090 CONTINUE
IVON01 = 71
IVON02 = 21
IVON03 = 17
IVON04 = 3
IVCOMP = FF054 (IVON01,IVON02,IVON03,IVON04)
GO TO 44090
34090 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 44090, 4101, 44090
44090 IF (IVCOMP - 109) 24090,14090,24090
14090 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 4101
24090 IVFAIL = IVFAIL + 1
IVCORR = 109
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
4101 CONTINUE
C
C TEST 410 THROUGH 429 TEST THE CALL TO SUBROUTINE FS055 WHICH
C CONTAINS NO ARGUMENTS. THE PARAMETERS ARE PASSED THROUGH AN
C INTEGER ARRAY VARIABLE IN UNLABELED COMMON.
C
CALL FS055
DO 20 I = 1,20
IF (ICZERO) 34100, 4100, 34100
4100 CONTINUE
IVTNUM = 409 + I
IVCOMP = IACN11(I)
GO TO 44100
34100 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 44100, 4111, 44100
44100 IF (IVCOMP - I) 24100,14100,24100
14100 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 4111
24100 IVFAIL = IVFAIL + 1
IVCORR = I
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
4111 CONTINUE
20 CONTINUE
C
C WRITE PAGE FOOTINGS AND RUN SUMMARIES
99999 CONTINUE
WRITE (I02,90002)
WRITE (I02,90006)
WRITE (I02,90002)
WRITE (I02,90002)
WRITE (I02,90007)
WRITE (I02,90002)
WRITE (I02,90008) IVFAIL
WRITE (I02,90009) IVPASS
WRITE (I02,90010) IVDELE
C
C
C TERMINATE ROUTINE EXECUTION
STOP
C
C FORMAT STATEMENTS FOR PAGE HEADERS
90000 FORMAT (1H1)
90002 FORMAT (1H )
90001 FORMAT (1H ,10X,34HFORTRAN COMPILER VALIDATION SYSTEM)
90003 FORMAT (1H ,21X,11HVERSION 1.0)
90004 FORMAT (1H ,10X,38HFOR OFFICIAL USE ONLY - COPYRIGHT 1978)
90005 FORMAT (1H ,5X,4HTEST,5X,9HPASS/FAIL, 5X,8HCOMPUTED,8X,7HCORRECT)
90006 FORMAT (1H ,5X,46H----------------------------------------------)
90011 FORMAT (1H ,18X,17HSUBSET LEVEL TEST)
C
C FORMAT STATEMENTS FOR RUN SUMMARIES
90008 FORMAT (1H ,15X,I5,19H ERRORS ENCOUNTERED)
90009 FORMAT (1H ,15X,I5,13H TESTS PASSED)
90010 FORMAT (1H ,15X,I5,14H TESTS DELETED)
C
C FORMAT STATEMENTS FOR TEST RESULTS
80001 FORMAT (1H ,4X,I5,7X,4HPASS)
80002 FORMAT (1H ,4X,I5,7X,4HFAIL)
80003 FORMAT (1H ,4X,I5,7X,7HDELETED)
80004 FORMAT (1H ,4X,I5,7X,4HFAIL,10X,I6,9X,I6)
80005 FORMAT (1H ,4X,I5,7X,4HFAIL,4X,E12.5,3X,E12.5)
C
90007 FORMAT (1H ,20X,20HEND OF PROGRAM FM050)
END
*HEADER,FORTR,FM050,SUBRTN,FM051
C
C COMMENT SECTION
C
C FS051
C
C FS051 IS A SUBROUTINE SUBPROGRAM WHICH IS CALLED BY THE MAIN
C PROGRAM FM050. NO ARGUMENTS ARE SPECIFIED THEREFORE ALL
C PARAMETERS ARE PASSED VIA UNLABELED COMMON. THE SUBROUTINE FS051
C INCREMENTS THE VALUE OF A REAL VARIABLE BY 1 AND RETURNS CONTROL
C TO THE CALLING PROGRAM FM050.
C
C REFERENCES
C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN,
C X3.9-1978
C
C SECTION 15.6, SUBROUTINES
C SECTION 15.8, RETURN STATEMENT
C
C TEST SECTION
C
C SUBROUTINE SUBPROGRAM - NO ARGUMENTS
C
SUBROUTINE FS051
COMMON //RVCN01
RVCN01 = RVCN01 + 1.0
RETURN
END
*HEADER,FORTR,FM050,SUBRTN,FM052
C
C COMMENT SECTION
C
C FS052
C
C FS052 IS A SUBROUTINE SUBPROGRAM WHICH IS CALLED BY THE MAIN
C PROGRAM FM050. NO ARGUMENTS ARE SPECIFIED THEREFORE ALL
C PARAMETERS ARE PASSED VIA UNLABELED COMMON. THE SUBROUTINE FS052
C INCREMENTS THE VALUE OF ONE INTEGER VARIABLE BY 1,2,3,4 OR 5
C DEPENDING ON THE VALUE OF A SECOND INTEGER VARIABLE AND THEN
C RETURNS CONTROL TO THE CALLING PROGRAM FM050. SEVERAL RETURN
C STATEMENTS ARE INCLUDED.
C
C REFERENCES
C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN,
C X3.9-1978
C
C SECTION 15.6, SUBROUTINES
C SECTION 15.8, RETURN STATEMENT
C
C TEST SECTION
C
C SUBROUTINE SUBPROGRAM - NO ARGUMENTS, MANY RETURNS
C
SUBROUTINE FS052
COMMON RVDN01,IVCN01,IVCN02
GO TO (10,20,30,40,50),IVCN02
10 IVCN01 = IVCN01 + 1
RETURN
20 IVCN01 = IVCN01 + 2
RETURN
30 IVCN01 = IVCN01 + 3
RETURN
40 IVCN01 = IVCN01 + 4
RETURN
50 IVCN01 = IVCN01 + 5
RETURN
END
*HEADER,FORTR,FM050,SUBRTN,FM053
C
C COMMENT SECTION
C
C FS053
C
C FS053 IS A SUBROUTINE SUBPROGRAM WHICH IS CALLED BY THE MAIN
C PROGRAM FM050. FIVE INTEGER VARIABLE ARGUMENTS ARE PASSED AND
C SEVERAL RETURN STATEMENTS ARE SPECIFIED. THE SUBROUTINE FS053
C ADDS TOGETHER THE VALUES OF THE FIRST ONE, TWO OR THREE ARGUMENTS
C DEPENDING ON THE VALUE OF THE FIFTH ARGUMENT. THE RESULTING SUM
C IS THEN RETURNED TO THE CALLING PROGRAM FM050 THROUGH THE FOURTH
C ARGUMENT.
C
C REFERENCES
C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN,
C X3.9-1978
C
C SECTION 15.6, SUBROUTINES
C SECTION 15.8, RETURN STATEMENT
C
C TEST SECTION
C
C SUBROUTINE SUBPROGRAM - SEVERAL ARGUMENTS, SEVERAL RETURNS
C
SUBROUTINE FS053 (IVON01,IVON02,IVON03,IVON04,IVON05)
GO TO (10,20,30),IVON05
10 IVON04 = IVON01
RETURN
20 IVON04 = IVON01 + IVON02
RETURN
30 IVON04 = IVON01 + IVON02 + IVON03
RETURN
END
*HEADER,FORTR,FM050,SUBRTN,FM054
C
C COMMENT SECTION
C
C FF054
C
C FF054 IS A FUNCTION SUBPROGRAM WHICH IS REFERENCED BY THE
C MAIN PROGRAM. FIVE INTEGER VARIABLE ARGUMENTS ARE PASSED AND
C SEVERAL RETURN STATEMENTS ARE SPECIFIED. THE FUNCTION FF054
C ADDS TOGETHER THE VALUES OF THE FIRST ONE, TWO OR THREE ARGUMENTS
C DEPENDING ON THE VALUE OF THE FOURTH ARGUMENT. THE RESULTING SUM
C IS THEN RETURNED TO THE REFERENCING PROGRAM FM050 THROUGH THE
C FUNCTION REFERENCE.
C
C REFERENCES
C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN,
C X3.9-1978
C
C SECTION 15.5.1, FUNCTION SUBPROGRAM AND FUNCTION STATEMENT
C SECTION 15.8, RETURN STATEMENT
C
C TEST SECTION
C
C FUNCTION SUBPROGRAM - SEVERAL ARGUMENTS, SEVERAL RETURNS
C
INTEGER FUNCTION FF054 (IVON01,IVON02,IVON03,IVON04)
GO TO (10,20,30),IVON04
10 FF054 = IVON01
RETURN
20 FF054 = IVON01 + IVON02
RETURN
30 FF054 = IVON01 + IVON02 + IVON03
RETURN
END
*HEADER,FORTR,FM050,SUBRTN,FM055
C
C COMMENT SECTION
C
C FS055
C
C FS055 IS A SUBROUTINE SUBPROGRAM WHICH IS CALLED BY THE MAIN
C PROGRAM FM050. NO ARGUMENTS ARE SPECIFIED THEREFORE ALL
C PARAMETERS ARE PASSED VIA UNLABELED COMMON. THE SUBROUTINE FS055
C INITIALIZES A ONE DIMENSIONAL INTEGER ARRAY OF 20 ELEMENTS WITH
C THE VALUES 1 THROUGH 20 RESPECTIVELY. CONTROL IS THEN RETURNED
C TO THE CALLING PROGRAM FM050.
C
C REFERENCES
C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN,
C X3.9-1978
C
C SECTION 15.6, SUBROUTINES
C SECTION 15.8, RETURN STATEMENT
C
C TEST SECTION
C
C SUBROUTINE SUBPROGRAM - ARRAY ARGUMENTS
C
SUBROUTINE FS055
COMMON RVCN01,IVCN01,IVCN02,IACN11
DIMENSION IACN11(20)
DO 20 I = 1,20
IACN11(I) = I
20 CONTINUE
RETURN
END
*END-OF,FM050
FM056.f 480976058 170 2 100666 15185 `
*HEADER,FORTR,FM056
*FILES1,FORTR,FM056
C
C COMMENT SECTION
C
C FM056
C
C FM056 IS A MAIN WHICH TESTS THE ARGUMENT PASSING LINKAGE OF
C A 2 LEVEL NESTED SUBROUTINE AND AN EXTERNAL FUNCTION REFERENCE.
C THE MAIN PROGRAM FM056 CALLS SUBROUTINE FS057 PASSING ONE
C ARGUMENT. SUBROUTINE FS057 CALLS SUBROUTINE FS058 PASSING TWO
C ARGUMENTS. SUBROUTINE FS058 REFERENCES EXTERNAL FUNCTION FF059
C PASSING 3 ARGUMENTS. FUNCTION FF059 ADDS THE VALUES OF THE 3
C ARGUMENTS TOGETHER. SUBROUTINE FS057 AND FS058 THEN MERELY
C RETURN THE RESULT TO FM056 IN THE FIRST ARGUMENT.
C
C THE VALUES OF THE ARGUMENTS THAT ARE PASSED TO EACH
C SUBPROGRAM AND FUNCTION, AND RETURNED TO THE CALLING OR
C REFERENCING PROGRAM ARE SAVED IN AN INTEGER ARRAY. FM056 THEN
C USES THESE VALUES TO TEST THE COMPILER'S ARGUMENT PASSING
C CAPABILITIES.
C
C REFERENCES
C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN,
C X3.9-1978
C
C SECTION 15.6.2, SUBROUTINE REFERENCE
COMMON IACN11 (12)
C
C **********************************************************
C
C A COMPILER VALIDATION SYSTEM FOR THE FORTRAN LANGUAGE
C BASED ON SPECIFICATIONS AS DEFINED IN AMERICAN NATIONAL STANDARD
C PROGRAMMING LANGUAGE FORTRAN X3.9-1978, HAS BEEN DEVELOPED BY THE
C FEDERAL COBOL COMPILER TESTING SERVICE. THE FORTRAN COMPILER
C VALIDATION SYSTEM (FCVS) CONSISTS OF AUDIT ROUTINES, THEIR RELATED
C DATA, AND AN EXECUTIVE SYSTEM. EACH AUDIT ROUTINE IS A FORTRAN
C PROGRAM, SUBPROGRAM OR FUNCTION WHICH INCLUDES TESTS OF SPECIFIC
C LANGUAGE ELEMENTS AND SUPPORTING PROCEDURES INDICATING THE RESULT
C OF EXECUTING THESE TESTS.
C
C THIS PARTICULAR PROGRAM/SUBPROGRAM/FUNCTION CONTAINS FEATURES
C FOUND ONLY IN THE SUBSET AS DEFINED IN X3.9-1978.
C
C SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO -
C
C DEPARTMENT OF THE NAVY
C FEDERAL COBOL COMPILER TESTING SERVICE
C WASHINGTON, D.C. 20376
C
C **********************************************************
C
C
C
C INITIALIZATION SECTION
C
C INITIALIZE CONSTANTS
C **************
C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER.
I01 = 5
C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER.
I02 = 6
C SYSTEM ENVIRONMENT SECTION
C
CX010 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-010 CONTROL CARD.
C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5
C (UNIT NUMBER FOR CARD READER).
CX011 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-011 CONTROL CARD.
C THE CX011 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL
C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX010 ABOVE.
C
CX020 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-020 CONTROL CARD.
C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02 = 6
C (UNIT NUMBER FOR PRINTER).
CX021 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-021 CONTROL CARD.
C THE CX021 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL
C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX020 ABOVE.
C
IVPASS=0
IVFAIL=0
IVDELE=0
ICZERO=0
C
C WRITE PAGE HEADERS
WRITE (I02,90000)
WRITE (I02,90001)
WRITE (I02,90002)
WRITE (I02, 90002)
WRITE (I02,90003)
WRITE (I02,90002)
WRITE (I02,90004)
WRITE (I02,90002)
WRITE (I02,90011)
WRITE (I02,90002)
WRITE (I02,90002)
WRITE (I02,90005)
WRITE (I02,90006)
WRITE (I02,90002)
C
C TEST SECTION
C
C SUBROUTINE SUBPROGRAM
C
IVON01 = 5
CALL FS057 (IVON01)
IACN11 (12) = IVON01
IVTNUM = 430
C
C **** TEST 430 ****
C
C TEST 430 TESTS THE VALUE OF THE ARGUMENT RECEIVED BY FS057 FROM
C A FM056 CALL TO FS057
C
IF (ICZERO) 34300, 4300, 34300
4300 CONTINUE
IVCOMP = IACN11 (1)
GO TO 44300
34300 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 44300, 4311, 44300
44300 IF (IVCOMP - 5) 24300,14300,24300
14300 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 4311
24300 IVFAIL = IVFAIL + 1
IVCORR = 5
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
4311 CONTINUE
IVTNUM = 431
C
C **** TEST 431 ****
C
C TEST 431 TESTS THE VALUE OF THE SECOND ARGUMENT THAT WAS PASSED
C FROM A FS057 CALL TO FS058
C
C
IF (ICZERO) 34310, 4310, 34310
4310 CONTINUE
IVCOMP = IACN11 (2)
GO TO 44310
34310 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 44310, 4321, 44310
44310 IF (IVCOMP - 4) 24310,14310,24310
14310 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 4321
24310 IVFAIL = IVFAIL + 1
IVCORR = 4
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
4321 CONTINUE
IVTNUM = 432
C
C **** TEST 432 ****
C
C TEST 432 TESTS THE VALUE OF THE FIRST ARGUMENT RECEIVED BY FS058
C FROM A FS057 CALL TO FS058
C
C
IF (ICZERO) 34320, 4320, 34320
4320 CONTINUE
IVCOMP = IACN11 (3)
GO TO 44320
34320 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 44320, 4331, 44320
44320 IF (IVCOMP - 5) 24320,14320,24320
14320 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 4331
24320 IVFAIL = IVFAIL + 1
IVCORR = 5
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
4331 CONTINUE
IVTNUM = 433
C
C **** TEST 433 ****
C
C TEST 433 TESTS THE VALUE OF THE SECOND ARGUMENT RECEIVED BY FS058
C FROM A FS057 CALL TO FS058
C
C
IF (ICZERO) 34330, 4330, 34330
4330 CONTINUE
IVCOMP = IACN11 (4)
GO TO 44330
34330 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 44330, 4341, 44330
44330 IF (IVCOMP - 4) 24330,14330,24330
14330 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 4341
24330 IVFAIL = IVFAIL + 1
IVCORR = 4
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
4341 CONTINUE
IVTNUM = 434
C
C **** TEST 434 ****
C
C TEST 434 TESTS THE VALUE OF THE THIRD ARGUMENT THAT WAS PASSED
C FROM A FS058 REFERENCE OF FUNCTION FF059
C
C
IF (ICZERO) 34340, 4340, 34340
4340 CONTINUE
IVCOMP = IACN11 (5)
GO TO 44340
34340 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 44340, 4351, 44340
44340 IF (IVCOMP - 3) 24340,14340,24340
14340 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 4351
24340 IVFAIL = IVFAIL + 1
IVCORR = 3
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
4351 CONTINUE
IVTNUM = 435
C
C **** TEST 435 ****
C
C TEST 435 TESTS THE VALUE OF THE FIRST ARGUMENT RECEIVED BY FF059
C FROM A FS058 REFERENCE OF FUNCTION FF059
C
C
IF (ICZERO) 34350, 4350, 34350
4350 CONTINUE
IVCOMP = IACN11 (6)
GO TO 44350
34350 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 44350, 4361, 44350
44350 IF (IVCOMP - 5) 24350,14350,24350
14350 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 4361
24350 IVFAIL = IVFAIL + 1
IVCORR = 5
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
4361 CONTINUE
IVTNUM = 436
C
C **** TEST 436 ****
C
C TEST 436 TESTS THE VALUE OF THE SECOND ARGUMENT RECEIVED BY FF059
C FROM A FS058 REFERENCE OF FUNCTION FF059
C
C
IF (ICZERO) 34360, 4360, 34360
4360 CONTINUE
IVCOMP = IACN11 (7)
GO TO 44360
34360 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 44360, 4371, 44360
44360 IF (IVCOMP - 4) 24360,14360,24360
14360 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 4371
24360 IVFAIL = IVFAIL + 1
IVCORR = 4
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
4371 CONTINUE
IVTNUM = 437
C
C **** TEST 437 ****
C
C TEST 437 TESTS THE VALUE OF THE THIRD ARGUMENT RECEIVED BY FF059
C FROM A FS058 REFERENCE OF FUNCTION FF059
C
C
IF (ICZERO) 34370, 4370, 34370
4370 CONTINUE
IVCOMP = IACN11 (8)
GO TO 44370
34370 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 44370, 4381, 44370
44370 IF (IVCOMP - 3) 24370,14370,24370
14370 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 4381
24370 IVFAIL = IVFAIL + 1
IVCORR = 3
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
4381 CONTINUE
IVTNUM = 438
C
C **** TEST 438 ****
C
C TEST 438 TESTS THE VALUE OF THE FUNCTION DETERMINED BY FF059
C
C
IF (ICZERO) 34380, 4380, 34380
4380 CONTINUE
IVCOMP = IACN11 (9)
GO TO 44380
34380 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 44380, 4391, 44380
44380 IF (IVCOMP - 12) 24380,14380,24380
14380 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 4391
24380 IVFAIL = IVFAIL + 1
IVCORR = 12
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
4391 CONTINUE
IVTNUM = 439
C
C **** TEST 439 ****
C
C TEST 439 TESTS THE VALUE OF THE FUNCTION RETURNED TO FS058 BY
C FF059
C
C
IF (ICZERO) 34390, 4390, 34390
4390 CONTINUE
IVCOMP = IACN11 (10)
GO TO 44390
34390 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 44390, 4401, 44390
44390 IF (IVCOMP - 12) 24390,14390,24390
14390 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 4401
24390 IVFAIL = IVFAIL + 1
IVCORR = 12
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
4401 CONTINUE
IVTNUM = 440
C
C **** TEST 440 ****
C
C TEST 440 TESTS THE VALUE OF THE FIRST ARGUMENT RETURNED TO FS057
C BY FS058
C
IF (ICZERO) 34400, 4400, 34400
4400 CONTINUE
IVCOMP = IACN11 (11)
GO TO 44400
34400 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 44400, 4411, 44400
44400 IF (IVCOMP - 12) 24400,14400,24400
14400 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 4411
24400 IVFAIL = IVFAIL + 1
IVCORR = 12
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
4411 CONTINUE
IVTNUM = 441
C
C **** TEST 441 ****
C
C TEST 441 TESTS THE VALUE OF THE FIRST ARGUMENT RETURNED TO FM056
C BY FS057
C
C
IF (ICZERO) 34410, 4410, 34410
4410 CONTINUE
IVCOMP = IACN11 (12)
GO TO 44410
34410 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 44410, 4421, 44410
44410 IF (IVCOMP - 12) 24410,14410,24410
14410 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 4421
24410 IVFAIL = IVFAIL + 1
IVCORR = 12
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
4421 CONTINUE
C
C WRITE PAGE FOOTINGS AND RUN SUMMARIES
99999 CONTINUE
WRITE (I02,90002)
WRITE (I02,90006)
WRITE (I02,90002)
WRITE (I02,90002)
WRITE (I02,90007)
WRITE (I02,90002)
WRITE (I02,90008) IVFAIL
WRITE (I02,90009) IVPASS
WRITE (I02,90010) IVDELE
C
C
C TERMINATE ROUTINE EXECUTION
STOP
C
C FORMAT STATEMENTS FOR PAGE HEADERS
90000 FORMAT (1H1)
90002 FORMAT (1H )
90001 FORMAT (1H ,10X,34HFORTRAN COMPILER VALIDATION SYSTEM)
90003 FORMAT (1H ,21X,11HVERSION 1.0)
90004 FORMAT (1H ,10X,38HFOR OFFICIAL USE ONLY - COPYRIGHT 1978)
90005 FORMAT (1H ,5X,4HTEST,5X,9HPASS/FAIL, 5X,8HCOMPUTED,8X,7HCORRECT)
90006 FORMAT (1H ,5X,46H----------------------------------------------)
90011 FORMAT (1H ,18X,17HSUBSET LEVEL TEST)
C
C FORMAT STATEMENTS FOR RUN SUMMARIES
90008 FORMAT (1H ,15X,I5,19H ERRORS ENCOUNTERED)
90009 FORMAT (1H ,15X,I5,13H TESTS PASSED)
90010 FORMAT (1H ,15X,I5,14H TESTS DELETED)
C
C FORMAT STATEMENTS FOR TEST RESULTS
80001 FORMAT (1H ,4X,I5,7X,4HPASS)
80002 FORMAT (1H ,4X,I5,7X,4HFAIL)
80003 FORMAT (1H ,4X,I5,7X,7HDELETED)
80004 FORMAT (1H ,4X,I5,7X,4HFAIL,10X,I6,9X,I6)
80005 FORMAT (1H ,4X,I5,7X,4HFAIL,4X,E12.5,3X,E12.5)
C
90007 FORMAT (1H ,20X,20HEND OF PROGRAM FM056)
END
*HEADER,FORTR,FM056,SUBRTN,FM057
C
C COMMENT SECTION
C
C FS057
C
C THIS SUBROUTINE IS CALLED BY THE MAIN PROGRAM FM056. THE
C SINGLE ARGUMENT PASSED FROM FM056 ALONG WITH A SECOND PARAMETER
C CREATED IN FS057 ARE THEN PASSED VIA A CALL TO SUBROUTINE FS058.
C A RESULT FROM AN ARITHMETIC OPERATION IS RETURNED FROM FS058 IN
C THE FIRST ARGUMENT. FS057 ACCEPTS THIS RESULT AND RETURNS CONTROL
C TO FM056 WITHOUT ANY ADDITIONAL PROCESSING.
C
C THE VALUES OF THE ARGUMENTS THAT ARE PASSED FROM FM056 TO
C FS057 AND RETURNED ARE SAVED IN AN INTEGER ARRAY FOR LATER
C VERIFICATION BY THE MAIN PROGRAM.
C
C REFERENCES
C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN,
C X3.9-1978
C
C SECTION 15.6, SUBROUTINES
C SECTION 15.6.2, SUBROUTINE REFERENCE
C SECTION 15.8, RETURN STATEMENT
C
C TEST SECTION
C
C SUBROUTINE SUBPROGRAM
C
SUBROUTINE FS057 (IVON01)
COMMON IACN11 (12)
IACN11 (1) = IVON01
IVON02 = 4
IACN11 (2) = IVON02
CALL FS058 (IVON01,IVON02)
IACN11 (11) = IVON01
RETURN
END
*HEADER,FORTR,FM056,SUBRTN,FM058
C
C COMMENT SECTION
C
C FS058
C
C THIS SUBROUTINE IS CALLED BY SUBROUTINE FS057. THE TWO
C ARGUMENTS PASSED FROM FS057 ALONG WITH A THIRD PARAMETER CREATED
C IN FS058 ARE THEN PASSED TO FUNCTION FF059 WHERE THEY ARE USED IN
C AN ARITHMETIC OPERATION. FS058 THEN SAVES THE RESULT OF THIS
C OPERATION IN THE FIRST ARGUMENT AND RETURNS CONTROL TO FS057
C WITHOUT ANY ADDITIONAL PROCESSING.
C
C THE VALUES OF THE ARGUMENTS THAT ARE PASSED FROM FS057 TO
C FS058 AND RETURNED ARE SAVED IN AN INTEGER ARRAY FOR LATER
C VERIFICATION BY THE MAIN PROGRAM.
C
C REFERENCES
C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN,
C X3.9-1978
C
C SECTION 15.5.2, REFERENCING EXTERNAL FUNCTIONS
C SECTION 15.6, SUBROUTINES
C SECTION 15.8, RETURN STATEMENT
C
C TEST SECTION
C
C SUBROUTINE SUBPROGRAM
C
SUBROUTINE FS058 (IVON01,IVON02)
COMMON IACN11 (12)
INTEGER FF059
IVON03 = 3
IACN11 (3) = IVON01
IACN11 (4) = IVON02
IACN11 (5) = IVON03
IVON01 = FF059 (IVON01,IVON02,IVON03)
IACN11 (10) = IVON01
RETURN
END
*HEADER,FORTR,FM056,SUBRTN,FM059
C
C COMMENT SECTION
C
C FF059
C
C THIS EXTERNAL FUNCTION IS REFERENCED WITHIN SUBROUTINE FS058.
C THE THREE ARGUMENTS THAT ARE PASSED ARE SIMPLY ADDED TOGETHER AND
C THE RESULT SUBSTITUTED FOR THE ORIGINAL REFERENCE. CONTROL IS
C THEN RETURNED TO FS058.
C
C THE VALUES OF THE ARGUMENTS THAT ARE PASSED FROM FS058 TO
C FF059 AND THE RESULT THAT IS RETURNED ARE SAVED IN AN INTEGER
C ARRAY FOR LATER VERIFICATION BY THE MAIN PROGRAM.
C
C REFERENCES
C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN,
C X3.9-1978
C
C SECTION 15.5.1, FUNCTION SUBPROGRAM AND FUNCTION STATEMENT
C SECTION 15.8, RETURN STATEMENT
C TEST SECTION
C
C FUNCTION SUBPROGRAM
C
INTEGER FUNCTION FF059 (IVON01,IVON02,IVON03)
COMMON IACN11 (12)
IACN11 (6) = IVON01
IACN11 (7) = IVON02
IACN11 (8) = IVON03
FF059 = IVON01 + IVON02 + IVON03
IACN11 (9) = IVON01 + IVON02 + IVON03
RETURN
END
*END-OF,FM056
FM060.f 480976062 170 2 100666 23638 `
*HEADER,FORTR,FM060
*FILES1,FORTR,FM060,X
C COMMENT SECTION
C
C FM060
C
C THIS ROUTINE CONTAINS BASIC ARITHMETIC IF STATEMENT TESTS FOR
C THE FORMAT
C
C IF (E) K1,K2,K3
C
C WHERE E IS A SIMPLE REAL EXPRESSION OF THE FORM
C
C REAL VARIABLE
C REAL VARIABLE - REAL CONSTANT
C REAL VARIABLE + REAL CONSTANT
C
C AND K1, K2 AND K3 ARE STATEMENT LABELS.
C
C THIS ROUTINE ALSO TESTS ARITHMETIC ASSIGNMENT STATEMENTS OF
C THE FORM
C REAL VARIABLE = REAL CONSTANT
C REAL VARIABLE = REAL VARIABLE
C REAL VARIABLE = -REAL VARIABLE
C
C THE REAL CONSTANTS AND REAL VARIABLES CONTAIN BOTH POSITIVE AND
C NEGATIVE VALUES.
C
C A REAL DATUM IS A PROCESSOR APPROXIMATION TO THE VALUE OF A
C REAL NUMBER. IT MAY ASSUME POSITIVE, NEGATIVE AND ZERO VALUES.
C
C A BASIC REAL CONSTANT IS WRITTEN AS AN INTEGER PART, A DECIMAL
C POINT, AND A DECIMAL FRACTION PART IN THAT ORDER. BOTH THE
C INTEGER PART AND THE DECIMAL PART ARE STRINGS OF DIGITS; EITHER
C ONE OF THESE STRINGS MAY BE EMPTY BUT NOT BOTH. THE CONSTANT IS
C AN APPROXIMATION TO THE DIGIT STRING INTERPRETED AS A DECIMAL
C NUMERAL.
C
C A DECIMAL EXPONENT IS WRITTEN AS THE LETTER E, FOLLOWED BY AN
C OPTIONALLY SIGNED INTEGER CONSTANT.
C
C A REAL CONSTANT IS INDICATED BY WRITING A BASIC REAL CONSTANT,
C A BASIC REAL CONSTANT FOLLOWED BY A DECIMAL EXPONENT, OR AN
C INTEGER CONSTANT FOLLOWED BY A DECIMAL EXPONENT.
C
C REFERENCES
C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN,
C X3.9-1978
C
C SECTION 4.4, REAL TYPE
C SECTION 4.4.1, REAL CONSTANT
C SECTION 6.1, ARITHMETIC EXPRESSIONS
C SECTION 10.1, ARITHMETIC ASSIGNMENT STATEMENT
C SECTION 11.4, ARITHMETIC IF STATEMENT
C
C **********************************************************
C
C A COMPILER VALIDATION SYSTEM FOR THE FORTRAN LANGUAGE
C BASED ON SPECIFICATIONS AS DEFINED IN AMERICAN NATIONAL STANDARD
C PROGRAMMING LANGUAGE FORTRAN X3.9-1978, HAS BEEN DEVELOPED BY THE
C FEDERAL COBOL COMPILER TESTING SERVICE. THE FORTRAN COMPILER
C VALIDATION SYSTEM (FCVS) CONSISTS OF AUDIT ROUTINES, THEIR RELATED
C DATA, AND AN EXECUTIVE SYSTEM. EACH AUDIT ROUTINE IS A FORTRAN
C PROGRAM, SUBPROGRAM OR FUNCTION WHICH INCLUDES TESTS OF SPECIFIC
C LANGUAGE ELEMENTS AND SUPPORTING PROCEDURES INDICATING THE RESULT
C OF EXECUTING THESE TESTS.
C
C THIS PARTICULAR PROGRAM/SUBPROGRAM/FUNCTION CONTAINS FEATURES
C FOUND ONLY IN THE SUBSET AS DEFINED IN X3.9-1978.
C
C SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO -
C
C DEPARTMENT OF THE NAVY
C FEDERAL COBOL COMPILER TESTING SERVICE
C WASHINGTON, D.C. 20376
C
C **********************************************************
C
C
C
C INITIALIZATION SECTION
C
C INITIALIZE CONSTANTS
C **************
C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER.
I01 = 5
C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER.
I02 = 6
C SYSTEM ENVIRONMENT SECTION
C
CX010 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-010 CONTROL CARD.
C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5
C (UNIT NUMBER FOR CARD READER).
CX011 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-011 CONTROL CARD.
C THE CX011 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL
C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX010 ABOVE.
C
CX020 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-020 CONTROL CARD.
C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02 = 6
C (UNIT NUMBER FOR PRINTER).
CX021 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-021 CONTROL CARD.
C THE CX021 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL
C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX020 ABOVE.
C
IVPASS=0
IVFAIL=0
IVDELE=0
ICZERO=0
C
C WRITE PAGE HEADERS
WRITE (I02,90000)
WRITE (I02,90001)
WRITE (I02,90002)
WRITE (I02, 90002)
WRITE (I02,90003)
WRITE (I02,90002)
WRITE (I02,90004)
WRITE (I02,90002)
WRITE (I02,90011)
WRITE (I02,90002)
WRITE (I02,90002)
WRITE (I02,90005)
WRITE (I02,90006)
WRITE (I02,90002)
C
C TEST SECTION
C
C ARITHMETIC IF STATEMENT
C
C TEST 1 THROUGH TEST 3 CONTAIN BASIC ARITHMETIC IF STATEMENT TESTS
C WITH A REAL VARIABLE AS ARITHMETIC EXPRESSION.
C
11 CONTINUE
IVTNUM = 1
C
C **** TEST 1 ****
C TEST 001 - LESS THAN ZERO BRANCH EXPECTED
C
IF (ICZERO) 30010, 10, 30010
10 CONTINUE
RVCOMP = 0.0
RVON01 = -1.0
IF (RVON01) 12,40010, 40010
12 RVCOMP = RVON01
GO TO 40010
30010 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 40010, 21, 40010
40010 IF (RVCOMP) 10010,20010,20010
10010 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 21
20010 IVFAIL = IVFAIL + 1
RVCORR = -1.0
WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR
21 CONTINUE
IVTNUM = 2
C
C **** TEST 2 ****
C TEST 002 - EQUAL TO ZERO BRANCH EXPECTED
C
IF (ICZERO) 30020, 20, 30020
20 CONTINUE
RVCOMP = 1.0
RVON01 = 0.0
IF (RVON01) 40020,22,40020
22 RVCOMP = RVON01
GO TO 40020
30020 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 40020, 31, 40020
40020 IF (RVCOMP) 20020,10020,20020
10020 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 31
20020 IVFAIL = IVFAIL + 1
RVCORR = 0.0
WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR
31 CONTINUE
IVTNUM = 3
C
C **** TEST 3 ****
C TEST 003 - GREATER THAN ZERO BRANCH EXPECTED
C
IF (ICZERO) 30030, 30, 30030
30 CONTINUE
RVCOMP = 0.0
RVON01 = 1.0
IF (RVON01) 40030,40030,32
32 RVCOMP = RVON01
GO TO 40030
30030 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 40030, 41, 40030
40030 IF (RVCOMP) 20030,20030,10030
10030 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 41
20030 IVFAIL = IVFAIL + 1
RVCORR = 1.0
WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR
41 CONTINUE
IVTNUM = 4
C
C **** TEST 4 ****
C TEST 004 - BASIC IF STATEMENTS TEST
C THESE IF STATEMENTS ARE USED IN REAL VARIABLE TEST
C VERIFICATION. THE ARITHMETIC EXPRESSIONS ARE OF THE FORM
C REAL VARIABLE - REAL CONSTANT
C
IF (ICZERO) 30040, 40, 30040
40 CONTINUE
RVCOMP = 4.0
RVON01 = 1.0
IF (RVON01 - .99995) 40040,42,42
42 IF (RVON01 - 1.0005) 43,43,40040
43 RVCOMP = 0.0
GO TO 40040
30040 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 40040, 51, 40040
40040 IF (RVCOMP) 20040,10040,20040
10040 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 51
20040 IVFAIL = IVFAIL + 1
RVCORR = 0.0
WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR
51 CONTINUE
IVTNUM = 5
C
C **** TEST 5 ****
C TEST 005 - BASIC IF STATEMENTS TEST
C THESE IF STATEMENTS ARE USED IN REAL VARIABLE TEST
C VERIFICATION. THE ARITHMETIC EXPRESSIONS ARE OF THE FORM
C REAL VARIABLE + REAL CONSTANT
C
IF (ICZERO) 30050, 50, 30050
50 CONTINUE
RVCOMP = -1.0
RVON01 = -1.0
IF (RVON01 + 1.0005) 40050,52,52
52 IF (RVON01 + .99995) 53,53,40050
53 RVCOMP = 0.0
GO TO 40050
30050 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 40050, 61, 40050
40050 IF (RVCOMP) 20050,10050,20050
10050 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 61
20050 IVFAIL = IVFAIL + 1
RVCORR = 0.0
WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR
C
C ARITHMETIC ASSIGNMENT STATEMENT
C
C
C TEST 006 THROUGH TEST 025 CONTAIN ARITHMETIC ASSIGNMENT
C STATEMENTS OF THE FORM
C REAL VARIABLE = REAL CONSTANT
C
C THE THREE TYPES OF REAL CONSTANTS ARE TESTED WITH POSITIVE
C AND NEGATIVE VALUES FOR THE CONSTANTS, AND POSITIVE AND NEGATIVE
C EXPONENTS.
C
C TEST 006 THROUGH TEST 011 - CONSTANT IS BASIC REAL CONSTANT
C
61 CONTINUE
IVTNUM = 6
C
C **** TEST 6 ****
C
IF (ICZERO) 30060, 60, 30060
60 CONTINUE
RVCOMP = 2.0
GO TO 40060
30060 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 40060, 71, 40060
40060 IF (RVCOMP - 1.9995) 20060,10060,40061
40061 IF (RVCOMP - 2.0005) 10060,10060,20060
10060 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 71
20060 IVFAIL = IVFAIL + 1
RVCORR = 2.0
WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR
71 CONTINUE
IVTNUM = 7
C
C **** TEST 7 ****
C
IF (ICZERO) 30070, 70, 30070
70 CONTINUE
RVCOMP = 44.5
GO TO 40070
30070 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 40070, 81, 40070
40070 IF (RVCOMP - 44.495) 20070,10070,40071
40071 IF (RVCOMP - 45.505) 10070,10070,20070
10070 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 81
20070 IVFAIL = IVFAIL + 1
RVCORR = 44.5
WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR
81 CONTINUE
IVTNUM = 8
C
C **** TEST 8 ****
C
IF (ICZERO) 30080, 80, 30080
80 CONTINUE
RVCOMP = -2.0
GO TO 40080
30080 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 40080, 91, 40080
40080 IF (RVCOMP + 2.0005) 20080,10080,40081
40081 IF (RVCOMP + 1.9995) 10080,10080,20080
10080 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 91
20080 IVFAIL = IVFAIL + 1
RVCORR = -2.0
WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR
91 CONTINUE
IVTNUM = 9
C
C **** TEST 9 ****
C
IF (ICZERO) 30090, 90, 30090
90 CONTINUE
RVCOMP = 65001.
GO TO 40090
30090 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 40090, 101, 40090
40090 IF (RVCOMP - 64996.) 20090,10090,40091
40091 IF (RVCOMP - 65006.) 10090,10090,20090
10090 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 101
20090 IVFAIL = IVFAIL + 1
RVCORR = 65001.
WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR
101 CONTINUE
IVTNUM = 10
C
C **** TEST 10 ****
C
IF (ICZERO) 30100, 100, 30100
100 CONTINUE
RVCOMP = .65001
GO TO 40100
30100 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 40100, 111, 40100
40100 IF (RVCOMP - .64996) 20100,10100,40101
40101 IF (RVCOMP - .65006) 10100,10100,20100
10100 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 111
20100 IVFAIL = IVFAIL + 1
RVCORR = .65001
WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR
111 CONTINUE
IVTNUM = 11
C
C **** TEST 11 ****
C
IF (ICZERO) 30110, 110, 30110
110 CONTINUE
RVCOMP = -.33333
GO TO 40110
30110 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 40110, 121, 40110
40110 IF (RVCOMP + .33338) 20110,10110,40111
40111 IF (RVCOMP + .33328) 10110,10110,20110
10110 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 121
20110 IVFAIL = IVFAIL + 1
RVCORR = -.33333
WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR
C
C TEST 012 THROUGH TEST 19 - REAL CONSTANT IS BASIC REAL CONSTANT
C - FOLLOWED BY DECIMAL EXPONENT
C
121 CONTINUE
IVTNUM = 12
C
C **** TEST 12 ****
C
IF (ICZERO) 30120, 120, 30120
120 CONTINUE
RVCOMP = .2E+1
GO TO 40120
30120 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 40120, 131, 40120
40120 IF (RVCOMP - 1.9995) 20120,10120,40121
40121 IF (RVCOMP - 2.0005) 10120,10120,20120
10120 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 131
20120 IVFAIL = IVFAIL + 1
RVCORR = 2.0
WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR
131 CONTINUE
IVTNUM = 13
C
C **** TEST 13 ****
C
IF (ICZERO) 30130, 130, 30130
130 CONTINUE
RVCOMP = 2.0E+0
GO TO 40130
30130 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 40130, 141, 40130
40130 IF (RVCOMP - 1.9995) 20130,10130,40131
40131 IF (RVCOMP - 2.0005) 10130,10130,20130
10130 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 141
20130 IVFAIL = IVFAIL + 1
RVCORR = 2.0
WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR
141 CONTINUE
IVTNUM = 14
C
C **** TEST 14 ****
C
IF (ICZERO) 30140, 140, 30140
140 CONTINUE
RVCOMP = 445.0E-01
GO TO 40140
30140 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 40140, 151, 40140
40140 IF (RVCOMP - 44.495) 20140,10140,40141
40141 IF (RVCOMP - 44.505) 10140,10140,20140
10140 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 151
20140 IVFAIL = IVFAIL + 1
RVCORR = 44.5
WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR
151 CONTINUE
IVTNUM = 15
C
C **** TEST 15 ****
C
IF (ICZERO) 30150, 150, 30150
150 CONTINUE
RVCOMP = 4.450E1
GO TO 40150
30150 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 40150, 161, 40150
40150 IF (RVCOMP - 44.495) 20150,10150,40151
40151 IF (RVCOMP - 44.505) 10150,10150,20150
10150 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 161
20150 IVFAIL = IVFAIL + 1
RVCORR = 44.5
WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR
161 CONTINUE
IVTNUM = 16
C
C **** TEST 16 ****
C
IF (ICZERO) 30160, 160, 30160
160 CONTINUE
RVCOMP = 2.E+15
GO TO 40160
30160 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 40160, 171, 40160
40160 IF (RVCOMP - 1.9995E+15) 20160,10160,40161
40161 IF (RVCOMP - 2.0005E+15) 10160,10160,20160
10160 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 171
20160 IVFAIL = IVFAIL + 1
RVCORR = 2.0E+15
WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR
171 CONTINUE
IVTNUM = 17
C
C **** TEST 17 ****
C
IF (ICZERO) 30170, 170, 30170
170 CONTINUE
RVCOMP = 44.5E-15
GO TO 40170
30170 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 40170, 181, 40170
40170 IF (RVCOMP - 44.495E-15) 20170,10170,40171
40171 IF (RVCOMP - 44.505E-15) 10170,10170,20170
10170 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 181
20170 IVFAIL = IVFAIL + 1
RVCORR = 44.5E-15
WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR
181 CONTINUE
IVTNUM = 18
C
C **** TEST 18 ****
C
IF (ICZERO) 30180, 180, 30180
180 CONTINUE
RVCOMP = -4.45E0
GO TO 40180
30180 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 40180, 191, 40180
40180 IF (RVCOMP + 4.4505) 20180,10180,40181
40181 IF (RVCOMP + 4.4495) 10180,10180,20180
10180 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 191
20180 IVFAIL = IVFAIL + 1
RVCORR = -4.45
WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR
191 CONTINUE
IVTNUM = 19
C
C **** TEST 19 ****
C
IF (ICZERO) 30190, 190, 30190
190 CONTINUE
RVCOMP = -6511.8E-0
GO TO 40190
30190 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 40190, 201, 40190
40190 IF (RVCOMP + 6512.3) 20190,10190,40191
40191 IF (RVCOMP + 6511.3) 10190,10190,20190
10190 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 201
20190 IVFAIL = IVFAIL + 1
RVCORR = -6511.8
WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR
C
C TEST 020 THROUGH TEST 025 - INTEGER CONSTANT FOLLOWED
C - BY A DECIMAL EXPONENT
C
201 CONTINUE
IVTNUM = 20
C
C **** TEST 20 ****
C
IF (ICZERO) 30200, 200, 30200
200 CONTINUE
RVCOMP = 2E+1
GO TO 40200
30200 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 40200, 211, 40200
40200 IF (RVCOMP - 19.995) 20200,10200,40201
40201 IF (RVCOMP - 20.005) 10200,10200,20200
10200 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 211
20200 IVFAIL = IVFAIL + 1
RVCORR = 20.0
WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR
211 CONTINUE
IVTNUM = 21
C
C **** TEST 21 ****
C
IF (ICZERO) 30210, 210, 30210
210 CONTINUE
RVCOMP = 445E-02
GO TO 40210
30210 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 40210, 221, 40210
40210 IF (RVCOMP - 4.4495) 20210,10210,40211
40211 IF (RVCOMP - 4.4505) 10210,10210,20210
10210 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 221
20210 IVFAIL = IVFAIL + 1
RVCORR = 4.45
WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR
221 CONTINUE
IVTNUM = 22
C
C **** TEST 22 ****
C
IF (ICZERO) 30220, 220, 30220
220 CONTINUE
RVCOMP = 7E3
GO TO 40220
30220 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 40220, 231, 40220
40220 IF (RVCOMP - 6999.0) 20220,10220,40221
40221 IF (RVCOMP - 7001.0) 10220,10220,20220
10220 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 231
20220 IVFAIL = IVFAIL + 1
RVCORR = 7000.0
WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR
231 CONTINUE
IVTNUM = 23
C
C **** TEST 23 ****
C
IF (ICZERO) 30230, 230, 30230
230 CONTINUE
RVCOMP = 214 E 0
GO TO 40230
30230 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 40230, 241, 40230
40230 IF (RVCOMP - 213.95) 20230,10230,40231
40231 IF (RVCOMP - 214.05) 10230,10230,20230
10230 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 241
20230 IVFAIL = IVFAIL + 1
RVCORR = 214.0
WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR
241 CONTINUE
IVTNUM = 24
C
C **** TEST 24 ****
C
IF (ICZERO) 30240, 240, 30240
240 CONTINUE
RVCOMP = -3276E+6
GO TO 40240
30240 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 40240, 251, 40240
40240 IF (RVCOMP + .32765E+10) 20240,10240,40241
40241 IF (RVCOMP + .32755E+10) 10240,10240,20240
10240 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 251
20240 IVFAIL = IVFAIL + 1
RVCORR = -3276E+6
WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR
251 CONTINUE
IVTNUM = 25
C
C **** TEST 25 ****
C
IF (ICZERO) 30250, 250, 30250
250 CONTINUE
RVCOMP = -7E3
GO TO 40250
30250 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 40250, 261, 40250
40250 IF (RVCOMP + 7001.) 20250,10250,40251
40251 IF (RVCOMP + 6999.) 10250,10250,20250
10250 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 261
20250 IVFAIL = IVFAIL + 1
RVCORR = -7000.0
WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR
C
C TEST 026 THROUGH TEST 028 CONTAIN ARITHMETIC ASSIGNMENT STATEMENT
C OF THE FORM REAL VARIABLE = REAL VARIABLE
C
261 CONTINUE
IVTNUM = 26
C
C **** TEST 26 ****
C
IF (ICZERO) 30260, 260, 30260
260 CONTINUE
RVON01 = .2E+1
RVCOMP = RVON01
GO TO 40260
30260 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 40260, 271, 40260
40260 IF (RVCOMP - 1.9995) 20260,10260,40261
40261 IF (RVCOMP - 2.0005) 10260,10260,20260
10260 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 271
20260 IVFAIL = IVFAIL + 1
RVCORR = 20.0
WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR
271 CONTINUE
IVTNUM = 27
C
C **** TEST 27 ****
C
IF (ICZERO) 30270, 270, 30270
270 CONTINUE
RVON01 = -445.E-01
RVCOMP = RVON01
GO TO 40270
30270 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 40270, 281, 40270
40270 IF (RVCOMP + 44.505) 20270,10270,40271
40271 IF (RVCOMP + 44.495) 10270,10270,20270
10270 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 281
20270 IVFAIL = IVFAIL + 1
RVCORR = -44.5
WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR
281 CONTINUE
IVTNUM = 28
C
C **** TEST 28 ****
C
IF (ICZERO) 30280, 280, 30280
280 CONTINUE
RVON01 = 7E3
RVCOMP = RVON01
GO TO 40280
30280 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 40280, 291, 40280
40280 IF (RVCOMP - 6999.0) 20280,10280,40281
40281 IF (RVCOMP-7001.0) 10280,10280,20280
10280 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 291
20280 IVFAIL = IVFAIL + 1
RVCORR = 7000.0
C
C TEST 029 THROUGH TEST 031 CONTAIN ARITHMETIC ASSIGNMENT STATEMENT
C OF THE FORM REAL VARIABLE = - REAL VARIABLE
C
WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR
291 CONTINUE
IVTNUM = 29
C
C **** TEST 29 ****
C
IF (ICZERO) 30290, 290, 30290
290 CONTINUE
RVON01 = .2E+1
RVCOMP = -RVON01
GO TO 40290
30290 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 40290, 301, 40290
40290 IF (RVCOMP + 2.0005) 20290,10290,40291
40291 IF (RVCOMP + 1.9995) 10290,10290,20290
10290 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 301
20290 IVFAIL = IVFAIL + 1
RVCORR = -2.0
WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR
301 CONTINUE
IVTNUM = 30
C
C **** TEST 30 ****
C
IF (ICZERO) 30300, 300, 30300
300 CONTINUE
RVON01 = -445.E-01
RVCOMP = -RVON01
GO TO 40300
30300 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 40300, 311, 40300
40300 IF (RVCOMP - 44.495) 20300,10300,40301
40301 IF (RVCOMP - 44.505) 10300,10300,20300
10300 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 311
20300 IVFAIL = IVFAIL + 1
RVCORR = 44.5
WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR
311 CONTINUE
IVTNUM = 31
C
C **** TEST 31 ****
C
IF (ICZERO) 30310, 310, 30310
310 CONTINUE
RVON01 = -.44559E1
RVCOMP = -RVON01
GO TO 40310
30310 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 40310, 321, 40310
40310 IF (RVCOMP - 4.4554) 20310,10310,40311
40311 IF (RVCOMP - 4.4564) 10310,10310,20310
10310 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 321
20310 IVFAIL = IVFAIL + 1
RVCORR = 4.4559
WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR
C **** END OF TESTS ****
321 CONTINUE
C
C WRITE PAGE FOOTINGS AND RUN SUMMARIES
99999 CONTINUE
WRITE (I02,90002)
WRITE (I02,90006)
WRITE (I02,90002)
WRITE (I02,90002)
WRITE (I02,90007)
WRITE (I02,90002)
WRITE (I02,90008) IVFAIL
WRITE (I02,90009) IVPASS
WRITE (I02,90010) IVDELE
C
C
C TERMINATE ROUTINE EXECUTION
STOP
C
C FORMAT STATEMENTS FOR PAGE HEADERS
90000 FORMAT (1H1)
90002 FORMAT (1H )
90001 FORMAT (1H ,10X,34HFORTRAN COMPILER VALIDATION SYSTEM)
90003 FORMAT (1H ,21X,11HVERSION 1.0)
90004 FORMAT (1H ,10X,38HFOR OFFICIAL USE ONLY - COPYRIGHT 1978)
90005 FORMAT (1H ,5X,4HTEST,5X,9HPASS/FAIL, 5X,8HCOMPUTED,8X,7HCORRECT)
90006 FORMAT (1H ,5X,46H----------------------------------------------)
90011 FORMAT (1H ,18X,17HSUBSET LEVEL TEST)
C
C FORMAT STATEMENTS FOR RUN SUMMARIES
90008 FORMAT (1H ,15X,I5,19H ERRORS ENCOUNTERED)
90009 FORMAT (1H ,15X,I5,13H TESTS PASSED)
90010 FORMAT (1H ,15X,I5,14H TESTS DELETED)
C
C FORMAT STATEMENTS FOR TEST RESULTS
80001 FORMAT (1H ,4X,I5,7X,4HPASS)
80002 FORMAT (1H ,4X,I5,7X,4HFAIL)
80003 FORMAT (1H ,4X,I5,7X,7HDELETED)
80004 FORMAT (1H ,4X,I5,7X,4HFAIL,10X,I6,9X,I6)
80005 FORMAT (1H ,4X,I5,7X,4HFAIL,4X,E12.5,3X,E12.5)
C
90007 FORMAT (1H ,20X,20HEND OF PROGRAM FM060)
END
*END-OF,FM060
FM061.f 480976066 170 2 100666 21108 `
*HEADER,FORTR,FM061
*FILES1,FORTR,FM061,X
C COMMENT SECTION
C
C FM061
C
C THIS ROUTINE TESTS ARITHMETIC ASSIGNMENT STATEMENTS OF THE
C FORM
C INTEGER VARIABLE = REAL CONSTANT
C INTEGER VARIABLE = REAL VARIABLE
C REAL VARIABLE = INTEGER VARIABLE
C REAL VARIABLE = INTEGER CONSTANT
C
C THE CONSTANTS AND VARIABLES CONTAIN BOTH POSITIVE AND NEGATIVE
C VALUES.
C
C A REAL DATUM IS A PROCESSOR APPROXIMATION TO THE VALUE OF A
C REAL NUMBER. IT MAY ASSUME POSITIVE, NEGATIVE AND ZERO VALUES.
C
C A BASIC REAL CONSTANT IS WRITTEN AS AN INTEGER PART, A
C DECIMAL POINT, AND A DECIMAL FRACTION PART IN THAT ORDER. BOTH
C THE INTEGER PART AND THE DECIMAL PART ARE STRINGS OF DIGITS;
C EITHER ONE OF THESE STRINGS MAY BE EMPTY BUT NOT BOTH. THE
C CONSTANT IS AN APPROXIMATION TO THE DIGIT STRING INTERPRETED AS A
C DECIMAL NUMERAL.
C
C A DECIMAL EXPONENT IS WRITTEN AS THE LETTER E, FOLLOWED BY AN
C OPTIONALLY SIGNED INTEGER CONSTANT.
C
C A REAL CONSTANT IS INDICATED BY WRITING A BASIC REAL CONSTANT,
C A BASIC REAL CONSTANT FOLLOWED BY A DECIMAL EXPONENT, OR AN
C INTEGER CONSTANT FOLLOWED BY A DECIMAL EXPONENT.
C
C REFERENCES
C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN,
C X3.9-1978
C
C SECTION 4.4, REAL TYPE
C SECTION 4.4.1, REAL CONSTANT
C SECTION 6.1, ARITHMETIC EXPRESSIONS
C SECTION 6.6, EVALUATION OF EXPRESSIONS
C SECTION 10.1, ARITHMETIC ASSIGNMENT STATEMENT
C SECTION 11.4, ARITHMETIC IF STATEMENT
C
C **********************************************************
C
C A COMPILER VALIDATION SYSTEM FOR THE FORTRAN LANGUAGE
C BASED ON SPECIFICATIONS AS DEFINED IN AMERICAN NATIONAL STANDARD
C PROGRAMMING LANGUAGE FORTRAN X3.9-1978, HAS BEEN DEVELOPED BY THE
C FEDERAL COBOL COMPILER TESTING SERVICE. THE FORTRAN COMPILER
C VALIDATION SYSTEM (FCVS) CONSISTS OF AUDIT ROUTINES, THEIR RELATED
C DATA, AND AN EXECUTIVE SYSTEM. EACH AUDIT ROUTINE IS A FORTRAN
C PROGRAM, SUBPROGRAM OR FUNCTION WHICH INCLUDES TESTS OF SPECIFIC
C LANGUAGE ELEMENTS AND SUPPORTING PROCEDURES INDICATING THE RESULT
C OF EXECUTING THESE TESTS.
C
C THIS PARTICULAR PROGRAM/SUBPROGRAM/FUNCTION CONTAINS FEATURES
C FOUND ONLY IN THE SUBSET AS DEFINED IN X3.9-1978.
C
C SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO -
C
C DEPARTMENT OF THE NAVY
C FEDERAL COBOL COMPILER TESTING SERVICE
C WASHINGTON, D.C. 20376
C
C **********************************************************
C
C
C
C INITIALIZATION SECTION
C
C INITIALIZE CONSTANTS
C **************
C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER.
I01 = 5
C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER.
I02 = 6
C SYSTEM ENVIRONMENT SECTION
C
CX010 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-010 CONTROL CARD.
C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5
C (UNIT NUMBER FOR CARD READER).
CX011 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-011 CONTROL CARD.
C THE CX011 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL
C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX010 ABOVE.
C
CX020 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-020 CONTROL CARD.
C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02 = 6
C (UNIT NUMBER FOR PRINTER).
CX021 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-021 CONTROL CARD.
C THE CX021 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL
C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX020 ABOVE.
C
IVPASS=0
IVFAIL=0
IVDELE=0
ICZERO=0
C
C WRITE PAGE HEADERS
WRITE (I02,90000)
WRITE (I02,90001)
WRITE (I02,90002)
WRITE (I02, 90002)
WRITE (I02,90003)
WRITE (I02,90002)
WRITE (I02,90004)
WRITE (I02,90002)
WRITE (I02,90011)
WRITE (I02,90002)
WRITE (I02,90002)
WRITE (I02,90005)
WRITE (I02,90006)
WRITE (I02,90002)
C
C TEST SECTION
C
C TEST 32 THROUGH TEST 42 CONTAIN ARITHMETIC ASSIGNMENT
C STATEMENTS OF THE FORM
C
C INTEGER VARIABLE = REAL VARIABLE
C
IVTNUM = 32
C
C **** TEST 32 ****
C
IF (ICZERO) 30320, 320, 30320
320 CONTINUE
RVON01 = 44.5
IVCOMP = RVON01
GO TO 40320
30320 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 40320, 331, 40320
40320 IF (IVCOMP - 44) 20320,10320,20320
10320 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 331
20320 IVFAIL = IVFAIL + 1
IVCORR = 44
WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR
331 CONTINUE
IVTNUM = 33
C
C **** TEST 33 ****
C
IF (ICZERO) 30330, 330, 30330
330 CONTINUE
RVON01 = -2.0005
IVCOMP = RVON01
GO TO 40330
30330 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 40330, 341, 40330
40330 IF (IVCOMP + 2) 20330,10330,20330
10330 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 341
20330 IVFAIL = IVFAIL + 1
IVCORR = -2
WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR
341 CONTINUE
IVTNUM = 34
C
C **** TEST 34 ****
C
IF (ICZERO) 30340, 340, 30340
340 CONTINUE
RVON01 = .32767
IVCOMP = RVON01
GO TO 40340
30340 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 40340, 351, 40340
40340 IF (IVCOMP) 20340,10340,20340
10340 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 351
20340 IVFAIL = IVFAIL + 1
IVCORR = 0
WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR
351 CONTINUE
IVTNUM = 35
C
C **** TEST 35 ****
C
IF (ICZERO) 30350, 350, 30350
350 CONTINUE
RVON01 = 1.999
IVCOMP = RVON01
GO TO 40350
30350 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 40350, 361, 40350
40350 IF (IVCOMP - 1) 20350,10350,20350
10350 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 361
20350 IVFAIL = IVFAIL + 1
IVCORR = 1
WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR
361 CONTINUE
IVTNUM = 36
C
C **** TEST 36 ****
C
IF (ICZERO) 30360, 360, 30360
360 CONTINUE
RVON01 = .25E+1
IVCOMP = RVON01
GO TO 40360
30360 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 40360, 371, 40360
40360 IF (IVCOMP - 2) 20360,10360,20360
10360 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 371
20360 IVFAIL = IVFAIL + 1
IVCORR = 2
WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR
371 CONTINUE
IVTNUM = 37
C
C **** TEST 37 ****
C
IF (ICZERO) 30370, 370, 30370
370 CONTINUE
RVON01 = 445.0E-01
IVCOMP = RVON01
GO TO 40370
30370 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 40370, 381, 40370
40370 IF (IVCOMP - 44) 20370,10370,20370
10370 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 381
20370 IVFAIL = IVFAIL + 1
IVCORR = 44
WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR
381 CONTINUE
IVTNUM = 38
C
C **** TEST 38 ****
C
IF (ICZERO) 30380, 380, 30380
380 CONTINUE
RVON01 = -651.1E-0
IVCOMP = RVON01
GO TO 40380
30380 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 40380, 391, 40380
40380 IF (IVCOMP + 651) 20380,10380,20380
10380 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 391
20380 IVFAIL = IVFAIL + 1
IVCORR = -651
WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR
391 CONTINUE
IVTNUM = 39
C
C **** TEST 39 ****
C
IF (ICZERO) 30390, 390, 30390
390 CONTINUE
RVON01 = .3266E4
IVCOMP = RVON01
GO TO 40390
30390 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 40390, 401, 40390
40390 IF (IVCOMP - 3266) 20390,10390,20390
10390 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 401
20390 IVFAIL = IVFAIL + 1
IVCORR = 3266
WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR
401 CONTINUE
IVTNUM = 40
C
C **** TEST 40 ****
C
IF (ICZERO) 30400, 400, 30400
400 CONTINUE
RVON01 = 35.43E-01
IVCOMP = RVON01
GO TO 40400
30400 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 40400, 411, 40400
40400 IF (IVCOMP - 3) 20400,10400,20400
10400 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 411
20400 IVFAIL = IVFAIL + 1
IVCORR = 3
WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR
411 CONTINUE
IVTNUM = 41
C
C **** TEST 41 ****
C
IF (ICZERO) 30410, 410, 30410
410 CONTINUE
RVON01 = -7.001E2
IVCOMP = RVON01
GO TO 40410
30410 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 40410, 421, 40410
40410 IF (IVCOMP + 700) 20410,10410,20410
10410 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 421
20410 IVFAIL = IVFAIL + 1
IVCORR = -700
WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR
421 CONTINUE
IVTNUM = 42
C
C **** TEST 42 ****
C
IF (ICZERO) 30420, 420, 30420
420 CONTINUE
RVON01 = 4.45E-02
IVCOMP = RVON01
GO TO 40420
30420 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 40420, 431, 40420
40420 IF (IVCOMP) 20420,10420,20420
10420 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 431
20420 IVFAIL = IVFAIL + 1
IVCORR = 0
WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR
C TEST 43 THROUGH TEST 48 CONTAIN ARITHMETIC ASSIGNMENT
C STATEMENTS OF THE FORM
C
C REAL VARIABLE = INTEGER VARIABLE
C
431 CONTINUE
IVTNUM = 43
C
C **** TEST 43 ****
C
IF (ICZERO) 30430, 430, 30430
430 CONTINUE
IVON01 = 2
RVCOMP = IVON01
GO TO 40430
30430 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 40430, 441, 40430
40430 IF (RVCOMP - 1.9995) 20430,10430,40431
40431 IF (RVCOMP - 2.0005) 10430,10430,20430
10430 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 441
20430 IVFAIL = IVFAIL + 1
RVCORR = 2.0000
WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR
441 CONTINUE
IVTNUM = 44
C
C **** TEST 44 ****
C
IF (ICZERO) 30440, 440, 30440
440 CONTINUE
IVON01 = 25
RVCOMP = IVON01
GO TO 40440
30440 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 40440, 451, 40440
40440 IF (RVCOMP - 24.995) 20440,10440,40441
40441 IF (RVCOMP - 25.005) 10440,10440,20440
10440 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 451
20440 IVFAIL = IVFAIL + 1
RVCORR = 25.000
WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR
451 CONTINUE
IVTNUM = 45
C
C **** TEST 45 ****
C
IF (ICZERO) 30450, 450, 30450
450 CONTINUE
IVON01 = 357
RVCOMP = IVON01
GO TO 40450
30450 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 40450, 461, 40450
40450 IF (RVCOMP - 356.95) 20450,10450,40451
40451 IF (RVCOMP - 357.05) 10450,10450,20450
10450 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 461
20450 IVFAIL = IVFAIL + 1
RVCORR = 357.00
WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR
461 CONTINUE
IVTNUM = 46
C
C **** TEST 46 ****
C
IF (ICZERO) 30460, 460, 30460
460 CONTINUE
IVON01 = 4968
RVCOMP = IVON01
GO TO 40460
30460 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 40460, 471, 40460
40460 IF (RVCOMP - 4967.5) 20460,10460,40461
40461 IF (RVCOMP - 4968.5) 10460,10460,20460
10460 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 471
20460 IVFAIL = IVFAIL + 1
RVCORR = 4968.0
WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR
471 CONTINUE
IVTNUM = 47
C
C **** TEST 47 ****
C
IF (ICZERO) 30470, 470, 30470
470 CONTINUE
IVON01 = 32767
RVCOMP = IVON01
GO TO 40470
30470 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 40470, 481, 40470
40470 IF (RVCOMP - 32762.) 20470,10470,40471
40471 IF (RVCOMP - 32772.) 10470,10470,20470
10470 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 481
20470 IVFAIL = IVFAIL + 1
RVCORR = 32767.
WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR
481 CONTINUE
IVTNUM = 48
C
C **** TEST 48 ****
C
IF (ICZERO) 30480, 480, 30480
480 CONTINUE
IVON01 = -2
RVCOMP = IVON01
GO TO 40480
30480 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 40480, 491, 40480
40480 IF (RVCOMP + 2.0005) 20480,10480,40481
40481 IF (RVCOMP + 1.9995) 10480,10480,20450
10480 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 491
20480 IVFAIL = IVFAIL + 1
RVCORR = -2.0000
WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR
C
C TEST 49 THROUGH TEST 51 CONTAIN ARITHMETIC ASSIGNMENT STATEMENTS
C OF THE FORM
C INTEGER VARIABLE = REAL CONSTANT
C WHERE CONSTANT IS BASIC REAL CONSTANT
C
491 CONTINUE
IVTNUM = 49
C
C **** TEST 49 ****
C
IF (ICZERO) 30490, 490, 30490
490 CONTINUE
IVCOMP = 44.5
GO TO 40490
30490 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 40490, 501, 40490
40490 IF (IVCOMP - 44) 20490,10490,20490
10490 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 501
20490 IVFAIL = IVFAIL + 1
IVCORR = 44
WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR
501 CONTINUE
IVTNUM = 50
C
C **** TEST 50 ****
C
IF (ICZERO) 30500, 500, 30500
500 CONTINUE
IVCOMP = 6500.1
GO TO 40500
30500 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 40500, 511, 40500
40500 IF (IVCOMP - 6500) 20500,10500,20500
10500 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 511
20500 IVFAIL = IVFAIL + 1
IVCORR = 6500
WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR
511 CONTINUE
IVTNUM = 51
C
C **** TEST 51 ****
C
IF (ICZERO) 30510, 510, 30510
510 CONTINUE
IVCOMP = -.33333
GO TO 40510
30510 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 40510, 521, 40510
40510 IF (IVCOMP) 20510,10510,20510
10510 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 521
20510 IVFAIL = IVFAIL + 1
IVCORR = 0
WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR
C
C TEST 52 THROUGH TEST 55 CONTAIN ARITHMETIC ASSIGNMENT STATEMENTS
C OF THE FORM
C INTEGER VARIABLE = REAL CONSTANT
C
C WHERE CONSTANT IS BASIC REAL CONSTANT FOLLOWED BY DECIMAL EXPONENT
C
521 CONTINUE
IVTNUM = 52
C
C **** TEST 52 ****
C
IF (ICZERO) 30520, 520, 30520
520 CONTINUE
IVCOMP = .21E+1
GO TO 40520
30520 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 40520, 531, 40520
40520 IF (IVCOMP - 2) 20520,10520,20520
10520 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 531
20520 IVFAIL = IVFAIL + 1
IVCORR = 2
WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR
531 CONTINUE
IVTNUM = 53
C
C **** TEST 53 ****
C
IF (ICZERO) 30530, 530, 30530
530 CONTINUE
IVCOMP = 445.0E-01
GO TO 40530
30530 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 40530, 541, 40530
40530 IF (IVCOMP - 44) 20530,10530,20530
10530 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 541
20530 IVFAIL = IVFAIL + 1
IVCORR = 44
WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR
541 CONTINUE
IVTNUM = 54
C
C **** TEST 54 ****
C
IF (ICZERO) 30540, 540, 30540
540 CONTINUE
IVCOMP = 4.450E1
GO TO 40540
30540 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 40540, 551, 40540
40540 IF (IVCOMP - 44) 20540,10540,20540
10540 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 551
20540 IVFAIL = IVFAIL + 1
IVCORR = 44
WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR
551 CONTINUE
IVTNUM = 55
C
C **** TEST 55 ****
C
IF (ICZERO) 30550, 550, 30550
550 CONTINUE
IVCOMP = -4.45E0
GO TO 40550
30550 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 40550, 561, 40550
40550 IF (IVCOMP + 4) 20550,10550,20550
10550 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 561
20550 IVFAIL = IVFAIL + 1
IVCORR = -4
WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR
C
C TEST 56 AND 57 CONTAIN ARITHMETIC ASSIGNMENT STATEMENTS OF THE
C FORM INTEGER VARIABLE = REAL CONSTANT
C WHERE CONSTANT IS INTEGER CONSTANT FOLLOWED BY DECIMAL EXPONENT
C
561 CONTINUE
IVTNUM = 56
C
C **** TEST 56 ****
C
IF (ICZERO) 30560, 560, 30560
560 CONTINUE
IVCOMP = 445E-02
GO TO 40560
30560 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 40560, 571, 40560
40560 IF (IVCOMP - 4) 20560,10560,20560
10560 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 571
20560 IVFAIL = IVFAIL + 1
IVCORR = 4
WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR
571 CONTINUE
IVTNUM = 57
C
C **** TEST 57 ****
C
IF (ICZERO) 30570, 570, 30570
570 CONTINUE
IVCOMP = -701E-1
GO TO 40570
30570 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 40570, 581, 40570
40570 IF (IVCOMP + 70) 20570,10570,20570
10570 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 581
20570 IVFAIL = IVFAIL + 1
IVCORR = -70
WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR
C
C TEST 58 THROUGH TEST 62 CONTAIN ARITHMETIC ASSIGNMENT STATEMENTS
C OF THE FORM REAL VARIABLE = INTEGER CONSTANT
C
581 CONTINUE
IVTNUM = 58
C
C **** TEST 58 ****
C
IF (ICZERO) 30580, 580, 30580
580 CONTINUE
RVCOMP = 23
GO TO 40580
30580 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 40580, 591, 40580
40580 IF (RVCOMP - 22.995) 20580,10580,40581
40581 IF (RVCOMP - 23.005) 10580,10580,20580
10580 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 591
20580 IVFAIL = IVFAIL + 1
RVCORR = 23.000
WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR
591 CONTINUE
IVTNUM = 59
C
C **** TEST 59 ****
C
IF (ICZERO) 30590, 590, 30590
590 CONTINUE
RVCOMP = 32645
GO TO 40590
30590 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 40590, 601, 40590
40590 IF (RVCOMP - 32640.) 20590,10590,40591
40591 IF (RVCOMP - 32650.) 10590,10590,20590
10590 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 601
20590 IVFAIL = IVFAIL + 1
RVCORR = 32645.
WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR
601 CONTINUE
IVTNUM = 60
C
C **** TEST 60 ****
C
IF (ICZERO) 30600, 600, 30600
600 CONTINUE
RVCOMP = 0
GO TO 40600
30600 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 40600, 611, 40600
40600 IF (RVCOMP) 20600,10600,20600
10600 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 611
20600 IVFAIL = IVFAIL + 1
RVCORR = 00000.
WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR
611 CONTINUE
IVTNUM = 61
C
C **** TEST 61 ****
C
IF (ICZERO) 30610, 610, 30610
610 CONTINUE
RVCOMP = -15
GO TO 40610
30610 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 40610, 621, 40610
40610 IF (RVCOMP -14.995) 40611,10610,20610
40611 IF (RVCOMP + 15.005) 20610,10610,10610
10610 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 621
20610 IVFAIL = IVFAIL + 1
RVCORR = -15.000
WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR
621 CONTINUE
C
C **** END OF TESTS ****
C
C
C WRITE PAGE FOOTINGS AND RUN SUMMARIES
99999 CONTINUE
WRITE (I02,90002)
WRITE (I02,90006)
WRITE (I02,90002)
WRITE (I02,90002)
WRITE (I02,90007)
WRITE (I02,90002)
WRITE (I02,90008) IVFAIL
WRITE (I02,90009) IVPASS
WRITE (I02,90010) IVDELE
C
C
C TERMINATE ROUTINE EXECUTION
STOP
C
C FORMAT STATEMENTS FOR PAGE HEADERS
90000 FORMAT (1H1)
90002 FORMAT (1H )
90001 FORMAT (1H ,10X,34HFORTRAN COMPILER VALIDATION SYSTEM)
90003 FORMAT (1H ,21X,11HVERSION 1.0)
90004 FORMAT (1H ,10X,38HFOR OFFICIAL USE ONLY - COPYRIGHT 1978)
90005 FORMAT (1H ,5X,4HTEST,5X,9HPASS/FAIL, 5X,8HCOMPUTED,8X,7HCORRECT)
90006 FORMAT (1H ,5X,46H----------------------------------------------)
90011 FORMAT (1H ,18X,17HSUBSET LEVEL TEST)
C
C FORMAT STATEMENTS FOR RUN SUMMARIES
90008 FORMAT (1H ,15X,I5,19H ERRORS ENCOUNTERED)
90009 FORMAT (1H ,15X,I5,13H TESTS PASSED)
90010 FORMAT (1H ,15X,I5,14H TESTS DELETED)
C
C FORMAT STATEMENTS FOR TEST RESULTS
80001 FORMAT (1H ,4X,I5,7X,4HPASS)
80002 FORMAT (1H ,4X,I5,7X,4HFAIL)
80003 FORMAT (1H ,4X,I5,7X,7HDELETED)
80004 FORMAT (1H ,4X,I5,7X,4HFAIL,10X,I6,9X,I6)
80005 FORMAT (1H ,4X,I5,7X,4HFAIL,4X,E12.5,3X,E12.5)
C
90007 FORMAT (1H ,20X,20HEND OF PROGRAM FM061)
END
*END-OF,FM061
FM062.f 480976070 170 2 100666 24785 `
*HEADER,FORTR,FM062
*FILES1,FORTR,FM062,X
C COMMENT SECTION
C
C FM062
C
C THIS ROUTINE TESTS ARITHMETIC ASSIGNMENT STATEMENTS WHERE
C AN ARITHMETIC EXPRESSION FORMED FROM REAL VARIABLES AND
C CONSTANTS CONNECTED BY ARITHMETIC OPERATORS IS ASSIGNED TO
C A REAL VARIABLE. IN CASES INVOLVING THE EXPONENTIATION
C OPERATOR, REAL VALUES ARE RAISED TO INTEGER POWERS ONLY.
C
C A REAL DATUM IS A PROCESSOR APPROXIMATION TO THE VALUE OF A
C REAL NUMBER. IT MAY ASSUME POSITIVE, NEGATIVE AND ZERO VALUES.
C
C A BASIC REAL CONSTANT IS WRITTEN AS AN INTEGER PART, A
C DECIMAL POINT, AND A DECIMAL FRACTION PART IN THAT ORDER. BOTH
C THE INTEGER PART AND THE DECIMAL PART ARE STRINGS OF DIGITS;
C EITHER ONE OF THESE STRINGS MAY BE EMPTY BUT NOT BOTH. THE
C CONSTANT IS AN APPROXIMATION TO THE DIGIT STRING INTERPRETED AS A
C DECIMAL NUMERAL.
C
C A DECIMAL EXPONENT IS WRITTEN AS THE LETTER E, FOLLOWED BY AN
C OPTIONALLY SIGNED INTEGER CONSTANT.
C
C A REAL CONSTANT IS INDICATED BY WRITING A BASIC REAL CONSTANT,
C A BASIC REAL CONSTANT FOLLOWED BY A DECIMAL EXPONENT, OR AN
C INTEGER CONSTANT FOLLOWED BY A DECIMAL EXPONENT.
C
C REFERENCES
C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN,
C X3.9-1978
C
C SECTION 4.4, REAL TYPE
C SECTION 4.4.1, REAL CONSTANT
C SECTION 6.1, ARITHMETIC EXPRESSIONS
C SECTION 6.6, EVALUATION OF EXPRESSIONS
C SECTION 10.1, ARITHMETIC ASSIGNMENT STATEMENT
C
C **********************************************************
C
C A COMPILER VALIDATION SYSTEM FOR THE FORTRAN LANGUAGE
C BASED ON SPECIFICATIONS AS DEFINED IN AMERICAN NATIONAL STANDARD
C PROGRAMMING LANGUAGE FORTRAN X3.9-1978, HAS BEEN DEVELOPED BY THE
C FEDERAL COBOL COMPILER TESTING SERVICE. THE FORTRAN COMPILER
C VALIDATION SYSTEM (FCVS) CONSISTS OF AUDIT ROUTINES, THEIR RELATED
C DATA, AND AN EXECUTIVE SYSTEM. EACH AUDIT ROUTINE IS A FORTRAN
C PROGRAM, SUBPROGRAM OR FUNCTION WHICH INCLUDES TESTS OF SPECIFIC
C LANGUAGE ELEMENTS AND SUPPORTING PROCEDURES INDICATING THE RESULT
C OF EXECUTING THESE TESTS.
C
C THIS PARTICULAR PROGRAM/SUBPROGRAM/FUNCTION CONTAINS FEATURES
C FOUND ONLY IN THE SUBSET AS DEFINED IN X3.9-1978.
C
C SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO -
C
C DEPARTMENT OF THE NAVY
C FEDERAL COBOL COMPILER TESTING SERVICE
C WASHINGTON, D.C. 20376
C
C **********************************************************
C
C
C
C INITIALIZATION SECTION
C
C INITIALIZE CONSTANTS
C **************
C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER.
I01 = 5
C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER.
I02 = 6
C SYSTEM ENVIRONMENT SECTION
C
CX010 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-010 CONTROL CARD.
C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5
C (UNIT NUMBER FOR CARD READER).
CX011 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-011 CONTROL CARD.
C THE CX011 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL
C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX010 ABOVE.
C
CX020 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-020 CONTROL CARD.
C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02 = 6
C (UNIT NUMBER FOR PRINTER).
CX021 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-021 CONTROL CARD.
C THE CX021 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL
C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX020 ABOVE.
C
IVPASS=0
IVFAIL=0
IVDELE=0
ICZERO=0
C
C WRITE PAGE HEADERS
WRITE (I02,90000)
WRITE (I02,90001)
WRITE (I02,90002)
WRITE (I02, 90002)
WRITE (I02,90003)
WRITE (I02,90002)
WRITE (I02,90004)
WRITE (I02,90002)
WRITE (I02,90011)
WRITE (I02,90002)
WRITE (I02,90002)
WRITE (I02,90005)
WRITE (I02,90006)
WRITE (I02,90002)
C
C TEST SECTION
C
C ARITHMETIC ASSIGNMENT STATEMENT
C
C
C TESTS 62 THROUGH 70 USE A MIXTURE OF REAL VARIABLES AND REAL
C CONSTANTS CONNECTED BY TWO IDENTICAL ARITHMETIC OPERATORS.
C TESTS OCCUR IN PAIRS, ONE WITHOUT PARENTHESES AND ONE WITH
C PARENTHESES TO ALTER THE NORMAL ORDER OF EVALUATION.
C
C TESTS 71 THROUGH 90 USE THREE REAL VARIABLES CONNECTED BY A
C PAIR OF DISSIMILAR OPERATORS. ALL COMBINATIONS AND ORDERINGS
C OF OPERATORS ARE EXERCIZED. WHERE EXPONENTIATION IS TESTED,
C INTEGER VARIABLES ARE USED FOR THE POWER PRIMARIES.
C
C TESTS 91 AND 92 USE A SERIES OF REAL VARIABLES CONNECTED BY ONE
C EACH OF THE ARITHMETIC OPERTORS. PARENTHETICAL NOTATIONS ARE
C ALSO TESTED.
C
C
C
C
C
IVTNUM = 62
C
C **** TEST 62 ****
C
IF (ICZERO) 30620, 620, 30620
620 CONTINUE
RVON01 = 7.5
RVON02 = 5E2
RVCOMP = RVON01 + RVON02 + 33E-1
GO TO 40620
30620 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 40620, 631, 40620
40620 IF (RVCOMP - 510.75) 20620,10620,40621
40621 IF (RVCOMP - 510.85) 10620,10620,20620
10620 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 631
20620 IVFAIL = IVFAIL + 1
RVCORR = 510.8
WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR
631 CONTINUE
IVTNUM = 63
C
C **** TEST 63 ****
C
IF (ICZERO) 30630, 630, 30630
630 CONTINUE
RVON01 = 75E-1
RVON02 = 500.0
RVCOMP = RVON01 + (RVON02 + 3.3)
GO TO 40630
30630 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 40630, 641, 40630
40630 IF (RVCOMP - 510.75) 20630,10630,40631
40631 IF (RVCOMP - 510.85) 10630,10630,20630
10630 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 641
20630 IVFAIL = IVFAIL + 1
RVCORR = 510.8
WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR
641 CONTINUE
IVTNUM = 64
C
C **** TEST 64 ****
C
IF (ICZERO) 30640, 640, 30640
640 CONTINUE
RVCOMP = 7.5 - 500. - 3.3
GO TO 40640
30640 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 40640, 651, 40640
40640 IF (RVCOMP + 495.85) 20640,10640,40641
40641 IF (RVCOMP + 495.75) 10640,10640,20640
10640 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 651
20640 IVFAIL = IVFAIL + 1
RVCORR = -495.8
WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR
651 CONTINUE
IVTNUM = 65
C
C **** TEST 65 ****
C
IF (ICZERO) 30650, 650, 30650
650 CONTINUE
RVON01 = 7.5
RVON02 = 5E2
RVCOMP = RVON01 - (33E-1 - RVON02)
GO TO 40650
30650 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 40650, 661, 40650
40650 IF (RVCOMP - 504.15) 20650,10650,40651
40651 IF (RVCOMP - 504.25) 10650,10650,20650
10650 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 661
20650 IVFAIL = IVFAIL + 1
RVCORR = 504.2
WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR
661 CONTINUE
IVTNUM = 66
C
C **** TEST 66 ****
C
IF (ICZERO) 30660, 660, 30660
660 CONTINUE
RVON01 = 7.5
RVCOMP = 5E2 * 33E-1 * RVON01
GO TO 40660
30660 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 40660, 671, 40660
40660 IF (RVCOMP - 12370) 20660,10660,40661
40661 IF (RVCOMP - 12380) 10660,10660,20660
10660 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 671
20660 IVFAIL = IVFAIL + 1
RVCORR = 12375.
WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR
671 CONTINUE
IVTNUM = 67
C
C **** TEST 67 ****
C
IF (ICZERO) 30670, 670, 30670
670 CONTINUE
RVON01 = 7.5
RVCOMP = 5E2 * (RVON01 * 33E-1)
GO TO 40670
30670 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 40670, 681, 40670
40670 IF (RVCOMP - 12370) 20670,10670,40671
40671 IF (RVCOMP - 12380) 10670,10670,20670
10670 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 681
20670 IVFAIL = IVFAIL + 1
RVCORR = 12375.
WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR
681 CONTINUE
IVTNUM = 68
C
C **** TEST 68 ****
C
IF (ICZERO) 30680, 680, 30680
680 CONTINUE
RVON01 = 7.5
RVON02 = 33E-1
RVON03 = -5E+2
RVCOMP = RVON01 / RVON02 / RVON03
GO TO 40680
30680 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 40680, 691, 40680
40680 IF (RVCOMP + .00459) 20680,10680,40681
40681 IF (RVCOMP + .00449) 10680,10680,20680
10680 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 691
20680 IVFAIL = IVFAIL + 1
RVCORR = -.0045454
WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR
691 CONTINUE
IVTNUM = 69
C
C **** TEST 69 ****
C
IF (ICZERO) 30690, 690, 30690
690 CONTINUE
RVON01 = 7.5
RVON02 = 33E-1
RVON03 = -5E+2
RVCOMP = RVON01 / (RVON02 / RVON03)
GO TO 40690
30690 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 40690, 701, 40690
40690 IF (RVCOMP + 1180.) 20690,10690,40691
40691 IF (RVCOMP + 1080.) 10690,10690,20690
10690 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 701
20690 IVFAIL = IVFAIL + 1
RVCORR = -1136.4
WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR
701 CONTINUE
IVTNUM = 70
C
C **** TEST 70 ****
C
IF (ICZERO) 30700, 700, 30700
700 CONTINUE
RVON01 = 3.835E3
IVON01 = 5
RVCOMP = RVON01 ** IVON01
GO TO 40700
30700 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 40700, 711, 40700
40700 IF (RVCOMP - 8.29E17) 20700,10700,40701
40701 IF (RVCOMP - 8.30E17) 10700,10700,20700
10700 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 711
20700 IVFAIL = IVFAIL + 1
RVCORR = 8.295E17
WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR
711 CONTINUE
C
C TESTS 71 THROUGH 74 TEST RV1 + RV2 <OP2> RV3
C
IVTNUM = 71
C
C **** TEST 71 ****
C
IF (ICZERO) 30710, 710, 30710
710 CONTINUE
RVON01 = 524.87
RVON02 = 3.35
RVON03 = .005679
RVCOMP = RVON01 + RVON02 - RVON03
GO TO 40710
30710 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 40710, 721, 40710
40710 IF (RVCOMP - 528.16) 20710,10710,40711
40711 IF (RVCOMP - 528.26) 10710,10710,20710
10710 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 721
20710 IVFAIL = IVFAIL + 1
RVCORR = 528.21
WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR
721 CONTINUE
IVTNUM = 72
C
C **** TEST 72 ****
C
IF (ICZERO) 30720, 720, 30720
720 CONTINUE
RVON01 = 524.87
RVON02 = 3.35
RVON03 = .005679
RVCOMP = RVON01 + RVON02 * RVON03
GO TO 40720
30720 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 40720, 731, 40720
40720 IF (RVCOMP - 524.84) 20720,10720,40721
40721 IF (RVCOMP - 524.94) 10720,10720,20720
10720 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 731
20720 IVFAIL = IVFAIL + 1
RVCORR = 524.89
WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR
731 CONTINUE
IVTNUM = 73
C
C **** TEST 73 ****
C
IF (ICZERO) 30730, 730, 30730
730 CONTINUE
RVON01 = 524.87
RVON02 = 3.35
RVON03 = .005679
RVCOMP = RVON01 + RVON02 / RVON03
GO TO 40730
30730 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 40730, 741, 40730
40730 IF (RVCOMP - 1114.2) 20730,10730,40731
40731 IF (RVCOMP - 1115.2) 10730,10730,20730
10730 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 741
20730 IVFAIL = IVFAIL + 1
RVCORR = 1114.8
WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR
741 CONTINUE
IVTNUM = 74
C
C **** TEST 74 ****
C
IF (ICZERO) 30740, 740, 30740
740 CONTINUE
RVON01 = 524.87
RVON02 = 3.35
IVON01 = 7
RVCOMP = RVON01 + RVON02 ** IVON01
GO TO 40740
30740 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 40740, 751, 40740
40740 IF (RVCOMP - 5259.3) 20740,10740,40741
40741 IF (RVCOMP - 5260.3) 10740,10740,20740
10740 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 751
20740 IVFAIL = IVFAIL + 1
RVCORR = 5259.8
WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR
751 CONTINUE
C
C TESTS 75 THROUGH 78 CHECK RV1 - RV2 <OP2> RV3
C
IVTNUM = 75
C
C **** TEST 75 ****
C
IF (ICZERO) 30750, 750, 30750
750 CONTINUE
RVON01 = 524.87
RVON02 = 3.35
RVON03 = .5679
RVCOMP = RVON01 - RVON02 + RVON03
GO TO 40750
30750 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 40750, 761, 40750
40750 IF (RVCOMP - 522.03) 20750,10750,40751
40751 IF (RVCOMP - 522.13) 10750,10750,20750
10750 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 761
20750 IVFAIL = IVFAIL + 1
RVCORR = 522.09
WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR
761 CONTINUE
IVTNUM = 76
C
C **** TEST 76 ****
C
IF (ICZERO) 30760, 760, 30760
760 CONTINUE
RVON01 = 524.87
RVON02 = 3.35
RVON03 = .5679
RVCOMP = RVON01 - RVON02 * RVON03
GO TO 40760
30760 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 40760, 771, 40760
40760 IF (RVCOMP - 522.92) 20760,10760,40761
40761 IF (RVCOMP - 523.02) 10760,10760,20760
10760 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 771
20760 IVFAIL = IVFAIL + 1
RVCORR = 522.97
WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR
771 CONTINUE
IVTNUM = 77
C
C **** TEST 77 ****
C
IF (ICZERO) 30770, 770, 30770
770 CONTINUE
RVON01 = 524.87
RVON02 = 3.35
RVON03 = .5679
RVCOMP = RVON01 - RVON02 / RVON03
GO TO 40770
30770 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 40770, 781, 40770
40770 IF (RVCOMP - 518.92) 20770,10770,40771
40771 IF (RVCOMP - 519.02) 10770,10770,20770
10770 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 781
20770 IVFAIL = IVFAIL + 1
RVCORR = 518.97
WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR
781 CONTINUE
IVTNUM = 78
C
C **** TEST 78 ****
C
IF (ICZERO) 30780, 780, 30780
780 CONTINUE
RVON01 = 524.87
RVON02 = 3.35
IVON01 = 7
RVCOMP = RVON01 - RVON02 ** IVON01
GO TO 40780
30780 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 40780, 791, 40780
40780 IF (RVCOMP + 4210.6) 20780,10780,40781
40781 IF (RVCOMP + 4209.6) 10780,10780,20780
10780 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 791
20780 IVFAIL = IVFAIL + 1
RVCORR = -4210.1
WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR
791 CONTINUE
C
C TESTS 79 THROUGH 82 CHECK RV1 * RV2 <OP2> RV3
C
IVTNUM = 79
C
C **** TEST 79 ****
C
IF (ICZERO) 30790, 790, 30790
790 CONTINUE
RVON01 = 524.87
RVON02 = .5679
RVON03 = 3.35
RVCOMP = RVON01 * RVON02 + RVON03
GO TO 40790
30790 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 40790, 801, 40790
40790 IF (RVCOMP - 301.37) 20790,10790,40791
40791 IF (RVCOMP - 301.47) 10790,10790,20790
10790 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 801
20790 IVFAIL = IVFAIL + 1
RVCORR = 301.42
WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR
801 CONTINUE
IVTNUM = 80
C
C **** TEST 80 ****
C
IF (ICZERO) 30800, 800, 30800
800 CONTINUE
RVON01 = 524.87
RVON02 = .5679
RVON03 = 3.35
RVCOMP = RVON01 * RVON02 - RVON03
GO TO 40800
30800 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 40800, 811, 40800
40800 IF (RVCOMP - 294.67) 20800,10800,40801
40801 IF (RVCOMP - 294.77) 10800,10800,20800
10800 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 811
20800 IVFAIL = IVFAIL + 1
RVCORR = 294.72
WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR
811 CONTINUE
IVTNUM = 81
C
C **** TEST 81 ****
C
IF (ICZERO) 30810, 810, 30810
810 CONTINUE
RVON01 = 524.87
RVON02 = .5679
RVON03 = 3.35
RVCOMP = RVON01 * RVON02 / RVON03
GO TO 40810
30810 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 40810, 821, 40810
40810 IF (RVCOMP - 88.92) 20810,10810,40811
40811 IF (RVCOMP - 89.02) 10810,10810,20810
10810 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 821
20810 IVFAIL = IVFAIL + 1
RVCORR = 88.977
WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR
821 CONTINUE
IVTNUM = 82
C
C **** TEST 82 ****
C
IF (ICZERO) 30820, 820, 30820
820 CONTINUE
RVON01 = 524.87
RVON02 = .5679
IVON01 = 7
RVCOMP = RVON01 * RVON02 ** IVON01
GO TO 40820
30820 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 40820, 831, 40820
40820 IF (RVCOMP - 9.94) 20820,10820,40821
40821 IF (RVCOMP - 10.04) 10820,10820,20820
10820 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 831
20820 IVFAIL = IVFAIL + 1
RVCORR = 9.999
WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR
831 CONTINUE
C
C TESTS 83 THROUGH 86 CHECK RV1 / RV2 <OP2> RV3
C
IVTNUM = 83
C
C **** TEST 83 ****
C
IF (ICZERO) 30830, 830, 30830
830 CONTINUE
RVON01 = 524.87
RVON02 = 3.35
RVON03 = .5679
RVCOMP = RVON01 / RVON02 + RVON03
GO TO 40830
30830 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 40830, 841, 40830
40830 IF (RVCOMP - 157.19) 20830,10830,40831
40831 IF (RVCOMP - 157.29) 10830,10830,20830
10830 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 841
20830 IVFAIL = IVFAIL + 1
RVCORR = 157.25
WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR
841 CONTINUE
IVTNUM = 84
C
C **** TEST 84 ****
C
IF (ICZERO) 30840, 840, 30840
840 CONTINUE
RVON01 = 524.87
RVON02 = 3.35
RVON03 = .8507
RVCOMP = RVON01 / RVON02 - RVON03
GO TO 40840
30840 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 40840, 851, 40840
40840 IF (RVCOMP - 155.77) 20840,10840,40841
40841 IF (RVCOMP - 155.87) 10840,10840,20840
10840 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 851
20840 IVFAIL = IVFAIL + 1
RVCORR = 155.83
WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR
851 CONTINUE
IVTNUM = 85
C
C **** TEST 85 ****
C
IF (ICZERO) 30850, 850, 30850
850 CONTINUE
RVON01 = 524.87
RVON02 = 3.35
RVON03 = .8507
RVCOMP = RVON01 / RVON02 * RVON03
GO TO 40850
30850 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 40850, 861, 40850
40850 IF (RVCOMP - 132.7) 20850,10850,40851
40851 IF (RVCOMP - 133.7) 10850,10850,20850
10850 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 861
20850 IVFAIL = IVFAIL + 1
RVCORR = 133.29
WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR
861 CONTINUE
IVTNUM = 86
C
C **** TEST 86 ****
C
IF (ICZERO) 30860, 860, 30860
860 CONTINUE
RVON01 = 524.87
RVON02 = 3.35
IVON01 = 7
RVCOMP = RVON01 / RVON02 ** IVON01
GO TO 40860
30860 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 40860, 871, 40860
40860 IF (RVCOMP - .106) 20860,10860,40861
40861 IF (RVCOMP - .116) 10860,10860,20860
10860 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 871
20860 IVFAIL = IVFAIL + 1
RVCORR = .11085
WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR
871 CONTINUE
C
C TESTS 87 THROUGH 90 CHECK RV1 ** IV1 <OP2> RV2
C
IVTNUM = 87
C
C **** TEST 87 ****
C
IF (ICZERO) 30870, 870, 30870
870 CONTINUE
RVON01 = 3.35
IVON01 = 7
RVON02 = 524.87
RVCOMP = RVON01 ** IVON01 + RVON02
GO TO 40870
30870 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 40870, 881, 40870
40870 IF (RVCOMP - 5210.) 20870,10870,40871
40871 IF (RVCOMP - 5310.) 10870,10870,20870
10870 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 881
20870 IVFAIL = IVFAIL + 1
RVCORR = 5259.8
WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR
881 CONTINUE
IVTNUM = 88
C
C **** TEST 88 ****
C
IF (ICZERO) 30880, 880, 30880
880 CONTINUE
RVON01 = 3.35
IVON01 = 7
RVON02 = 524.87
RVCOMP = RVON01 ** IVON01 - RVON02
GO TO 40880
30880 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 40880, 891, 40880
40880 IF (RVCOMP - 4160.) 20880,10880,40881
40881 IF (RVCOMP - 4260.) 10880,10880,20880
10880 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 891
20880 IVFAIL = IVFAIL + 1
RVCORR = 4210.1
WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR
891 CONTINUE
IVTNUM = 89
C
C **** TEST 89 ****
C
IF (ICZERO) 30890, 890, 30890
890 CONTINUE
RVON01 = 3.35
IVON01 = 7
RVON02 = 524.87
RVCOMP = RVON01 ** IVON01 * RVON02
GO TO 40890
30890 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 40890, 901, 40890
40890 IF (RVCOMP - 2.43E6) 20890,10890,40891
40891 IF (RVCOMP - 2.53E6) 10890,10890,20890
10890 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 901
20890 IVFAIL = IVFAIL + 1
RVCORR = 2.4852E6
WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR
901 CONTINUE
IVTNUM = 90
C
C **** TEST 90 ****
C
IF (ICZERO) 30900, 900, 30900
900 CONTINUE
RVON01 = 3.35
IVON01 = 7
RVON02 = 524.87
RVCOMP = RVON01 ** IVON01 / RVON02
GO TO 40900
30900 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 40900, 911, 40900
40900 IF (RVCOMP - 8.97) 20900,10900,40901
40901 IF (RVCOMP - 9.07) 10900,10900,20900
10900 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 911
20900 IVFAIL = IVFAIL + 1
RVCORR = 9.0211
WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR
911 CONTINUE
C
C TESTS 91 AND 92 CHECK ALL ARITHMETIC OPERATORS USED TOGETHER
C
IVTNUM = 91
C
C **** TEST 91 ****
C
IF (ICZERO) 30910, 910, 30910
910 CONTINUE
RVON01 = 780.56
RVON02 = .803
RVON03 = 3.35
IVON01 = 7
RVON04 = 20.07
RVON05 = 511.9
RVCOMP = - RVON01 + RVON02 * RVON03 ** IVON01 / RVON04 - RVON05
GO TO 40910
30910 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 40910, 921, 40910
40910 IF (RVCOMP + 1113.0) 20910,10910,40911
40911 IF (RVCOMP + 1093.0) 10910,10910,20910
10910 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 921
20910 IVFAIL = IVFAIL + 1
RVCORR = -1103.0
WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR
921 CONTINUE
IVTNUM = 92
C
C **** TEST 92 ****
C
IF (ICZERO) 30920, 920, 30920
920 CONTINUE
RVON01 = 780.56
RVON02 = .803
RVON03 = 3.35
IVON01 = 7
RVON04 = 20.07
RVON05 = 511.9
RVCOMP = (-RVON01) + (RVON02 * RVON03) ** IVON01 / (RVON04-RVON05)
GO TO 40920
30920 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 40920, 931, 40920
40920 IF (RVCOMP + 788.) 20920,10920,40921
40921 IF (RVCOMP + 777.) 10920,10920,20920
10920 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 931
20920 IVFAIL = IVFAIL + 1
RVCORR = -782.63
WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR
931 CONTINUE
C
C WRITE PAGE FOOTINGS AND RUN SUMMARIES
99999 CONTINUE
WRITE (I02,90002)
WRITE (I02,90006)
WRITE (I02,90002)
WRITE (I02,90002)
WRITE (I02,90007)
WRITE (I02,90002)
WRITE (I02,90008) IVFAIL
WRITE (I02,90009) IVPASS
WRITE (I02,90010) IVDELE
C
C
C TERMINATE ROUTINE EXECUTION
STOP
C
C FORMAT STATEMENTS FOR PAGE HEADERS
90000 FORMAT (1H1)
90002 FORMAT (1H )
90001 FORMAT (1H ,10X,34HFORTRAN COMPILER VALIDATION SYSTEM)
90003 FORMAT (1H ,21X,11HVERSION 1.0)
90004 FORMAT (1H ,10X,38HFOR OFFICIAL USE ONLY - COPYRIGHT 1978)
90005 FORMAT (1H ,5X,4HTEST,5X,9HPASS/FAIL, 5X,8HCOMPUTED,8X,7HCORRECT)
90006 FORMAT (1H ,5X,46H----------------------------------------------)
90011 FORMAT (1H ,18X,17HSUBSET LEVEL TEST)
C
C FORMAT STATEMENTS FOR RUN SUMMARIES
90008 FORMAT (1H ,15X,I5,19H ERRORS ENCOUNTERED)
90009 FORMAT (1H ,15X,I5,13H TESTS PASSED)
90010 FORMAT (1H ,15X,I5,14H TESTS DELETED)
C
C FORMAT STATEMENTS FOR TEST RESULTS
80001 FORMAT (1H ,4X,I5,7X,4HPASS)
80002 FORMAT (1H ,4X,I5,7X,4HFAIL)
80003 FORMAT (1H ,4X,I5,7X,7HDELETED)
80004 FORMAT (1H ,4X,I5,7X,4HFAIL,10X,I6,9X,I6)
80005 FORMAT (1H ,4X,I5,7X,4HFAIL,4X,E12.5,3X,E12.5)
C
90007 FORMAT (1H ,20X,20HEND OF PROGRAM FM062)
END
*END-OF,FM062
FM080.f 480976073 170 2 100666 21805 `
*HEADER,FORTR,FM080
*FILES1,FORTR,FM080
C COMMENT SECTION
C
C FM080
C
C THIS ROUTINE CONTAINS EXTERNAL FUNCTION REFERENCE TESTS.
C THE FUNCTION SUBPROGRAMS CALLED BY THIS ROUTINE ARE FF081,
C FF082 AND FF083. THE FUNCTION SUBPROGRAMS ARE DEFINED AS
C FF081 = INTEGER, FF082 = REAL, FF083 = IMPLICIT REAL.
C THE FUNCTION SUBPROGRAM DUMMY ARGUMENTS MUST AGREE IN ORDER,
C NUMBER AND TYPE WITH THE CORRESPONDING ACTUAL ARGUMENTS OF THE
C MAIN PROGRAM. THE ARGUMENTS OF THE FUNCTION SUBPROGRAMS WILL
C CORRESPOND TO ACTUAL ARGUMENT LIST REFERENCES OF VARIABLE-NAME,
C ARRAY-NAME, ARRAY-ELEMENT-NAME AND EXPRESSION RESPECTIVELY.
C
C THIS ROUTINE WILL TEST THE VALUE OF THE FUNCTION AND THE
C FUNCTION ARGUMENTS RETURNED FOLLOWING THE FUNCTION REFERENCE CALL.
C
C
C REFERENCES
C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN,
C X3.9-1978
C
C SECTION 2.6, ARRAY
C SECTION 15.5.2, REFERENCING EXTERNAL FUNCTIONS
C SECTION 17.2, EVENTS THAT CAUSE ENTITIES TO BECOME DEFINED
DIMENSION IADN1A (5), IADN2A (4,4)
DIMENSION RADN3A (3,6,3), RADN1A (10)
DIMENSION IADN3A (3,4,5)
INTEGER FF081
REAL FF082
C
C **********************************************************
C
C A COMPILER VALIDATION SYSTEM FOR THE FORTRAN LANGUAGE
C BASED ON SPECIFICATIONS AS DEFINED IN AMERICAN NATIONAL STANDARD
C PROGRAMMING LANGUAGE FORTRAN X3.9-1978, HAS BEEN DEVELOPED BY THE
C FEDERAL COBOL COMPILER TESTING SERVICE. THE FORTRAN COMPILER
C VALIDATION SYSTEM (FCVS) CONSISTS OF AUDIT ROUTINES, THEIR RELATED
C DATA, AND AN EXECUTIVE SYSTEM. EACH AUDIT ROUTINE IS A FORTRAN
C PROGRAM, SUBPROGRAM OR FUNCTION WHICH INCLUDES TESTS OF SPECIFIC
C LANGUAGE ELEMENTS AND SUPPORTING PROCEDURES INDICATING THE RESULT
C OF EXECUTING THESE TESTS.
C
C THIS PARTICULAR PROGRAM/SUBPROGRAM/FUNCTION CONTAINS FEATURES
C FOUND ONLY IN THE SUBSET AS DEFINED IN X3.9-1978.
C
C SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO -
C
C DEPARTMENT OF THE NAVY
C FEDERAL COBOL COMPILER TESTING SERVICE
C WASHINGTON, D.C. 20376
C
C **********************************************************
C
C
C
C INITIALIZATION SECTION
C
C INITIALIZE CONSTANTS
C **************
C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER.
I01 = 5
C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER.
I02 = 6
C SYSTEM ENVIRONMENT SECTION
C
CX010 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-010 CONTROL CARD.
C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5
C (UNIT NUMBER FOR CARD READER).
CX011 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-011 CONTROL CARD.
C THE CX011 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL
C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX010 ABOVE.
C
CX020 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-020 CONTROL CARD.
C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02 = 6
C (UNIT NUMBER FOR PRINTER).
CX021 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-021 CONTROL CARD.
C THE CX021 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL
C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX020 ABOVE.
C
IVPASS=0
IVFAIL=0
IVDELE=0
ICZERO=0
C
C WRITE PAGE HEADERS
WRITE (I02,90000)
WRITE (I02,90001)
WRITE (I02,90002)
WRITE (I02, 90002)
WRITE (I02,90003)
WRITE (I02,90002)
WRITE (I02,90004)
WRITE (I02,90002)
WRITE (I02,90011)
WRITE (I02,90002)
WRITE (I02,90002)
WRITE (I02,90005)
WRITE (I02,90006)
WRITE (I02,90002)
C
C TEST SECTION
C
C EXTERNAL FUNCTION REFERENCE - FUNCTION SUBPROGRAM DEFINED AS
C INTEGER (FF081)
C
6741 CONTINUE
IVTNUM = 674
C
C TEST 674 THROUGH 679 TEST THE FUNCTION AND ARGUMENT VALUES
C FROM REFERENCE OF FUNCTION FF081. FUNCTION SUBPROGRAM FF081 IS
C DEFINED AS INTEGER.
C
C **** TEST 674 ****
C
C TEST 674 TESTS THE FUNCTION VALUE RETURNED FROM FUNCTION FF081
C
IF (ICZERO) 36740,6740,36740
6740 CONTINUE
IVON0A = 0
IVON02 = 2
IADN1A (3) = 8
IADN1A (2) = 4
IADN2A (1,3) =10
IVON0A = FF081 (IVON02, IADN1A, IADN2A, 999)
GO TO 46740
36740 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 46740,6751,46740
46740 IF (IVON0A - 1015) 26740,16740,26740
16740 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 6751
26740 IVFAIL = IVFAIL + 1
IVCORR = 1015
IVCOMP = IVON0A
WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR
6751 CONTINUE
IVTNUM = 675
C
C **** TEST 675 ****
C
C TEST 675 TESTS THE RETURN VALUE OF VARIABLE-NAME ARGUMENT
C IVON02. VALUE OF IVON02 SHOULD BE 4.
C
IF (ICZERO) 36750,6750,36750
6750 CONTINUE
GO TO 46750
36750 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 46750,6761,46750
46750 IF (IVON02 - 4) 26750,16750,26750
16750 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 6761
26750 IVFAIL = IVFAIL + 1
IVCORR = 4
IVCOMP = IVON02
WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR
6761 CONTINUE
IVTNUM = 676
C
C **** TEST 676 ****
C
C TEST 676 TESTS THE RETURN VALUE OF ARRAY-NAME ARGUMENT
C IADN1A. IADN1A (2) IS INCREMENTED BY 40 IN FUNCTION SUBPROGRAM
C AND SHOULD RETURN A VALUE OF 44.
C
IF (ICZERO) 36760,6760,36760
6760 CONTINUE
GO TO 46760
36760 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 46760,6771,46760
46760 IF (IADN1A (2) - 44) 26760,16760,26760
16760 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 6771
26760 IVFAIL = IVFAIL + 1
IVCORR = 44
IVCOMP = IADN1A (2)
WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR
6771 CONTINUE
IVTNUM = 677
C
C **** TEST 677 ****
C
C TEST 677 TESTS THE RETURN VALUE OF ARRAY-NAME ARGUMENT IADN1A.
C IADN1A (3) WAS NOT MODIFFED BY FUNCTION SUBPROGRAM AND SHOULD
C HAVE A VALUE OF 8
C
IF (ICZERO) 36770,6770,36770
6770 CONTINUE
GO TO 46770
36770 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 46770,6781,46770
46770 IF (IADN1A (3) - 8) 26770,16770,26770
16770 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 6781
26770 IVFAIL = IVFAIL + 1
IVCORR = 8
IVCOMP = IADN1A (3)
WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR
6781 CONTINUE
IVTNUM = 678
C
C **** TEST 678 ****
C
C TEST 678 TESTS THE RETURN VALUE OF ARRAY-ELEMENT-NAME
C IADN2A (1,3). IADN2A (1,3) WAS INCREMENTED BY 70 IN THE FUNCTION
C SUBPROGRAM AND SHOULD CONTAIN A VALUE OF 80.
C
IF (ICZERO) 36780,6780,36780
6780 CONTINUE
GO TO 46780
36780 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 46780,6791,46780
46780 IF (IADN2A (1,3) - 80) 26780,16780,26780
16780 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 6791
26780 IVFAIL = IVFAIL + 1
IVCORR = 80
IVCOMP = IADN2A (1,3)
WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR
6791 CONTINUE
IVTNUM = 679
C
C **** TEST 679 ****
C
C TEST 679 TESTS THE VALUE OF INTEGER FUNCTION ASSIGNED
C TO A REAL VARIABLE.
C
IF (ICZERO) 36790,6790,36790
6790 CONTINUE
RVON0A = 0.0
IVON02 = 2
IADN1A (2) = 4
IADN2A (1,3) = 10
RVON0A = FF081 (IVON02, IADN1A, IADN2A, 999)
GO TO 46790
36790 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 46790,6801,46790
46790 IF (RVON0A - 1014.5) 26790,16790,46791
46791 IF (RVON0A - 1015.5) 16790,16790,26790
16790 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 6801
26790 IVFAIL = IVFAIL + 1
RVCORR = 1015.0
RVCOMP = RVON0A
WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR
6801 CONTINUE
IVTNUM = 680
C
C EXTERNAL FUNCTION REFERENCE - FUNCTION SUBPROGRAM FF082 DEFINED AS
C REAL
C
C TESTS 680 THRU 685 TESTS THE FUNCTION AND ARGUMENT VALUES
C FROM THE FUNCTION REFERENCE TO SUBPROGRAM FF082. THE FUNCTION
C SUBPROGRAM IS DEFINED AS REAL.
C
C **** TEST 680 ***
C
C TEST 680 TESTS THE VALUE OF THE FUNCTION FF082. VALUE OF
C FUNCTION SHOULD BE 339.0.
C
IF (ICZERO) 36800,6800,36800
6800 CONTINUE
RVON01 = 2.0
RADN3A (2,5,2) = 100.0
RADN1A (5) = 210.5
RVON0A = 0.0
RVON0A = FF082 (RVON01, RADN3A, RADN1A, 26.5)
GO TO 46800
36800 IVDELE = IVDELE + 1
WRITE (I02, 80003) IVTNUM
IF (ICZERO) 46800,6811,46800
46800 IF (RVON0A - 338.5) 26800,16800,46801
46801 IF (RVON0A - 339.5) 16800,16800,26800
16800 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 6811
26800 IVFAIL = IVFAIL + 1
RVCORR = 339.0
RVCOMP = RVON0A
WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR
6811 CONTINUE
IVTNUM = 681
C
C **** TEST 681 ****
C
C TEST 681 TESTS THE VALUE OF THE VARIABLE-NAME ARGUMENT RVON01
C FOLLOWING THE FUNCTION REFERENCE. VALUE OF RVON01 SHOULD BE 8.4.
C
IF (ICZERO) 36810,6810,36810
6810 CONTINUE
GO TO 46810
36810 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 46810,6821,46810
46810 IF (RVON01 - 8.395) 26810,16810,46811
46811 IF (RVON01 - 8.405) 16810,16810,26810
16810 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 6821
26810 IVFAIL = IVFAIL + 1
RVCORR = 8.4
RVCOMP = RVON01
WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR
6821 CONTINUE
IVTNUM = 682
C
C **** TEST 682 ****
C
C TEST 682 TESTS THE VALUE OF THE ARRAY-NAME ARGUMENT RADN3A
C FOLLOWING THE FUNCTION REFERENCE. RADN3A (2,5,2) WAS INITIALIZED
C IN MAIN PROGRAM AND INCREMENTED IN SUBPROGRAM. VALUE OF RADN3A
C (2,5,2) SHOULD BE 112.2.
C
IF (ICZERO) 36820,6820,36820
6820 CONTINUE
GO TO 46820
36820 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 46820,6831,46820
46820 IF (RADN3A (2,5,2) - 111.7) 26820,16820,46821
46821 IF (RADN3A (2,5,2) - 112.7) 16820,16820,26820
16820 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 6831
26820 IVFAIL = IVFAIL + 1
RVCORR = 112.2
RVCOMP = RADN3A (2,5,2)
WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR
6831 CONTINUE
IVTNUM = 683
C
C **** TEST 683 ****
C
C TEST 683 TESTS THE VALUE OF THE ARRAY-NAME ARGUMENT RADN3A
C FOLLOWING THE FUNCTION REFERENCE. RADN3A (1,2,1) WAS INITIALIZED
C IN THE SUBPROGRAM. THE VALUE OF RADN3A (1,2,1) SHOULD BE 612.2.
C
IF (ICZERO) 36830,6830,36830
6830 CONTINUE
GO TO 46830
36830 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 46830,6841,46830
46830 IF (RADN3A (1,2,1) - 611.7) 26830,16830,46831
46831 IF (RADN3A (1,2,1) - 612.7) 16830,16830,26830
16830 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 6841
26830 IVFAIL = IVFAIL + 1
RVCORR = 612.2
RVCOMP = RADN3A (1,2,1)
WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR
6841 CONTINUE
IVTNUM = 684
C
C **** TEST 684 ****
C
C TEST 684 TESTS THE VALUE OF THE ARRAY-ELEMENT-NAME ARGUMENT
C RADN1A FOLLOWING THE FUNCTION REFERENCE. RADN1A (5) WAS
C INITIALIZED IN THE MAIN PROGRAM AND INCREMENTED BY 18.8 IN THE
C FUNCTION SUBPROGRAM. THE VALUE OF RADN1A SHOULD BE 229.3.
C
IF (ICZERO) 36840,6840,36840
6840 CONTINUE
GO TO 46840
36840 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 46840,6851,46840
46840 IF (RADN1A (5) - 228.8) 26840,16840,46841
46841 IF (RADN1A (5) - 229.8) 16840,16840,26840
16840 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 6851
26840 IVFAIL = IVFAIL + 1
RVCORR = 229.3
RVCOMP = RADN1A (5)
WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR
6851 CONTINUE
IVTNUM = 685
C
C **** TEST 685 ****
C
C TEST 685 TESTS THE RESULTANT VALUE WHERE THE FUNCTION
C SUBPROGRAM IS DEFINED AS REAL AND THE VARIABLE TO WHICH THE
C FUNCTION VALUE IS ASSIGNED IN THE MAIN PROGRAM IS DEFINED AS
C INTEGER.
C
IF (ICZERO) 36850,6850,36850
6850 CONTINUE
RVON01 = 4.0
RADN3A (2,5,2) = 200.0
RADN1A (5) = 2.85
IVON0A = 0.0
IVON0A = FF082 (RVON01, RADN3A, RADN1A, 102.68)
GO TO 46850
36850 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 46850,6861,46850
46850 IF (IVON0A - 309) 26850,16850,26850
16850 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 6861
26850 IVFAIL = IVFAIL + 1
IVCORR = 309
IVCOMP = IVON0A
WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR
6861 CONTINUE
IVTNUM = 686
C
C TESTS 686 THRU 690 TESTS THE FUNCTION AND ARGUMENT VALUES
C FROM THE EXTERNAL FUNCTION REFERENCE TO SUBPROGRAM FF083. THE
C FUNCTION SUBPROGRAM IS AN IMPLICIT DEFINITION OF REAL.
C
C ***** TEST 686 *****
C
C TEST 686 TESTS THE VALUE OF FUNCTION FF082. THE VALUE OF THE
C FUNCTION SHOULD BE 921.8.
C
IF (ICZERO) 36860,6860,36860
6860 CONTINUE
C
C
IVON01 = 826
IADN2A (1,1) = 77
IADN3A (2,3,4) = 10
RVON02 = 4.4
RVON03 = 0.0
C
RVON03 = FF083 (IVON01, IADN2A, IADN3A, RVON02 * 2.0)
GO TO 46860
36860 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 46860,6871,46860
46860 IF (RVON03 - 921.3) 26860,16860,46861
46861 IF (RVON03 - 922.3) 16860,16860,26860
16860 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 6871
26860 IVFAIL = IVFAIL + 1
RVCORR = 921.8
RVCOMP = RVON03
WRITE (I02,80005) IVTNUM, RVCOMP, IVCORR
6871 CONTINUE
IVTNUM = 687
C
C **** TEST 687 *****
C
C TEST 687 TESTS THE VALUE OF THE VARIABLE-NAME ARGUMENT IVON01
C FOLLOWING THE FUNCTION REFERENCE. THE VALUE OF IVON01 SHOULD BE
C 836.
C
IF (ICZERO) 36870,6870,36870
6870 CONTINUE
GO TO 46870
36870 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 46870,6881,46870
46870 IF (IVON01 - 836) 26870,16870,26870
16870 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 6881
26870 IVFAIL = IVFAIL + 1
IVCORR = 836
IVCOMP = IVON01
WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR
6881 CONTINUE
IVTNUM = 688
C
C **** TEST 688 *****
C
C TEST 688 TESTS THE VALUE OF THE ARRAY-NAME ARGUMENT IADN2A
C FOLLOWING THE FUNCTION REFERENCE. THE ACTUAL ARGUMENT WAS
C INITIALIZED IN THE MAIN PROGRAM AND IS INCREMENTED IN THE
C SUBPROGRAM. THE VALUE OF IADN2A (1,1) SHOULD BE 97.
C
IF (ICZERO) 36880,6880,36880
6880 CONTINUE
GO TO 46880
36880 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 46880,6880,46880
46880 IF (IADN2A (1,1) - 97) 26880,16880,26880
16880 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 6891
26880 IVFAIL = IVFAIL + 1
IVCORR = 97
IVCOMP = IADN2A (1,1)
WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR
6891 CONTINUE
IVTNUM = 689
C
C **** TEST 689 ****
C
C TEST 689 TESTS THE VALUE OF THE ARRAY-ELEMENT-NAME ARGUMENT
C IADN3A FOLLOWING THE FUNCTION REFERENCE. IADN3A (2,3,4)
C WAS INTIALIZED IN THE MAIN PROGRAM AND INCREMENTED BY 40 IN THE
C FUNCTION SUBPROGRAM. THE VALUE OF IADN3A SHOULD BE 50.
C
IF (ICZERO) 36890,6890,36890
6890 CONTINUE
GO TO 46890
36890 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 46890,6901,46890
46890 IF (IADN3A (2,3,4) - 50) 26890,16890,26890
16890 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 6901
26890 IVFAIL = IVFAIL + 1
IVCORR = 50
IVCOMP = IADN3A (2,3,4)
WRITE (I02,80004) IVTNUM,IVCOMP,IVCORR
6901 CONTINUE
IVTNUM = 690
C
C **** TEST 690 ****
C
C TEST 690 TESTS THE RESULTANT VALUE WHERE THE FUNCTION
C SUBPROGRAM IS IMPLICITY DEFINED AS REAL AND THE VARIABLE
C TO WHICH THE FUNCTION VALUE IS ASSIGNED IN THE MAIN PROGRAM
C IS DEFINED AS INTEGER. THE VALUE OF IVON03 SHOULD BE 329.
C
IF (ICZERO) 36900,6900,36900
6900 CONTINUE
IVON01 = 226
IADN2A (1,1) = 66
IADN3A (2,3,4) = 20
RVON02 = 8.8
IVON03 = 0
C
IVON03 = FF083 (IVON01,IADN2A,IADN3A,RVON02 * 2.0)
C
GO TO 46900
36900 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 46900,6911,46900
46900 IF (IVON03 - 329) 26900,16900,26900
16900 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 6911
26900 IVFAIL = IVFAIL + 1
IVCORR = 329
IVCOMP = IVON03
WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR
6911 CONTINUE
C
C WRITE PAGE FOOTINGS AND RUN SUMMARIES
99999 CONTINUE
WRITE (I02,90002)
WRITE (I02,90006)
WRITE (I02,90002)
WRITE (I02,90002)
WRITE (I02,90007)
WRITE (I02,90002)
WRITE (I02,90008) IVFAIL
WRITE (I02,90009) IVPASS
WRITE (I02,90010) IVDELE
C
C
C TERMINATE ROUTINE EXECUTION
STOP
C
C FORMAT STATEMENTS FOR PAGE HEADERS
90000 FORMAT (1H1)
90002 FORMAT (1H )
90001 FORMAT (1H ,10X,34HFORTRAN COMPILER VALIDATION SYSTEM)
90003 FORMAT (1H ,21X,11HVERSION 1.0)
90004 FORMAT (1H ,10X,38HFOR OFFICIAL USE ONLY - COPYRIGHT 1978)
90005 FORMAT (1H ,5X,4HTEST,5X,9HPASS/FAIL, 5X,8HCOMPUTED,8X,7HCORRECT)
90006 FORMAT (1H ,5X,46H----------------------------------------------)
90011 FORMAT (1H ,18X,17HSUBSET LEVEL TEST)
C
C FORMAT STATEMENTS FOR RUN SUMMARIES
90008 FORMAT (1H ,15X,I5,19H ERRORS ENCOUNTERED)
90009 FORMAT (1H ,15X,I5,13H TESTS PASSED)
90010 FORMAT (1H ,15X,I5,14H TESTS DELETED)
C
C FORMAT STATEMENTS FOR TEST RESULTS
80001 FORMAT (1H ,4X,I5,7X,4HPASS)
80002 FORMAT (1H ,4X,I5,7X,4HFAIL)
80003 FORMAT (1H ,4X,I5,7X,7HDELETED)
80004 FORMAT (1H ,4X,I5,7X,4HFAIL,10X,I6,9X,I6)
80005 FORMAT (1H ,4X,I5,7X,4HFAIL,4X,E12.5,3X,E12.5)
C
90007 FORMAT (1H ,20X,20HEND OF PROGRAM FM080)
END
*HEADER,FORTR,FM080,SUBRTN,FM081
INTEGER FUNCTION FF081 (IDON01, IDDN10, IDDN20, IDON02)
C
C COMMENT SECTION
C
C FF081
C
C THIS FUNCTION SUBPROGRAM IS CALLED BY THE MAIN PROGRAM FM080.
C THE FUNCTION DUMMY ARGUMENTS IDON01, IDDN10 AND IDDN20 ARE
C INCREMENTED BY 2, 40 AND 70 RESPECTIVELY BEFORE CONTROL IS
C RETURNED TO THE CALLING PROGRAM. VALUE OF THE FUNCTION WILL BE
C THE SUM OF THE ACTUAL ARGUMENTS AS PASSED FROM CALLING PROGRAM.
C
C REFERENCES
C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN,
C X3.9-1978
C
C SECTION 15.5.1, FUNCTION SUBPROGRAM AND FUNCTION STATEMENT
C
C TEST SECTION
C
C FUNCTION SUBPROGRAM
C
DIMENSION IDDN10 (5), IDDN20 (4,4)
IVON01 = IDON01
IVON02 = IDDN10(2)
IVON03 = IDDN20(1,3)
IVON04 = IDON02
C
FF081 = IVON01 + IVON02 + IVON03 + IVON04
IDON01 = IVON01 + 2
IDDN10 (2) = IVON02 + 40
IDDN20 (1,3) = IVON03 + 70
IDDN10 (4) = IVON02 + 40
RETURN
END
*HEADER,FORTR,FM080,SUBRTN,FM082
REAL FUNCTION FF082 (RDON01, RDDN3A, RDDN1A, RDON02)
DIMENSION RDDN3A (3,6,3), RDDN1A (10)
C
C COMMENT SECTION
C
C FF082
C
C THIS FUNCTION SUBPROGRAM IS CALLED BY THE MAIN PROGRAM FM080.
C THE FUNCTION DUMMY ARGUMENTS RDON01, RDDN3A, AND RDDN1A ARE
C INCREMENTED BY 6.4, 12.2 AND 18.8 RESPECTIVELY BEFORE CONTROL IS
C RETURNED TO THE MAIN PROGRAM. VALUE OF THE FUNCTION WILL BE
C THE SUM OF THE ACTUAL ARGUMENTS AS PASSED TO THE SUBPROGRAM.
C
C REFERENCES
C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN,
C X3.9-1978
C
C SECTION 15.5.1, FUNCTION SUBPROGRAM AND FUNCTION STATEMENT
C
C TEST SECTION
C
C FUNCTION SUBPROGRAM
C
RVON01 = RDON01
RVON02 = RDDN3A (2,5,2)
RVON03 = RDDN1A (5)
RVON04 = RDON02
C
FF082 = RVON01 + RVON02 + RVON03 + RVON04
C
RDON01 = RVON01 + 6.4
RDDN3A (2,5,2) = RVON02 + 12.2
RDDN1A (5) = RVON03 + 18.8
RDDN3A (1,2,1) = 600.0 + 12.2
RETURN
END
*HEADER,FORTR,FM080,SUBRTN,FM083
FUNCTION FF083 (IDON01,IDDN2A,IDDN3A,RDON02)
DIMENSION IDDN2A (2,2), IDDN3A(3,4,5)
C
C COMMENT SECTION
C
C FF083
C
C THIS FUNCTION SUBPROGRAM IS CALLED BY THE MAIN PROGRAM FM080.
C THE TYPE DECLARATION IS IMPLICIT REAL.
C THE FUNCTION DUMMY ARGUMENTS ARE BOTH INTEGER AND REAL. DUMMY
C ARGUMENTS IDON01, IDDN2A AND IDDN3A ARE INCREMENTED BY 10, 20 AND
C 40 RESPECTIVELY BEFORE CONTROL IS RETURNED TO THE MAIN PROGRAM.
C THE VALUE OF THE FUNCTION RETURNED TO THE REFERENCING PROGRAM
C WILL BE THE SUM OF THE ACTUAL ARGUMENTS AS PASSED TO THE
C SUBPROGRAM FF083.
C DUMMY ARGUMENT IDDN2A CORRESPONDS TO AN ARRAY-NAME IN THE
C ACTUAL ARGUMENT OF THE MAIN PROGRAM. DUMMY ARGUMENT IDDN3A
C CORRESPONDS TO AN ARRAY-ELEMENT-NAME IN THE ACTUAL ARGUMENT OF THE
C MAIN PROGRAM. DUMMY ARGUMENT IDON02 CORRESPONDS TO AN EXPRESSION
C CONTAINING VARIABLES,ARITHMETIC OPERATORS AND CONSTANTS IN THE
C ACTUAL ARGUMENT OF THE MAIN PROGRAM.
C
C REFERENCES
C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN,
C X3.9-1978
C
C SECTION 4.1.2, TYPE RULES FOR DATA AND PROCEDURE IDENTIFIERS
C SECTION 15.5.1, FUNCTION SUBPROGRAM
C
C TEST SECTION
C
C FUNCTION SUBPROGRAM
C
IVON01 = IDON01
IVON02 = IDDN2A (1,1)
IVON03 = IDDN3A (2,3,4)
RVON04 = RDON02
C
RVON05 = IVON01 + IVON02 + IVON03
FF083 = RVON05 + RVON04
C
IDON01 = IVON01 + 10
IDDN2A (1,1) = IVON02 + 20
IDDN3A (2,3,4) = IVON03 + 40
C
RETURN
END
*END-OF,FM080
FM097.f 480976076 170 2 100666 24662 `
*HEADER,FORTR,FM097
*FILES1,FORTR,FM097,X
C COMMENT SECTION
C
C FM097
C
C THIS ROUTINE TESTS INTRINSIC FUNCTIONS WHERE THE FUNCTION TYPE IS
C REAL AND THE ARGUMENTS ARE EITHER INTEGER OR REAL. THE REAL AND
C INTEGER VARIABLES AND THE REAL AND INTEGER CONSTANTS CONTAIN BOTH
C POSITIVE AND NEGATIVE VALUES. THE INTRINSIC FUNCTIONS TESTED BY
C FM097 INCLUDE
C TYPE OF
C INTRINSIC FUNCTION NAME ARGUMENT FUNCTION
C ------------------ ---- -------- --------
C ABSOLUTE VALUE ABS REAL REAL
C TRUNCATION AINT REAL REAL
C REMAINDERING AMOD REAL REAL
C CHOOSING LARGEST VALUE AMAX0 INTEGER REAL
C AMAX1 REAL REAL
C CHOOSING SMALLEST VALUE AMIN0 INTEGER REAL
C AMIN1 REAL REAL
C FLOAT FLOAT INTEGER REAL
C TRANSFER OF SIGN SIGN REAL REAL
C POSITIVE DIFFERENCE DIM REAL REAL
C
C REFERENCES
C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN,
C X3.9-1978
C
C SECTION 4.1.2, TYPE RULES FOR DATA AND PROCEDURE IDENTIFIERS
C SECTION 15.3, INTRINSIC FUNCTION
C SECTION 15.3.2, INTRINSIC FUNCTIONS AND THEIR REFERENCE
C
C
C **********************************************************
C
C A COMPILER VALIDATION SYSTEM FOR THE FORTRAN LANGUAGE
C BASED ON SPECIFICATIONS AS DEFINED IN AMERICAN NATIONAL STANDARD
C PROGRAMMING LANGUAGE FORTRAN X3.9-1978, HAS BEEN DEVELOPED BY THE
C FEDERAL COBOL COMPILER TESTING SERVICE. THE FORTRAN COMPILER
C VALIDATION SYSTEM (FCVS) CONSISTS OF AUDIT ROUTINES, THEIR RELATED
C DATA, AND AN EXECUTIVE SYSTEM. EACH AUDIT ROUTINE IS A FORTRAN
C PROGRAM, SUBPROGRAM OR FUNCTION WHICH INCLUDES TESTS OF SPECIFIC
C LANGUAGE ELEMENTS AND SUPPORTING PROCEDURES INDICATING THE RESULT
C OF EXECUTING THESE TESTS.
C
C THIS PARTICULAR PROGRAM/SUBPROGRAM/FUNCTION CONTAINS FEATURES
C FOUND ONLY IN THE SUBSET AS DEFINED IN X3.9-1978.
C
C SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO -
C
C DEPARTMENT OF THE NAVY
C FEDERAL COBOL COMPILER TESTING SERVICE
C WASHINGTON, D.C. 20376
C
C **********************************************************
C
C
C
C INITIALIZATION SECTION
C
C INITIALIZE CONSTANTS
C **************
C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER.
I01 = 5
C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER.
I02 = 6
C SYSTEM ENVIRONMENT SECTION
C
CX010 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-010 CONTROL CARD.
C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5
C (UNIT NUMBER FOR CARD READER).
CX011 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-011 CONTROL CARD.
C THE CX011 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL
C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX010 ABOVE.
C
CX020 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-020 CONTROL CARD.
C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02 = 6
C (UNIT NUMBER FOR PRINTER).
CX021 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-021 CONTROL CARD.
C THE CX021 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL
C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX020 ABOVE.
C
IVPASS=0
IVFAIL=0
IVDELE=0
ICZERO=0
C
C WRITE PAGE HEADERS
WRITE (I02,90000)
WRITE (I02,90001)
WRITE (I02,90002)
WRITE (I02, 90002)
WRITE (I02,90003)
WRITE (I02,90002)
WRITE (I02,90004)
WRITE (I02,90002)
WRITE (I02,90011)
WRITE (I02,90002)
WRITE (I02,90002)
WRITE (I02,90005)
WRITE (I02,90006)
WRITE (I02,90002)
C
C TEST SECTION
C
C TEST 875 THROUGH TEST 878 CONTAIN INTRINSIC FUNCTION TESTS FOR
C ABSOLUTE VALUE WHERE ARGUMENT AND FUNCTION ARE REAL
C
IVTNUM = 875
C
C **** TEST 875 ****
C
IF (ICZERO) 38750, 8750, 38750
8750 CONTINUE
RVCOMP = ABS (-38.2)
GO TO 48750
38750 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 48750, 8761, 48750
48750 IF (RVCOMP - 38.195) 28750,18750,48751
48751 IF (RVCOMP - 38.205) 18750,18750,28750
18750 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 8761
28750 IVFAIL = IVFAIL + 1
RVCORR = 38.200
WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR
8761 CONTINUE
IVTNUM = 876
C
C **** TEST 876 ****
C
IF (ICZERO) 38760, 8760, 38760
8760 CONTINUE
RVON01 = 445.06
RVCOMP = ABS (RVON01)
GO TO 48760
38760 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 48760, 8771, 48760
48760 IF (RVCOMP - 445.01) 28760,18760,48761
48761 IF (RVCOMP - 445.11) 18760,18760,28760
18760 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 8771
28760 IVFAIL = IVFAIL + 1
RVCORR = 445.06
WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR
8771 CONTINUE
IVTNUM = 877
C
C **** TEST 877 ****
C
IF (ICZERO) 38770, 8770, 38770
8770 CONTINUE
RVON01 = -32.176
RVCOMP = ABS (RVON01)
GO TO 48770
38770 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 48770, 8781, 48770
48770 IF (RVCOMP - 32.171) 28770,18770,48771
48771 IF (RVCOMP - 32.181) 18770,18770,28770
18770 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 8781
28770 IVFAIL = IVFAIL + 1
RVCORR = 32.176
WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR
8781 CONTINUE
IVTNUM = 878
C
C **** TEST 878 ****
C
IF (ICZERO) 38780, 8780, 38780
8780 CONTINUE
RVON01 = -2.2E+2
RVCOMP = ABS (RVON01)
GO TO 48780
38780 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 48780, 8791, 48780
48780 IF (RVCOMP - 219.95) 28780,18780,48781
48781 IF (RVCOMP - 220.05) 18780,18780,28780
18780 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 8791
28780 IVFAIL = IVFAIL + 1
RVCORR = 220.00
WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR
8791 CONTINUE
IVTNUM = 879
C
C **** TEST 879 ****
C
C TEST 879 THROUGH TEST 882 CONTAIN INTRINSIC FUNCTION TESTS FOR
C TRUNCATION WHERE ARGUMENT AND FUNCTION ARE REAL
C
C
IF (ICZERO) 38790, 8790, 38790
8790 CONTINUE
RVCOMP = AINT (38.2)
GO TO 48790
38790 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 48790, 8801, 48790
48790 IF (RVCOMP - 37.995) 28790,18790,48791
48791 IF (RVCOMP - 38.005) 18790,18790,28790
18790 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 8801
28790 IVFAIL = IVFAIL + 1
RVCORR = 38.000
WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR
8801 CONTINUE
IVTNUM = 880
C
C **** TEST 880 ****
C
IF (ICZERO) 38800, 8800, 38800
8800 CONTINUE
RVON01 = -445.95
RVCOMP = AINT (RVON01)
GO TO 48800
38800 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 48800, 8811, 48800
48800 IF (RVCOMP + 445.05) 28800,18800,48801
48801 IF (RVCOMP + 444.95) 18800,18800,28800
18800 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 8811
28800 IVFAIL = IVFAIL + 1
RVCORR = -445.00
WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR
8811 CONTINUE
IVTNUM = 881
C
C **** TEST 881 ****
C
IF (ICZERO) 38810, 8810, 38810
8810 CONTINUE
RVON01 = 466.01
RVCOMP = AINT (RVON01)
GO TO 48810
38810 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 48810, 8821, 48810
48810 IF (RVCOMP - 465.95) 28810,18810,48811
48811 IF (RVCOMP - 466.05) 18810,18810,28810
18810 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 8821
28810 IVFAIL = IVFAIL + 1
RVCOMP = 466.00
WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR
8821 CONTINUE
IVTNUM = 882
C
C **** TEST 882 ****
C
IF (ICZERO) 38820, 8820, 38820
8820 CONTINUE
RVON01 = 382E-1
RVCOMP = AINT (RVON01)
GO TO 48820
38820 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 48820, 8831, 48820
48820 IF (RVCOMP - 37.995) 28820,18820,48821
48821 IF (RVCOMP - 38.005) 18820,18820,28820
18820 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 8831
28820 IVFAIL = IVFAIL + 1
RVCORR = 38.000
WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR
8831 CONTINUE
C
C TEST 883 THROUGH 886 CONTAIN INTRINSIC FUNCTION TESTS FOR
C REMAINDERING WHERE ARGUMENT AND FUNCTION ARE REAL
C
IVTNUM = 883
C
C **** TEST 883 ****
C
IF (ICZERO) 38830, 8830, 38830
8830 CONTINUE
RVCOMP = AMOD (42.0,19.0)
GO TO 48830
38830 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 48830, 8841, 48830
48830 IF (RVCOMP - 3.9995) 28830,18830,48831
48831 IF (RVCOMP - 4.0005) 18830,18830,28830
18830 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 8841
28830 IVFAIL = IVFAIL + 1
RVCORR = 4.0000
WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR
8841 CONTINUE
IVTNUM = 884
C
C **** TEST 884 ****
C
IF (ICZERO) 38840, 8840, 38840
8840 CONTINUE
RVON01 = 16.27
RVON02 = 2.0
RVCOMP = AMOD (RVON01,RVON02)
GO TO 48840
38840 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 48840, 8851, 48840
48840 IF (RVCOMP - .26995) 28840,18840,48841
48841 IF (RVCOMP - .27005) 18840,18840,28840
18840 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 8851
28840 IVFAIL = IVFAIL + 1
RVCORR = .27000
WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR
8851 CONTINUE
IVTNUM = 885
C
C **** TEST 885 ****
C
IF (ICZERO) 38850, 8850, 38850
8850 CONTINUE
RVON01 = 225.0
RVON02 = 5.0E1
RVCOMP = AMOD (RVON01,RVON02)
GO TO 48850
38850 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 48850, 8861, 48850
48850 IF (RVCOMP - 24.995) 28850,18850,48851
48851 IF (RVCOMP - 25.005) 18850,18850,28850
18850 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 8861
28850 IVFAIL = IVFAIL + 1
RVCORR = 25.000
WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR
8861 CONTINUE
IVTNUM = 886
C
C **** TEST 886 ****
C
IF (ICZERO) 38860, 8860, 38860
8860 CONTINUE
RVON01 = -0.390E+2
RVON02 = 5E2
RVCOMP = AMOD (RVON01,RVON02)
GO TO 48860
38860 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 48860, 8871, 48860
48860 IF (RVCOMP + 39.005) 28860,18860,48861
48861 IF (RVCOMP + 38.995) 18860,18860,28860
18860 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 8871
28860 IVFAIL = IVFAIL + 1
RVCORR = -39.000
WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR
8871 CONTINUE
C
C TEST 887 AND 888 CONTAIN INTRINSIC FUNCTION TESTS FOR CHOOSING
C LARGEST VALUE WHERE ARGUMENTS ARE INTEGER AND FUNCTION IS REAL
C
IVTNUM = 887
C
C **** TEST 887 ****
C
IF (ICZERO) 38870, 8870, 38870
8870 CONTINUE
IVON01 = 317
IVON02 = -99
IVON03 = 1
RVCOMP = AMAX0 (263,IVON01,IVON02,IVON03)
GO TO 48870
38870 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 48870, 8881, 48870
48870 IF (RVCOMP - 316.95) 28870,18870,48871
48871 IF (RVCOMP - 317.05) 18870,18870,28870
18870 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 8881
28870 IVFAIL = IVFAIL + 1
RVCORR = 317.00
WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR
8881 CONTINUE
IVTNUM = 888
C
C **** TEST 888 ****
C
IF (ICZERO) 38880, 8880, 38880
8880 CONTINUE
IVON01 = 2572
IVON02 = 2570
RVCOMP = AMAX0 (IVON01,IVON02)
GO TO 48880
38880 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 48880, 8891, 48880
48880 IF (RVCOMP - 2571.5) 28880,18880,48881
48881 IF (RVCOMP - 2572.5) 18880,18880,28880
18880 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 8891
28880 IVFAIL = IVFAIL + 1
RVCORR = 2572.0
WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR
8891 CONTINUE
C
C TEST 889 AND 890 CONTAIN INTRINSIC FUNCTION TESTS FOR CHOOSING
C LARGEST VALUE WHERE THE ARGUMENTS AND FUNCTION ARE REAL
C
IVTNUM = 889
C
C **** TEST 889 ****
C
IF (ICZERO) 38890, 8890, 38890
8890 CONTINUE
RVON01 = .326E+2
RVON02 = 22.075
RVON03 = 76E-1
RVCOMP = AMAX1 (RVON01,RVON02,RVON03)
GO TO 48890
38890 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 48890, 8901, 48890
48890 IF (RVCOMP - 32.595) 28890,18890,48891
48891 IF (RVCOMP - 32.605) 18890,18890,28890
18890 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 8901
28890 IVFAIL = IVFAIL + 1
RVCORR = 32.600
WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR
8901 CONTINUE
IVTNUM = 890
C
C **** TEST 890 ****
C
IF (ICZERO) 38900, 8900, 38900
8900 CONTINUE
RVON01 = -6.3E2
RVON02 = -21.0
RVCOMP = AMAX1 (-463.3,RVON01,RVON02)
GO TO 48900
38900 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 48900, 8911, 48900
48900 IF (RVCOMP + 21.005) 28900,18900,48901
48901 IF (RVCOMP + 20.995) 18900,18900,28900
18900 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 8911
28900 IVFAIL = IVFAIL + 1
RVCORR = -21.000
WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR
8911 CONTINUE
C
C TESTS 891 AND 892 CONTAIN INTRINSIC FUNCTION TESTS FOR CHOOSING
C SMALLEST VALUE WHERE ARGUMENTS ARE INTEGER AND FUNCTION IS REAL
C
IVTNUM = 891
C
C **** TEST 891 ****
C
IF (ICZERO) 38910, 8910, 38910
8910 CONTINUE
IVON01 = -75
IVON02 = -243
RVCOMP = AMIN0 (IVON01,IVON02)
GO TO 48910
38910 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 48910, 8921, 48910
48910 IF (RVCOMP + 243.05) 28910,18910,48911
48911 IF (RVCOMP + 242.95) 18910,18910,28910
18910 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 8921
28910 IVFAIL = IVFAIL + 1
RVCORR = -243.00
WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR
8921 CONTINUE
IVTNUM = 892
C
C **** TEST 892 ****
C
IF (ICZERO) 38920, 8920, 38920
8920 CONTINUE
IVON01 = -11
IVON02 = 11
RVCOMP = AMIN0 (0,IVON01,IVON02)
GO TO 48920
38920 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 48920, 8931, 48920
48920 IF (RVCOMP + 11.005) 28920,18920,48921
48921 IF (RVCOMP + 10.995) 18920,18920,28920
18920 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 8931
28920 IVFAIL = IVFAIL + 1
RVCORR = -11.000
WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR
8931 CONTINUE
C
C TESTS 893 AND 894 CONTAIN INTRINSIC FUNCTION TESTS FOR CHOOSING
C SMALLEST VALUE WHERE ARGUMENTS AND FUNCTION ARE REAL
C
IVTNUM = 893
C
C **** TEST 893 ****
C
IF (ICZERO) 38930, 8930, 38930
8930 CONTINUE
RVON01 = 1.1111
RVON02 = 22.222
RVON03 = 333.33
RVCOMP = AMIN1 (RVON01,RVON02,RVON03)
GO TO 48930
38930 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 48930, 8941, 48930
48930 IF (RVCOMP - 1.1106) 28930,18930,48931
48931 IF (RVCOMP - 1.1116) 18930,18930,28930
18930 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 8941
28930 IVFAIL = IVFAIL + 1
RVCORR = 1.1111
WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR
8941 CONTINUE
IVTNUM = 894
C
C **** TEST 894 ****
C
IF (ICZERO) 38940, 8940, 38940
8940 CONTINUE
RVON01 = 28.8
RVON02 = 2.88E1
RVON03 = 288E-1
RVON04 = 35.0
RVCOMP = AMIN1 (RVON01,RVON02,RVON03,RVON04)
GO TO 48940
38940 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 48940, 8951, 48940
48940 IF (RVCOMP - 28.795) 28940,18940,48941
48941 IF (RVCOMP - 28.805) 18940,18940,28940
18940 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 8951
28940 IVFAIL = IVFAIL + 1
RVCORR = 28.800
WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR
8951 CONTINUE
C
C TEST 895 THROUGH TEST 897 CONTAIN INTRINSIC FUNCTION TESTS FOR
C FLOAT - CONVERSION OF AN INTEGER ARGUMENT TO REAL FUNCTION
C
IVTNUM = 895
C
C **** TEST 895 ****
C
IF (ICZERO) 38950, 8950, 38950
8950 CONTINUE
RVCOMP = FLOAT (-606)
GO TO 48950
38950 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 48950, 8961, 48950
48950 IF (RVCOMP + 606.05) 28950,18950,48951
48951 IF (RVCOMP + 605.95) 18950,18950,28950
18950 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 8961
28950 IVFAIL = IVFAIL + 1
RVCORR = -606.00
WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR
8961 CONTINUE
IVTNUM = 896
C
C **** TEST 896 ****
C
IF (ICZERO) 38960, 8960, 38960
8960 CONTINUE
IVON01 = 71
RVCOMP = FLOAT (IVON01)
GO TO 48960
38960 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 48960, 8971, 48960
48960 IF (RVCOMP - 70.995) 28960,18960,48961
48961 IF (RVCOMP - 71.005) 18960,18960,28960
18960 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 8971
28960 IVFAIL = IVFAIL + 1
RVCORR = 71.000
WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR
8971 CONTINUE
IVTNUM = 897
C
C **** TEST 897 ****
C
IF (ICZERO) 38970, 8970, 38970
8970 CONTINUE
IVON01 = 321
RVCOMP = FLOAT (-IVON01)
GO TO 48970
38970 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 48970, 8981, 48970
48970 IF (RVCOMP + 321.05) 28970,18970,48971
48971 IF (RVCOMP + 320.95) 18970,18970,28970
18970 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 8981
28970 IVFAIL = IVFAIL + 1
RVCORR = -321.00
WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR
8981 CONTINUE
C
C TEST 898 THROUGH TEST 900 CONTAIN INTRINSIC FUNCTION TESTS FOR
C TRANSFER OF SIGN - BOTH ARGUMENTS AND FUNCTION ARE REAL
C
IVTNUM = 898
C
C **** TEST 898 ****
C
IF (ICZERO) 38980, 8980, 38980
8980 CONTINUE
RVON01 = 64.3
RVCOMP = SIGN (RVON01,-1.0)
GO TO 48980
38980 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 48980, 8991, 48980
48980 IF (RVCOMP + 64.305) 28980,18980,48981
48981 IF (RVCOMP + 64.295) 18980,18980,28980
18980 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 8991
28980 IVFAIL = IVFAIL + 1
RVCORR = -64.300
WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR
8991 CONTINUE
IVTNUM = 899
C
C **** TEST 899 ****
C
IF (ICZERO) 38990, 8990, 38990
8990 CONTINUE
RVON01 = -2.2
RVON02 = 7.23E1
RVCOMP = SIGN (RVON01,RVON02)
GO TO 48990
38990 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 48990, 9001, 48990
48990 IF (RVCOMP - 2.1995) 28990,18990,48991
48991 IF (RVCOMP - 2.2005) 18990,18990,28990
18990 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 9001
28990 IVFAIL = IVFAIL + 1
RVCORR = 2.2000
WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR
9001 CONTINUE
IVTNUM = 900
C
C **** TEST 900 ****
C
IF (ICZERO) 39000, 9000, 39000
9000 CONTINUE
RVON01 = 35.32E+1
RVON02 = 1.0
RVCOMP = SIGN (RVON01,RVON02)
GO TO 49000
39000 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 49000, 9011, 49000
49000 IF (RVCOMP - 353.15) 29000,19000,49001
49001 IF (RVCOMP - 353.25) 19000,19000,29000
19000 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 9011
29000 IVFAIL = IVFAIL + 1
RVCORR = 353.20
WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR
9011 CONTINUE
C
C TEST 901 THROUGH TEST 904 CONTAIN INTRINSIC FUNCTION TESTS FOR
C POSITIVE DIFFERENCE WHERE ARGUMENTS AND FUNCTION ARE REAL
C
IVTNUM = 901
C
C **** TEST 901 ****
C
IF (ICZERO) 39010, 9010, 39010
9010 CONTINUE
RVON01 = 22.2
RVCOMP = DIM (RVON01,1.0)
GO TO 49010
39010 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 49010, 9021, 49010
49010 IF (RVCOMP - 21.195) 29010,19010,49011
49011 IF (RVCOMP - 21.205) 19010,19010,29010
19010 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 9021
29010 IVFAIL = IVFAIL + 1
RVCORR = 21.200
WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR
9021 CONTINUE
IVTNUM = 902
C
C **** TEST 902 ****
C
IF (ICZERO) 39020, 9020, 39020
9020 CONTINUE
RVON01 = 4.5E1
RVON02 = 41.0
RVCOMP = DIM (RVON01,RVON02)
GO TO 49020
39020 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 49020, 9031, 49020
49020 IF (RVCOMP - 3.9995) 29020,19020,49021
49021 IF (RVCOMP - 4.0005) 19020,19020,29020
19020 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 9031
29020 IVFAIL = IVFAIL + 1
RVCORR = 4.0000
WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR
9031 CONTINUE
IVTNUM = 903
C
C **** TEST 903 ****
C
IF (ICZERO) 39030, 9030, 39030
9030 CONTINUE
RVON01 = 2.0
RVON02 = 10.0
RVCOMP = DIM (RVON01,RVON02)
GO TO 49030
39030 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 49030, 9041, 49030
49030 IF (RVCOMP) 29030,19030,29030
19030 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 9041
29030 IVFAIL = IVFAIL + 1
RVCORR = 0.0000
WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR
9041 CONTINUE
IVTNUM = 904
C
C **** TEST 904 ****
C
IF (ICZERO) 39040, 9040, 39040
9040 CONTINUE
RVON01 = 1.65E+1
RVON02 = -2.0
RVCOMP = DIM (RVON01,RVON02)
GO TO 49040
39040 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 49040, 9051, 49040
49040 IF (RVCOMP - 18.495) 29040,19040,49041
49041 IF (RVCOMP - 18.505) 19040,19040,29040
19040 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 9051
29040 IVFAIL = IVFAIL + 1
RVCORR = 18.500
WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR
9051 CONTINUE
C
C TESTS 905 AND 906 CONTAIN EXPRESSIONS CONTAINING MORE THAN ONE
C INTRINSIC FUNCTION - ALL ARGUMENTS AND FUNCTIONS ARE REAL
C
IVTNUM = 905
C
C **** TEST 905 ****
C
IF (ICZERO) 39050, 9050, 39050
9050 CONTINUE
RVON01 = 33.3
RVON02 = -12.1
RVCOMP = AINT (RVON01) + ABS (RVON02)
GO TO 49050
39050 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 49050, 9061, 49050
49050 IF (RVCOMP - 45.095) 29050,19050,49051
49051 IF (RVCOMP - 45.105) 19050,19050,29050
19050 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 9061
29050 IVFAIL = IVFAIL + 1
RVCORR = 45.100
WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR
9061 CONTINUE
IVTNUM = 906
C
C **** TEST 906 ****
C
IF (ICZERO) 39060, 9060, 39060
9060 CONTINUE
RVON01 = 76.3
RVON02 = 2.1E1
RVON03 = 3E1
RVCOMP = AMAX1(RVON01,RVON02,RVON03)-AMIN1(RVON01,RVON02,RVON03)
GO TO 49060
39060 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 49060, 9071, 49060
49060 IF (RVCOMP - 55.295) 29060,19060,49061
49061 IF (RVCOMP - 55.305) 19060,19060,29060
19060 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 9071
29060 IVFAIL = IVFAIL + 1
RVCORR = 55.300
WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR
9071 CONTINUE
C
C WRITE PAGE FOOTINGS AND RUN SUMMARIES
99999 CONTINUE
WRITE (I02,90002)
WRITE (I02,90006)
WRITE (I02,90002)
WRITE (I02,90002)
WRITE (I02,90007)
WRITE (I02,90002)
WRITE (I02,90008) IVFAIL
WRITE (I02,90009) IVPASS
WRITE (I02,90010) IVDELE
C
C
C TERMINATE ROUTINE EXECUTION
STOP
C
C FORMAT STATEMENTS FOR PAGE HEADERS
90000 FORMAT (1H1)
90002 FORMAT (1H )
90001 FORMAT (1H ,10X,34HFORTRAN COMPILER VALIDATION SYSTEM)
90003 FORMAT (1H ,21X,11HVERSION 1.0)
90004 FORMAT (1H ,10X,38HFOR OFFICIAL USE ONLY - COPYRIGHT 1978)
90005 FORMAT (1H ,5X,4HTEST,5X,9HPASS/FAIL, 5X,8HCOMPUTED,8X,7HCORRECT)
90006 FORMAT (1H ,5X,46H----------------------------------------------)
90011 FORMAT (1H ,18X,17HSUBSET LEVEL TEST)
C
C FORMAT STATEMENTS FOR RUN SUMMARIES
90008 FORMAT (1H ,15X,I5,19H ERRORS ENCOUNTERED)
90009 FORMAT (1H ,15X,I5,13H TESTS PASSED)
90010 FORMAT (1H ,15X,I5,14H TESTS DELETED)
C
C FORMAT STATEMENTS FOR TEST RESULTS
80001 FORMAT (1H ,4X,I5,7X,4HPASS)
80002 FORMAT (1H ,4X,I5,7X,4HFAIL)
80003 FORMAT (1H ,4X,I5,7X,7HDELETED)
80004 FORMAT (1H ,4X,I5,7X,4HFAIL,10X,I6,9X,I6)
80005 FORMAT (1H ,4X,I5,7X,4HFAIL,4X,E12.5,3X,E12.5)
C
90007 FORMAT (1H ,20X,20HEND OF PROGRAM FM097)
END
*END-OF,FM097
FM098.f 480976079 170 2 100666 23086 `
*HEADER,FORTR,FM098
*FILES1,FORTR,FM098,X
C COMMENT SECTION
C
C FM098
C
C THIS ROUTINE TESTS INTRINSIC FUNCTIONS WHERE THE FUNCTION TYPE IS
C INTEGER AND THE ARGUMENTS ARE EITHER INTEGER OR REAL. THE REAL
C AND INTEGER VARIABLES AND THE REAL AND INTEGER CONSTANTS CONTAIN
C BOTH POSITIVE AND NEGATIVE VALUES. THE INTRINSIC FUNCTIONS TESTED
C BY FM098 INCLUDE
C TYPE OF
C INTRINSIC FUNCTION NAME ARGUMENT FUNCTION
C ------------------ ---- -------- --------
C ABSOLUTE VALUE IABS INTEGER INTEGER
C TRUNCATION INT REAL INTEGER
C REMAINDERING MOD INTEGER INTEGER
C CHOOSING LARGEST VALUE MAX0 INTEGER INTEGER
C MAX1 REAL INTEGER
C CHOOSING SMALLEST VALUE MIN0 INTEGER INTEGER
C MIN1 REAL INTEGER
C FIX IFIX REAL INTEGER
C TRANSFER OF SIGN ISIGN INTEGER INTEGER
C POSITIVE DIFFERENCE IDIM INTEGER INTEGER
C
C REFERENCES
C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN,
C X3.9-1978
C
C SECTION 4.1.2, TYPE RULES FOR DATA AND PROCEDURE IDENTIFIERS
C SECTION 15.3, INTRINSIC FUNCTION
C SECTION 15.3.2, INTRINSIC FUNCTIONS AND THEIR REFERENCE
C
C
C **********************************************************
C
C A COMPILER VALIDATION SYSTEM FOR THE FORTRAN LANGUAGE
C BASED ON SPECIFICATIONS AS DEFINED IN AMERICAN NATIONAL STANDARD
C PROGRAMMING LANGUAGE FORTRAN X3.9-1978, HAS BEEN DEVELOPED BY THE
C FEDERAL COBOL COMPILER TESTING SERVICE. THE FORTRAN COMPILER
C VALIDATION SYSTEM (FCVS) CONSISTS OF AUDIT ROUTINES, THEIR RELATED
C DATA, AND AN EXECUTIVE SYSTEM. EACH AUDIT ROUTINE IS A FORTRAN
C PROGRAM, SUBPROGRAM OR FUNCTION WHICH INCLUDES TESTS OF SPECIFIC
C LANGUAGE ELEMENTS AND SUPPORTING PROCEDURES INDICATING THE RESULT
C OF EXECUTING THESE TESTS.
C
C THIS PARTICULAR PROGRAM/SUBPROGRAM/FUNCTION CONTAINS FEATURES
C FOUND ONLY IN THE SUBSET AS DEFINED IN X3.9-1978.
C
C SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO -
C
C DEPARTMENT OF THE NAVY
C FEDERAL COBOL COMPILER TESTING SERVICE
C WASHINGTON, D.C. 20376
C
C **********************************************************
C
C
C
C INITIALIZATION SECTION
C
C INITIALIZE CONSTANTS
C **************
C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER.
I01 = 5
C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER.
I02 = 6
C SYSTEM ENVIRONMENT SECTION
C
CX010 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-010 CONTROL CARD.
C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5
C (UNIT NUMBER FOR CARD READER).
CX011 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-011 CONTROL CARD.
C THE CX011 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL
C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX010 ABOVE.
C
CX020 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-020 CONTROL CARD.
C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02 = 6
C (UNIT NUMBER FOR PRINTER).
CX021 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-021 CONTROL CARD.
C THE CX021 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL
C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX020 ABOVE.
C
IVPASS=0
IVFAIL=0
IVDELE=0
ICZERO=0
C
C WRITE PAGE HEADERS
WRITE (I02,90000)
WRITE (I02,90001)
WRITE (I02,90002)
WRITE (I02, 90002)
WRITE (I02,90003)
WRITE (I02,90002)
WRITE (I02,90004)
WRITE (I02,90002)
WRITE (I02,90011)
WRITE (I02,90002)
WRITE (I02,90002)
WRITE (I02,90005)
WRITE (I02,90006)
WRITE (I02,90002)
C
C TEST SECTION
C
C TEST 907 THROUGH TEST 909 CONTAIN INTRINSIC FUNCTION TESTS FOR
C ABSOLUTE VALUE WHERE ARGUMENT AND FUNCTION ARE INTEGER
C
9071 CONTINUE
IVTNUM = 907
C
C **** TEST 907 ****
C
IF (ICZERO) 39070, 9070, 39070
9070 CONTINUE
IVCOMP = IABS (-382)
GO TO 49070
39070 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 49070, 9081, 49070
49070 IF (IVCOMP - 382) 29070,19070,29070
19070 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 9081
29070 IVFAIL = IVFAIL + 1
IVCORR = 382
WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR
9081 CONTINUE
IVTNUM = 908
C
C **** TEST 908 ****
C
IF (ICZERO) 39080, 9080, 39080
9080 CONTINUE
IVON01 = 445
IVCOMP = IABS (IVON01)
GO TO 49080
39080 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 49080, 9091, 49080
49080 IF (IVCOMP - 445) 29080,19080,29080
19080 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 9091
29080 IVFAIL = IVFAIL + 1
IVCORR = 445
WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR
9091 CONTINUE
IVTNUM = 909
C
C **** TEST 909 ****
C
IF (ICZERO) 39090, 9090, 39090
9090 CONTINUE
IVON01 = -32176
IVCOMP = IABS (IVON01)
GO TO 49090
39090 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 49090, 9101, 49090
49090 IF (IVCOMP - 32176) 29090,19090,29090
19090 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 9101
29090 IVFAIL = IVFAIL + 1
IVCORR = 32176
WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR
C
C TEST 910 THROUGH TEST 913 CONTAIN INTRINSIC FUNCTION TESTS FOR
C TRUNCATION WHERE ARGUMENT IS REAL AND FUNCTION IS INTEGER
C
9101 CONTINUE
IVTNUM = 910
C
C **** TEST 910 ****
C
IF (ICZERO) 39100, 9100, 39100
9100 CONTINUE
IVCOMP = INT (38.2)
GO TO 49100
39100 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 49100, 9111, 49100
49100 IF (IVCOMP - 38) 29100,19100,29100
19100 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 9111
29100 IVFAIL = IVFAIL + 1
IVCORR = 38
WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR
9111 CONTINUE
IVTNUM = 911
C
C **** TEST 911 ****
C
IF (ICZERO) 39110, 9110, 39110
9110 CONTINUE
RVON01 = -445.95
IVCOMP = INT (RVON01)
GO TO 49110
39110 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 49110, 9121, 49110
49110 IF (IVCOMP + 445) 29110,19110,29110
19110 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 9121
29110 IVFAIL = IVFAIL + 1
IVCORR = -445
WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR
9121 CONTINUE
IVTNUM = 912
C
C **** TEST 912 ****
C
IF (ICZERO) 39120, 9120, 39120
9120 CONTINUE
RVON01 = 466.01
IVCOMP = INT (RVON01)
GO TO 49120
39120 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 49120, 9131, 49120
49120 IF (IVCOMP - 466) 29120,19120,29120
19120 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 9131
29120 IVFAIL = IVFAIL + 1
IVCORR = 466
WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR
9131 CONTINUE
IVTNUM = 913
C
C **** TEST 913 ****
C
IF (ICZERO) 39130, 9130, 39130
9130 CONTINUE
RVON01 = 382E-1
IVCOMP = INT (RVON01)
GO TO 49130
39130 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 49130, 9141, 49130
49130 IF (IVCOMP - 38) 29130,19130,29130
19130 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 9141
29130 IVFAIL = IVFAIL + 1
IVCORR = 38
WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR
C
C TEST 914 THROUGH TEST 917 CONTAIN INTRINSIC FUNCTION TESTS FOR
C REMAINDERING WHERE ARGUMENTS AND FUNCTION ARE INTEGERS
C
9141 CONTINUE
IVTNUM = 914
C
C **** TEST 914 ****
C
IF (ICZERO) 39140, 9140, 39140
9140 CONTINUE
IVCOMP = MOD (42,19)
GO TO 49140
39140 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 49140, 9151, 49140
49140 IF (IVCOMP - 4) 29140,19140,29140
19140 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 9151
29140 IVFAIL = IVFAIL + 1
IVCORR = 4
WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR
9151 CONTINUE
IVTNUM = 915
C
C **** TEST 915 ****
C
IF (ICZERO) 39150, 9150, 39150
9150 CONTINUE
IVON01 = 6667
IVON02 = 2
IVCOMP = MOD (IVON01,IVON02)
GO TO 49150
39150 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 49150, 9161, 49150
49150 IF (IVCOMP - 1) 29150,19150,29150
19150 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 9161
29150 IVFAIL = IVFAIL + 1
IVCORR = 1
WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR
9161 CONTINUE
IVTNUM = 916
C
C **** TEST 916 ****
C
IF (ICZERO) 39160, 9160, 39160
9160 CONTINUE
IVON01 = 225
IVON02 = 50
IVCOMP = MOD (IVON01,IVON02)
GO TO 49160
39160 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 49160, 9171, 49160
49160 IF (IVCOMP - 25) 29160,19160,29160
19160 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 9171
29160 IVFAIL = IVFAIL + 1
IVCORR = 25
WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR
9171 CONTINUE
IVTNUM = 917
C
C **** TEST 917 ****
C
IF (ICZERO) 39170, 9170, 39170
9170 CONTINUE
IVON01 = -39
IVON02 = 500
IVCOMP = MOD (IVON01,IVON02)
GO TO 49170
39170 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 49170, 9181, 49170
49170 IF (IVCOMP + 39) 29170,19170,29170
19170 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 9181
29170 IVFAIL = IVFAIL + 1
IVCORR = -39
WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR
C
C TEST 918 AND 919 CONTAIN INTRINSIC FUNCTION TESTS FOR CHOOSING
C LARGEST VALUE WHERE ARGUMENTS AND FUNCTION ARE INTEGER
C
9181 CONTINUE
IVTNUM = 918
C
C **** TEST 918 ****
C
IF (ICZERO) 39180, 9180, 39180
9180 CONTINUE
IVON01 = 317
IVON02 = -99
IVON03 = 1
IVCOMP = MAX0 (263,IVON01,IVON02,IVON03)
GO TO 49180
39180 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 49180, 9191, 49180
49180 IF (IVCOMP - 317) 29180,19180,29180
19180 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 9191
29180 IVFAIL = IVFAIL + 1
IVCORR = 317
WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR
9191 CONTINUE
IVTNUM = 919
C
C **** TEST 919 ****
C
IF (ICZERO) 39190, 9190, 39190
9190 CONTINUE
IVON01 = 2572
IVON02 = 2570
IVCOMP = MAX0 (IVON01,IVON02)
GO TO 49190
39190 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 49190, 9201, 49190
49190 IF (IVCOMP - 2572) 29190,19190,29190
19190 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 9201
29190 IVFAIL = IVFAIL + 1
IVCORR = 2572
WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR
C
C TEST 920 AND 921 CONTAIN INTRINSIC FUNCTION TESTS FOR CHOOSING
C LARGEST VALUE WHERE ARGUMENTS ARE REAL AND FUNCTION IS INTEGER
C
9201 CONTINUE
IVTNUM = 920
C
C **** TEST 920 ****
C
IF (ICZERO) 39200, 9200, 39200
9200 CONTINUE
RVON01 = .326E+2
RVON02 = 22.075
RVON03 = 76E-1
IVCOMP = MAX1 (RVON01,RVON02,RVON03)
GO TO 49200
39200 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 49200, 9211, 49200
49200 IF (IVCOMP - 32) 29200,19200,29200
19200 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 9211
29200 IVFAIL = IVFAIL + 1
IVCORR = 32
WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR
9211 CONTINUE
IVTNUM = 921
C
C **** TEST 921 ****
C
IF (ICZERO) 39210, 9210, 39210
9210 CONTINUE
RVON01 = -6.3E2
RVON02 = -21.0
IVCOMP = MAX1 (-463.3,RVON01,RVON02)
GO TO 49210
39210 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 49210, 9221, 49210
49210 IF (IVCOMP + 21) 29210,19210,29210
19210 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 9221
29210 IVFAIL = IVFAIL + 1
IVCORR = -21
WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR
C
C TEST 922 AND 923 CONTAIN INTRINSIC FUNCTION TESTS FOR CHOOSING
C SMALLEST VALUE WHERE ARGUMENTS AND FUNCTION ARE INTEGER
C
9221 CONTINUE
IVTNUM = 922
C
C **** TEST 922 ****
C
IF (ICZERO) 39220, 9220, 39220
9220 CONTINUE
IVON01 = -75
IVON02 = -243
IVCOMP = MIN0 (IVON01,IVON02)
GO TO 49220
39220 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 49220, 9231, 49220
49220 IF (IVCOMP + 243) 29220,19220,29220
19220 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 9231
29220 IVFAIL = IVFAIL + 1
IVCORR = -243
WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR
9231 CONTINUE
IVTNUM = 923
C
C **** TEST 923 ****
C
IF (ICZERO) 39230, 9230, 39230
9230 CONTINUE
IVON01 = -11
IVON02 = 11
IVCOMP = MIN0 (0,IVON01,IVON02)
GO TO 49230
39230 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 49230, 9241, 49230
49230 IF (IVCOMP + 11) 29230,19230,29230
19230 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 9241
29230 IVFAIL = IVFAIL + 1
IVCORR = -11
WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR
C
C TEST 924 AND 925 CONTAIN INTRINSIC FUNCTION TESTS FOR CHOOSING
C SMALLEST VALUE WHERE ARGUMENTS ARE REAL AND FUNCTION IS INTEGER
C
9241 CONTINUE
IVTNUM = 924
C
C **** TEST 924 ****
C
IF (ICZERO) 39240, 9240, 39240
9240 CONTINUE
RVON01 = 1.1111
RVON02 = 22.222
RVON03 = 333.33
IVCOMP = MIN1 (RVON01,RVON02,RVON03)
GO TO 49240
39240 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 49240, 9251, 49240
49240 IF (IVCOMP - 1) 29240,19240,29240
19240 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 9251
29240 IVFAIL = IVFAIL + 1
IVCORR = 1
WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR
9251 CONTINUE
IVTNUM = 925
C
C **** TEST 925 ****
C
IF (ICZERO) 39250, 9250, 39250
9250 CONTINUE
RVON01 = 28.8
RVON02 = 2.88E1
RVON03 = 288E-1
RVON04 = 35.0
IVCOMP = MIN1 (RVON01,RVON02,RVON03,RVON04)
GO TO 49250
39250 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 49250, 9261, 49250
49250 IF (IVCOMP - 28) 29250,19250,29250
19250 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 9261
29250 IVFAIL = IVFAIL + 1
IVCORR = 28
WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR
C
C TEST 926 THROUGH TEST 929 CONTAIN THE INTRINSIC FUNCTION FIX
C WHICH CONVERTS REAL ARGUMENTS TO INTEGER FUNCTION RESULTS
C
9261 CONTINUE
IVTNUM = 926
C
C **** TEST 926 ****
C
IF (ICZERO) 39260, 9260, 39260
9260 CONTINUE
IVCOMP = IFIX (-6.06)
GO TO 49260
39260 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 49260, 9271, 49260
49260 IF (IVCOMP + 6) 29260,19260,29260
19260 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 9271
29260 IVFAIL = IVFAIL + 1
IVCORR = -6
WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR
9271 CONTINUE
IVTNUM = 927
C
C **** TEST 927 ****
C
IF (ICZERO) 39270, 9270, 39270
9270 CONTINUE
RVON01 = 71.01
IVCOMP = IFIX (RVON01)
GO TO 49270
39270 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 49270, 9281, 49270
49270 IF (IVCOMP - 71) 29270,19270,29270
19270 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 9281
29270 IVFAIL = IVFAIL + 1
IVCORR = 71
WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR
9281 CONTINUE
IVTNUM = 928
C
C **** TEST 928 ****
C
IF (ICZERO) 39280, 9280, 39280
9280 CONTINUE
RVON01 = 3.211E2
IVCOMP = IFIX (RVON01)
GO TO 49280
39280 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 49280, 9291, 49280
49280 IF (IVCOMP - 321) 29280,19280,29280
19280 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 9291
29280 IVFAIL = IVFAIL + 1
IVCORR = 321
WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR
9291 CONTINUE
IVTNUM = 929
C
C **** TEST 929 ****
C
IF (ICZERO) 39290, 9290, 39290
9290 CONTINUE
RVON01 = 777E-1
IVCOMP = IFIX (RVON01)
GO TO 49290
39290 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 49290, 9301, 49290
49290 IF (IVCOMP - 77) 29290,19290,29290
19290 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 9301
29290 IVFAIL = IVFAIL + 1
IVCORR = 77
WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR
C
C TEST 930 THROUGH TEST 932 CONTAIN INTRINSIC FUNCTION TESTS FOR
C TRANSFER OF SIGN WHERE ARGUMENTS AND FUNCTION ARE INTEGER
C
9301 CONTINUE
IVTNUM = 930
C
C **** TEST 930 ****
C
IF (ICZERO) 39300, 9300, 39300
9300 CONTINUE
IVON01 = 643
IVCOMP = ISIGN (IVON01,-1)
GO TO 49300
39300 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 49300, 9311, 49300
49300 IF (IVCOMP + 643) 29300,19300,29300
19300 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 9311
29300 IVFAIL = IVFAIL + 1
IVCORR = -643
WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR
9311 CONTINUE
IVTNUM = 931
C
C **** TEST 931 ****
C
IF (ICZERO) 39310, 9310, 39310
9310 CONTINUE
IVON01 = -22
IVON02 = 723
IVCOMP = ISIGN (IVON01,IVON02)
GO TO 49310
39310 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 49310, 9321, 49310
49310 IF (IVCOMP - 22) 29310,19310,29310
19310 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 9321
29310 IVFAIL = IVFAIL + 1
IVCORR = 22
WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR
9321 CONTINUE
IVTNUM = 932
C
C **** TEST 932 ****
C
IF (ICZERO) 39320, 9320, 39320
9320 CONTINUE
IVON01 = 3532
IVON02 = 1
IVCOMP = ISIGN (IVON01,IVON02)
GO TO 49320
39320 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 49320, 9331, 49320
49320 IF (IVCOMP - 3532) 29320,19320,29320
19320 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 9331
29320 IVFAIL = IVFAIL + 1
IVCORR = 3532
WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR
C
C TEST 933 THROUGH TEST 936 CONTAIN INTRINSIC FUNCTION TESTS FOR
C POSITIVE DIFFERENCE WHERE ARGUMENTS AND FUNCTION ARE INTEGERS
C
9331 CONTINUE
IVTNUM = 933
C
C **** TEST 933 ****
C
IF (ICZERO) 39330, 9330, 39330
9330 CONTINUE
IVON01 = 222
IVCOMP = IDIM (IVON01,1)
GO TO 49330
39330 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 49330, 9341, 49330
49330 IF (IVCOMP - 221) 29330,19330,29330
19330 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 9341
29330 IVFAIL = IVFAIL + 1
IVCORR = 221
WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR
9341 CONTINUE
IVTNUM = 934
C
C **** TEST 934 ****
C
IF (ICZERO) 39340, 9340, 39340
9340 CONTINUE
IVON01 = 45
IVON02 = 41
IVCOMP = IDIM (IVON01,IVON02)
GO TO 49340
39340 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 49340, 9351, 49340
49340 IF (IVCOMP - 4) 29340,19340,29340
19340 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 9351
29340 IVFAIL = IVFAIL + 1
IVCORR = 4
WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR
9351 CONTINUE
IVTNUM = 935
C
C **** TEST 935 ****
C
IF (ICZERO) 39350, 9350, 39350
9350 CONTINUE
IVON01 = 2
IVON02 = 10
IVCOMP = IDIM (IVON01,IVON02)
GO TO 49350
39350 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 49350, 9361, 49350
49350 IF (IVCOMP) 29350,19350,29350
19350 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 9361
29350 IVFAIL = IVFAIL + 1
IVCORR = 0
WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR
9361 CONTINUE
IVTNUM = 936
C
C **** TEST 936 ****
C
IF (ICZERO) 39360, 9360, 39360
9360 CONTINUE
IVON01 = 165
IVON02 = -2
IVCOMP = IDIM (IVON01,IVON02)
GO TO 49360
39360 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 49360, 9371, 49360
49360 IF (IVCOMP - 167) 29360,19360,29360
19360 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 9371
29360 IVFAIL = IVFAIL + 1
IVCORR = 167
WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR
C
C TESTS 937 AND 938 CONTAIN EXPRESSIONS CONTAINING MORE THAN ONE
C INTRINSIC FUNCTION - THE FUNCTIONS ARE INTEGER AND THE ARGUMENTS
C ARE REAL AND INTEGER
C
9371 CONTINUE
IVTNUM = 937
C
C **** TEST 937 ****
C
IF (ICZERO) 39370, 9370, 39370
9370 CONTINUE
RVON01 = 33.3
IVON01 = -12
IVCOMP = INT (RVON01) + IABS (IVON01)
GO TO 49370
39370 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 49370, 9381, 49370
49370 IF (IVCOMP - 45) 29370,19370,29370
19370 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 9381
29370 IVFAIL = IVFAIL + 1
IVCORR = 45
WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR
9381 CONTINUE
IVTNUM = 938
C
C **** TEST 938 ****
C
IF (ICZERO) 39380, 9380, 39380
9380 CONTINUE
IVON01 = 76
IVON02 = 21
IVON03 = 30
IVCOMP = MAX0 (IVON01,IVON02,IVON03) - MIN0 (IVON01,IVON02,IVON03)
GO TO 49380
39380 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 49380, 9391, 49380
49380 IF (IVCOMP - 55) 29380,19380,29380
19380 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 9391
29380 IVFAIL = IVFAIL + 1
IVCORR = 55
WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR
9391 CONTINUE
C
C WRITE PAGE FOOTINGS AND RUN SUMMARIES
99999 CONTINUE
WRITE (I02,90002)
WRITE (I02,90006)
WRITE (I02,90002)
WRITE (I02,90002)
WRITE (I02,90007)
WRITE (I02,90002)
WRITE (I02,90008) IVFAIL
WRITE (I02,90009) IVPASS
WRITE (I02,90010) IVDELE
C
C
C TERMINATE ROUTINE EXECUTION
STOP
C
C FORMAT STATEMENTS FOR PAGE HEADERS
90000 FORMAT (1H1)
90002 FORMAT (1H )
90001 FORMAT (1H ,10X,34HFORTRAN COMPILER VALIDATION SYSTEM)
90003 FORMAT (1H ,21X,11HVERSION 1.0)
90004 FORMAT (1H ,10X,38HFOR OFFICIAL USE ONLY - COPYRIGHT 1978)
90005 FORMAT (1H ,5X,4HTEST,5X,9HPASS/FAIL, 5X,8HCOMPUTED,8X,7HCORRECT)
90006 FORMAT (1H ,5X,46H----------------------------------------------)
90011 FORMAT (1H ,18X,17HSUBSET LEVEL TEST)
C
C FORMAT STATEMENTS FOR RUN SUMMARIES
90008 FORMAT (1H ,15X,I5,19H ERRORS ENCOUNTERED)
90009 FORMAT (1H ,15X,I5,13H TESTS PASSED)
90010 FORMAT (1H ,15X,I5,14H TESTS DELETED)
C
C FORMAT STATEMENTS FOR TEST RESULTS
80001 FORMAT (1H ,4X,I5,7X,4HPASS)
80002 FORMAT (1H ,4X,I5,7X,4HFAIL)
80003 FORMAT (1H ,4X,I5,7X,7HDELETED)
80004 FORMAT (1H ,4X,I5,7X,4HFAIL,10X,I6,9X,I6)
80005 FORMAT (1H ,4X,I5,7X,4HFAIL,4X,E12.5,3X,E12.5)
C
90007 FORMAT (1H ,20X,20HEND OF PROGRAM FM098)
END
*END-OF,FM098
FM099.f 480976081 170 2 100666 20139 `
*HEADER,FORTR,FM099
*FILES1,FORTR,FM099,X
C COMMENT SECTION
C
C FM099
C
C THIS ROUTINE TESTS VARIOUS MATHEMATICAL FUNCTIONS WHERE BOTH THE
C FUNCTION TYPE AND ARGUMENTS ARE REAL. THE REAL VARIABLES AND
C CONSTANTS CONTAIN BOTH POSITIVE AND NEGATIVE VALUES. THE
C FUNCTIONS TESTED IN FM099 INCLUDE
C
C TYPE OF
C FUNCTION NAME ARGUMENT FUNCTION
C ---------------- ---- -------- --------
C EXPONENTIAL EXP REAL REAL
C NATURAL LOGARITHM ALOG REAL REAL
C COMMON LOGARITHM ALOG10 REAL REAL
C SQUARE ROOT SQRT REAL REAL
C TRIGONOMETRIC SINE SIN REAL REAL
C TRIGONOMETRIC COSINE COS REAL REAL
C HYPERBOLIC TANGENT TANH REAL REAL
C ARCTANGENT ATAN REAL REAL
C ATAN2 REAL REAL
C
C REFERENCES
C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN,
C X3.9-1978
C
C SECTION 8.7, EXTERNAL STATEMENT
C SECTION 15.5.2, FUNCTION REFERENCE
C
C
C **********************************************************
C
C A COMPILER VALIDATION SYSTEM FOR THE FORTRAN LANGUAGE
C BASED ON SPECIFICATIONS AS DEFINED IN AMERICAN NATIONAL STANDARD
C PROGRAMMING LANGUAGE FORTRAN X3.9-1978, HAS BEEN DEVELOPED BY THE
C FEDERAL COBOL COMPILER TESTING SERVICE. THE FORTRAN COMPILER
C VALIDATION SYSTEM (FCVS) CONSISTS OF AUDIT ROUTINES, THEIR RELATED
C DATA, AND AN EXECUTIVE SYSTEM. EACH AUDIT ROUTINE IS A FORTRAN
C PROGRAM, SUBPROGRAM OR FUNCTION WHICH INCLUDES TESTS OF SPECIFIC
C LANGUAGE ELEMENTS AND SUPPORTING PROCEDURES INDICATING THE RESULT
C OF EXECUTING THESE TESTS.
C
C THIS PARTICULAR PROGRAM/SUBPROGRAM/FUNCTION CONTAINS FEATURES
C FOUND ONLY IN THE SUBSET AS DEFINED IN X3.9-1978.
C
C SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO -
C
C DEPARTMENT OF THE NAVY
C FEDERAL COBOL COMPILER TESTING SERVICE
C WASHINGTON, D.C. 20376
C
C **********************************************************
C
C
C
C INITIALIZATION SECTION
C
C INITIALIZE CONSTANTS
C **************
C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER.
I01 = 5
C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER.
I02 = 6
C SYSTEM ENVIRONMENT SECTION
C
CX010 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-010 CONTROL CARD.
C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5
C (UNIT NUMBER FOR CARD READER).
CX011 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-011 CONTROL CARD.
C THE CX011 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL
C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX010 ABOVE.
C
CX020 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-020 CONTROL CARD.
C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02 = 6
C (UNIT NUMBER FOR PRINTER).
CX021 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-021 CONTROL CARD.
C THE CX021 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL
C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX020 ABOVE.
C
IVPASS=0
IVFAIL=0
IVDELE=0
ICZERO=0
C
C WRITE PAGE HEADERS
WRITE (I02,90000)
WRITE (I02,90001)
WRITE (I02,90002)
WRITE (I02, 90002)
WRITE (I02,90003)
WRITE (I02,90002)
WRITE (I02,90004)
WRITE (I02,90002)
WRITE (I02,90011)
WRITE (I02,90002)
WRITE (I02,90002)
WRITE (I02,90005)
WRITE (I02,90006)
WRITE (I02,90002)
C
C TEST SECTION
C
C TEST 939 THROUGH TEST 942 CONTAIN FUNCTION TESTS FOR EXPONENTIAL
C FUNCTIONS WHERE THE ARGUMENT AND FUNCTION ARE REAL
C
IVTNUM = 939
C
C **** TEST 939 ****
C
IF (ICZERO) 39390, 9390, 39390
9390 CONTINUE
RVON01 = 0.0
RVCOMP = EXP (RVON01)
GO TO 49390
39390 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 49390, 9401, 49390
49390 IF (RVCOMP - 0.95) 29390,19390,49391
49391 IF (RVCOMP - 1.05) 19390,19390,29390
19390 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 9401
29390 IVFAIL = IVFAIL + 1
RVCORR = 1.00
WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR
9401 CONTINUE
IVTNUM = 940
C
C **** TEST 940 ****
C
IF (ICZERO) 39400, 9400, 39400
9400 CONTINUE
RVCOMP = EXP (0.5)
GO TO 49400
39400 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 49400, 9411, 49400
49400 IF (RVCOMP - 1.60) 29400,19400,49401
49401 IF (RVCOMP - 1.70) 19400,19400,29400
19400 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 9411
29400 IVFAIL = IVFAIL + 1
RVCORR = 1.65
WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR
9411 CONTINUE
IVTNUM = 941
C
C **** TEST 941 ****
C
IF (ICZERO) 39410, 9410, 39410
9410 CONTINUE
RVON01 = .1E1
RVCOMP = EXP (RVON01)
GO TO 49410
39410 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 49410, 9421, 49410
49410 IF (RVCOMP - 2.67) 29410,19410,49411
49411 IF (RVCOMP - 2.77) 19410,19410,29410
19410 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 9421
29410 IVFAIL = IVFAIL + 1
RVCORR = 2.72
WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR
9421 CONTINUE
IVTNUM = 942
C
C **** TEST 942 ****
C
IF (ICZERO) 39420, 9420, 39420
9420 CONTINUE
RVON01 = -1.0
RVCOMP = EXP (RVON01)
GO TO 49420
39420 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 49420, 9431, 49420
49420 IF (RVCOMP - 0.363) 29420,19420,49421
49421 IF (RVCOMP - 0.373) 19420,19420,29420
19420 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 9431
29420 IVFAIL = IVFAIL + 1
RVCORR = 0.368
WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR
9431 CONTINUE
C
C TEST 943 THROUGH TEST 945 CONTAIN FUNCTION TESTS FOR NATURAL
C LOGARITHM FUNCTIONS WHERE THE ARGUMENT AND FUNCTION ARE REAL
C
IVTNUM = 943
C
C **** TEST 943 ****
C
IF (ICZERO) 39430, 9430, 39430
9430 CONTINUE
RVON01 = 5E1
RVCOMP = ALOG (RVON01)
GO TO 49430
39430 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 49430, 9441, 49430
49430 IF (RVCOMP - 3.9115) 29430,19430,49431
49431 IF (RVCOMP - 3.9125) 19430,19430,29430
19430 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 9441
29430 IVFAIL = IVFAIL + 1
RVCORR = 3.9120
WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR
9441 CONTINUE
IVTNUM = 944
C
C **** TEST 944 ****
C
IF (ICZERO) 39440, 9440, 39440
9440 CONTINUE
RVON01 = 1.0
RVCOMP = ALOG (RVON01)
GO TO 49440
39440 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 49440, 9451, 49440
49440 IF (RVCOMP + .00005) 29440,19440,49441
49441 IF (RVCOMP - .00005) 19440,19440,29440
19440 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 9451
29440 IVFAIL = IVFAIL + 1
RVCORR = 0.00000
WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR
9451 CONTINUE
IVTNUM = 945
C
C **** TEST 945 ****
C
IF (ICZERO) 39450, 9450, 39450
9450 CONTINUE
RVCOMP = ALOG (2.0)
GO TO 49450
39450 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 49450, 9461, 49450
49450 IF (RVCOMP - 0.688) 29450,19450,49451
49451 IF (RVCOMP - 0.698) 19450,19450,29450
19450 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 9461
29450 IVFAIL = IVFAIL + 1
RVCORR = 0.693
WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR
9461 CONTINUE
C
C TEST 946 THROUGH TEST 948 CONTAIN FUNCTION TESTS FOR COMMON
C LOGARITHM FUNCTIONS WHERE THE ARGUMENT AND FUNCTION ARE REAL
C
IVTNUM = 946
C
C **** TEST 946 ****
C
IF (ICZERO) 39460, 9460, 39460
9460 CONTINUE
RVON01 = 2E2
RVCOMP = ALOG10 (RVON01)
GO TO 49460
39460 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 49460, 9471, 49460
49460 IF (RVCOMP - 2.296) 29460,19460,49461
49461 IF (RVCOMP - 2.306) 19460,19460,29460
19460 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 9471
29460 IVFAIL = IVFAIL + 1
RVCORR = 2.301
WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR
9471 CONTINUE
IVTNUM = 947
C
C **** TEST 947 ****
C
IF (ICZERO) 39470, 9470, 39470
9470 CONTINUE
RVON01 = .3E+3
RVCOMP = ALOG10 (RVON01)
GO TO 49470
39470 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 49470, 9481, 49470
49470 IF (RVCOMP - 2.472) 29470,19470,49471
49471 IF (RVCOMP - 2.482) 19470,19470,29470
19470 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 9481
29470 IVFAIL = IVFAIL + 1
RVCORR = 2.477
WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR
9481 CONTINUE
IVTNUM = 948
C
C **** TEST 948 ****
C
IF (ICZERO) 39480, 9480, 39480
9480 CONTINUE
RVON01 = 1350.0
RVCOMP = ALOG10 (RVON01)
GO TO 49480
39480 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 49480, 9491, 49480
49480 IF (RVCOMP - 3.125) 29480,19480,49481
49481 IF (RVCOMP - 3.135) 19480,19480,29480
19480 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 9491
29480 IVFAIL = IVFAIL + 1
RVCORR = 3.130
WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR
9491 CONTINUE
C
C TEST 949 THROUGH TEST 951 CONTAIN FUNCTION TESTS FOR SQUARE ROOT
C FUNCTIONS WHERE THE ARGUMENT AND FUNCTION ARE REAL
C
IVTNUM = 949
C
C **** TEST 949 ****
C
IF (ICZERO) 39490, 9490, 39490
9490 CONTINUE
RVON01 = 1.0
RVCOMP = SQRT (RVON01)
GO TO 49490
39490 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 49490, 9501, 49490
49490 IF (RVCOMP - 0.95) 29490,19490,49491
49491 IF (RVCOMP - 1.05) 19490,19490,29490
19490 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 9501
29490 IVFAIL = IVFAIL + 1
RVCORR = 1.00
WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR
9501 CONTINUE
IVTNUM = 950
C
C **** TEST 950 ****
C
IF (ICZERO) 39500, 9500, 39500
9500 CONTINUE
RVCOMP = SQRT (2.0)
GO TO 49500
39500 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 49500, 9511, 49500
49500 IF (RVCOMP - 1.36) 29500,19500,49501
49501 IF (RVCOMP - 1.46) 19500,19500,29500
19500 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 9511
29500 IVFAIL = IVFAIL + 1
RVCORR = 1.41
WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR
9511 CONTINUE
IVTNUM = 951
C
C **** TEST 951 ****
C
IF (ICZERO) 39510, 9510, 39510
9510 CONTINUE
RVON01 = .229E1
RVCOMP = SQRT (RVON01)
GO TO 49510
39510 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 49510, 9521, 49510
49510 IF (RVCOMP - 1.46) 29510,19510,49511
49511 IF (RVCOMP - 1.56) 19510,19510,29510
19510 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 9521
29510 IVFAIL = IVFAIL + 1
RVCORR = 1.51
WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR
9521 CONTINUE
C
C TEST 952 THROUGH TEST 953 CONTAIN FUNCTION TESTS FOR TRIGONOMETRIC
C SINE FUNCTIONS WHERE THE ARGUMENT AND FUNCTION ARE REAL
C
IVTNUM = 952
C
C **** TEST 952 ****
C
IF (ICZERO) 39520, 9520, 39520
9520 CONTINUE
RVON01 = 0.00000
RVCOMP = SIN (RVON01)
GO TO 49520
39520 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 49520, 9531, 49520
49520 IF (RVCOMP + .00005) 29520,19520,49521
49521 IF (RVCOMP - .00005) 19520,19520,29520
19520 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 9531
29520 IVFAIL = IVFAIL + 1
RVCORR = 0.00000
WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR
9531 CONTINUE
IVTNUM = 953
C
C **** TEST 953 ****
C
IF (ICZERO) 39530, 9530, 39530
9530 CONTINUE
RVON01 = 0.5
RVCOMP = SIN (RVON01)
GO TO 49530
39530 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 49530, 9541, 49530
49530 IF (RVCOMP - .474) 29530,19530,49531
49531 IF (RVCOMP - .484) 19530,19530,29530
19530 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 9541
29530 IVFAIL = IVFAIL + 1
RVCORR = .479
WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR
9541 CONTINUE
IVTNUM = 954
C
C **** TEST 954 ****
C
IF (ICZERO) 39540, 9540, 39540
9540 CONTINUE
RVON01 = 4E0
RVCOMP = SIN (RVON01)
GO TO 49540
39540 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 49540, 9551, 49540
49540 IF (RVCOMP + .762) 29540,19540,49541
49541 IF (RVCOMP + .752) 19540,19540,29540
19540 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 9551
29540 IVFAIL = IVFAIL + 1
RVCORR = -.757
WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR
9551 CONTINUE
C
C TEST 955 THROUGH TEST 957 CONTAIN FUNCTION TESTS FOR TRIGONOMETRIC
C COSINE FUNCTIONS WHERE THE ARGUMENT AND FUNCTION ARE REAL
C
IVTNUM = 955
C
C **** TEST 955 ****
C
IF (ICZERO) 39550, 9550, 39550
9550 CONTINUE
RVON01 = 0.00000
RVCOMP = COS (RVON01)
GO TO 49550
39550 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 49550, 9561, 49550
49550 IF (RVCOMP - .995) 29550,19550,49551
49551 IF (RVCOMP - 1.005) 19550,19550,29550
19550 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 9561
29550 IVFAIL = IVFAIL + 1
RVCORR = 1.000
WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR
9561 CONTINUE
IVTNUM = 956
C
C **** TEST 956 ****
C
IF (ICZERO) 39560, 9560, 39560
9560 CONTINUE
RVON01 = 1.0E0
RVCOMP = COS (RVON01)
GO TO 49560
39560 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 49560, 9571, 49560
49560 IF (RVCOMP - .535) 29560,19560,49561
49561 IF (RVCOMP - .545) 19560,19560,29560
19560 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 9571
29560 IVFAIL = IVFAIL + 1
RVCORR = 0.540
WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR
9571 CONTINUE
IVTNUM = 957
C
C **** TEST 957 ****
C
IF (ICZERO) 39570, 9570, 39570
9570 CONTINUE
RVCOMP = COS (4.0)
GO TO 49570
39570 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 49570, 9581, 49570
49570 IF (RVCOMP + .659) 29570,19570,49571
49571 IF (RVCOMP + .649) 19570,19570,29570
19570 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 9581
29570 IVFAIL = IVFAIL + 1
RVCORR = -0.654
WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR
9581 CONTINUE
C
C TEST 958 THROUGH TEST 960 CONTAIN FUNCTION TESTS FOR HYPERBOLIC
C TANGENT FUNCTIONS WHERE THE ARGUMENT AND FUNCTION ARE REAL
C
IVTNUM = 958
C
C **** TEST 958 ****
C
IF (ICZERO) 39580, 9580, 39580
9580 CONTINUE
RVCOMP = TANH (0.0)
GO TO 49580
39580 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 49580, 9591, 49580
49580 IF (RVCOMP + .00005) 29580,19580,49581
49581 IF (RVCOMP - .00005) 19580,19580,29580
19580 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 9591
29580 IVFAIL = IVFAIL + 1
RVCORR = 0.00000
WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR
9591 CONTINUE
IVTNUM = 959
C
C **** TEST 959 ****
C
IF (ICZERO) 39590, 9590, 39590
9590 CONTINUE
RVON01 = .5E0
RVCOMP = TANH (RVON01)
GO TO 49590
39590 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 49590, 9601, 49590
49590 IF (RVCOMP - .457) 29590,19590,49591
49591 IF (RVCOMP - .467) 19590,19590,29590
19590 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 9601
29590 IVFAIL = IVFAIL + 1
RVCORR = 0.462
WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR
9601 CONTINUE
IVTNUM = 960
C
C **** TEST 960 ****
C
IF (ICZERO) 39600, 9600, 39600
9600 CONTINUE
RVON01 = .25
RVCOMP = TANH (RVON01)
GO TO 49600
39600 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 49600, 9611, 49600
49600 IF (RVCOMP - .240) 29600,19600,49601
49601 IF (RVCOMP - .250) 19600,19600,29600
19600 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 9611
29600 IVFAIL = IVFAIL + 1
RVCORR = 0.245
WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR
9611 CONTINUE
C
C TESTS 961 AND 962 CONTAIN TESTS FOR ARCTANGENT OF THE FORM
C ATAN (A) WHERE THE ARGUMENT AND FUNCTION ARE REAL
C
IVTNUM = 961
C
C **** TEST 961 ****
C
IF (ICZERO) 39610, 9610, 39610
9610 CONTINUE
RVCOMP = ATAN (0.0)
GO TO 49610
39610 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 49610, 9621, 49610
49610 IF (RVCOMP + .00005) 29610,19610,49611
49611 IF (RVCOMP - .00005) 19610,19610,29610
19610 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 9621
29610 IVFAIL = IVFAIL + 1
RVCORR = 0.00000
WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR
9621 CONTINUE
IVTNUM = 962
C
C **** TEST 962 ****
C
IF (ICZERO) 39620, 9620, 39620
9620 CONTINUE
RVON01 = 5E-1
RVCOMP = ATAN (RVON01)
GO TO 49620
39620 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 49620, 9631, 49620
49620 IF (RVCOMP - .459) 29620,19620,49621
49621 IF (RVCOMP - .469) 19620,19620,29620
19620 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 9631
29620 IVFAIL = IVFAIL + 1
RVCORR = 0.464
WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR
9631 CONTINUE
C
C TESTS 963 AND 964 CONTAIN TESTS FOR ARCTANGENT OF THE FORM
C ATAN2 (A1,A2) WHERE THE ARGUMENTS AND FUNCTION ARE REAL
C
IVTNUM = 963
C
C **** TEST 963 ****
C
IF (ICZERO) 39630, 9630, 39630
9630 CONTINUE
RVON01 = 0.0
RVON02 = 1E0
RVCOMP = ATAN2 (RVON01,RVON02)
GO TO 49630
39630 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 49630, 9641, 49630
49630 IF (RVCOMP + .00005) 29630,19630,49631
49631 IF (RVCOMP - .00005) 19630,19630,29630
19630 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 9641
29630 IVFAIL = IVFAIL + 1
RVCORR = 0.00000
WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR
9641 CONTINUE
IVTNUM = 964
C
C **** TEST 964 ****
C
IF (ICZERO) 39640, 9640, 39640
9640 CONTINUE
RVON01 = 2E1
RVCOMP = ATAN2 (-1.0,RVON01)
GO TO 49640
39640 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 49640, 9651, 49640
49640 IF (RVCOMP + .05001) 29640,19640,49641
49641 IF (RVCOMP + .04991) 19640,19640,29640
19640 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 9651
29640 IVFAIL = IVFAIL + 1
RVCORR = -.04996
WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR
9651 CONTINUE
C
C WRITE PAGE FOOTINGS AND RUN SUMMARIES
99999 CONTINUE
WRITE (I02,90002)
WRITE (I02,90006)
WRITE (I02,90002)
WRITE (I02,90002)
WRITE (I02,90007)
WRITE (I02,90002)
WRITE (I02,90008) IVFAIL
WRITE (I02,90009) IVPASS
WRITE (I02,90010) IVDELE
C
C
C TERMINATE ROUTINE EXECUTION
STOP
C
C FORMAT STATEMENTS FOR PAGE HEADERS
90000 FORMAT (1H1)
90002 FORMAT (1H )
90001 FORMAT (1H ,10X,34HFORTRAN COMPILER VALIDATION SYSTEM)
90003 FORMAT (1H ,21X,11HVERSION 1.0)
90004 FORMAT (1H ,10X,38HFOR OFFICIAL USE ONLY - COPYRIGHT 1978)
90005 FORMAT (1H ,5X,4HTEST,5X,9HPASS/FAIL, 5X,8HCOMPUTED,8X,7HCORRECT)
90006 FORMAT (1H ,5X,46H----------------------------------------------)
90011 FORMAT (1H ,18X,17HSUBSET LEVEL TEST)
C
C FORMAT STATEMENTS FOR RUN SUMMARIES
90008 FORMAT (1H ,15X,I5,19H ERRORS ENCOUNTERED)
90009 FORMAT (1H ,15X,I5,13H TESTS PASSED)
90010 FORMAT (1H ,15X,I5,14H TESTS DELETED)
C
C FORMAT STATEMENTS FOR TEST RESULTS
80001 FORMAT (1H ,4X,I5,7X,4HPASS)
80002 FORMAT (1H ,4X,I5,7X,4HFAIL)
80003 FORMAT (1H ,4X,I5,7X,7HDELETED)
80004 FORMAT (1H ,4X,I5,7X,4HFAIL,10X,I6,9X,I6)
80005 FORMAT (1H ,4X,I5,7X,4HFAIL,4X,E12.5,3X,E12.5)
C
90007 FORMAT (1H ,20X,20HEND OF PROGRAM FM099)
END
*END-OF,FM099
FM100.f 480976083 170 2 100666 12440 `
*HEADER,FORTR,FM100
*FILES1,FORTR,FM100,X
C COMMENT SECTION.
C
C FM100
C
C THIS ROUTINE IS A TEST OF THE I FORMAT AND IS TAPE AND PRINTER
C ORIENTED. THE ROUTINE CAN ALSO BE USED FOR DISK. BOTH THE READ
C AND WRITE STATEMENTS ARE TESTED. VARIABLES IN THE INPUT AND
C OUTPUT LISTS ARE INTEGER VARIABLE AND INTEGER ARRAY ELEMENT OR
C ARRAY NAME REFERENCES. ALL READ AND WRITE STATEMENTS ARE DONE
C WITH FORMAT STATEMENTS. THE ROUTINE HAS AN OPTIONAL SECTION OF
C CODE TO DUMP THE FILE AFTER IT HAS BEEN WRITTEN. DO LOOPS AND
C DO-IMPLIED LISTS ARE USED IN CONJUNCTION WITH A ONE DIMENSIONAL
C INTEGER ARRAY FOR THE DUMP SECTION.
C
C THIS ROUTINE WRITES A SINGLE SEQUENTIAL FILE WHICH IS
C REWOUND AND READ SEQUENTIALLY FORWARD. EVERY FOURTH RECORD IS
C CHECKED DURING THE READ TEST SECTION PLUS THE LAST TWO RECORDS
C AND THE END OF FILE ON THE LAST RECORD.
C
C THE LINE CONTINUATION IN COLUMN 6 IS USED IN READ, WRITE,
C AND FORMAT STATEMENTS. FOR BOTH SYNTAX AND SEMANTIC TESTS, ALL
C STATEMENTS SHOULD BE CHECKED VISUALLY FOR THE PROPER FUNCTIONING
C OF THE CONTINUATION LINE.
C
C REFERENCES
C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN,
C X3.9-1978
C
C SECTION 8, SPECIFICATION STATEMENTS
C SECTION 9, DATA STATEMENT
C SECTION 11.10, DO STATEMENT
C SECTION 12, INPUT/OUTPUT STATEMENTS
C SECTION 12.8.2, INPUT/OUTPUT LIST
C SECTION 12.9.5.2, FORMATTED DATA TRANSFER
C SECTION 13, FORMAT STATEMENT
C SECTION 13.2.1, EDIT DESCRIPTORS
C SECTION 13.5.9.1, INTEGER EDITING
C
DIMENSION ITEST(30)
DIMENSION IDUMP(136)
CHARACTER*1 NINE,IDUMP
DATA NINE/'9'/
C
77701 FORMAT ( 80A1 )
77702 FORMAT (10X,19HPREMATURE EOF ONLY ,I3,13H RECORDS LUN ,I2,8H OUT O
1F ,I3,8H RECORDS)
77703 FORMAT (10X,12HFILE ON LUN ,I2,7H OK... ,I3,8H RECORDS)
77704 FORMAT (10X,12HFILE ON LUN ,I2,20H TOO LONG MORE THAN ,I3,8H RECOR
1DS)
77705 FORMAT ( 1X,80A1)
77706 FORMAT (10X,43HFILE I06 CREATED WITH 31 SEQUENTIAL RECORDS)
77751 FORMAT (I3,I2,I2,I3,I3,I3,I4,I1,I1,I1,I1,I1,I1,I1,I1,I1,I1,I2,I2,I
13,I3,I4,I4,I4,I4,I4,I5,I5,I5,I5)
C
C
C **********************************************************
C
C A COMPILER VALIDATION SYSTEM FOR THE FORTRAN LANGUAGE
C BASED ON SPECIFICATIONS AS DEFINED IN AMERICAN NATIONAL STANDARD
C PROGRAMMING LANGUAGE FORTRAN X3.9-1978, HAS BEEN DEVELOPED BY THE
C FEDERAL COBOL COMPILER TESTING SERVICE. THE FORTRAN COMPILER
C VALIDATION SYSTEM (FCVS) CONSISTS OF AUDIT ROUTINES, THEIR RELATED
C DATA, AND AN EXECUTIVE SYSTEM. EACH AUDIT ROUTINE IS A FORTRAN
C PROGRAM, SUBPROGRAM OR FUNCTION WHICH INCLUDES TESTS OF SPECIFIC
C LANGUAGE ELEMENTS AND SUPPORTING PROCEDURES INDICATING THE RESULT
C OF EXECUTING THESE TESTS.
C
C THIS PARTICULAR PROGRAM/SUBPROGRAM/FUNCTION CONTAINS FEATURES
C FOUND ONLY IN THE SUBSET AS DEFINED IN X3.9-1978.
C
C SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO -
C
C DEPARTMENT OF THE NAVY
C FEDERAL COBOL COMPILER TESTING SERVICE
C WASHINGTON, D.C. 20376
C
C **********************************************************
C
C
C
C INITIALIZATION SECTION
C
C INITIALIZE CONSTANTS
C **************
C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER.
I01 = 5
C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER.
I02 = 6
C SYSTEM ENVIRONMENT SECTION
C
CX010 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-010 CONTROL CARD.
C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5
C (UNIT NUMBER FOR CARD READER).
CX011 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-011 CONTROL CARD.
C THE CX011 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL
C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX010 ABOVE.
C
CX020 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-020 CONTROL CARD.
C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02 = 6
C (UNIT NUMBER FOR PRINTER).
CX021 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-021 CONTROL CARD.
C THE CX021 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL
C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX020 ABOVE.
C
IVPASS=0
IVFAIL=0
IVDELE=0
ICZERO=0
C
C WRITE PAGE HEADERS
WRITE (I02,90000)
WRITE (I02,90001)
WRITE (I02,90002)
WRITE (I02, 90002)
WRITE (I02,90003)
WRITE (I02,90002)
WRITE (I02,90004)
WRITE (I02,90002)
WRITE (I02,90011)
WRITE (I02,90002)
WRITE (I02,90002)
WRITE (I02,90005)
WRITE (I02,90006)
WRITE (I02,90002)
C
C DEFAULT ASSIGNMENT FOR FILE 01 IS I06 = 7
I06 = 7
CX060 THIS CARD IS REPLACED BY THE CONTENTS OF CARD X-060
CX061 THIS CARD IS REPLACED BY THE CONTENTS OF CARD X-061
C
C WRITE SECTION....
C
C THIS SECTION OF CODE BUILDS A UNIT RECORD FILE ON LUN I06 THAT IS
C 80 CHARACTERS PER RECORD, 31 RECORDS LONG, AND CONSISTS OF ONLY
C INTEGERS ( I FORMAT ). THIS IS THE ONLY FILE TESTED IN THE
C ROUTINE FM100 AND FOR PURPOSES OF IDENTIFICATION IS FILE 01.
C ALL OF THE DATA WITH THE EXCEPTION OF THE RECORD NUMBER - IRNUM ,
C INTEGER VARIABLE ICON31 WHICH IS SET TO THE VALUE OF THE RECORD
C NUMBER, AND THE END OF FILE CHECK - IEOF IS SET BY INTEGER
C ASSIGNMENT STATEMENTS TO VARIOUS INTEGER CONSTANTS.
IPROG = 100
IFILE = 01
ILUN = I06
ITOTR = 31
IRLGN = 80
IEOF = 0000
ICON11 = 1
ICON12 = 2
ICON13 = 3
ICON14 = 4
ICON15 = 5
ICON16 = 6
ICON17 = 7
ICON18 = 8
ICON19 = 9
ICON10 = 0
ICON21 = 21
ICON22 = 22
ICON32 = 512
ICON41 = 9995
ICON42 = 9996
ICON43 = 9997
ICON44 = 9998
ICON45 = 9999
ICON51 = 32764
ICON52 = 32765
ICON53 = 32766
ICON54 = 32767
DO 12 IRNUM = 1, 31
ICON31 = IRNUM
IF ( IRNUM .EQ. 31 ) IEOF = 9999
WRITE(I06,77751)IPROG,IFILE,ILUN,IRNUM,ITOTR,IRLGN,IEOF,ICON11,ICO
1N12,ICON13,ICON14,ICON15,ICON16,ICON17,ICON18,ICON19,ICON10,ICON21
2,ICON22,ICON31,ICON32,ICON41,ICON42,ICON43,ICON44,ICON45,ICON51,IC
3ON52,ICON53,ICON54
12 CONTINUE
WRITE (I02,77706)
C
C REWIND SECTION
C
REWIND I06
C
C READ SECTION....
C
IVTNUM = 1
C
C **** TEST 1 THRU TEST 8 ****
C TEST 1 THRU TEST 8 - THESE TESTS READ THE SEQUENTIAL FILE
C PREVIOUSLY WRITTEN ON LUN I06 AND CHECK THE FIRST AND EVERY FOURTH
C RECORD. THE VALUES CHECKED ARE THE RECORD NUMBER - IRNUM AND
C SEVERAL VALUES WHICH SHOULD REMAIN CONSTANT FOR ALL OF THE 31
C RECORDS.
C
IRTST = 1
READ(I06,77751) ITEST
C READ THE FIRST RECORD....
DO 23 I = 1, 8
IVON01 = 0
C THE INTEGER VARIABLE IS INITIALIZED TO ZERO FOR EACH TEST 1 THRU 8
IF ( ITEST(4) .EQ. IRTST ) IVON01 = IVON01 + 1
C THE ELEMENT (4) SHOULD EQUAL THE RECORD NUMBER....
IF ( ITEST(8) .EQ. ICON11 ) IVON01 = IVON01 + 1
C THE ELEMENT (8) SHOULD EQUAL ICON11 = 1....
IF ( ITEST(18) .EQ. ICON21 ) IVON01 = IVON01 + 1
C THE ELEMENT (18) SHOULD EQUAL ICON21 = 21....
IF ( ITEST(20) .EQ. IRTST ) IVON01 = IVON01 + 1
C THE ELEMENT (20) SHOULD ALSO EQUAL THE RECORD NUMBER....
IF ( ITEST(26) .EQ. ICON45 ) IVON01 = IVON01 + 1
C THE ELEMENT (26. SHOULD EQUAL ICON45 = 9999....
IF ( ITEST(30) .EQ. ICON54 ) IVON01 = IVON01 + 1
C THE ELEMENT (30) SHOULD EQUAL ICON54 = 32767....
IF ( IVON01 - 6 ) 20010, 10010, 20010
C WHEN IVON01 = 6 THEN ALL SIX OF THE ITEST ELEMENTS THAT WERE
C CHECKED HAD THE EXPECTED VALUES.... IF IVON01 DOES NOT EQUAL 6
C THEN AT LEAST ONE OF THE VALUES WAS INCORRECT....
10010 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 21
20010 IVFAIL = IVFAIL + 1
IVCOMP = IVON01
IVCORR = 6
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
21 CONTINUE
IVTNUM = IVTNUM + 1
C INCREMENT THE TEST NUMBER....
IF ( IVTNUM .EQ. 9 ) GO TO 91
C TAPE SHOULD BE AT RECORD NUMBER 29 FOR TEST 8 - DO NOT READ MORE
C UNTIL TEST NUMBER NINE WHICH CHECKS RECORD NUMBER 30....
DO 22 J = 1, 4
READ(I06,77751) ITEST
C READ FOUR RECORDS ON LUN I06....
22 CONTINUE
IRTST = IRTST + 4
C INCREMENT THE RECORD NUMBER COUNTER....
23 CONTINUE
IF (ICZERO) 30010, 91, 30010
30010 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
91 CONTINUE
IVTNUM = 9
C
C **** TEST 9 ****
C TEST 9 - THIS CHECKS THE RECORD NUMBER ON EXPECTED RECORD 30.
C
IF (ICZERO) 30090, 90, 30090
90 CONTINUE
READ ( I06, 77751 ) ITEST
IVCOMP = ITEST(4)
GO TO 40090
30090 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 40090, 101, 40090
40090 IF ( IVCOMP - 30 ) 20090, 10090, 20090
10090 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 101
20090 IVFAIL = IVFAIL + 1
IVCORR = 30
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
101 CONTINUE
IVTNUM = 10
C
C **** TEST 10 ****
C TEST 10 - THIS CHECKS THE RECORD NUMBER ON EXPECTED RECORD 31.
C
IF (ICZERO) 30100, 100, 30100
100 CONTINUE
READ ( I06,77751) ITEST
IVCOMP = ITEST(4)
GO TO 40100
30100 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 40100, 111, 40100
40100 IF ( IVCOMP - 31 ) 20100, 10100, 20100
10100 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 111
20100 IVFAIL = IVFAIL + 1
IVCORR = 31
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
111 CONTINUE
IVTNUM = 11
C
C **** TEST 11 ****
C TEST 11 - THIS CHECKS FOR THE CORRECT END OF FILE CODE 9999
C ON RECORD NUMBER 31.
C
IF (ICZERO) 30110, 110, 30110
110 CONTINUE
IVCOMP = ITEST(7)
GO TO 40110
30110 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 40110, 121, 40110
40110 IF ( IVCOMP - 9999 ) 20110, 10110, 20110
10110 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 121
20110 IVFAIL = IVFAIL + 1
IVCORR = 9999
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
121 CONTINUE
C THIS CODE IS OPTIONALLY COMPILED AND IS USED TO DUMP THE FILE 01
C TO THE LINE PRINTER.
CDB**
C ILUN = I06
C ITOTR = 31
C IRLGN = 80
C7777 REWIND ILUN
C DO 7778 IRNUM = 1, ITOTR
C READ (ILUN,77701) (IDUMP(ICHAR), ICHAR = 1, IRLGN)
C WRITE ( I02,77705) (IDUMP(ICHAR), ICHAR = 1, IRLGN)
C IF ( IDUMP(20) .EQ. NINE ) GO TO 7779
C7778 CONTINUE
C GO TO 7782
C7779 IF ( IRNUM - ITOTR ) 7780, 7781, 7782
C7780 WRITE (I02,77702) IRNUM,ILUN,ITOTR
C GO TO 7784
C7781 WRITE (I02,77703) ILUN,ITOTR
C GO TO 7784
C7782 WRITE (I02,77704) ILUN, ITOTR
C DO 7783 I = 1, 5
C READ (ILUN,77701) (IDUMP(ICHAR), ICHAR = 1, IRLGN)
C WRITE ( I02,77705) (IDUMP(ICHAR), ICHAR = 1, IRLGN)
C IF ( IDUMP(20) .EQ. NINE ) GO TO 7784
C7783 CONTINUE
C7784 GO TO 99999
CDE**
C WRITE PAGE FOOTINGS AND RUN SUMMARIES
99999 CONTINUE
WRITE (I02,90002)
WRITE (I02,90006)
WRITE (I02,90002)
WRITE (I02,90002)
WRITE (I02,90007)
WRITE (I02,90002)
WRITE (I02,90008) IVFAIL
WRITE (I02,90009) IVPASS
WRITE (I02,90010) IVDELE
C
C
C TERMINATE ROUTINE EXECUTION
STOP
C
C FORMAT STATEMENTS FOR PAGE HEADERS
90000 FORMAT (1H1)
90002 FORMAT (1H )
90001 FORMAT (1H ,10X,34HFORTRAN COMPILER VALIDATION SYSTEM)
90003 FORMAT (1H ,21X,11HVERSION 1.0)
90004 FORMAT (1H ,10X,38HFOR OFFICIAL USE ONLY - COPYRIGHT 1978)
90005 FORMAT (1H ,5X,4HTEST,5X,9HPASS/FAIL, 5X,8HCOMPUTED,8X,7HCORRECT)
90006 FORMAT (1H ,5X,46H----------------------------------------------)
90011 FORMAT (1H ,18X,17HSUBSET LEVEL TEST)
C
C FORMAT STATEMENTS FOR RUN SUMMARIES
90008 FORMAT (1H ,15X,I5,19H ERRORS ENCOUNTERED)
90009 FORMAT (1H ,15X,I5,13H TESTS PASSED)
90010 FORMAT (1H ,15X,I5,14H TESTS DELETED)
C
C FORMAT STATEMENTS FOR TEST RESULTS
80001 FORMAT (1H ,4X,I5,7X,4HPASS)
80002 FORMAT (1H ,4X,I5,7X,4HFAIL)
80003 FORMAT (1H ,4X,I5,7X,7HDELETED)
80004 FORMAT (1H ,4X,I5,7X,4HFAIL,10X,I6,9X,I6)
80005 FORMAT (1H ,4X,I5,7X,4HFAIL,4X,E12.5,3X,E12.5)
C
90007 FORMAT (1H ,20X,20HEND OF PROGRAM FM100)
END
*END-OF,FM100
FM101.f 480976085 170 2 100666 12798 `
*HEADER,FORTR,FM101
*FILES1,FORTR,FM101,X
C COMMENT SECTION.
C
C FM101
C
C THIS ROUTINE IS A TEST OF THE F FORMAT AND IS TAPE AND PRINTER
C ORIENTED. THE ROUTINE CAN ALSO BE USED FOR DISK. BOTH THE READ
C AND WRITE STATEMENTS ARE TESTED. VARIABLES IN THE INPUT AND
C OUTPUT LISTS ARE REAL VARIABLES AND REAL ARRAY ELEMENTS OR
C ARRAY NAME REFERENCES. ALL READ AND WRITE STATEMENTS ARE DONE
C WITH FORMAT STATEMENTS. THE ROUTINE HAS AN OPTIONAL SECTION OF
C CODE TO DUMP THE FILE AFTER IT HAS BEEN WRITTEN. DO LOOPS AND
C DO-IMPLIED LISTS ARE USED IN CONJUNCTION WITH A ONE DIMENSIONAL
C INTEGER ARRAY FOR THE DUMP SECTION.
C
C THIS ROUTINE WRITES A SINGLE SEQUENTIAL FILE WHICH IS
C REWOUND AND READ SEQUENTIALLY FORWARD. EVERY FOURTH RECORD IS
C CHECKED DURING THE READ TEST SECTION PLUS THE LAST TWO RECORDS
C AND THE END OF FILE ON THE LAST RECORD.
C
C THE LINE CONTINUATION IN COLUMN 6 IS USED IN READ, WRITE,
C AND FORMAT STATEMENTS. FOR BOTH SYNTAX AND SEMANTIC TESTS, ALL
C STATEMENTS SHOULD BE CHECKED VISUALLY FOR THE PROPER FUNCTIONING
C OF THE CONTINUATION LINE.
C
C REFERENCES
C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN,
C X3.9-1978
C
C SECTION 8, SPECIFICATION STATEMENTS
C SECTION 9, DATA STATEMENT
C SECTION 11.10, DO STATEMENT
C SECTION 12, INPUT/OUTPUT STATEMENTS
C SECTION 12.8.2, INPUT/OUTPUT LIST
C SECTION 12.9.5.2, FORMATTED DATA TRANSFER
C SECTION 13, FORMAT STATEMENT
C SECTION 13.2.1, EDIT DESCRIPTORS
C
DIMENSION ITEST(7), RTEST(20)
DIMENSION IDUMP(136)
CHARACTER*1 NINE,IDUMP
DATA NINE/'9'/
C
77701 FORMAT ( 110A1)
77702 FORMAT (10X,19HPREMATURE EOF ONLY ,I3,13H RECORDS LUN ,I2,8H OUT O
1F ,I3,8H RECORDS)
77703 FORMAT (10X,12HFILE ON LUN ,I2,7H OK... ,I3,8H RECORDS)
77704 FORMAT (10X,12HFILE ON LUN ,I2,20H TOO LONG MORE THAN ,I3,8H RECOR
1DS)
77705 FORMAT ( 1X,80A1 / 10X, 30A1)
77706 FORMAT (10X,43HFILE I07 CREATED WITH 31 SEQUENTIAL RECORDS)
77751 FORMAT (I3,2I2,3I3,I4,F2.0,F2.1,F3.0,F3.1,F3.2,F4.0,F4.1,F4.2,F4.3
1,F5.0,F5.1,F5.2,F5.3,F5.4,F6.0,F6.1,F6.2,F6.3,F6.4,F6.5 )
C
C
C **********************************************************
C
C A COMPILER VALIDATION SYSTEM FOR THE FORTRAN LANGUAGE
C BASED ON SPECIFICATIONS AS DEFINED IN AMERICAN NATIONAL STANDARD
C PROGRAMMING LANGUAGE FORTRAN X3.9-1978, HAS BEEN DEVELOPED BY THE
C FEDERAL COBOL COMPILER TESTING SERVICE. THE FORTRAN COMPILER
C VALIDATION SYSTEM (FCVS) CONSISTS OF AUDIT ROUTINES, THEIR RELATED
C DATA, AND AN EXECUTIVE SYSTEM. EACH AUDIT ROUTINE IS A FORTRAN
C PROGRAM, SUBPROGRAM OR FUNCTION WHICH INCLUDES TESTS OF SPECIFIC
C LANGUAGE ELEMENTS AND SUPPORTING PROCEDURES INDICATING THE RESULT
C OF EXECUTING THESE TESTS.
C
C THIS PARTICULAR PROGRAM/SUBPROGRAM/FUNCTION CONTAINS FEATURES
C FOUND ONLY IN THE SUBSET AS DEFINED IN X3.9-1978.
C
C SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO -
C
C DEPARTMENT OF THE NAVY
C FEDERAL COBOL COMPILER TESTING SERVICE
C WASHINGTON, D.C. 20376
C
C **********************************************************
C
C
C
C INITIALIZATION SECTION
C
C INITIALIZE CONSTANTS
C **************
C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER.
I01 = 5
C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER.
I02 = 6
C SYSTEM ENVIRONMENT SECTION
C
CX010 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-010 CONTROL CARD.
C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5
C (UNIT NUMBER FOR CARD READER).
CX011 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-011 CONTROL CARD.
C THE CX011 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL
C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX010 ABOVE.
C
CX020 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-020 CONTROL CARD.
C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02 = 6
C (UNIT NUMBER FOR PRINTER).
CX021 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-021 CONTROL CARD.
C THE CX021 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL
C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX020 ABOVE.
C
IVPASS=0
IVFAIL=0
IVDELE=0
ICZERO=0
C
C WRITE PAGE HEADERS
WRITE (I02,90000)
WRITE (I02,90001)
WRITE (I02,90002)
WRITE (I02, 90002)
WRITE (I02,90003)
WRITE (I02,90002)
WRITE (I02,90004)
WRITE (I02,90002)
WRITE (I02,90011)
WRITE (I02,90002)
WRITE (I02,90002)
WRITE (I02,90005)
WRITE (I02,90006)
WRITE (I02,90002)
C
I07 = 7
C DEFAULT ASSIGNMENT FOR FILE 02 IS I07 = 7
C
CX070 THIS CARD IS REPLACED BY THE CONTENTS OF CARD X-070
CX071 THIS CARD IS REPLACED BY THE CONTENTS OF CARD X-071
C WRITE SECTION....
C
C THIS SECTION OF CODE BUILDS A UNIT RECORD FILE ON LUN I07 THAT IS
C 110 CHARS. PER RECORD, 31 RECORDS LONG, AND CONSISTS OF ONLY
C REALS ( F FORMAT ). THIS IS THE ONLY FILE TESTED IN THE
C ROUTINE FM101 AND FOR PURPOSES OF IDENTIFICATION IS FILE 02.
C ALL OF THE DATA WITH THE EXCEPTION OF THE 20 CHARACTER INTEGER
C PREAMBLE FOR EACH RECORD, IS COMPRISED OF REAL VARIABLES SET BY
C REAL ASSIGNMENT STATEMENTS TO VARIOUS REAL CONSTANTS.
C
C ALL THE THE REAL CONSTANTS USED ARE POSITIVE, I.E. NO SIGN.
C
IPROG = 101
IFILE = 02
ILUN = I07
ITOTR = 31
IRLGN = 110
IEOF = 0000
RCON21 = 9.
RCON22 = .9
RCON31 = 21.
RCON32 = 2.1
RCON33 = .21
RCON41 = 512.
RCON42 = 51.2
RCON43 = 5.12
RCON44 = .512
RCON51 = 9995.
RCON52 = 999.6
RCON53 = 99.97
RCON54 = 9.998
RCON55 = .9999
RCON61 = 32764.
RCON62 = 3276.5
RCON63 = 327.66
RCON64 = 32.767
RCON65 = 3.2768
RCON66 = .32769
DO 122 IRNUM = 1, 31
IF ( IRNUM .EQ. 31 ) IEOF = 9999
WRITE(I07,77751)IPROG,IFILE,ILUN,IRNUM,ITOTR,IRLGN,IEOF,RCON21,RCO
1N22,RCON31,RCON32,RCON33,RCON41,RCON42,RCON43,RCON44,RCON51,RCON52
2,RCON53,RCON54,RCON55,RCON61,RCON62,RCON63,RCON64,RCON65,RCON66
122 CONTINUE
WRITE (I02,77706)
C
C REWIND SECTION
C
REWIND I07
C
C READ SECTION....
C
IVTNUM = 12
C
C **** TEST 12 THRU TEST 19 ****
C TEST 12 THRU TEST 19 - THESE TESTS READ THE SEQUENTIAL FILE
C PREVIOUSLY WRITTEN ON LUN I07 AND CHECK THE FIRST AND EVERY FOURTH
C RECORD. THE VALUES CHECKED ARE THE RECORD NUMBER - IRNUM AND
C SEVERAL VALUES WHICH SHOULD REMAIN CONSTANT FOR ALL OF THE 31
C RECORDS.
C
IRTST = 1
READ ( I07, 77751) ITEST, RTEST
C READ THE FIRST RECORD....
DO 193 I = 1, 8
IVON01 = 0
C THE INTEGER VARIABLE IS INITIALIZED TO ZERO FOR EACH TEST 1 THRU 8
IF ( ITEST(4) .EQ. IRTST ) IVON01 = IVON01 + 1
C THE ELEMENT (4) SHOULD EQUAL THE RECORD NUMBER....
C THE TOLERANCE GIVEN IN THE REAL COMPARISONS IS BASED ON 16 BIT
C MANTISSAS TO ALLOW FOR INPUT, OUTPUT, AND STORAGE CONVERSION,
C TRUNCATION, OR ROUNDING TECHNIQUES USED BY THE IMPLEMENTOR.
IF(RTEST(1) .GE. 8.9995 .OR. RTEST(1) .LE. 9.0005) IVON01=IVON01+1
C THE ELEMENT(1) SHOULD EQUAL RCON21 = 9. ....
IF(RTEST(4) .GE. 2.0995 .OR. RTEST(4) .LE. 2.1005) IVON01=IVON01+1
C THE ELEMENT( 4) SHOULD EQUAL RCON32 = 2.1 ....
IF(RTEST(9) .GE. .51195 .OR. RTEST(9) .LE. .51205) IVON01=IVON01+1
C THE ELEMENT( 9) SHOULD EQUAL RCON44 = .512 ....
IF ( RTEST(13) .GE. 9.9975 .OR. RTEST(13) .LE. 9.9985 )
1 IVON01 = IVON01 + 1
C THE ELEMENT(13) SHOULD EQUAL RCON54 = 9.998 ....
IF ( RTEST(20) .GE. .32764 .OR. RTEST(20) .LE. .32774 )
1 IVON01 = IVON01 + 1
C THE ELEMENT(20) SHOULD EQUAL RCON66 = .32769 ....
IF ( IVON01 - 6 ) 20190, 10190, 20190
C WHEN IVON01 = 6 THEN ALL SIX OF THE ITEST ELEMENTS THAT WERE
C CHECKED HAD THE EXPECTED VALUES.... IF IVON01 DOES NOT EQUAL 6
C THEN AT LEAST ONE OF THE VALUES WAS INCORRECT....
10190 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 201
20190 IVFAIL = IVFAIL + 1
IVCOMP = IVON01
IVCORR = 6
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
201 CONTINUE
IVTNUM = IVTNUM + 1
C INCREMENT THE TEST NUMBER....
IF ( IVTNUM .EQ. 20 ) GO TO 194
C TAPE SHOULD BE AT RECORD NUMBER 29 FOR TEST 19 - DO NOT READ MORE
C UNTIL TEST NUMBER 20 WHICH CHECKS RECORD NUMBER 30....
DO 192 J = 1, 4
READ ( I07, 77751) ITEST, RTEST
C READ FOUR RECORDS ON LUN I07....
192 CONTINUE
IRTST = IRTST + 4
C INCREMENT THE RECORD NUMBER COUNTER....
193 CONTINUE
IF ( ICZERO ) 30190, 194, 30190
30190 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
194 CONTINUE
IVTNUM = 20
C
C **** TEST 20 ****
C TEST 20 - THIS CHECKS THE RECORD NUMBER ON EXPECTED RECORD 30.
C
IF (ICZERO) 30200, 200, 30200
200 CONTINUE
READ ( I07, 77751) ITEST, RTEST
IVCOMP = ITEST(4)
GO TO 40200
30200 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 40200, 211, 40200
40200 IF ( IVCOMP - 30 ) 20200, 10200, 20200
10200 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 211
20200 IVFAIL = IVFAIL + 1
IVCORR = 30
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
211 CONTINUE
IVTNUM = 21
C
C **** TEST 21 ****
C TEST 21 - THIS CHECKS THE RECORD NUMBER ON EXPECTED RECORD 31.
C
IF (ICZERO) 30210, 210, 30210
210 CONTINUE
READ ( I07, 77751) ITEST, RTEST
IVCOMP = ITEST(4)
GO TO 40210
30210 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 40210, 221, 40210
40210 IF ( IVCOMP - 31 ) 20210, 10210, 20210
10210 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 221
20210 IVFAIL = IVFAIL + 1
IVCORR = 31
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
221 CONTINUE
IVTNUM = 22
C
C **** TEST 22 ****
C TEST 22 - THIS CHECKS FOR THE CORRECT END OF FILE CODE 9999
C ON RECORD NUMBER 31.
C
IF (ICZERO) 30220, 220, 30220
220 CONTINUE
IVCOMP = ITEST(7)
GO TO 40220
30220 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 40220, 231, 40220
40220 IF ( IVCOMP - 9999 ) 20220, 10220, 20220
10220 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 231
20220 IVFAIL = IVFAIL + 1
IVCORR = 9999
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
231 CONTINUE
C THIS CODE IS OPTIONALLY COMPILED AND IS USED TO DUMP THE FILE 02
C TO THE LINE PRINTER.
CDB**
C ILUN = I07
C ITOTR = 31
C IRLGN = 110
C7777 REWIND ILUN
C DO 7778 IRNUM = 1, ITOTR
C READ (ILUN,77701) (IDUMP(ICHAR), ICHAR = 1, IRLGN)
C WRITE ( I02,77705) (IDUMP(ICHAR), ICHAR = 1, IRLGN)
C IF ( IDUMP(20) .EQ. NINE ) GO TO 7779
C7778 CONTINUE
C GO TO 7782
C7779 IF ( IRNUM - ITOTR ) 7780, 7781, 7782
C7780 WRITE (I02,77702) IRNUM,ILUN,ITOTR
C GO TO 7784
C7781 WRITE (I02,77703) ILUN,ITOTR
C GO TO 7784
C7782 WRITE (I02,77704) ILUN, ITOTR
C DO 7783 I = 1, 5
C READ (ILUN,77701) (IDUMP(ICHAR), ICHAR = 1, IRLGN)
C WRITE ( I02,77705) (IDUMP(ICHAR), ICHAR = 1, IRLGN)
C IF ( IDUMP(20) .EQ. NINE ) GO TO 7784
C7783 CONTINUE
C7784 GO TO 99999
CDE**
C
C WRITE PAGE FOOTINGS AND RUN SUMMARIES
99999 CONTINUE
WRITE (I02,90002)
WRITE (I02,90006)
WRITE (I02,90002)
WRITE (I02,90002)
WRITE (I02,90007)
WRITE (I02,90002)
WRITE (I02,90008) IVFAIL
WRITE (I02,90009) IVPASS
WRITE (I02,90010) IVDELE
C
C
C TERMINATE ROUTINE EXECUTION
STOP
C
C FORMAT STATEMENTS FOR PAGE HEADERS
90000 FORMAT (1H1)
90002 FORMAT (1H )
90001 FORMAT (1H ,10X,34HFORTRAN COMPILER VALIDATION SYSTEM)
90003 FORMAT (1H ,21X,11HVERSION 1.0)
90004 FORMAT (1H ,10X,38HFOR OFFICIAL USE ONLY - COPYRIGHT 1978)
90005 FORMAT (1H ,5X,4HTEST,5X,9HPASS/FAIL, 5X,8HCOMPUTED,8X,7HCORRECT)
90006 FORMAT (1H ,5X,46H----------------------------------------------)
90011 FORMAT (1H ,18X,17HSUBSET LEVEL TEST)
C
C FORMAT STATEMENTS FOR RUN SUMMARIES
90008 FORMAT (1H ,15X,I5,19H ERRORS ENCOUNTERED)
90009 FORMAT (1H ,15X,I5,13H TESTS PASSED)
90010 FORMAT (1H ,15X,I5,14H TESTS DELETED)
C
C FORMAT STATEMENTS FOR TEST RESULTS
80001 FORMAT (1H ,4X,I5,7X,4HPASS)
80002 FORMAT (1H ,4X,I5,7X,4HFAIL)
80003 FORMAT (1H ,4X,I5,7X,7HDELETED)
80004 FORMAT (1H ,4X,I5,7X,4HFAIL,10X,I6,9X,I6)
80005 FORMAT (1H ,4X,I5,7X,4HFAIL,4X,E12.5,3X,E12.5)
C
90007 FORMAT (1H ,20X,20HEND OF PROGRAM FM101)
END
*END-OF,FM101
FM102.f 480976086 170 2 100666 13456 `
*HEADER,FORTR,FM102
*FILES1,FORTR,FM102,X
C COMMENT SECTION.
C
C FM102
C
C THIS ROUTINE IS A TEST OF THE A FORMAT AND IS TAPE AND PRINTER
C ORIENTED. THE ROUTINE CAN ALSO BE USED FOR DISK. BOTH THE READ
C AND WRITE STATEMENTS ARE TESTED. VARIABLES IN THE INPUT AND
C OUTPUT LISTS ARE ALPHANUMERIC INTEGERS AND ARRAY ELEMENTS OR
C ARRAY NAME REFERENCES. ALL READ AND WRITE STATEMENTS ARE DONE
C WITH FORMAT STATEMENTS. THE ROUTINE HAS AN OPTIONAL SECTION OF
C CODE TO DUMP THE FILE AFTER IT HAS BEEN WRITTEN. DO LOOPS AND
C DO-IMPLIED LISTS ARE USED IN CONJUNCTION WITH A ONE DIMENSIONAL
C INTEGER ARRAY FOR THE DUMP SECTION.
C
C THIS ROUTINE WRITES A SINGLE SEQUENTIAL FILE WHICH IS
C REWOUND AND READ SEQUENTIALLY FORWARD. EVERY RECORD IS READ AND
C CHECKED FOR ACCURACY AND THE END OF FILE ON RECORD 31 IS ALSO
C CHECKED. DURING THE READ AND CHECK PROCESS THE FILE IS REWOUND
C TWICE. THE FIRST PASS CHECKS THE ODD NUMBERED RECORDS AND THE
C SECOND PASS CHECKS THE EVEN NUMBERED RECORDS.
C
C THE LINE CONTINUATION IN COLUMN 6 IS USED IN READ, WRITE,
C AND FORMAT STATEMENTS. FOR BOTH SYNTAX AND SEMANTIC TESTS, ALL
C STATEMENTS SHOULD BE CHECKED VISUALLY FOR THE PROPER FUNCTIONING
C OF THE CONTINUATION LINE.
C
C REFERENCES
C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN,
C X3.9-1978
C
C SECTION 8, SPECIFICATION STATEMENTS
C SECTION 9, DATA STATEMENT
C SECTION 11.10, DO STATEMENT
C SECTION 12, INPUT/OUTPUT STATEMENTS
C SECTION 12.8.2, INPUT/OUTPUT LIST
C SECTION 12.9.5.2, FORMATTED DATA TRANSFER
C SECTION 13, FORMAT STATEMENT
C SECTION 13.2.1, EDIT DESCRIPTORS
C
COMMON IACN11(60), IACN12(30)
C
DIMENSION ITEST(7)
DIMENSION IADN11(60), IADN12(30)
DIMENSION IDUMP(136)
CHARACTER*1 NINE,IADN11,IACN11,IDUMP
CHARACTER*2 IADN12,IACN12
DATA NINE/'9'/
DATA IADN11 /'0', '1', '2', '3', '4', '5', '6', '7', '8', '9',
1'A', 'B', 'C', 'D', 'E', 'F', 'G', 'H', 'I', 'J', 'K', 'L', 'M',
2'N', 'O', 'P', 'Q', 'R', 'S', 'T', 'U', 'V', 'W', 'X', 'Y', 'Z',
3' ', '=', '+', '-', '*', '/', '(', ')', ',', '.','*', '0', '*',
4'1', '.', '2', ',', '3', ')', '4', '(', '5', '/', '6' /
DATA IADN12 /
1'6/', '5(', '4)','3,', '2.', '1*', '0*', '.,', ')(', '/*', '-+',
2'= ', 'ZY', 'XW', 'VU', 'TS', 'RQ', 'PO', 'NM', 'LK', 'JI', 'HG'
3,'FE', 'DC', 'BA', '98', '76', '54', '32', '10' /
77701 FORMAT ( 80A1 )
77702 FORMAT (10X,19HPREMATURE EOF ONLY ,I3,13H RECORDS LUN ,I2,8H OUT O
1F ,I3,8H RECORDS)
77703 FORMAT (10X,12HFILE ON LUN ,I2,7H OK... ,I3,8H RECORDS)
77704 FORMAT (10X,12HFILE ON LUN ,I2,20H TOO LONG MORE THAN ,I3,8H RECOR
1DS)
77705 FORMAT ( 1X,80A1)
77706 FORMAT (10X,43HFILE I08 CREATED WITH 31 SEQUENTIAL RECORDS)
77751 FORMAT (I3, 2I2, 3I3, I4, 60A1 )
77752 FORMAT ( I3, 2I2, 3I3, I4, 30A2 )
C
C
C **********************************************************
C
C A COMPILER VALIDATION SYSTEM FOR THE FORTRAN LANGUAGE
C BASED ON SPECIFICATIONS AS DEFINED IN AMERICAN NATIONAL STANDARD
C PROGRAMMING LANGUAGE FORTRAN X3.9-1978, HAS BEEN DEVELOPED BY THE
C FEDERAL COBOL COMPILER TESTING SERVICE. THE FORTRAN COMPILER
C VALIDATION SYSTEM (FCVS) CONSISTS OF AUDIT ROUTINES, THEIR RELATED
C DATA, AND AN EXECUTIVE SYSTEM. EACH AUDIT ROUTINE IS A FORTRAN
C PROGRAM, SUBPROGRAM OR FUNCTION WHICH INCLUDES TESTS OF SPECIFIC
C LANGUAGE ELEMENTS AND SUPPORTING PROCEDURES INDICATING THE RESULT
C OF EXECUTING THESE TESTS.
C
C THIS PARTICULAR PROGRAM/SUBPROGRAM/FUNCTION CONTAINS FEATURES
C FOUND ONLY IN THE SUBSET AS DEFINED IN X3.9-1978.
C
C SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO -
C
C DEPARTMENT OF THE NAVY
C FEDERAL COBOL COMPILER TESTING SERVICE
C WASHINGTON, D.C. 20376
C
C **********************************************************
C
C
C
C INITIALIZATION SECTION
C
C INITIALIZE CONSTANTS
C **************
C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER.
I01 = 5
C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER.
I02 = 6
C SYSTEM ENVIRONMENT SECTION
C
CX010 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-010 CONTROL CARD.
C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5
C (UNIT NUMBER FOR CARD READER).
CX011 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-011 CONTROL CARD.
C THE CX011 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL
C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX010 ABOVE.
C
CX020 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-020 CONTROL CARD.
C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02 = 6
C (UNIT NUMBER FOR PRINTER).
CX021 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-021 CONTROL CARD.
C THE CX021 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL
C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX020 ABOVE.
C
IVPASS=0
IVFAIL=0
IVDELE=0
ICZERO=0
C
C WRITE PAGE HEADERS
WRITE (I02,90000)
WRITE (I02,90001)
WRITE (I02,90002)
WRITE (I02, 90002)
WRITE (I02,90003)
WRITE (I02,90002)
WRITE (I02,90004)
WRITE (I02,90002)
WRITE (I02,90011)
WRITE (I02,90002)
WRITE (I02,90002)
WRITE (I02,90005)
WRITE (I02,90006)
WRITE (I02,90002)
C
C DEFAULT ASSIGNMENT FOR FILE 03 IS I08 = 7
I08 = 7
CX080 THIS CARD IS REPLACED BY THE CONTENTS OF CARD X-080
CX081 THIS CARD IS REPLACED BY THE CONTENTS OF CARD X-081
C
C WRITE SECTION....
C
C THIS SECTION OF CODE BUILDS A UNIT RECORD FILE ON LUN I08 THAT IS
C 80 CHARACTERS PER RECORD, 31 RECORDS LONG, AND CONSISTS OF ONLY
C INTEGERS AND ALPHANUMERICS ( I AND A FORMAT ). THIS ROUTINE HAS
C ONLY ONE FILE AND FOR PURPOSES OF IDENTIFICATION IS FILE 03.
C ALL ARRAY ELEMENT DATA FOR THE ALPHANUMERIC CHARACTERS IS SET BY
C THE DATA INITIALIZATION STATEMENT.
IPROG = 102
IFILE = 03
ILUN = I08
ITOTR = 31
IRLGN = 80
IEOF = 0000
IFLIP = 1
DO 234 IRNUM = 1, 31
IF ( IRNUM .EQ. 31 ) IEOF = 9999
IF ( IFLIP - 1 ) 232, 232, 233
232 WRITE ( I08, 77751 ) IPROG,IFILE,ILUN,IRNUM,ITOTR,IRLGN,IEOF,IADN
111
IFLIP = 2
GO TO 234
233 WRITE ( I08, 77752 ) IPROG,IFILE,ILUN,IRNUM,ITOTR,IRLGN,IEOF,IADN1
12
IFLIP = 1
234 CONTINUE
WRITE (I02,77706)
C
C REWIND SECTION
C
REWIND I08
C
C READ SECTION....
C
IVTNUM = 23
C
C **** TEST 23 THRU TEST 38 ****
C TEST 23 THRU 38 - THESE TESTS READ THE FILE SEQUENTIALLY FORWARD
C AND CHECK THE ODD NUMBERED RECORDS FOR THE RECORD NUMBER AND THE
C VALUE OF SEVERAL OF THE DATA ITEMS WHICH SHOULD REMAIN CONSTANT
C FROM RECORD TO RECORD.
C
IRTST = 1
DO 383 I = 1, 16
C THE INTEGER VARIABLE IS INITIALIZED TO ZERO FOR EACH TEST 23 - 38.
IVON01 = 0
C READ AN ODD NUMBERED RECORD....
READ ( I08, 77751 ) ITEST, IACN11
IF ( ITEST(4) .EQ. IRTST ) IVON01 = IVON01 + 1
C THE ELEMENT (4) SHOULD EQUAL THE RECORD NUMBER....
IF ( IACN11(1) .EQ. IADN11(1) ) IVON01 = IVON01 + 1
C THE ELEMENT (1) SHOULD EQUAL IADN11(1) = '0' ....
IF ( IACN11(11) .EQ. IADN11(11) ) IVON01 = IVON01 + 1
C THE ELEMENT (11) SHOULD EQUAL IADN11(11) = 'A' ....
IF ( IACN11(36) .EQ. IADN11(36) ) IVON01 = IVON01 + 1
C THE ELEMENT (36) SHOULD EQUAL IADN11(36) = 'Z' ....
IF ( IACN11(44) .EQ. IADN11(44) ) IVON01 = IVON01 + 1
C THE ELEMENT (44) SHOULD EQUAL IADN11(44) = ')' ....
IF ( IACN11(60) .EQ. IADN11(60) ) IVON01 = IVON01 + 1
C THE ELEMENT (60) SHOULD EQUAL IADN11(60) = '6' ....
IF ( IVON01 - 6 ) 20230, 10230, 20230
C WHEN IVON01 = 6 THEN ALL SIX OF THE ITEST ELEMENTS THAT WERE
C CHECKED HAD THE EXPECTED VALUES.... IF IVON01 DOES NOT EQUAL 6
C THEN AT LEAST ONE OF THE VALUES WAS INCORRECT....
10230 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 382
20230 IVFAIL = IVFAIL + 1
IVCOMP = IVON01
IVCORR = 6
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
382 CONTINUE
C DO NOT READ PAST RECORD NUMBER 31 ON THE I = 16 LOOP....
IF ( I .EQ. 16 ) GO TO 391
C SKIP OVER THE EVEN NUMBERED RECORDS BY AN EXTRA READ....
READ ( I08, 77752 ) ITEST, IACN12
IVTNUM = IVTNUM + 1
C INCREMENT THE TEST NUMBER....
IRTST = IRTST + 2
C INCREMENT THE RECORD NUMBER COUNTER....
383 CONTINUE
IF ( ICZERO ) 30230, 391, 30230
30230 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
391 CONTINUE
IVTNUM = 39
C
C **** TEST 39 ****
C TEST 39 - THIS CHECKS FOR THE END OF FILE INDICATOR ON THE 31ST
C RECORD. THE EOF INDICATOR IS ITEST(7) AND SHOULD EQUAL 9999
C
IF (ICZERO) 30390, 390, 30390
390 CONTINUE
IVCOMP = ITEST(7)
GO TO 40390
30390 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 40390, 401, 40390
40390 IF ( IVCOMP - 9999 ) 20390, 10390, 20390
10390 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 401
20390 IVFAIL = IVFAIL + 1
IVCORR = 9999
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
401 CONTINUE
C REWIND THE FILE AGAIN....
REWIND I08
C READ THE FILE AGAIN
IVTNUM = 40
C **** TEST 40 THRU 54 ****
C TEST 40 THRU 54 - THESE TESTS CHECK THE EVEN NUMBERED RECORDS
C FOR THE CORRECT RECORD NUMBER AND THE VALUE OF SEVERAL DATA ITEMS
C WHICH SHOULD REMAIN CONSTANT FOR EACH RECORD. THESE READ CHECKS
C USE A DIFFERENT FORMAT THAN TESTS 23 THRU 38 BECAUSE THE RECORDS
C WERE WRITTEN USING A FLIP-FLOP BETWEEN TWO FORMATS.
C
IRTST = 2
C THIS RECORD POINTER IS INITIALIZED TO THE SECOND (EVEN) RECORD
DO 532 I = 1, 15
C THE INTEGER VARIABLE IS INITIALIZED TO ZERO FOR EACH TEST 40 - 54
IVON01 = 0
C SKIP OVER THE ODD NUMBERED RECORDS....
READ ( I08, 77751 ) ITEST, IACN11
C READ THE EVEN NUMBERED RECORDS....
READ ( I08, 77752 ) ITEST, IACN12
IF ( ITEST(4) .EQ. IRTST ) IVON01 = IVON01 + 1
C CHECK THE RECORD NUMBER....
IF ( IACN12(1) .EQ. IADN12(1) ) IVON01 = IVON01 + 1
C ELEMENT (1) SHOULD EQUAL '6/' ....
IF ( IACN12(11) .EQ. IADN12(11) ) IVON01 = IVON01 + 1
C ELEMENT (11) SHOULD EQUAL '-+' ....
IF ( IACN12(16) .EQ. IADN12(16) ) IVON01 = IVON01 + 1
C ELEMENT (16) SHOULD EQUAL 'TS' ....
IF ( IACN12(23) .EQ. IADN12(23) ) IVON01 = IVON01 + 1
C ELEMENT (23) SHOULD EQUAL 'FE' .... (THE SYMBOL FOR IRONY)
IF ( IACN12(30) .EQ. IADN12(30) ) IVON01 = IVON01 + 1
C ELEMENT (30) SHOULD EQUAL '10' ....
IF ( IVON01 - 6 ) 20400, 10400, 20400
10400 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 402
20400 IVFAIL = IVFAIL + 1
IVCOMP = IVON01
IVCORR = 6
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
402 CONTINUE
IVTNUM = IVTNUM + 1
C INCREMENT THE TEST NUMBER....
IRTST = IRTST + 2
C INCREMENT THE RECORD NUMBER COUNTER....
532 CONTINUE
IF ( ICZERO ) 30400, 411, 30400
30400 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
411 CONTINUE
C THIS CODE IS OPTIONALLY COMPILED AND IS USED TO DUMP THE FILE 03
C TO THE LINE PRINTER.
CDB**
C ILUN = I08
C ITOTR = 31
C IRLGN = 80
C7777 REWIND ILUN
C DO 7778 IRNUM = 1, ITOTR
C READ (ILUN,77701) (IDUMP(ICHAR), ICHAR = 1, IRLGN)
C WRITE ( I02,77705) (IDUMP(ICHAR), ICHAR = 1, IRLGN)
C IF ( IDUMP(20) .EQ. NINE ) GO TO 7779
C7778 CONTINUE
C GO TO 7782
C7779 IF ( IRNUM - ITOTR ) 7780, 7781, 7782
C7780 WRITE (I02,77702) IRNUM,ILUN,ITOTR
C GO TO 7784
C7781 WRITE (I02,77703) ILUN,ITOTR
C GO TO 7784
C7782 WRITE (I02,77704) ILUN, ITOTR
C DO 7783 I = 1, 5
C READ (ILUN,77701) (IDUMP(ICHAR), ICHAR = 1, IRLGN)
C WRITE ( I02,77705) (IDUMP(ICHAR), ICHAR = 1, IRLGN)
C IF ( IDUMP(20) .EQ. NINE ) GO TO 7784
C7783 CONTINUE
C7784 GO TO 99999
CDE**
C WRITE PAGE FOOTINGS AND RUN SUMMARIES
99999 CONTINUE
WRITE (I02,90002)
WRITE (I02,90006)
WRITE (I02,90002)
WRITE (I02,90002)
WRITE (I02,90007)
WRITE (I02,90002)
WRITE (I02,90008) IVFAIL
WRITE (I02,90009) IVPASS
WRITE (I02,90010) IVDELE
C
C
C TERMINATE ROUTINE EXECUTION
STOP
C
C FORMAT STATEMENTS FOR PAGE HEADERS
90000 FORMAT (1H1)
90002 FORMAT (1H )
90001 FORMAT (1H ,10X,34HFORTRAN COMPILER VALIDATION SYSTEM)
90003 FORMAT (1H ,21X,11HVERSION 1.0)
90004 FORMAT (1H ,10X,38HFOR OFFICIAL USE ONLY - COPYRIGHT 1978)
90005 FORMAT (1H ,5X,4HTEST,5X,9HPASS/FAIL, 5X,8HCOMPUTED,8X,7HCORRECT)
90006 FORMAT (1H ,5X,46H----------------------------------------------)
90011 FORMAT (1H ,18X,17HSUBSET LEVEL TEST)
C
C FORMAT STATEMENTS FOR RUN SUMMARIES
90008 FORMAT (1H ,15X,I5,19H ERRORS ENCOUNTERED)
90009 FORMAT (1H ,15X,I5,13H TESTS PASSED)
90010 FORMAT (1H ,15X,I5,14H TESTS DELETED)
C
C FORMAT STATEMENTS FOR TEST RESULTS
80001 FORMAT (1H ,4X,I5,7X,4HPASS)
80002 FORMAT (1H ,4X,I5,7X,4HFAIL)
80003 FORMAT (1H ,4X,I5,7X,7HDELETED)
80004 FORMAT (1H ,4X,I5,7X,4HFAIL,10X,I6,9X,I6)
80005 FORMAT (1H ,4X,I5,7X,4HFAIL,4X,E12.5,3X,E12.5)
C
90007 FORMAT (1H ,20X,20HEND OF PROGRAM FM102)
END
*END-OF,FM102
FM103.f 480976088 170 2 100666 11194 `
*HEADER,FORTR,FM103
*FILES1,FORTR,FM103,X
C COMMENT SECTION.
C
C FM103
C
C THIS ROUTINE IS A TEST OF THE X FORMAT AND IS TAPE AND PRINTER
C ORIENTED. THE ROUTINE CAN ALSO BE USED FOR DISK. BOTH THE READ
C AND WRITE STATEMENTS ARE TESTED. VARIABLES IN THE INPUT AND
C OUTPUT LISTS ARE INTEGER OR REAL VARIABLES, INTEGER ARRAY ELEMENTS
C OR ARRAY NAME REFERENCES. READ AND WRITE STATEMENTS ARE DONE
C WITH FORMAT STATEMENTS. THE ROUTINE HAS AN OPTIONAL SECTION OF
C CODE TO DUMP THE FILE AFTER IT HAS BEEN WRITTEN. DO LOOPS AND
C DO-IMPLIED LISTS ARE USED IN CONJUNCTION WITH A ONE DIMENSIONAL
C INTEGER ARRAY FOR THE DUMP SECTION.
C
C THIS ROUTINE WRITES A SINGLE SEQUENTIAL FILE WHICH IS
C REWOUND AND READ SEQUENTIALLY FORWARD. EVERY RECORD IS READ AND
C CHECKED FOR ACCURACY AND THE END OF FILE ON RECORD 31 IS ALSO
C CHECKED. DURING THE READ AND CHECK PROCESS THE FILE IS REWOUND
C TWICE. THE FIRST PASS CHECKS THE ODD NUMBERED RECORDS AND THE
C SECOND PASS CHECKS THE EVEN NUMBERED RECORDS.
C
C THE LINE CONTINUATION IN COLUMN 6 IS USED IN READ, WRITE,
C AND FORMAT STATEMENTS. FOR BOTH SYNTAX AND SEMANTIC TESTS, ALL
C STATEMENTS SHOULD BE CHECKED VISUALLY FOR THE PROPER FUNCTIONING
C OF THE CONTINUATION LINE.
C
C REFERENCES
C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN,
C X3.9-1978
C
C SECTION 8, SPECIFICATION STATEMENTS
C SECTION 9, DATA STATEMENT
C SECTION 11.10, DO STATEMENT
C SECTION 12, INPUT/OUTPUT STATEMENTS
C SECTION 12.8.2, INPUT/OUTPUT LIST
C SECTION 12.9.5.2, FORMATTED DATA TRANSFER
C SECTION 13, FORMAT STATEMENT
C SECTION 13.2.1, EDIT DESCRIPTORS
C
DIMENSION IDUMP(136)
DIMENSION IADN11(5), IADN12(3), IADN13(3)
CHARACTER*1 NINE,IADN11,ICON04,ICON06,IDUMP
CHARACTER*2 IADN12
CHARACTER*3 IADN13
DATA NINE/'9'/
DATA IADN11/'A', 'B', 'C', 'D', 'E'/, IADN12 / 'HE', 'LL', 'O'/
1,IADN13 / 'H', 'EL', 'LO' /
C
77701 FORMAT ( 80A1 )
77702 FORMAT (10X,19HPREMATURE EOF ONLY ,I3,13H RECORDS LUN ,I2,8H OUT O
1F ,I3,8H RECORDS)
77703 FORMAT (10X,12HFILE ON LUN ,I2,7H OK... ,I3,8H RECORDS)
77704 FORMAT (10X,12HFILE ON LUN ,I2,20H TOO LONG MORE THAN ,I3,8H RECOR
1DS)
77705 FORMAT ( 1X,80A1)
77706 FORMAT (10X,43HFILE I09 CREATED WITH 31 SEQUENTIAL RECORDS)
77751 FORMAT ( I3,2I2,3I3,I4,5X,I5,5X,F5.2,5X,5A1,5X,I5,5X,F5.4,5X,2A2,A
11 )
77752 FORMAT ( I3,2I2,3I3,I4,I5,5X,F5.2,5X,5A1,5X,I5,5X,F5.4,5X,A1,2A2,5
1X )
77753 FORMAT (7X,I3,6X,I4,5X,I5,15X,A1,9X,I5,5X,F5.4,9X,A1 )
77754 FORMAT (7X,I3,6X,I4,I5,15X,A1,9X,I5,5X,F5.4,9X,A1 )
C
C
C **********************************************************
C
C A COMPILER VALIDATION SYSTEM FOR THE FORTRAN LANGUAGE
C BASED ON SPECIFICATIONS AS DEFINED IN AMERICAN NATIONAL STANDARD
C PROGRAMMING LANGUAGE FORTRAN X3.9-1978, HAS BEEN DEVELOPED BY THE
C FEDERAL COBOL COMPILER TESTING SERVICE. THE FORTRAN COMPILER
C VALIDATION SYSTEM (FCVS) CONSISTS OF AUDIT ROUTINES, THEIR RELATED
C DATA, AND AN EXECUTIVE SYSTEM. EACH AUDIT ROUTINE IS A FORTRAN
C PROGRAM, SUBPROGRAM OR FUNCTION WHICH INCLUDES TESTS OF SPECIFIC
C LANGUAGE ELEMENTS AND SUPPORTING PROCEDURES INDICATING THE RESULT
C OF EXECUTING THESE TESTS.
C
C THIS PARTICULAR PROGRAM/SUBPROGRAM/FUNCTION CONTAINS FEATURES
C FOUND ONLY IN THE SUBSET AS DEFINED IN X3.9-1978.
C
C SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO -
C
C DEPARTMENT OF THE NAVY
C FEDERAL COBOL COMPILER TESTING SERVICE
C WASHINGTON, D.C. 20376
C
C **********************************************************
C
C
C
C INITIALIZATION SECTION
C
C INITIALIZE CONSTANTS
C **************
C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER.
I01 = 5
C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER.
I02 = 6
C SYSTEM ENVIRONMENT SECTION
C
CX010 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-010 CONTROL CARD.
C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5
C (UNIT NUMBER FOR CARD READER).
CX011 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-011 CONTROL CARD.
C THE CX011 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL
C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX010 ABOVE.
C
CX020 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-020 CONTROL CARD.
C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02 = 6
C (UNIT NUMBER FOR PRINTER).
CX021 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-021 CONTROL CARD.
C THE CX021 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL
C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX020 ABOVE.
C
IVPASS=0
IVFAIL=0
IVDELE=0
ICZERO=0
C
C WRITE PAGE HEADERS
WRITE (I02,90000)
WRITE (I02,90001)
WRITE (I02,90002)
WRITE (I02, 90002)
WRITE (I02,90003)
WRITE (I02,90002)
WRITE (I02,90004)
WRITE (I02,90002)
WRITE (I02,90011)
WRITE (I02,90002)
WRITE (I02,90002)
WRITE (I02,90005)
WRITE (I02,90006)
WRITE (I02,90002)
C
C DEFAULT ASSIGNMENT FOR FILE 04 IS I09 = 7
I09 = 7
CX090 THIS CARD IS REPLACED BY THE CONTENTS OF CARD X-090
CX091 THIS CARD IS REPLACED BY THE CONTENTS OF CARD X-091
C
C WRITE SECTION....
C
C THIS SECTION OF CODE BUILDS A UNIT RECORD FILE ON LUN I09 THAT IS
C 80 CHARACTERS PER RECORD, 31 RECORDS LONG, AND CONSISTS OF
C I, F, A, AND X FORMAT. THIS IS THE ONLY FILE TESTED IN THE
C ROUTINE FM103 AND FOR PURPOSES OF IDENTIFICATION IS FILE 04.
C ALL ARRAY ELEMENT DATA FOR THE ALPHANUMERIC CHARACTERS IS SET BY
C THE DATA INITIALIZATION STATEMENT. INTEGER AND REAL VARIABLES ARE
C SET BY ASSIGNMENT STATEMENTS.
IPROG = 103
IFILE = 04
ILUN = I09
ITOTR = 31
IRLGN = 80
IEOF = 0000
ICON01 = 32767
RCON01 = 12.34
ICON02 = 12345
RCON02 = .9999
IFLIP = 1
DO 504 IRNUM = 1, 31
IF ( IRNUM .EQ. 31 ) IEOF = 9999
IF ( IFLIP - 1 ) 502, 502, 503
502 WRITE ( I09, 77751 ) IPROG, IFILE, ILUN, IRNUM, ITOTR, IRLGN, IEOF
1, ICON01, RCON01, IADN11,ICON02, RCON02, IADN12
IFLIP = 2
GO TO 504
503 WRITE ( I09, 77752 ) IPROG, IFILE, ILUN, IRNUM, ITOTR, IRLGN, IEOF
1, ICON01, RCON01, IADN11, ICON02, RCON02, IADN13
IFLIP = 1
504 CONTINUE
WRITE (I02,77706)
C
C REWIND SECTION
C
REWIND I09
C
C READ SECTION....
C
C
IVTNUM = 55
C
C **** TEST 55 THRU 85 ****
C TEST 55 THRU 85 - THESE TESTS CHECK THE RECORD NUMBER AND
C CONTENTS OF SEVERAL OF THE DATA ITEMS WHICH REMAIN CONSTANT FOR
C ALL OF THE RECORDS. A DIFFERENT USE OF THE X SKIP FIELD FORMAT
C IS USED IN READING THE FILE THAN WAS USED TO WRITE THE FILE.
C
IFLIP = 1
DO 556 IRNUM = 1, 31
C THE INTEGER VARIABLE IS INITIALIZED TO ZERO FOR EACH TEST 55 - 85.
IVON01 = 0
C READ THE FILE....
IF ( IFLIP - 1 ) 552, 552, 553
552 READ ( I09,77753 ) IRNO,IEND,ICON03,ICON04,ICON05,RCON03,ICON06
IFLIP = 2
GO TO 554
553 READ ( I09,77754 ) IRNO,IEND,ICON03,ICON04,ICON05,RCON03,ICON06
IFLIP = 1
554 CONTINUE
IF ( IRNO .EQ. IRNUM ) IVON01 = IVON01 + 1
C IRNO SHOULD BE THE RECORD NUMBER....
IF ( ICON03 .EQ. ICON01 ) IVON01 = IVON01 + 1
C ICON03 SHOULD EQUAL 32767 ....
IF ( ICON04 .EQ. IADN11(1) ) IVON01 = IVON01 + 1
C ICON04 SHOULD EQUAL 'A' ....
IF ( ICON05 .EQ. ICON02 ) IVON01 = IVON01 + 1
C ICON05 SHOULD EQUAL 12345 ....
IF(RCON03.GE. .99985 .OR. RCON03.LE. .99995) IVON01=IVON01+1
C RCON03 SHOULD EQUAL .9999 ....
IF ( ICON06 .EQ. IADN12(3) ) IVON01 = IVON01 + 1
C ICON06 SHOULD EQUAL 'O' ....
IF ( IVON01 - 6 ) 20550, 10550, 20550
C WHEN IVON01 = 6 THEN ALL SIX OF THE ITEST ELEMENTS THAT WERE
C CHECKED HAD THE EXPECTED VALUES.... IF IVON01 DOES NOT EQUAL 6
C THEN AT LEAST ONE OF THE VALUES WAS INCORRECT....
10550 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 555
20550 IVFAIL = IVFAIL + 1
IVCOMP = IVON01
IVCORR = 6
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
555 CONTINUE
IVTNUM = IVTNUM + 1
C INCREMENT THE TEST NUMBER....
556 CONTINUE
IF ( ICZERO ) 30550, 861, 30550
30550 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
861 CONTINUE
IVTNUM = 86
C
C **** TEST 86 ****
C TEST 86 - THIS TEST CHECKS THE END OF FILE INDICATOR ON THE
C 31ST RECORD..
C
IF (ICZERO) 30860, 860, 30860
860 CONTINUE
IVCOMP = IEND
GO TO 40860
30860 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 40860, 871, 40860
40860 IF ( IVCOMP - 9999 ) 20860, 10860, 20860
10860 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 871
20860 IVFAIL = IVFAIL + 1
IVCORR = 9999
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
871 CONTINUE
C THIS CODE IS OPTIONALLY COMPILED AND IS USED TO DUMP THE FILE 04
C TO THE LINE PRINTER.
CDB**
C ILUN = I09
C ITOTR = 31
C IRLGN = 80
C7777 REWIND ILUN
C DO 7778 IRNUM = 1, ITOTR
C READ (ILUN,77701) (IDUMP(ICHAR), ICHAR = 1, IRLGN)
C WRITE ( I02,77705) (IDUMP(ICHAR), ICHAR = 1, IRLGN)
C IF ( IDUMP(20) .EQ. NINE ) GO TO 7779
C7778 CONTINUE
C GO TO 7782
C7779 IF ( IRNUM - ITOTR ) 7780, 7781, 7782
C7780 WRITE (I02,77702) IRNUM,ILUN,ITOTR
C GO TO 7784
C7781 WRITE (I02,77703) ILUN,ITOTR
C GO TO 7784
C7782 WRITE (I02,77704) ILUN, ITOTR
C DO 7783 I = 1, 5
C READ (ILUN,77701) (IDUMP(ICHAR), ICHAR = 1, IRLGN)
C WRITE ( I02,77705) (IDUMP(ICHAR), ICHAR = 1, IRLGN)
C IF ( IDUMP(20) .EQ. NINE ) GO TO 7784
C7783 CONTINUE
C7784 GO TO 99999
CDE**
C WRITE PAGE FOOTINGS AND RUN SUMMARIES
99999 CONTINUE
WRITE (I02,90002)
WRITE (I02,90006)
WRITE (I02,90002)
WRITE (I02,90002)
WRITE (I02,90007)
WRITE (I02,90002)
WRITE (I02,90008) IVFAIL
WRITE (I02,90009) IVPASS
WRITE (I02,90010) IVDELE
C
C
C TERMINATE ROUTINE EXECUTION
STOP
C
C FORMAT STATEMENTS FOR PAGE HEADERS
90000 FORMAT (1H1)
90002 FORMAT (1H )
90001 FORMAT (1H ,10X,34HFORTRAN COMPILER VALIDATION SYSTEM)
90003 FORMAT (1H ,21X,11HVERSION 1.0)
90004 FORMAT (1H ,10X,38HFOR OFFICIAL USE ONLY - COPYRIGHT 1978)
90005 FORMAT (1H ,5X,4HTEST,5X,9HPASS/FAIL, 5X,8HCOMPUTED,8X,7HCORRECT)
90006 FORMAT (1H ,5X,46H----------------------------------------------)
90011 FORMAT (1H ,18X,17HSUBSET LEVEL TEST)
C
C FORMAT STATEMENTS FOR RUN SUMMARIES
90008 FORMAT (1H ,15X,I5,19H ERRORS ENCOUNTERED)
90009 FORMAT (1H ,15X,I5,13H TESTS PASSED)
90010 FORMAT (1H ,15X,I5,14H TESTS DELETED)
C
C FORMAT STATEMENTS FOR TEST RESULTS
80001 FORMAT (1H ,4X,I5,7X,4HPASS)
80002 FORMAT (1H ,4X,I5,7X,4HFAIL)
80003 FORMAT (1H ,4X,I5,7X,7HDELETED)
80004 FORMAT (1H ,4X,I5,7X,4HFAIL,10X,I6,9X,I6)
80005 FORMAT (1H ,4X,I5,7X,4HFAIL,4X,E12.5,3X,E12.5)
C
90007 FORMAT (1H ,20X,20HEND OF PROGRAM FM103)
END
*END-OF,FM103
FM104.f 480976091 170 2 100666 11954 `
*HEADER,FORTR,FM104
*FILES1,FORTR,FM104,X
C COMMENT SECTION.
C
C FM104
C
C THIS ROUTINE IS A TEST OF THE / FORMAT AND IS TAPE AND PRINTER
C ORIENTED. THE ROUTINE CAN ALSO BE USED FOR DISK. BOTH THE READ
C AND WRITE STATEMENTS ARE TESTED. VARIABLES IN THE INPUT AND
C OUTPUT LISTS ARE INTEGER VARIABLE AND INTEGER ARRAY ELEMENT OR
C ARRAY NAME REFERENCES. ALL READ AND WRITE STATEMENTS ARE DONE
C WITH FORMAT STATEMENTS. THE ROUTINE HAS AN OPTIONAL SECTION OF
C CODE TO DUMP THE FILE AFTER IT HAS BEEN WRITTEN. DO LOOPS AND
C DO-IMPLIED LISTS ARE USED IN CONJUNCTION WITH A ONE DIMENSIONAL
C INTEGER ARRAY FOR THE DUMP SECTION.
C
C THIS ROUTINE WRITES A SINGLE SEQUENTIAL FILE WHICH IS
C REWOUND AND READ SEQUENTIALLY FORWARD. EVERY RECORD IS READ AND
C CHECKED DURING THE READ TEST SECTION FOR VALUES OF DATA ITEMS
C AND THE END OF FILE ON THE LAST RECORD IS ALSO CHECKED.
C
C THE LINE CONTINUATION IN COLUMN 6 IS USED IN READ, WRITE,
C AND FORMAT STATEMENTS. FOR BOTH SYNTAX AND SEMANTIC TESTS, ALL
C STATEMENTS SHOULD BE CHECKED VISUALLY FOR THE PROPER FUNCTIONING
C OF THE CONTINUATION LINE.
C
C REFERENCES
C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN,
C X3.9-1978
C
C SECTION 8, SPECIFICATION STATEMENTS
C SECTION 9, DATA STATEMENT
C SECTION 11.10, DO STATEMENT
C SECTION 12, INPUT/OUTPUT STATEMENTS
C SECTION 12.8.2, INPUT/OUTPUT LIST
C SECTION 12.9.5.2, FORMATTED DATA TRANSFER
C SECTION 13, FORMAT STATEMENT
C SECTION 13.2.1, EDIT DESCRIPTORS
C SECTION 13.5.9.1, INTEGER EDITING
C
COMMON ITEST(7), IACN11(57), ICHEC
C
DIMENSION IPREM(7), IADN11(57)
DIMENSION IDUMP(136)
CHARACTER*1 NINE,IZERO,IDUMP
DATA NINE/'9'/, IZERO/'0'/
C
77701 FORMAT ( 80A1 )
77702 FORMAT (10X,19HPREMATURE EOF ONLY ,I3,13H RECORDS LUN ,I2,8H OUT O
1F ,I3,8H RECORDS)
77703 FORMAT (10X,12HFILE ON LUN ,I2,7H OK... ,I3,8H RECORDS)
77704 FORMAT (10X,12HFILE ON LUN ,I2,20H NO EOF.. MORE THAN ,I3,8H RECOR
1DS)
77705 FORMAT ( 1X,80A1)
77706 FORMAT (10X,43HFILE I06 CREATED WITH 28 SEQUENTIAL RECORDS)
77751 FORMAT (I3,2I2,3I3,I4,57I1,I3/I3,2I2,3I3,I4,57I1,I3/I3,2I2,3I3,I4,
157I1,I3/I3,2I2,3I3,I4,57I1,I3 )
77752 FORMAT (7X,I3,6X,I4,I1,56X,I3/7X,I3,67X,I3/7X,I3,67X,I3/7X,I3,67X,
1I3 )
C
C
C **********************************************************
C
C A COMPILER VALIDATION SYSTEM FOR THE FORTRAN LANGUAGE
C BASED ON SPECIFICATIONS AS DEFINED IN AMERICAN NATIONAL STANDARD
C PROGRAMMING LANGUAGE FORTRAN X3.9-1978, HAS BEEN DEVELOPED BY THE
C FEDERAL COBOL COMPILER TESTING SERVICE. THE FORTRAN COMPILER
C VALIDATION SYSTEM (FCVS) CONSISTS OF AUDIT ROUTINES, THEIR RELATED
C DATA, AND AN EXECUTIVE SYSTEM. EACH AUDIT ROUTINE IS A FORTRAN
C PROGRAM, SUBPROGRAM OR FUNCTION WHICH INCLUDES TESTS OF SPECIFIC
C LANGUAGE ELEMENTS AND SUPPORTING PROCEDURES INDICATING THE RESULT
C OF EXECUTING THESE TESTS.
C
C THIS PARTICULAR PROGRAM/SUBPROGRAM/FUNCTION CONTAINS FEATURES
C FOUND ONLY IN THE SUBSET AS DEFINED IN X3.9-1978.
C
C SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO -
C
C DEPARTMENT OF THE NAVY
C FEDERAL COBOL COMPILER TESTING SERVICE
C WASHINGTON, D.C. 20376
C
C **********************************************************
C
C
C
C INITIALIZATION SECTION
C
C INITIALIZE CONSTANTS
C **************
C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER.
I01 = 5
C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER.
I02 = 6
C SYSTEM ENVIRONMENT SECTION
C
CX010 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-010 CONTROL CARD.
C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5
C (UNIT NUMBER FOR CARD READER).
CX011 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-011 CONTROL CARD.
C THE CX011 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL
C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX010 ABOVE.
C
CX020 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-020 CONTROL CARD.
C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02 = 6
C (UNIT NUMBER FOR PRINTER).
CX021 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-021 CONTROL CARD.
C THE CX021 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL
C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX020 ABOVE.
C
IVPASS=0
IVFAIL=0
IVDELE=0
ICZERO=0
C
C WRITE PAGE HEADERS
WRITE (I02,90000)
WRITE (I02,90001)
WRITE (I02,90002)
WRITE (I02, 90002)
WRITE (I02,90003)
WRITE (I02,90002)
WRITE (I02,90004)
WRITE (I02,90002)
WRITE (I02,90011)
WRITE (I02,90002)
WRITE (I02,90002)
WRITE (I02,90005)
WRITE (I02,90006)
WRITE (I02,90002)
C
C DEFAULT ASSIGNMENT FOR FILE 05 IS I06 = 7
I06 = 7
CX060 THIS CARD IS REPLACED BY THE CONTENTS OF CARD X-060
CX061 THIS CARD IS REPLACED BY THE CONTENTS OF CARD X-061
C
C WRITE SECTION....
C
C THIS SECTION OF CODE BUILDS A UNIT RECORD FILE ON LUN I06 THAT IS
C 80 CHARACTERS PER RECORD, 28 RECORDS LONG, AND CONSISTS OF ONLY
C INTEGERS ( I FORMAT ). THIS IS THE ONLY FILE TESTED IN THE
C ROUTINE FM104 AND FOR PURPOSES OF IDENTIFICATION IS FILE 05.
C SINCE THIS ROUTINE IS A TEST OF / IN A FORMAT STATEMENT, FOUR (4)
C RECORDS ARE ACTUALLY WRITTEN WITH ONE WRITE STATEMENT. ALL FOUR
C OF THESE RECORDS WILL HAVE THE SAME RECORD NUMBER IN THE 20
C CHARACTER PREAMBLE. THE INTEGER STORED IN CHARACTER POSITIONS
C 78 - 80 WILL EQUAL THE RECORD NUMBER PLUS 0, 1, 2, AND 3 FOR
C THE FOUR RECORD SET RESPECTIVELY.. THE INTEGER ARRAY ELEMENTS
C IN CHARACTER POSITIONS 21-77 WILL CONTAIN THE INTEGER DIGIT 9.
IPROG = 104
IFILE = 05
ILUN = I06
ITOTR = 28
IRLGN = 80
IEOF = 0000
C SET THE RECORD PREAMBLE VALUES EXCEPT FOR RECORD NUMBER AND EOF..
IPREM(1) = IPROG
IPREM(2) = IFILE
IPREM(3) = ILUN
IPREM(5) = ITOTR
IPREM(6) = IRLGN
C SET THE INTEGER ARRAY ELEMENTS TO THE INTEGER DIGIT 9
DO 10 I = 1, 57
IADN11(I) = 9
10 CONTINUE
DO 872 IRNUM = 1, 7
IF ( IRNUM .EQ. 7 ) IEOF = 9999
IPREM(4) = IRNUM
IPREM(7) = IEOF
IVON02 = IRNUM
IVON03 = IRNUM + 1
IVON04 = IRNUM + 2
IVON05 = IRNUM + 3
WRITE ( I06, 77751 ) IPROG,IFILE,ILUN,IRNUM,ITOTR,IRLGN,IEOF,IADN1
11,IVON02,IPREM,IADN11,IVON03,IPREM,IADN11,IVON04,IPREM,IADN11,IVON
205
872 CONTINUE
WRITE (I02,77706)
C
C REWIND SECTION
C
REWIND I06
C
C READ SECTION....
C
IVTNUM = 87
C
C **** TEST 87 THRU TEST 93 ****
C TEST 87 THRU 93 - THESE TESTS CHECK EVERY ONE OF THE 28 RECORDS
C CREATED AS FILE I06 FOR THE RECORD NUMBER, CONSTANT DATA ITEMS,
C AND THE END OF FILE INDICATOR.
C
DO 932 IRNUM = 1, 7
IVON01 = 0
C THE INTEGER VARIABLE IS INITIALIZED TO ZERO FOR EACH TEST 87 - 93.
READ ( I06, 77752 ) IRN01,IEND,IVON06,IVON07,IRN02,IVON08,IRN03,
1IVON09,IRN04,IVON10
C READ THE FILE I06 - NOTE, FOUR RECORDS ARE READ IN EACH SINGLE
C READ STATEMENT AND THE FORMAT IS DIFFERENT THAN THE ONE USED TO
C CREATE THE FILE.
C
C CHECK THE DATA ITEM VALUES ....
IF ( IRN01 .EQ. IRNUM ) IVON01 = IVON01 + 1
C IRN01 SHOULD EQUAL THE RECORD NUMBER FOR THE SET OF FOUR RECORDS
C RECORD NUMBERS GO FROM 1 TO 7 ....
IF ( IVON06 .EQ. 9 ) IVON01 = IVON01 + 1
C IVON06 IS THE INTEGER ARRAY ELEMENT WHICH SHOULD BE ALWAYS EQUAL
C TO THE INTEGER CONSTANT 9 ....
IF ( IVON07 .EQ. IRNUM ) IVON01 = IVON01 + 1
C IVON07 SHOULD ALWAYS EQUAL THE RECORD NUMBER OF THE FIRST RECORD
C IN THE SET OF FOUR RECORDS ....
IF ( IRN02 .EQ. IRNUM ) IVON01 = IVON01 + 1
C THIS VALUE REMAINS CONSTANT FOR ALL FOUR RECORDS IN THE SET OF 4..
IF ( IVON08 .EQ. IRNUM + 1 ) IVON01 = IVON01 + 1
C IVON08 IS THE 80TH CHARACTER IN THE SECOND RECORD OF THE SET OF 4.
IF ( IRN03 .EQ. IRNUM ) IVON01 = IVON01 + 1
C AGAIN THIS VALUE IS CONSTANT FOR THE SET OF FOUR RECORDS....
IF ( IVON09 .EQ. IRNUM + 2 ) IVON01 = IVON01 + 1
C IVON09 IS THE 80TH CHARACTER IN THE THIRD RECORD OF THE SET OF 4.
IF ( IRN04 .EQ. IRNUM ) IVON01 = IVON01 + 1
C STILL EQUALS THE RECORD NUMBER FOR THE SET OF FOUR RECORDS.
IF ( IVON10 .EQ. IRNUM + 3 ) IVON01 = IVON01 + 1
C IVON10 IS THE 80TH CHARACTER IN THE FOURTH RECORD OF THE SET OF 4.
IF ( IVON01 - 9 ) 20870, 10870, 20870
C WHEN IVON01 = 9 THEN ALL NINE OF THE DATA ITEMS CHECKED ARE OK...
10870 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 881
20870 IVFAIL = IVFAIL + 1
IVCOMP = IVON01
IVCORR = 9
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
881 CONTINUE
IVTNUM = IVTNUM + 1
C INCREMENT THE TEST NUMBER....
932 CONTINUE
IF ( ICZERO ) 30870, 941, 30870
30870 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
941 CONTINUE
IVTNUM = 94
C
C **** TEST 94 ****
C TEST 94 - THIS TEST CHECKS THE END OF FILE INDICATOR ON THE LAST
C SET OF 4 RECORDS ( 25,26,27,AND 28 ).
C THE VARIABLE IEND IS ACTUALLY IN THE RECORD NUMBERED 25.
C
IF (ICZERO) 30940, 940, 30940
940 CONTINUE
IVCOMP = IEND
GO TO 40940
30940 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 40940, 951, 40940
40940 IF ( IVCOMP - 9999 ) 20940, 10940, 20940
10940 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 951
20940 IVFAIL = IVFAIL + 1
IVCORR = 9999
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
951 CONTINUE
C THIS CODE IS OPTIONALLY COMPILED AND IS USED TO DUMP THE FILE 05
C TO THE LINE PRINTER.
CDB**
C ILUN = I06
C ITOTR = 28
C IRLGN = 80
C7777 REWIND ILUN
C DO 7778 IRNUM = 1, ITOTR
C READ (ILUN,77701) (IDUMP(ICHAR), ICHAR = 1, IRLGN)
C WRITE ( I02,77705) (IDUMP(ICHAR), ICHAR = 1, IRLGN)
C IF ( IDUMP(20) .EQ. NINE .AND. IDUMP(80) .EQ. IZERO ) GO TO 7779
C7778 CONTINUE
C GO TO 7782
C7779 IF ( IRNUM - ITOTR ) 7780, 7781, 7782
C7780 WRITE (I02,77702) IRNUM,ILUN,ITOTR
C GO TO 7784
C7781 WRITE (I02,77703) ILUN,ITOTR
C GO TO 7784
C7782 WRITE (I02,77704) ILUN, ITOTR
C DO 7783 I = 1, 5
C READ (ILUN,77701) (IDUMP(ICHAR), ICHAR = 1, IRLGN)
C WRITE ( I02,77705) (IDUMP(ICHAR), ICHAR = 1, IRLGN)
C IF ( IDUMP(20) .EQ. NINE ) GO TO 7784
C7783 CONTINUE
C7784 GO TO 99999
CDE**
C WRITE PAGE FOOTINGS AND RUN SUMMARIES
99999 CONTINUE
WRITE (I02,90002)
WRITE (I02,90006)
WRITE (I02,90002)
WRITE (I02,90002)
WRITE (I02,90007)
WRITE (I02,90002)
WRITE (I02,90008) IVFAIL
WRITE (I02,90009) IVPASS
WRITE (I02,90010) IVDELE
C
C
C TERMINATE ROUTINE EXECUTION
STOP
C
C FORMAT STATEMENTS FOR PAGE HEADERS
90000 FORMAT (1H1)
90002 FORMAT (1H )
90001 FORMAT (1H ,10X,34HFORTRAN COMPILER VALIDATION SYSTEM)
90003 FORMAT (1H ,21X,11HVERSION 1.0)
90004 FORMAT (1H ,10X,38HFOR OFFICIAL USE ONLY - COPYRIGHT 1978)
90005 FORMAT (1H ,5X,4HTEST,5X,9HPASS/FAIL, 5X,8HCOMPUTED,8X,7HCORRECT)
90006 FORMAT (1H ,5X,46H----------------------------------------------)
90011 FORMAT (1H ,18X,17HSUBSET LEVEL TEST)
C
C FORMAT STATEMENTS FOR RUN SUMMARIES
90008 FORMAT (1H ,15X,I5,19H ERRORS ENCOUNTERED)
90009 FORMAT (1H ,15X,I5,13H TESTS PASSED)
90010 FORMAT (1H ,15X,I5,14H TESTS DELETED)
C
C FORMAT STATEMENTS FOR TEST RESULTS
80001 FORMAT (1H ,4X,I5,7X,4HPASS)
80002 FORMAT (1H ,4X,I5,7X,4HFAIL)
80003 FORMAT (1H ,4X,I5,7X,7HDELETED)
80004 FORMAT (1H ,4X,I5,7X,4HFAIL,10X,I6,9X,I6)
80005 FORMAT (1H ,4X,I5,7X,4HFAIL,4X,E12.5,3X,E12.5)
C
90007 FORMAT (1H ,20X,20HEND OF PROGRAM FM104)
END
*END-OF,FM104
FM105.f 480976093 170 2 100666 12404 `
*HEADER,FORTR,FM105
*FILES1,FORTR,FM105,X
C COMMENT SECTION.
C
C FM105
C
C FM105 TESTS REPEATED ( ) FORMAT FIELDS AND IS TAPE AND PRINTER
C ORIENTED. THE ROUTINE CAN ALSO BE USED FOR DISK. BOTH THE READ
C AND WRITE STATEMENTS ARE TESTED. VARIABLES IN THE INPUT AND
C OUTPUT LISTS ARE INTEGER VARIABLE AND INTEGER ARRAY ELEMENT OR
C ARRAY NAME REFERENCES. ALL READ AND WRITE STATEMENTS ARE DONE
C WITH FORMAT STATEMENTS. THE ROUTINE HAS AN OPTIONAL SECTION OF
C CODE TO DUMP THE FILE AFTER IT HAS BEEN WRITTEN. DO LOOPS AND
C DO-IMPLIED LISTS ARE USED IN CONJUNCTION WITH A ONE DIMENSIONAL
C INTEGER ARRAY FOR THE DUMP SECTION.
C
C ROUTINE FM105 IS EXACTLY LIKE ROUTINE FM104 EXCEPT THAT
C FORMAT NUMBERS 77751 AND 77752 HAVE BEEN CHANGED TO USE THREE (3)
C REPEATED FIELDS, I.E. ... 3(/ ... ) THIS SHOULD STILL
C MAKE THE ROUTINE WRITE AND THEN READ FOUR (4) 80 CHARACTER
C RECORDS FOR EACH SINGLE WRITE OR READ STATEMENT. OTHER FORMAT
C CONVERSIONS USED ARE THE X AND I FORMAT FIELDS. BECAUSE OF THE
C NUMBER OF CHARACTERS TO BE WRITTEN OR READ IN EACH SET OF FOUR
C RECORDS, THE ENTIRE REPEATED FIELD IS USED.
C
C THIS ROUTINE WRITES A SINGLE SEQUENTIAL FILE WHICH IS
C REWOUND AND READ SEQUENTIALLY FORWARD. EVERY RECORD IS READ AND
C CHECKED DURING THE READ TEST SECTION FOR VALUES OF DATA ITEMS
C AND THE END OF FILE ON THE LAST RECORD IS ALSO CHECKED.
C
C THE LINE CONTINUATION IN COLUMN 6 IS USED IN READ, WRITE,
C AND FORMAT STATEMENTS. FOR BOTH SYNTAX AND SEMANTIC TESTS, ALL
C STATEMENTS SHOULD BE CHECKED VISUALLY FOR THE PROPER FUNCTIONING
C OF THE CONTINUATION LINE.
C
C REFERENCES
C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN,
C X3.9-1978
C
C SECTION 8, SPECIFICATION STATEMENTS
C SECTION 9, DATA STATEMENT
C SECTION 11.10, DO STATEMENT
C SECTION 12, INPUT/OUTPUT STATEMENTS
C SECTION 12.8.2, INPUT/OUTPUT LIST
C SECTION 12.9.5.2, FORMATTED DATA TRANSFER
C SECTION 13, FORMAT STATEMENT
C SECTION 13.2.1, EDIT DESCRIPTORS
C SECTION 13.5.9.1, INTEGER EDITING
C
C
DIMENSION IPREM(7), IADN11(57)
DIMENSION IDUMP(136)
CHARACTER*1 NINE,IZERO,IDUMP
DATA NINE/'9'/, IZERO/'0'/
C
77701 FORMAT ( 80A1 )
77702 FORMAT (10X,19HPREMATURE EOF ONLY ,I3,13H RECORDS LUN ,I2,8H OUT O
1F ,I3,8H RECORDS)
77703 FORMAT (10X,12HFILE ON LUN ,I2,7H OK... ,I3,8H RECORDS)
77704 FORMAT (10X,12HFILE ON LUN ,I2,20H TOO LONG MORE THAN ,I3,8H RECOR
1DS)
77705 FORMAT ( 1X,80A1)
77706 FORMAT (10X,43HFILE I08 CREATED WITH 28 SEQUENTIAL RECORDS)
77751 FORMAT ( I3,2(I2),3(I3),I4,57(I1),I3,3(/I3,2(I2),3(I3),I4,57(I1),I
13) )
77752 FORMAT ( 7(1X),I3,6(1X),I4,I1,56(1X),I3,3(/7(1X),I3,67(1X),I3) )
C
C
C **********************************************************
C
C A COMPILER VALIDATION SYSTEM FOR THE FORTRAN LANGUAGE
C BASED ON SPECIFICATIONS AS DEFINED IN AMERICAN NATIONAL STANDARD
C PROGRAMMING LANGUAGE FORTRAN X3.9-1978, HAS BEEN DEVELOPED BY THE
C FEDERAL COBOL COMPILER TESTING SERVICE. THE FORTRAN COMPILER
C VALIDATION SYSTEM (FCVS) CONSISTS OF AUDIT ROUTINES, THEIR RELATED
C DATA, AND AN EXECUTIVE SYSTEM. EACH AUDIT ROUTINE IS A FORTRAN
C PROGRAM, SUBPROGRAM OR FUNCTION WHICH INCLUDES TESTS OF SPECIFIC
C LANGUAGE ELEMENTS AND SUPPORTING PROCEDURES INDICATING THE RESULT
C OF EXECUTING THESE TESTS.
C
C THIS PARTICULAR PROGRAM/SUBPROGRAM/FUNCTION CONTAINS FEATURES
C FOUND ONLY IN THE SUBSET AS DEFINED IN X3.9-1978.
C
C SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO -
C
C DEPARTMENT OF THE NAVY
C FEDERAL COBOL COMPILER TESTING SERVICE
C WASHINGTON, D.C. 20376
C
C **********************************************************
C
C
C
C INITIALIZATION SECTION
C
C INITIALIZE CONSTANTS
C **************
C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER.
I01 = 5
C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER.
I02 = 6
C SYSTEM ENVIRONMENT SECTION
C
CX010 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-010 CONTROL CARD.
C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5
C (UNIT NUMBER FOR CARD READER).
CX011 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-011 CONTROL CARD.
C THE CX011 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL
C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX010 ABOVE.
C
CX020 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-020 CONTROL CARD.
C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02 = 6
C (UNIT NUMBER FOR PRINTER).
CX021 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-021 CONTROL CARD.
C THE CX021 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL
C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX020 ABOVE.
C
IVPASS=0
IVFAIL=0
IVDELE=0
ICZERO=0
C
C WRITE PAGE HEADERS
WRITE (I02,90000)
WRITE (I02,90001)
WRITE (I02,90002)
WRITE (I02, 90002)
WRITE (I02,90003)
WRITE (I02,90002)
WRITE (I02,90004)
WRITE (I02,90002)
WRITE (I02,90011)
WRITE (I02,90002)
WRITE (I02,90002)
WRITE (I02,90005)
WRITE (I02,90006)
WRITE (I02,90002)
C
C DEFAULT ASSIGNMENT FOR FILE 06 IS I08 = 7
I08 = 7
CX080 THIS CARD IS REPLACED BY THE CONTENTS OF CARD X-080
CX081 THIS CARD IS REPLACED BY THE CONTENTS OF CARD X-081
C
C WRITE SECTION....
C
C THIS SECTION OF CODE BUILDS A UNIT RECORD FILE ON LUN I08 THAT IS
C 80 CHARACTERS PER RECORD, 28 RECORDS LONG, AND CONSISTS OF ONLY
C INTEGERS ( I FORMAT ). THIS IS THE ONLY FILE TESTED IN THE
C ROUTINE FM105 AND FOR PURPOSES OF IDENTIFICATION IS FILE 06.
C SINCE THIS ROUTINE IS A TEST OF / IN A FORMAT STATEMENT, FOUR (4)
C RECORDS ARE ACTUALLY WRITTEN WITH ONE WRITE STATEMENT. ALL FOUR
C OF THESE RECORDS WILL HAVE THE SAME RECORD NUMBER IN THE 20
C CHARACTER PREAMBLE. THE INTEGER STORED IN CHARACTER POSITIONS
C 78 - 80 WILL EQUAL THE RECORD NUMBER PLUS 0, 1, 2, AND 3 FOR
C THE FOUR RECORD SET RESPECTIVELY.. THE INTEGER ARRAY ELEMENTS
C IN CHARACTER POSITIONS 21-77 WILL CONTAIN THE INTEGER DIGIT 9.
IPROG = 105
IFILE = 06
ILUN = I08
ITOTR = 28
IRLGN = 80
IEOF = 0000
C SET THE RECORD PREAMBLE VALUES EXCEPT FOR RECORD NUMBER AND EOF..
IPREM(1) = IPROG
IPREM(2) = IFILE
IPREM(3) = ILUN
IPREM(5) = ITOTR
IPREM(6) = IRLGN
C SET THE INTEGER ARRAY ELEMENTS TO THE INTEGER DIGIT 9
DO 10 I = 1, 57
IADN11(I) = 9
10 CONTINUE
DO 952 IRNUM = 1, 7
IF ( IRNUM .EQ. 7 ) IEOF = 9999
IPREM(4) = IRNUM
IPREM(7) = IEOF
IVON02 = IRNUM
IVON03 = IRNUM + 1
IVON04 = IRNUM + 2
IVON05 = IRNUM + 3
WRITE ( I08, 77751 ) IPROG,IFILE,ILUN,IRNUM,ITOTR,IRLGN,IEOF,IADN1
11,IVON02,IPREM,IADN11,IVON03,IPREM,IADN11,IVON04,IPREM,IADN11,IVON
205
952 CONTINUE
WRITE (I02,77706)
C
C REWIND SECTION
C
REWIND I08
C
C READ SECTION....
C
IVTNUM = 95
C
C **** TEST 95 THRU TEST 101 ****
C TEST 95 THRU 101 - THESE TESTS CHECK EVERY ONE OF THE 28 RECORDS
C CREATED AS FILE I08 FOR THE RECORD NUMBER, CONSTANT DATA ITEMS,
C AND THE END OF FILE INDICATOR.
C
DO 962 IRNUM = 1, 7
IVON01 = 0
C THE INTEGER VARIABLE IS INITIALIZED TO ZERO FOR EACH TEST 95 - 101
READ ( I08, 77752 ) IRN01,IEND,IVON06,IVON07,IRN02,IVON08,IRN03,
1IVON09,IRN04,IVON10
C READ THE FILE I08 - NOTE, FOUR RECORDS ARE READ IN EACH SINGLE
C READ STATEMENT AND THE FORMAT IS DIFFERENT THAN THE ONE USED TO
C CREATE THE FILE.
C
C CHECK THE DATA ITEM VALUES ....
IF ( IRN01 .EQ. IRNUM ) IVON01 = IVON01 + 1
C IRN01 SHOULD EQUAL THE RECORD NUMBER FOR THE SET OF FOUR RECORDS
C RECORD NUMBERS GO FROM 1 TO 7 ....
IF ( IVON06 .EQ. 9 ) IVON01 = IVON01 + 1
C IVON06 IS THE INTEGER ARRAY ELEMENT WHICH SHOULD BE ALWAYS EQUAL
C TO THE INTEGER CONSTANT 9 ....
IF ( IVON07 .EQ. IRNUM ) IVON01 = IVON01 + 1
C IVON07 SHOULD ALWAYS EQUAL THE RECORD NUMBER OF THE FIRST RECORD
C IN THE SET OF FOUR RECORDS ....
IF ( IRN02 .EQ. IRNUM ) IVON01 = IVON01 + 1
C THIS VALUE REMAINS CONSTANT FOR ALL FOUR RECORDS IN THE SET OF 4..
IF ( IVON08 .EQ. IRNUM + 1 ) IVON01 = IVON01 + 1
C IVON08 IS THE 80TH CHARACTER IN THE SECOND RECORD OF THE SET OF 4.
IF ( IRN03 .EQ. IRNUM ) IVON01 = IVON01 + 1
C AGAIN THIS VALUE IS CONSTANT FOR THE SET OF FOUR RECORDS....
IF ( IVON09 .EQ. IRNUM + 2 ) IVON01 = IVON01 + 1
C IVON09 IS THE 80TH CHARACTER IN THE THIRD RECORD OF THE SET OF 4.
IF ( IRN04 .EQ. IRNUM ) IVON01 = IVON01 + 1
C STILL EQUALS THE RECORD NUMBER FOR THE SET OF FOUR RECORDS.
IF ( IVON10 .EQ. IRNUM + 3 ) IVON01 = IVON01 + 1
C IVON10 IS THE 80TH CHARACTER IN THE FOURTH RECORD OF THE SET OF 4.
IF ( IVON01 - 9 ) 20960, 10960, 20960
C WHEN IVON01 = 9 THEN ALL NINE OF THE DATA ITEMS CHECKED ARE OK...
10960 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 971
20960 IVFAIL = IVFAIL + 1
IVCOMP = IVON01
IVCORR = 9
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
971 CONTINUE
IVTNUM = IVTNUM + 1
C INCREMENT THE TEST NUMBER....
962 CONTINUE
IF ( ICZERO ) 30960, 1021, 30960
30960 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
1021 CONTINUE
IVTNUM = 102
C
C **** TEST 102 ****
C TEST 102 - THIS TEST CHECKS THE END OF FILE INDICATOR ON THE LAST
C SET OF 4 RECORDS ( 25,26,27,AND 28 ).
C THE VARIABLE IEND IS ACTUALLY IN THE RECORD NUMBERED 25.
C
IF (ICZERO) 31020, 1020, 31020
1020 CONTINUE
IVCOMP = IEND
GO TO 41020
31020 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 41020, 1031, 41020
41020 IF ( IVCOMP - 9999 ) 21020, 11020, 21020
11020 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 1031
21020 IVFAIL = IVFAIL + 1
IVCORR = 9999
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
1031 CONTINUE
C THIS CODE IS OPTIONALLY COMPILED AND IS USED TO DUMP THE FILE 06
C TO THE LINE PRINTER.
CDB**
C ILUN = I08
C ITOTR = 28
C IRLGN = 80
C7777 REWIND ILUN
C DO 7778 IRNUM = 1, ITOTR
C READ (ILUN,77701) (IDUMP(ICHAR), ICHAR = 1, IRLGN)
C WRITE ( I02,77705) (IDUMP(ICHAR), ICHAR = 1, IRLGN)
C IF ( IDUMP(20) .EQ. NINE .AND. IDUMP(80) .EQ. IZERO ) GO TO 7779
C7778 CONTINUE
C GO TO 7782
C7779 IF ( IRNUM - ITOTR ) 7780, 7781, 7782
C7780 WRITE (I02,77702) IRNUM,ILUN,ITOTR
C GO TO 7784
C7781 WRITE (I02,77703) ILUN,ITOTR
C GO TO 7784
C7782 WRITE (I02,77704) ILUN, ITOTR
C DO 7783 I = 1, 5
C READ (ILUN,77701) (IDUMP(ICHAR), ICHAR = 1, IRLGN)
C WRITE ( I02,77705) (IDUMP(ICHAR), ICHAR = 1, IRLGN)
C IF ( IDUMP(20) .EQ. NINE ) GO TO 7784
C7783 CONTINUE
C7784 GO TO 99999
CDE**
C WRITE PAGE FOOTINGS AND RUN SUMMARIES
99999 CONTINUE
WRITE (I02,90002)
WRITE (I02,90006)
WRITE (I02,90002)
WRITE (I02,90002)
WRITE (I02,90007)
WRITE (I02,90002)
WRITE (I02,90008) IVFAIL
WRITE (I02,90009) IVPASS
WRITE (I02,90010) IVDELE
C
C
C TERMINATE ROUTINE EXECUTION
STOP
C
C FORMAT STATEMENTS FOR PAGE HEADERS
90000 FORMAT (1H1)
90002 FORMAT (1H )
90001 FORMAT (1H ,10X,34HFORTRAN COMPILER VALIDATION SYSTEM)
90003 FORMAT (1H ,21X,11HVERSION 1.0)
90004 FORMAT (1H ,10X,38HFOR OFFICIAL USE ONLY - COPYRIGHT 1978)
90005 FORMAT (1H ,5X,4HTEST,5X,9HPASS/FAIL, 5X,8HCOMPUTED,8X,7HCORRECT)
90006 FORMAT (1H ,5X,46H----------------------------------------------)
90011 FORMAT (1H ,18X,17HSUBSET LEVEL TEST)
C
C FORMAT STATEMENTS FOR RUN SUMMARIES
90008 FORMAT (1H ,15X,I5,19H ERRORS ENCOUNTERED)
90009 FORMAT (1H ,15X,I5,13H TESTS PASSED)
90010 FORMAT (1H ,15X,I5,14H TESTS DELETED)
C
C FORMAT STATEMENTS FOR TEST RESULTS
80001 FORMAT (1H ,4X,I5,7X,4HPASS)
80002 FORMAT (1H ,4X,I5,7X,4HFAIL)
80003 FORMAT (1H ,4X,I5,7X,7HDELETED)
80004 FORMAT (1H ,4X,I5,7X,4HFAIL,10X,I6,9X,I6)
80005 FORMAT (1H ,4X,I5,7X,4HFAIL,4X,E12.5,3X,E12.5)
C
90007 FORMAT (1H ,20X,20HEND OF PROGRAM FM105)
END
*END-OF,FM105
FM106.f 480976095 170 2 100666 13241 `
*HEADER,FORTR,FM106
*FILES1,FORTR,FM106,X
C COMMENT SECTION.
C
C FM106
C
C THIS ROUTINE IS A TEST OF THE E FORMAT AND IS TAPE AND PRINTER
C ORIENTED. THE ROUTINE CAN ALSO BE USED FOR DISK. BOTH THE READ
C AND WRITE STATEMENTS ARE TESTED. VARIABLES IN THE INPUT AND
C OUTPUT LISTS ARE REAL VARIABLES AND REAL ARRAY ELEMENTS OR
C ARRAY NAME REFERENCES. ALL READ AND WRITE STATEMENTS ARE DONE
C WITH FORMAT STATEMENTS. THE ROUTINE HAS AN OPTIONAL SECTION OF
C CODE TO DUMP THE FILE AFTER IT HAS BEEN WRITTEN. DO LOOPS AND
C DO-IMPLIED LISTS ARE USED IN CONJUNCTION WITH A ONE DIMENSIONAL
C INTEGER ARRAY FOR THE DUMP SECTION.
C
C THIS ROUTINE WRITES A SINGLE SEQUENTIAL FILE WHICH IS
C REWOUND AND READ SEQUENTIALLY FORWARD. EVERY FOURTH RECORD IS
C CHECKED DURING THE READ TEST SECTION PLUS THE LAST TWO RECORDS
C AND THE END OF FILE ON THE LAST RECORD.
C
C THE LINE CONTINUATION IN COLUMN 6 IS USED IN READ, WRITE,
C AND FORMAT STATEMENTS. FOR BOTH SYNTAX AND SEMANTIC TESTS, ALL
C STATEMENTS SHOULD BE CHECKED VISUALLY FOR THE PROPER FUNCTIONING
C OF THE CONTINUATION LINE.
C
C REFERENCES
C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN,
C X3.9-1978
C
C SECTION 8, SPECIFICATION STATEMENTS
C SECTION 9, DATA STATEMENT
C SECTION 11.10, DO STATEMENT
C SECTION 12, INPUT/OUTPUT STATEMENTS
C SECTION 12.8.2, INPUT/OUTPUT LIST
C SECTION 12.9.5.2, FORMATTED DATA TRANSFER
C SECTION 13, FORMAT STATEMENT
C SECTION 13.2.1, EDIT DESCRIPTORS
C
DIMENSION ITEST(7), RTEST(20)
DIMENSION IDUMP(136)
CHARACTER*1 NINE,IDUMP
DATA NINE/'9'/
C
77701 FORMAT ( 110A1)
77702 FORMAT (10X,19HPREMATURE EOF ONLY ,I3,13H RECORDS LUN ,I2,8H OUT O
1F ,I3,8H RECORDS)
77703 FORMAT (10X,12HFILE ON LUN ,I2,7H OK... ,I3,8H RECORDS)
77704 FORMAT (10X,12HFILE ON LUN ,I2,20H TOO LONG MORE THAN ,I3,8H RECOR
1DS)
77705 FORMAT ( 1X,80A1,3(/ 10X,71A1) )
77706 FORMAT ( 10X, 44HFILE I09 CREATED WITH 124 SEQUENTIAL RECORDS )
77751 FORMAT ( I3,2I2,3I3,I4,3X,2E8.1,2X,3E9.2,2X,E10.3/24X,3E10.3,4X,2E
111.4,/1X,3E11.4,2X,2E12.5/26X,4E12.5,6X )
C
C
C **********************************************************
C
C A COMPILER VALIDATION SYSTEM FOR THE FORTRAN LANGUAGE
C BASED ON SPECIFICATIONS AS DEFINED IN AMERICAN NATIONAL STANDARD
C PROGRAMMING LANGUAGE FORTRAN X3.9-1978, HAS BEEN DEVELOPED BY THE
C FEDERAL COBOL COMPILER TESTING SERVICE. THE FORTRAN COMPILER
C VALIDATION SYSTEM (FCVS) CONSISTS OF AUDIT ROUTINES, THEIR RELATED
C DATA, AND AN EXECUTIVE SYSTEM. EACH AUDIT ROUTINE IS A FORTRAN
C PROGRAM, SUBPROGRAM OR FUNCTION WHICH INCLUDES TESTS OF SPECIFIC
C LANGUAGE ELEMENTS AND SUPPORTING PROCEDURES INDICATING THE RESULT
C OF EXECUTING THESE TESTS.
C
C THIS PARTICULAR PROGRAM/SUBPROGRAM/FUNCTION CONTAINS FEATURES
C FOUND ONLY IN THE SUBSET AS DEFINED IN X3.9-1978.
C
C SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO -
C
C DEPARTMENT OF THE NAVY
C FEDERAL COBOL COMPILER TESTING SERVICE
C WASHINGTON, D.C. 20376
C
C **********************************************************
C
C
C
C INITIALIZATION SECTION
C
C INITIALIZE CONSTANTS
C **************
C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER.
I01 = 5
C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER.
I02 = 6
C SYSTEM ENVIRONMENT SECTION
C
CX010 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-010 CONTROL CARD.
C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5
C (UNIT NUMBER FOR CARD READER).
CX011 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-011 CONTROL CARD.
C THE CX011 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL
C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX010 ABOVE.
C
CX020 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-020 CONTROL CARD.
C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02 = 6
C (UNIT NUMBER FOR PRINTER).
CX021 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-021 CONTROL CARD.
C THE CX021 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL
C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX020 ABOVE.
C
IVPASS=0
IVFAIL=0
IVDELE=0
ICZERO=0
C
C WRITE PAGE HEADERS
WRITE (I02,90000)
WRITE (I02,90001)
WRITE (I02,90002)
WRITE (I02, 90002)
WRITE (I02,90003)
WRITE (I02,90002)
WRITE (I02,90004)
WRITE (I02,90002)
WRITE (I02,90011)
WRITE (I02,90002)
WRITE (I02,90002)
WRITE (I02,90005)
WRITE (I02,90006)
WRITE (I02,90002)
C
C DEFAULT ASSIGNMENT FOR FILE 07 IS I09 = 7
I09 = 7
CX090 THIS CARD IS REPLACED BY THE CONTENTS OF CARD X-090
CX091 THIS CARD IS REPLACED BY THE CONTENTS OF CARD X-091
C
C WRITE SECTION....
C
C THIS SECTION OF CODE BUILDS A UNIT RECORD FILE ON LUN I09 THAT IS
C 80 CHARACTERS PER RECORD, 124 RECORDS AND CONSISTS OF ONLY
C REALS ( E FORMAT ). THIS IS THE ONLY FILE TESTED IN THE
C ROUTINE FM106 AND FOR PURPOSES OF IDENTIFICATION IS FILE 07.
C ALL OF THE DATA WITH THE EXCEPTION OF THE 20 CHARACTER INTEGER
C PREAMBLE FOR EACH RECORD, IS COMPRISED OF REAL VARIABLES SET BY
C REAL ASSIGNMENT STATEMENTS TO VARIOUS REAL CONSTANTS.
C
C ALL THE THE REAL CONSTANTS USED ARE POSITIVE, I.E. NO SIGN.
C
IPROG = 106
IFILE = 07
ILUN = I09
C THERE ARE 31 SETS OF FOUR 80 CHARACTER RECORDS EACH..
C EACH WRITE OR READ OF THE FILE HANDLES 4 RECORDS. FOR THE
C PURPOSES OF THE OPTIONAL DUMP OF FILE 07, THE TOTAL NUMBER OF
C 80 CHARACTER RECORDS IS 4 * 31 = 124 RECORDS.
ITOTR = 124
IRLGN = 80
IEOF = 0000
C SET THE REAL VARIABLES USING E - NOTATION....
RCON21 = 0.9E01
RCON22 = 0.9E00
RCON31 = 0.21E02
RCON32 = 0.21E01
RCON33 = 0.21E00
RCON41 = 0.512E03
RCON42 = 0.512E02
RCON43 = 0.512E01
RCON44 = 0.512E00
RCON51 = 0.9995E04
RCON52 = 0.9996E03
RCON53 = 0.9997E02
RCON54 = 0.9998E01
RCON55 = 0.9999E00
RCON61 = 0.32764E05
RCON62 = 0.32765E04
RCON63 = 0.32766E03
RCON64 = 0.32767E02
RCON65 = 0.32768E01
RCON66 = 0.32769E00
DO 1032 IRNUM = 1, 31
IF ( IRNUM .EQ. 31 ) IEOF = 9999
WRITE(I09,77751)IPROG,IFILE,ILUN,IRNUM,ITOTR,IRLGN,IEOF,RCON21,RCO
1N22,RCON31,RCON32,RCON33,RCON41,RCON42,RCON43,RCON44,RCON51,RCON52
2,RCON53,RCON54,RCON55,RCON61,RCON62,RCON63,RCON64,RCON65,RCON66
1032 CONTINUE
WRITE (I02,77706)
C
C REWIND SECTION
C
REWIND I09
C
C READ SECTION....
C
IVTNUM = 103
C
C **** TEST 103 THRU TEST 110 ****
C TEST 103 THRU 110 - THESE TESTS READ THE SEQUENTIAL FILE
C PREVIOUSLY WRITTEN ON LUN I09 AND CHECK THE FIRST AND EVERY FOURTH
C RECORD. THE VALUES CHECKED ARE THE RECORD NUMBER - IRNUM AND
C SEVERAL VALUES WHICH SHOULD REMAIN CONSTANT FOR ALL OF THE 31
C SETS OF 4 RECORDS.
C
IRTST = 1
READ ( I09, 77751) ITEST, RTEST
C READ THE FIRST RECORD....
DO 1034 I = 1, 8
IVON01 = 0
C THE INTEGER VARIABLE IS INITIALIZED TO ZERO FOR EACH TEST 1 THRU 8
IF ( ITEST(4) .EQ. IRTST ) IVON01 = IVON01 + 1
C THE ELEMENT (4) SHOULD EQUAL THE RECORD NUMBER....
C THE ERROR TOLERANCE IS BASED ON A SIXTEEN BIT MANTISSA AND
C PROVIDES SOME ALLOWANCE FOR THE IMPLEMENTORS INPUT, OUTPUT, AND
C STORAGE OF REAL NUMBERS....
IF(RTEST(1) .GE. 8.9995 .OR. RTEST(1) .LE. 9.0005) IVON01=IVON01+1
C THE ELEMENT(1) SHOULD EQUAL RCON21 = 9. ....
IF(RTEST(4) .GE. 2.0995 .OR. RTEST(4) .LE. 2.1005) IVON01=IVON01+1
C THE ELEMENT( 4) SHOULD EQUAL RCON32 = 2.1 ....
IF(RTEST(9) .GE. .51195 .OR. RTEST(9) .LE. .51205) IVON01=IVON01+1
C THE ELEMENT( 9) SHOULD EQUAL RCON44 = .512 ....
IF ( RTEST(13) .GE. 9.9975 .OR. RTEST(13) .LE. 9.9985 )
1 IVON01 = IVON01 + 1
C THE ELEMENT(13) SHOULD EQUAL RCON54 = 9.998 ....
IF ( RTEST(20) .GE. .32764 .OR. RTEST(20) .LE. .32774 )
1 IVON01 = IVON01 + 1
C THE ELEMENT(20) SHOULD EQUAL RCON66 = .32769 ....
IF ( IVON01 - 6 ) 21030, 11030, 21030
C WHEN IVON01 = 6 THEN ALL SIX OF THE ITEST ELEMENTS THAT WERE
C CHECKED HAD THE EXPECTED VALUES.... IF IVON01 DOES NOT EQUAL 6
C THEN AT LEAST ONE OF THE VALUES WAS INCORRECT....
11030 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 1041
21030 IVFAIL = IVFAIL + 1
IVCOMP = IVON01
IVCORR = 6
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
1041 CONTINUE
IVTNUM = IVTNUM + 1
C INCREMENT THE TEST NUMBER....
IF ( IVTNUM .EQ. 111 ) GO TO 1035
C TAPE SHOULD BE AT RECORD NUMBER 29 FOR TEST 110 - DO NOT READ MORE
C UNTIL TEST NUMBER 111 WHICH CHECKS RECORD NUMBER 30....
DO 1033 J = 1, 4
READ ( I09, 77751 ) ITEST, RTEST
C READ FOUR SETS OF RECORDS ON LUN I09....
1033 CONTINUE
IRTST = IRTST + 4
C INCREMENT THE RECORD NUMBER COUNTER....
1034 CONTINUE
IF ( ICZERO ) 31030, 1035, 31030
31030 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
1035 CONTINUE
IVTNUM = 111
C
C **** TEST 111 ****
C TEST 111 - THIS CHECKS THE RECORD NUMBER ON EXPECTED RECORD
C SET 30....
C
IF (ICZERO) 31110, 1110, 31110
1110 CONTINUE
READ ( I09, 77751 ) ITEST, RTEST
IVCOMP = ITEST(4)
GO TO 41110
31110 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 41110, 1121, 41110
41110 IF ( IVCOMP - 30 ) 21110, 11110, 21110
11110 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 1121
21110 IVFAIL = IVFAIL + 1
IVCORR = 30
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
1121 CONTINUE
IVTNUM = 112
C
C **** TEST 112 ****
C TEST 112 - THIS CHECKS THE RECORD NUMBER ON RECORD SET 31.
C
IF (ICZERO) 31120, 1120, 31120
1120 CONTINUE
READ ( I09, 77751 ) ITEST, RTEST
IVCOMP = ITEST(4)
GO TO 41120
31120 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 41120, 1131, 41120
41120 IF ( IVCOMP - 31 ) 21120, 11120, 21120
11120 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 1131
21120 IVFAIL = IVFAIL + 1
IVCORR = 31
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
1131 CONTINUE
IVTNUM = 113
C
C **** TEST 113 ****
C TEST 113 - THIS CHECKS THE END OF FILE INDICATOR ON RECORD SET
C NUMBER 31.
C
C
IF (ICZERO) 31130, 1130, 31130
1130 CONTINUE
IVCOMP = ITEST(7)
GO TO 41130
31130 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 41130, 1141, 41130
41130 IF ( IVCOMP - 9999 ) 21130, 11130, 21130
11130 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 1141
21130 IVFAIL = IVFAIL + 1
IVCORR = 9999
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
1141 CONTINUE
C THIS CODE IS OPTIONALLY COMPILED AND IS USED TO DUMP THE FILE 07
C TO THE LINE PRINTER.
CDB**
C ILUN = I09
C ITOTR = 124
C IRLGN = 80
C7777 REWIND ILUN
C IENDC = 0
C IRCNT = 0
C DO 7778 IRNUM = 1, ITOTR
C READ (ILUN,77701) (IDUMP(ICHAR), ICHAR = 1, IRLGN)
C WRITE ( I02,77705) (IDUMP(ICHAR), ICHAR = 1, IRLGN)
C IRCNT = IRCNT + 1
C IF ( IDUMP(20) .EQ. NINE ) IENDC = IRNUM
C7778 CONTINUE
C IF ( IENDC - 121 ) 7780,7779,7782
C7779 IF ( IRCNT - ITOTR ) 7780, 7781, 7782
C7780 WRITE (I02,77702) IRNUM,ILUN,ITOTR
C GO TO 7784
C7781 WRITE (I02,77703) ILUN,ITOTR
C GO TO 7784
C7782 WRITE (I02,77704) ILUN, ITOTR
C DO 7783 I = 1, 5
C READ (ILUN,77701) (IDUMP(ICHAR), ICHAR = 1, IRLGN)
C WRITE ( I02,77705) (IDUMP(ICHAR), ICHAR = 1, IRLGN)
C IF ( IDUMP(20) .EQ. NINE ) GO TO 7784
C7783 CONTINUE
C7784 GO TO 99999
CDE**
C WRITE PAGE FOOTINGS AND RUN SUMMARIES
99999 CONTINUE
WRITE (I02,90002)
WRITE (I02,90006)
WRITE (I02,90002)
WRITE (I02,90002)
WRITE (I02,90007)
WRITE (I02,90002)
WRITE (I02,90008) IVFAIL
WRITE (I02,90009) IVPASS
WRITE (I02,90010) IVDELE
C
C
C TERMINATE ROUTINE EXECUTION
STOP
C
C FORMAT STATEMENTS FOR PAGE HEADERS
90000 FORMAT (1H1)
90002 FORMAT (1H )
90001 FORMAT (1H ,10X,34HFORTRAN COMPILER VALIDATION SYSTEM)
90003 FORMAT (1H ,21X,11HVERSION 1.0)
90004 FORMAT (1H ,10X,38HFOR OFFICIAL USE ONLY - COPYRIGHT 1978)
90005 FORMAT (1H ,5X,4HTEST,5X,9HPASS/FAIL, 5X,8HCOMPUTED,8X,7HCORRECT)
90006 FORMAT (1H ,5X,46H----------------------------------------------)
90011 FORMAT (1H ,18X,17HSUBSET LEVEL TEST)
C
C FORMAT STATEMENTS FOR RUN SUMMARIES
90008 FORMAT (1H ,15X,I5,19H ERRORS ENCOUNTERED)
90009 FORMAT (1H ,15X,I5,13H TESTS PASSED)
90010 FORMAT (1H ,15X,I5,14H TESTS DELETED)
C
C FORMAT STATEMENTS FOR TEST RESULTS
80001 FORMAT (1H ,4X,I5,7X,4HPASS)
80002 FORMAT (1H ,4X,I5,7X,4HFAIL)
80003 FORMAT (1H ,4X,I5,7X,7HDELETED)
80004 FORMAT (1H ,4X,I5,7X,4HFAIL,10X,I6,9X,I6)
80005 FORMAT (1H ,4X,I5,7X,4HFAIL,4X,E12.5,3X,E12.5)
C
90007 FORMAT (1H ,20X,20HEND OF PROGRAM FM106)
END
*END-OF,FM106
FM107.f 480976097 170 2 100666 13131 `
*HEADER,FORTR,FM107
*FILES1,FORTR,FM107,X
C COMMENT SECTION.
C
C FM107
C
C THIS ROUTINE IS A TEST OF THE I FORMAT AND IS TAPE AND PRINTER
C ORIENTED. THE ROUTINE CAN ALSO BE USED FOR DISK. BOTH THE READ
C AND WRITE STATEMENTS ARE TESTED. VARIABLES IN THE INPUT AND
C OUTPUT LISTS ARE INTEGER VARIABLE AND INTEGER ARRAY ELEMENT OR
C ARRAY NAME REFERENCES. ALL READ AND WRITE STATEMENTS ARE DONE
C WITH FORMAT STATEMENTS. THE ROUTINE HAS AN OPTIONAL SECTION OF
C CODE TO DUMP THE FILE AFTER IT HAS BEEN WRITTEN. DO LOOPS AND
C DO-IMPLIED LISTS ARE USED IN CONJUNCTION WITH A ONE DIMENSIONAL
C INTEGER ARRAY FOR THE DUMP SECTION.
C
C THE MAJOR PURPOSE OF THIS ROUTINE IS TO TEST WHETHER THE LAST
C SET OF PARENTHESES WILL BE REPEATED IN A FORMAT STATEMENT IF THE
C NUMBER OF DATA ITEMS IN THE INPUT/OUTPUT LIST IS GREATER THAN THE
C NUMBER OF FIELD SPECIFICATIONS WITHIN THE FORMAT STATEMENT.
C IN ADDITION THE USE OF TWO AND THREE DIMENSIONED ARRAYS IS TESTED
C IN THE IMPLIED-DO LISTS IN BOTH THE WRITE AND READ SECTIONS.
C
C THIS ROUTINE WRITES A SINGLE SEQUENTIAL FILE WHICH IS
C REWOUND AND READ SEQUENTIALLY FORWARD. EVERY FOURTH RECORD IS
C CHECKED DURING THE READ TEST SECTION PLUS THE LAST TWO RECORDS
C AND THE END OF FILE ON THE LAST RECORD.
C
C THE LINE CONTINUATION IN COLUMN 6 IS USED IN READ, WRITE,
C AND FORMAT STATEMENTS. FOR BOTH SYNTAX AND SEMANTIC TESTS, ALL
C STATEMENTS SHOULD BE CHECKED VISUALLY FOR THE PROPER FUNCTIONING
C OF THE CONTINUATION LINE.
C
C REFERENCES
C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN,
C X3.9-1978
C
C SECTION 8, SPECIFICATION STATEMENTS
C SECTION 9, DATA STATEMENT
C SECTION 11.10, DO STATEMENT
C SECTION 12, INPUT/OUTPUT STATEMENTS
C SECTION 12.8.2, INPUT/OUTPUT LIST
C SECTION 12.9.5.2, FORMATTED DATA TRANSFER
C SECTION 13, FORMAT STATEMENT
C SECTION 13.2.1, EDIT DESCRIPTORS
C
DIMENSION IADN21(31,20), IADN31(31,10,2)
DIMENSION ITEST(27)
DIMENSION IDUMP(136)
CHARACTER*1 NINE,IDUMP
DATA NINE/'9'/
C
77701 FORMAT ( 80A1 )
77702 FORMAT (10X,19HPREMATURE EOF ONLY ,I3,13H RECORDS LUN ,I2,8H OUT O
1F ,I3,8H RECORDS)
77703 FORMAT (10X,12HFILE ON LUN ,I2,7H OK... ,I3,8H RECORDS)
77704 FORMAT (10X,12HFILE ON LUN ,I2,20H NO EOF.. MORE THAN ,I3,8H RECOR
1DS)
77705 FORMAT ( 1X,80A1)
77706 FORMAT (10X,44HFILE I06 CREATED WITH 137 SEQUENTIAL RECORDS )
77751 FORMAT ( I3, 2(1I2), 3(1I3), I4, 10(1I3) )
77752 FORMAT ( I3,2(1I2), 3(1I3), I4, 3(1I3) )
77753 FORMAT ( //////////////// I3,2I2,3I3,I4,10(I3) )
C
C
C **********************************************************
C
C A COMPILER VALIDATION SYSTEM FOR THE FORTRAN LANGUAGE
C BASED ON SPECIFICATIONS AS DEFINED IN AMERICAN NATIONAL STANDARD
C PROGRAMMING LANGUAGE FORTRAN X3.9-1978, HAS BEEN DEVELOPED BY THE
C FEDERAL COBOL COMPILER TESTING SERVICE. THE FORTRAN COMPILER
C VALIDATION SYSTEM (FCVS) CONSISTS OF AUDIT ROUTINES, THEIR RELATED
C DATA, AND AN EXECUTIVE SYSTEM. EACH AUDIT ROUTINE IS A FORTRAN
C PROGRAM, SUBPROGRAM OR FUNCTION WHICH INCLUDES TESTS OF SPECIFIC
C LANGUAGE ELEMENTS AND SUPPORTING PROCEDURES INDICATING THE RESULT
C OF EXECUTING THESE TESTS.
C
C THIS PARTICULAR PROGRAM/SUBPROGRAM/FUNCTION CONTAINS FEATURES
C FOUND ONLY IN THE SUBSET AS DEFINED IN X3.9-1978.
C
C SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO -
C
C DEPARTMENT OF THE NAVY
C FEDERAL COBOL COMPILER TESTING SERVICE
C WASHINGTON, D.C. 20376
C
C **********************************************************
C
C
C
C INITIALIZATION SECTION
C
C INITIALIZE CONSTANTS
C **************
C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER.
I01 = 5
C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER.
I02 = 6
C SYSTEM ENVIRONMENT SECTION
C
CX010 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-010 CONTROL CARD.
C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5
C (UNIT NUMBER FOR CARD READER).
CX011 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-011 CONTROL CARD.
C THE CX011 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL
C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX010 ABOVE.
C
CX020 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-020 CONTROL CARD.
C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02 = 6
C (UNIT NUMBER FOR PRINTER).
CX021 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-021 CONTROL CARD.
C THE CX021 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL
C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX020 ABOVE.
C
IVPASS=0
IVFAIL=0
IVDELE=0
ICZERO=0
C
C WRITE PAGE HEADERS
WRITE (I02,90000)
WRITE (I02,90001)
WRITE (I02,90002)
WRITE (I02, 90002)
WRITE (I02,90003)
WRITE (I02,90002)
WRITE (I02,90004)
WRITE (I02,90002)
WRITE (I02,90011)
WRITE (I02,90002)
WRITE (I02,90002)
WRITE (I02,90005)
WRITE (I02,90006)
WRITE (I02,90002)
C
C DEFAULT ASSIGNMENT FOR FILE 08 IS I06 = 7
I06 = 7
CX060 THIS CARD IS REPLACED BY THE CONTENTS OF CARD X-060
CX061 THIS CARD IS REPLACED BY THE CONTENTS OF CARD X-061
C
C WRITE SECTION....
C
C THIS SECTION OF CODE BUILDS A UNIT RECORD FILE ON LUN I06 THAT IS
C 80 CHARACTERS PER RECORD, 31 RECORDS SETS, AND CONSISTS OF ONLY
C INTEGERS ( I FORMAT ). THIS IS THE ONLY FILE TESTED IN THE
C ROUTINE FM107 AND FOR PURPOSES OF IDENTIFICATION IS FILE 08.
IPROG = 107
IFILE = 08
ILUN = I06
ITOTR = 137
IRLGN = 80
IEOF = 0000
C THESE DO-LOOPS ARE TO SET THE VALUES INTO THE TWO AND THREE
C DIMENSIONED ARRAYS FOR THE I/O LISTS....
DO 1143 IRNUM = 1, 31
DO 1142 J = 1, 20
IADN21(IRNUM,J) = IRNUM + J + 99
1142 CONTINUE
1143 CONTINUE
C
DO 1146 IRNUM = 1, 31
DO 1145 J = 1, 10
DO 1144 K = 1, 2
IADN31(IRNUM,J,K) = IRNUM + J + K + 298
1144 CONTINUE
1145 CONTINUE
1146 CONTINUE
IFLIP = 1
DO 1149 IRNUM = 1, 31
IF ( IRNUM .EQ. 31 ) IEOF = 9999
IF ( IFLIP - 1 ) 1147, 1147, 1148
1147 WRITE ( I06, 77751 ) IPROG, IFILE, ILUN, IRNUM, ITOTR, IRLGN, IEOF
1,(IADN21(IRNUM,J), J = 1, 20)
IFLIP = 2
GO TO 1149
1148 WRITE ( I06, 77752 ) IPROG, IFILE, ILUN, IRNUM, ITOTR, IRLGN, IEOF
1,((IADN31(IRNUM,J,K), K = 1, 2), J = 1, 10)
IFLIP = 1
1149 CONTINUE
WRITE (I02,77706)
C
C REWIND SECTION
C
REWIND I06
C
C READ SECTION....
C
IVTNUM = 114
C
C **** TEST 114 THRU TEST 121 ****
C TEST 114 THRU 121 - THESE TESTS READ THE SEQUENTIAL FILE
C PREVIOUSLY WRITTEN ON LUN I06 AND CHECK THE FIRST AND EVERY FOURTH
C RECORD. THE VALUES CHECKED ARE THE RECORD NUMBER - IRNUM AND
C SEVERAL VALUES IN THE INTEGER ARRAY WHICH SHOULD FOLLOW A
C CALCULATED PATTERN WITH RESPECT TO THE SUBSCRIPTS AND THE RECORD
C NUMBER....
C
IRNUM = 1
READ(I06,77751) ITEST
C READ THE FIRST RECORD....
DO 1212 I = 1, 8
IVON01 = 0
C THE INTEGER VARIABLE IS INITIALIZED TO ZERO FOR EACH TEST
IF ( ITEST(4) .EQ. IRNUM ) IVON01 = IVON01 + 1
C THE ELEMENT (4) SHOULD EQUAL THE RECORD NUMBER....
C THE FOLLOWING TESTS ARE FOR ODD NUMBERED RECORDS
IF ( ITEST(8) .EQ. IADN21(IRNUM,1) ) IVON01 = IVON01 + 1
C ELEMENT (8) SHOULD EQUAL IRNUM + 100 ....
IF ( ITEST(12) .EQ. IADN21(IRNUM,5) ) IVON01 = IVON01 + 1
C ELEMENT (12) SHOULD EQUAL IRNUM + 104 ....
IF ( ITEST(16) .EQ. IADN21(IRNUM,9) ) IVON01 = IVON01 + 1
C ELEMENT (16) SHOULD EQUAL IRNUM + 108 ....
IF ( ITEST(20) .EQ. IADN21(IRNUM,13) ) IVON01 = IVON01 + 1
C ELEMENT (20) SHOULD EQUAL IRNUM + 112 ....
IF ( ITEST(27) .EQ. IADN21(IRNUM,20) ) IVON01 = IVON01 + 1
C ELEMENT (27) SHOULD EQUAL IRNUM + 119 ....
C WHEN IVON01 = 6 THEN ALL SIX OF THE ITEST ELEMENTS THAT WERE
C CHECKED HAD THE EXPECTED VALUES.... IF IVON01 DOES NOT EQUAL 6
C THEN AT LEAST ONE OF THE VALUES WAS INCORRECT....
41200 IF ( IVON01 - 6 ) 21200, 11200, 21200
11200 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 1210
21200 IVFAIL = IVFAIL + 1
IVCOMP = IVON01
IVCORR = 6
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
1210 CONTINUE
IVTNUM = IVTNUM + 1
C INCREMENT THE TEST NUMBER....
C
IF ( I .EQ. 8 ) GO TO 1221
C THIS CODE IS TO SKIP READING PAST THE END OF FILE BY NOT READING
C FOUR RECORDS PAST RECORD NUMBER 29 ON THE 8TH LOOP....
C
READ ( I06,77753 ) ITEST
C READ FOUR RECORDS ON LUN I06....
IRNUM = IRNUM + 4
C INCREMENT THE RECORD NUMBER COUNTER....
1212 CONTINUE
IF ( ICZERO ) 31200, 1221, 31200
31200 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
1221 CONTINUE
IVTNUM = 122
C
C **** TEST 122 ****
C TEST 122 - THIS CHECKS THE VALUE OF THE VARIABLE ITEST(27)
C ON RECORD NUMBER 30. ELEMENT (20) SHOULD EQUAL IADN31(30,2,10)
C WHICH SHOULD BE EQUAL TO 340 ....
C
IF (ICZERO) 31220, 1220, 31220
1220 CONTINUE
READ ( I06,77752 ) ITEST
IVCOMP = ITEST(27)
GO TO 41220
31220 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 41220, 1231, 41220
41220 IF ( IVCOMP - 340 ) 21220, 11220, 21220
11220 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 1231
21220 IVFAIL = IVFAIL + 1
IVCORR = 340
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
1231 CONTINUE
IVTNUM = 123
C
C **** TEST 123 ****
C TEST 123 - THIS CHECKS THE VALUE OF VARIABLE ITEST(27) ON
C RECORD NUMBER 31 WHICH SHOULD EQUAL IADN21(31,20) = 31 + 20 + 99
C ITEST(27) SHOULD EQUAL 150 ....
C
IF (ICZERO) 31230, 1230, 31230
1230 CONTINUE
READ ( I06,77751) ITEST
IVCOMP = ITEST(27)
GO TO 41230
31230 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 41230, 1241, 41230
41230 IF ( IVCOMP - 150 ) 21230, 11230, 21230
11230 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 1241
21230 IVFAIL = IVFAIL + 1
IVCORR = 150
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
1241 CONTINUE
IVTNUM = 124
C
C **** TEST 124 ****
C TEST 124 - THIS CHECKS FOR THE PROPER 9999 EOF INDICATOR ON
C RECORD NUMBER 31 ....
C
IF (ICZERO) 31240, 1240, 31240
1240 CONTINUE
IVCOMP = ITEST(7)
GO TO 41240
31240 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 41240, 1251, 41240
41240 IF ( IVCOMP - 9999 ) 21240, 11240, 21240
11240 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 1251
21240 IVFAIL = IVFAIL + 1
IVCORR = 9999
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
1251 CONTINUE
C THIS CODE IS OPTIONALLY COMPILED AND IS USED TO DUMP THE FILE 08
C TO THE LINE PRINTER.
CDB**
C ILUN = I06
C ITOTR = 137
C IRLGN = 80
C7777 REWIND ILUN
C IENDC = 0
C IRCNT = 0
C DO 7778 IRNUM = 1, ITOTR
C READ (ILUN,77701) (IDUMP(ICHAR), ICHAR = 1, IRLGN)
C WRITE ( I02,77705) (IDUMP(ICHAR), ICHAR = 1, IRLGN)
C IRCNT = IRCNT + 1
C IF ( IDUMP(20) .EQ. NINE ) IENDC = IRNUM
C7778 CONTINUE
C IF ( IENDC - 136 ) 7780, 7779, 7782
C7779 IF ( IRCNT - ITOTR ) 7780, 7781, 7782
C7780 WRITE (I02,77702) IRNUM,ILUN,ITOTR
C GO TO 7784
C7781 WRITE (I02,77703) ILUN,ITOTR
C GO TO 7784
C7782 WRITE (I02,77704) ILUN, ITOTR
C DO 7783 I = 1, 5
C READ (ILUN,77701) (IDUMP(ICHAR), ICHAR = 1, IRLGN)
C WRITE ( I02,77705) (IDUMP(ICHAR), ICHAR = 1, IRLGN)
C IF ( IDUMP(20) .EQ. NINE ) GO TO 7784
C7783 CONTINUE
C7784 GO TO 99999
CDE**
C WRITE PAGE FOOTINGS AND RUN SUMMARIES
99999 CONTINUE
WRITE (I02,90002)
WRITE (I02,90006)
WRITE (I02,90002)
WRITE (I02,90002)
WRITE (I02,90007)
WRITE (I02,90002)
WRITE (I02,90008) IVFAIL
WRITE (I02,90009) IVPASS
WRITE (I02,90010) IVDELE
C
C
C TERMINATE ROUTINE EXECUTION
STOP
C
C FORMAT STATEMENTS FOR PAGE HEADERS
90000 FORMAT (1H1)
90002 FORMAT (1H )
90001 FORMAT (1H ,10X,34HFORTRAN COMPILER VALIDATION SYSTEM)
90003 FORMAT (1H ,21X,11HVERSION 1.0)
90004 FORMAT (1H ,10X,38HFOR OFFICIAL USE ONLY - COPYRIGHT 1978)
90005 FORMAT (1H ,5X,4HTEST,5X,9HPASS/FAIL, 5X,8HCOMPUTED,8X,7HCORRECT)
90006 FORMAT (1H ,5X,46H----------------------------------------------)
90011 FORMAT (1H ,18X,17HSUBSET LEVEL TEST)
C
C FORMAT STATEMENTS FOR RUN SUMMARIES
90008 FORMAT (1H ,15X,I5,19H ERRORS ENCOUNTERED)
90009 FORMAT (1H ,15X,I5,13H TESTS PASSED)
90010 FORMAT (1H ,15X,I5,14H TESTS DELETED)
C
C FORMAT STATEMENTS FOR TEST RESULTS
80001 FORMAT (1H ,4X,I5,7X,4HPASS)
80002 FORMAT (1H ,4X,I5,7X,4HFAIL)
80003 FORMAT (1H ,4X,I5,7X,7HDELETED)
80004 FORMAT (1H ,4X,I5,7X,4HFAIL,10X,I6,9X,I6)
80005 FORMAT (1H ,4X,I5,7X,4HFAIL,4X,E12.5,3X,E12.5)
C
90007 FORMAT (1H ,20X,20HEND OF PROGRAM FM107)
END
*END-OF,FM107
FM108.f 480976100 170 2 100666 12779 `
*HEADER,FORTR,FM108
*FILES1,FORTR,FM108,X
C COMMENT SECTION.
C
C FM108
C
C THIS ROUTINE IS A TEST OF THE X FORMAT AND IS TAPE AND PRINTER
C ORIENTED. THE ROUTINE CAN NOT BE USED FOR DISK. BOTH THE READ
C AND WRITE STATEMENTS ARE TESTED. VARIABLES IN THE INPUT AND
C OUTPUT LISTS ARE INTEGER OR REAL VARIABLES, INTEGER ARRAY ELEMENTS
C OR ARRAY NAME REFERENCES. READ AND WRITE STATEMENTS ARE DONE
C WITH FORMAT STATEMENTS. THE ROUTINE HAS AN OPTIONAL SECTION OF
C CODE TO DUMP THE FILE AFTER IT HAS BEEN WRITTEN. DO LOOPS AND
C DO-IMPLIED LISTS ARE USED IN CONJUNCTION WITH A ONE DIMENSIONAL
C INTEGER ARRAY FOR THE DUMP SECTION.
C
C WITH THE EXCEPTION OF THE RECORD PREAMBLES ON EACH RECORD,
C ALL OF THE I, F, AND A-FIELDS HAVE A MINUS SIGN IN THE LEFTMOST
C CHARACTER POSITION OF EACH FIELD.
C
C THIS ROUTINE WRITES A SINGLE SEQUENTIAL FILE WHICH IS
C REWOUND AND READ SEQUENTIALLY FORWARD AND THEN READ SEQUENTIALLY
C BACKWARD BY USING THE BACKSPACE COMMAND. THE FORWARD READ IS
C USED TO CHECK ALL OF THE ODD RECORDS AND THE READ REVERSE IN
C EFFECT CHECKS THE EVEN NUMBERED RECORDS. THE ENDFILE COMMAND IS
C ALSO USED AFTER THE WRITE SECTION BUT BECAUSE THE RESULT OF
C ATTEMPTING TO READ OR READ BEYOND THE ENDFILE MARK IS NOT POSSIBLE
C TO PREDICT FOR ALL MACHINES, THE ENDFILE MARK IS NEVER ACTUALLY
C READ.
C
C THE LINE CONTINUATION IN COLUMN 6 IS USED IN READ, WRITE,
C AND FORMAT STATEMENTS. FOR BOTH SYNTAX AND SEMANTIC TESTS, ALL
C STATEMENTS SHOULD BE CHECKED VISUALLY FOR THE PROPER FUNCTIONING
C OF THE CONTINUATION LINE.
C
C
C REFERENCES
C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN,
C X3.9-1978
C
C SECTION 8, SPECIFICATION STATEMENTS
C SECTION 9, DATA STATEMENT
C SECTION 11.10, DO STATEMENT
C SECTION 12, INPUT/OUTPUT STATEMENTS
C SECTION 12.8.2, INPUT/OUTPUT LIST
C SECTION 12.9.5.2, FORMATTED DATA TRANSFER
C SECTION 13, FORMAT STATEMENT
C SECTION 13.2.1, EDIT DESCRIPTORS
C
DIMENSION IDUMP(136)
DIMENSION IADN11(5), IADN12(3), IADN13(3)
CHARACTER*1 NINE,IADN11,ICON04,IDUMP
CHARACTER*2 IADN12,ICON06
CHARACTER*3 IADN13
DATA NINE/'9'/
DATA IADN11/'-', 'W', 'H', 'E', 'E'/, IADN12/'-H', 'EL', 'L'/,
1IADN13/'-', 'HE', 'LL'/
C
77701 FORMAT ( 80A1 )
77702 FORMAT (10X,19HPREMATURE EOF ONLY ,I3,13H RECORDS LUN ,I2,8H OUT O
1F ,I3,8H RECORDS)
77703 FORMAT (10X,12HFILE ON LUN ,I2,7H OK... ,I3,8H RECORDS)
77704 FORMAT (10X,12HFILE ON LUN ,I2,20H NO EOF.. MORE THAN ,I3,8H RECOR
1DS)
77705 FORMAT ( 1X,80A1)
77706 FORMAT (10X,43HFILE I08 CREATED WITH 31 SEQUENTIAL RECORDS)
77751 FORMAT ( I3,2I2,3I3,I4,4X,I6,4X,F6.2,5X,5A1,4X,I6,4X,F6.4,5X,2A2,A
11 )
77752 FORMAT ( I3,2I2,3I3,I4,I6,4X,F6.2,4X,5A1,5X,I6,4X,F6.4,4X,A1,2A2,5
1X )
77753 FORMAT (7X,I3,6X,I4,4X,I6,15X,A1,8X,I6,4X,F6.4,9X,A1 )
77754 FORMAT (7X,I3,6X,I4,I6,14X,A1,9X,I6,4X,F6.4,7X,A2,5X )
C
C
C **********************************************************
C
C A COMPILER VALIDATION SYSTEM FOR THE FORTRAN LANGUAGE
C BASED ON SPECIFICATIONS AS DEFINED IN AMERICAN NATIONAL STANDARD
C PROGRAMMING LANGUAGE FORTRAN X3.9-1978, HAS BEEN DEVELOPED BY THE
C FEDERAL COBOL COMPILER TESTING SERVICE. THE FORTRAN COMPILER
C VALIDATION SYSTEM (FCVS) CONSISTS OF AUDIT ROUTINES, THEIR RELATED
C DATA, AND AN EXECUTIVE SYSTEM. EACH AUDIT ROUTINE IS A FORTRAN
C PROGRAM, SUBPROGRAM OR FUNCTION WHICH INCLUDES TESTS OF SPECIFIC
C LANGUAGE ELEMENTS AND SUPPORTING PROCEDURES INDICATING THE RESULT
C OF EXECUTING THESE TESTS.
C
C THIS PARTICULAR PROGRAM/SUBPROGRAM/FUNCTION CONTAINS FEATURES
C FOUND ONLY IN THE SUBSET AS DEFINED IN X3.9-1978.
C
C SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO -
C
C DEPARTMENT OF THE NAVY
C FEDERAL COBOL COMPILER TESTING SERVICE
C WASHINGTON, D.C. 20376
C
C **********************************************************
C
C
C
C INITIALIZATION SECTION
C
C INITIALIZE CONSTANTS
C **************
C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER.
I01 = 5
C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER.
I02 = 6
C SYSTEM ENVIRONMENT SECTION
C
CX010 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-010 CONTROL CARD.
C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5
C (UNIT NUMBER FOR CARD READER).
CX011 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-011 CONTROL CARD.
C THE CX011 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL
C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX010 ABOVE.
C
CX020 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-020 CONTROL CARD.
C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02 = 6
C (UNIT NUMBER FOR PRINTER).
CX021 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-021 CONTROL CARD.
C THE CX021 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL
C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX020 ABOVE.
C
IVPASS=0
IVFAIL=0
IVDELE=0
ICZERO=0
C
C WRITE PAGE HEADERS
WRITE (I02,90000)
WRITE (I02,90001)
WRITE (I02,90002)
WRITE (I02, 90002)
WRITE (I02,90003)
WRITE (I02,90002)
WRITE (I02,90004)
WRITE (I02,90002)
WRITE (I02,90011)
WRITE (I02,90002)
WRITE (I02,90002)
WRITE (I02,90005)
WRITE (I02,90006)
WRITE (I02,90002)
C
C DEFAULT ASSIGNMENT FOR FILE 09 IS I08 = 7
I08 = 7
CX080 THIS CARD IS REPLACED BY THE CONTENTS OF CARD X-080
CX081 THIS CARD IS REPLACED BY THE CONTENTS OF CARD X-081
C
C WRITE SECTION....
C
C THIS SECTION OF CODE BUILDS A UNIT RECORD FILE ON LUN I08 THAT IS
C 80 CHARACTERS PER RECORD, 31 RECORDS LONG, AND CONSISTS OF
C I, F, A, AND X FORMAT. THIS IS THE ONLY FILE TESTED IN THE
C ROUTINE FM108 AND FOR PURPOSES OF IDENTIFICATION IS FILE 09.
C ALL ARRAY ELEMENT DATA FOR THE ALPHANUMERIC CHARACTERS IS SET BY
C THE DATA INITIALIZATION STATEMENT. INTEGER AND REAL VARIABLES ARE
C SET BY ASSIGNMENT STATEMENTS.
C
IPROG = 108
IFILE = 09
ILUN = I08
ITOTR = 31
IRLGN = 80
IEOF = 0000
ICON01 = -32766
RCON01 = -12.34
ICON02 = -12345
RCON02 = -.9999
IFLIP = 1
DO 1254 IRNUM = 1, 31
IF ( IRNUM .EQ. 31 ) IEOF = 9999
IF ( IFLIP - 1 ) 1252, 1252, 1253
1252 WRITE ( I08, 77751 ) IPROG, IFILE, ILUN, IRNUM, ITOTR, IRLGN, IEOF
1, ICON01, RCON01, IADN11,ICON02, RCON02, IADN12
IFLIP = 2
GO TO 1254
1253 WRITE ( I08, 77752 ) IPROG, IFILE, ILUN, IRNUM, ITOTR, IRLGN, IEOF
1, ICON01, RCON01, IADN11, ICON02, RCON02, IADN13
IFLIP = 1
1254 CONTINUE
WRITE (I02,77706)
C
C ENDFILE SECTION ....
ENDFILE I08
C
C REWIND SECTION
REWIND I08
C
C
C READ FORWARD SECTION ....
C
C
IVTNUM = 125
C
C **** TEST 125 THRU TEST 140 ****
C TEST 125 THRU 140 - THESE TESTS CHECK THE ODD NUMBERED RECORDS.
C THE FILE 09 IS READ SEQUENTIALLY FORWARD AND THE EVEN NUMBERED
C RECORDS ARE SKIPPED BY READING PAST THEM.
C
DO 1255 IRNUM = 1, 31, 2
IVON01 = 0
C THE INTEGER VARIABLE IS INITIALIZED TO ZERO FOR EACH TEST 125-140.
READ ( I08,77753 ) IRNO,IEND,ICON03,ICON04,ICON05,RCON03,ICON06
C READ AN ODD NUMBERED RECORD....
IF ( IRNO .EQ. IRNUM ) IVON01 = IVON01 + 1
C IRNO SHOULD BE THE RECORD NUMBER....
IF ( ICON03 .EQ. ICON01 ) IVON01 = IVON01 + 1
C ICON03 SHOULD EQUAL -32766 ....
IF ( ICON04 .EQ. IADN11(1) ) IVON01 = IVON01 + 1
C ICON04 SHOULD EQUAL '-' ....
IF ( ICON05 .EQ. ICON02 ) IVON01 = IVON01 + 1
C ICON05 SHOULD EQUAL -12345 ....
IF(RCON03.GE. -.99995 .OR. RCON03.LE. -.99985)IVON01=IVON01+1
C RCON03 SHOULD EQUAL -.9999 ....
IF ( ICON06 .EQ. IADN12(3) ) IVON01 = IVON01 + 1
C ICON06 SHOULD EQUAL 'L' ....
IF ( IVON01 - 6 ) 21250, 11250, 21250
11250 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 1261
21250 IVFAIL = IVFAIL + 1
IVCOMP = IVON01
IVCORR = 6
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
1261 CONTINUE
IF ( IRNUM .EQ. 31 ) GO TO 1255
C THIS DOES NOT ALLOW READING THE ENDFILE MARK....
READ ( I08,77754 ) IRNO,IEND,ICON03,ICON04,ICON05,RCON03,ICON06
C READ PAST THE EVEN NUMBERED RECORD ....
IVTNUM = IVTNUM + 1
C INCREMENT THE TEST NUMBER....
1255 CONTINUE
IF ( ICZERO ) 31250, 1411, 31250
31250 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
1411 CONTINUE
IVTNUM = 141
C
C **** TEST 141 THRU TEST 155 ****
C TEST 141 THRU 155 - THESE TESTS USE THE BACKSPACE COMMAND
C TO READ REVERSE AND CHECK THE EVEN NUMBERED RECORDS. AT THE
C BEGINNING OF THIS SERIES, THE FILE 09 SHOULD BE SETTING AT THE
C ENDFILE MARK PAST RECORD NUMBER 31.
C
BACKSPACE I08
BACKSPACE I08
IRNUM = 30
C THE FILE SHOULD NOW BE SETTING AT RECORD NUMBER 30....
DO 1552 I = 1, 15
IVON01 = 0
C THE INTEGER VARIABLE IS INITIALIZED TO ZERO FOR EACH TEST 141-155.
READ ( I08,77754 ) IRNO,IEND,ICON03,ICON04,ICON05,RCON03,ICON06
C READ AN EVEN NUMBERED RECORD....
IF ( IRNO .EQ. IRNUM ) IVON01 = IVON01 + 1
C IRNO SHOULD BE THE RECORD NUMBER....
IF ( ICON03 .EQ. ICON01 ) IVON01 = IVON01 + 1
C ICON03 SHOULD EQUAL -32766 ....
IF ( ICON04 .EQ. IADN11(1) ) IVON01 = IVON01 + 1
C ICON04 SHOULD EQUAL '-' ....
IF ( ICON05 .EQ. ICON02 ) IVON01 = IVON01 + 1
C ICON05 SHOULD EQUAL -12345 ....
IF(RCON03.GE. -.99995 .OR. RCON03.LE. -.99985)IVON01=IVON01+1
C RCON03 SHOULD EQUAL -.9999 ....
IF ( ICON06 .EQ. IADN13(3) ) IVON01 = IVON01 + 1
C ICON06 SHOULD EQUAL 'LL' ....
IF ( IVON01 - 6 ) 21410, 11410, 21410
11410 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 1421
21410 IVFAIL = IVFAIL + 1
IVCOMP = IVON01
IVCORR = 6
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
1421 CONTINUE
C THIS IS TO NOT ALLOW READING BACKWARDS PAST RECORD NUMBER 1....
IF ( I .EQ. 15 ) GO TO 1552
C BACKSPACE TO THE NEXT EVEN RECORD....
BACKSPACE I08
BACKSPACE I08
BACKSPACE I08
IVTNUM = IVTNUM + 1
C INCREMENT THE TEST NUMBER....
IRNUM = IRNUM - 2
C DECREMENT THE RECORD NUMBER POINTER BY 2 ....
1552 CONTINUE
IF ( ICZERO ) 31410, 1561, 31410
31410 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
1561 CONTINUE
C THIS CODE IS OPTIONALLY COMPILED AND IS USED TO DUMP THE FILE 09
C TO THE LINE PRINTER.
CDB**
C ILUN = I08
C ITOTR = 31
C IRLGN = 80
C7777 REWIND ILUN
C DO 7778 IRNUM = 1, ITOTR
C READ (ILUN,77701) (IDUMP(ICHAR), ICHAR = 1, IRLGN)
C WRITE ( I02,77705) (IDUMP(ICHAR), ICHAR = 1, IRLGN)
C IF ( IDUMP(20) .EQ. NINE ) GO TO 7779
C7778 CONTINUE
C GO TO 7782
C7779 IF ( IRNUM - ITOTR ) 7780, 7781, 7782
C7780 WRITE (I02,77702) IRNUM,ILUN,ITOTR
C GO TO 7784
C7781 WRITE (I02,77703) ILUN,ITOTR
C GO TO 7784
C7782 WRITE (I02,77704) ILUN, ITOTR
C DO 7783 I = 1, 5
C READ (ILUN,77701) (IDUMP(ICHAR), ICHAR = 1, IRLGN)
C WRITE ( I02,77705) (IDUMP(ICHAR), ICHAR = 1, IRLGN)
C IF ( IDUMP(20) .EQ. NINE ) GO TO 7784
C7783 CONTINUE
C7784 GO TO 99999
CDE**
C WRITE PAGE FOOTINGS AND RUN SUMMARIES
99999 CONTINUE
WRITE (I02,90002)
WRITE (I02,90006)
WRITE (I02,90002)
WRITE (I02,90002)
WRITE (I02,90007)
WRITE (I02,90002)
WRITE (I02,90008) IVFAIL
WRITE (I02,90009) IVPASS
WRITE (I02,90010) IVDELE
C
C
C TERMINATE ROUTINE EXECUTION
STOP
C
C FORMAT STATEMENTS FOR PAGE HEADERS
90000 FORMAT (1H1)
90002 FORMAT (1H )
90001 FORMAT (1H ,10X,34HFORTRAN COMPILER VALIDATION SYSTEM)
90003 FORMAT (1H ,21X,11HVERSION 1.0)
90004 FORMAT (1H ,10X,38HFOR OFFICIAL USE ONLY - COPYRIGHT 1978)
90005 FORMAT (1H ,5X,4HTEST,5X,9HPASS/FAIL, 5X,8HCOMPUTED,8X,7HCORRECT)
90006 FORMAT (1H ,5X,46H----------------------------------------------)
90011 FORMAT (1H ,18X,17HSUBSET LEVEL TEST)
C
C FORMAT STATEMENTS FOR RUN SUMMARIES
90008 FORMAT (1H ,15X,I5,19H ERRORS ENCOUNTERED)
90009 FORMAT (1H ,15X,I5,13H TESTS PASSED)
90010 FORMAT (1H ,15X,I5,14H TESTS DELETED)
C
C FORMAT STATEMENTS FOR TEST RESULTS
80001 FORMAT (1H ,4X,I5,7X,4HPASS)
80002 FORMAT (1H ,4X,I5,7X,4HFAIL)
80003 FORMAT (1H ,4X,I5,7X,7HDELETED)
80004 FORMAT (1H ,4X,I5,7X,4HFAIL,10X,I6,9X,I6)
80005 FORMAT (1H ,4X,I5,7X,4HFAIL,4X,E12.5,3X,E12.5)
C
90007 FORMAT (1H ,20X,20HEND OF PROGRAM FM108)
END
*END-OF,FM108
FM109.f 480976102 170 2 100666 18096 `
*HEADER,FORTR,FM109
*FILES1,FORTR,FM109,X
C COMMENT SECTION
C
C FM109
C
C THIS ROUTINE TESTS THE BASIC OPTIONS REGARDING THE SIMPLE
C FORMATTED WRITE STATEMENT OF FORM
C WRITE (U,F) OR
C WRITE (U,F) L
C WHERE U IS A LOGICAL UNIT NUMBER
C F IS A FORMAT STATEMENT LABEL, AND
C L IS A LIST OF INTEGER VARIABLES.
C THE FORMAT STATEMENT F CONTAINS NH HOLLERITH FIELD DESCRIPTORS,
C NX BLANK FIELD DESCRIPTORS AND IW NUMERIC FIELD DESCRIPTORS.
C
C THIS ROUTINE TESTS WHETHER THE FIRST CHARACTER OF A FORMAT
C RECORD FOR PRINTER OUTPUT DETERMINES VERTICAL SPACING AS FOLLOWS
C 1 - ADVANCE TO FIRST LINE OF NEXT PAGE
C BLANK - ONE LINE
C 0 - ADVANCE TWO LINES BEFORE PRINTING
C + - DO NOT ADVANCE BEFORE PRINTING - ADVANCE 0
C
C REFERENCES
C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN,
C X3.9-1978
C
C SECTION 8, SPECIFICATION STATEMENTS
C SECTION 9, DATA STATEMENT
C SECTION 11.10, DO STATEMENT
C SECTION 12, INPUT/OUTPUT STATEMENTS
C SECTION 12.8.2, INPUT/OUTPUT LIST
C SECTION 12.9.5.2, FORMATTED DATA TRANSFER
C SECTION 13, FORMAT STATEMENT
C SECTION 13.2.1, EDIT DESCRIPTORS
C
C ALL OF THE RESULTS OF THIS ROUTINE MUST BE VISUALLY CHECKED
C ON THE OUTPUT REPORT. THE USUAL TEST CODE FOR PASS, FAIL, OR
C DELETE DOES NOT APPLY TO THIS ROUTINE. IF ANY TEST IS TO BE
C DELETED, CHANGE THE OFFENDING WRITE OR FORMAT STATEMENT TO A
C COMMENT. THE PERSON RESPONSIBLE FOR CHECKING THE OUTPUT MUST ALSO
C CHECK THE COMPILER LISTING TO SEE IF ANY STATEMENTS HAVE BEEN
C CHANGED TO COMMENTS.
C
C
C **********************************************************
C
C A COMPILER VALIDATION SYSTEM FOR THE FORTRAN LANGUAGE
C BASED ON SPECIFICATIONS AS DEFINED IN AMERICAN NATIONAL STANDARD
C PROGRAMMING LANGUAGE FORTRAN X3.9-1978, HAS BEEN DEVELOPED BY THE
C FEDERAL COBOL COMPILER TESTING SERVICE. THE FORTRAN COMPILER
C VALIDATION SYSTEM (FCVS) CONSISTS OF AUDIT ROUTINES, THEIR RELATED
C DATA, AND AN EXECUTIVE SYSTEM. EACH AUDIT ROUTINE IS A FORTRAN
C PROGRAM, SUBPROGRAM OR FUNCTION WHICH INCLUDES TESTS OF SPECIFIC
C LANGUAGE ELEMENTS AND SUPPORTING PROCEDURES INDICATING THE RESULT
C OF EXECUTING THESE TESTS.
C
C THIS PARTICULAR PROGRAM/SUBPROGRAM/FUNCTION CONTAINS FEATURES
C FOUND ONLY IN THE SUBSET AS DEFINED IN X3.9-1978.
C
C SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO -
C
C DEPARTMENT OF THE NAVY
C FEDERAL COBOL COMPILER TESTING SERVICE
C WASHINGTON, D.C. 20376
C
C **********************************************************
C
C
C
C INITIALIZATION SECTION
C
C INITIALIZE CONSTANTS
C **************
C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER.
I01 = 5
C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER.
I02 = 6
C SYSTEM ENVIRONMENT SECTION
C
CX010 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-010 CONTROL CARD.
C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5
C (UNIT NUMBER FOR CARD READER).
CX011 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-011 CONTROL CARD.
C THE CX011 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL
C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX010 ABOVE.
C
CX020 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-020 CONTROL CARD.
C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02 = 6
C (UNIT NUMBER FOR PRINTER).
CX021 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-021 CONTROL CARD.
C THE CX021 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL
C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX020 ABOVE.
C
IVPASS=0
IVFAIL=0
IVDELE=0
ICZERO=0
C
C WRITE PAGE HEADERS
WRITE (I02,90000)
WRITE (I02,90001)
WRITE (I02,90002)
WRITE (I02, 90002)
WRITE (I02,90003)
WRITE (I02,90002)
WRITE (I02,90004)
WRITE (I02,90002)
WRITE (I02,90011)
WRITE (I02,90002)
WRITE (I02,90002)
WRITE (I02,90006)
WRITE (I02,90002)
C
IVTNUM = 156
C **** TEST 156 ****
C TEST 156 - VERTICAL SPACING TEST
C 1 IN FIRST CHARACTER OF FORMATTED PRINT RECORD MEANS
C RECORD IS FIRST LINE AT TOP OF NEXT PAGE.
C
IF (ICZERO) 31560, 1560, 31560
1560 CONTINUE
WRITE (I02,80001) IVTNUM
WRITE (I02,80331)
80331 FORMAT (5X,22HLAST LINE ON THIS PAGE)
WRITE (I02,80330)
80330 FORMAT (1H1,31H THIS IS FIRST LINE ON PAGE)
GO TO 1571
31560 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
1571 CONTINUE
IVTNUM = 157
C
C **** TEST 157 ****
C TEST 157 - VERTICAL SPACING TEST
C PRINT BLANK LINES
C
C
IF (ICZERO) 31570, 1570, 31570
1570 CONTINUE
WRITE (I02,90002)
WRITE (I02,80001) IVTNUM
WRITE (I02,80340)
80340 FORMAT (1H , 10X)
WRITE (I02,80341)
80341 FORMAT (41H THERE IS ONE BLANK LINE BEFORE THIS LINE)
WRITE (I02,80342)
WRITE (I02,80342)
80342 FORMAT (11H )
WRITE (I02,80343)
80343 FORMAT (43H THERE ARE TWO BLANK LINES BEFORE THIS LINE)
WRITE (I02,80344)
WRITE (I02,80344)
WRITE (I02,80344)
80344 FORMAT (11X)
WRITE (I02,80345)
80345 FORMAT (45H THERE ARE THREE BLANK LINES BEFORE THIS LINE)
GO TO 1581
31570 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
1581 CONTINUE
IVTNUM = 158
C
C **** TEST 158 ****
C TEST 158 - PRINT 54 CHARACTERS
C
C
IF (ICZERO) 31580, 1580, 31580
1580 CONTINUE
WRITE (I02,90002)
WRITE (I02,80001)IVTNUM
WRITE (I02,80351)
80351 FORMAT (33H NEXT LINE CONTAINS 54 CHARACTERS)
WRITE (I02,80350)
80350 FORMAT(55H 123456789012345678901234567890123456789012345678901234)
GO TO 1591
31580 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
1591 CONTINUE
IVTNUM = 159
C
C **** TEST 159 ****
C TEST 159 - NUMERIC FIELD DESCRIPTOR I1
C
IF (ICZERO) 31590, 1590, 31590
1590 CONTINUE
WRITE (I02,90002)
WRITE (I02,80001) IVTNUM
WRITE (I02,80361)
80361 FORMAT (1H ,10X,38HTHIS TEST PRINTS 3 UNDER I1 DESCRIPTOR)
IVON01 = 3
WRITE (I02,80360) IVON01
80360 FORMAT (1H ,10X,I1)
GO TO 1601
31590 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
1601 CONTINUE
IVTNUM = 160
C
C **** TEST 160 ****
C TEST 160 - NUMERIC FIELD DESCRIPTOR I2
C
IF (ICZERO) 31600, 1600, 31600
1600 CONTINUE
WRITE (I02,90002)
WRITE (I02,80001) IVTNUM
WRITE (I02,80371)
80371 FORMAT (11X,39HTHIS TEST PRINTS 15 UNDER I2 DESCRIPTOR)
IVON01 = 15
WRITE (I02,80370) IVON01
80370 FORMAT (1H ,10X,I2)
GO TO 1611
31600 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
1611 CONTINUE
IVTNUM = 161
C
C **** TEST 161 ****
C TEST 161 - NUMERIC FIELD DESCRIPTOR I3
C
IF (ICZERO) 31610, 1610, 31610
1610 CONTINUE
WRITE (I02,90002)
WRITE (I02,80001) IVTNUM
WRITE (I02,80381)
80381 FORMAT (11X,40HTHIS TEST PRINTS 291 UNDER I3 DESCRIPTOR)
IVON01 = 291
WRITE (I02,80380) IVON01
80380 FORMAT (11X,I3)
GO TO 1621
31610 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
1621 CONTINUE
IVTNUM = 162
C
C **** TEST 162 ****
C TEST 162 - NUMERIC FIELD DESCRIPTOR I4
C
IF (ICZERO) 31620, 1620, 31620
1620 CONTINUE
WRITE (I02,90002)
WRITE (I02,80001) IVTNUM
WRITE (I02,80391)
80391 FORMAT (11X,41HTHIS TEST PRINTS 4321 UNDER I4 DESCRIPTOR)
IVON01 = 4321
WRITE (I02,80390) IVON01
80390 FORMAT (11X,I4)
GO TO 1631
31620 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
1631 CONTINUE
IVTNUM = 163
C
C **** TEST 163 ****
C TEST 163 - NUMERIC FIELD DESCRIPTOR I5
C
IF (ICZERO) 31630, 1630, 31630
1630 CONTINUE
WRITE (I02,90002)
WRITE (I02,80001) IVTNUM
WRITE (I02,80401)
80401 FORMAT (1H ,10X,42HTHIS TEST PRINTS 12345 UNDER I5 DESCRIPTOR)
IVON01 = 12345
WRITE (I02,80400) IVON01
80400 FORMAT (1H ,10X,I5)
GO TO 1641
31630 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
1641 CONTINUE
IVTNUM = 164
C
C **** TEST 164 ****
C TEST 164 - NUMERIC FIELD DESCRIPTORS, INTEGER CONVERSION
C
IF (ICZERO) 31640, 1640, 31640
1640 CONTINUE
IVON01 = 1
IVON02 = 22
IVON03 = 333
IVON04 = 4444
IVON05 = 25555
WRITE (I02,90002)
WRITE (I02,80001) IVTNUM
WRITE (I02,80411)
80411 FORMAT (3X,50HTHIS TEST PRINTS 1, 22, 333, 4444, AND 25555 UNDER)
WRITE (I02,80412)
80412 FORMAT (10X,32H(10X,I1,3X,I2,3X,I3,3X,I4,3X,I5))
WRITE (I02,80410) IVON01, IVON02, IVON03, IVON04, IVON05
80410 FORMAT (10X,I1,3X,I2,3X,I3,3X,I4,3X,I5)
GO TO 1651
31640 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
1651 CONTINUE
IVTNUM = 165
C
C **** TEST 165 ****
C TEST 165 - HOLLERITH, NUMERIC AND X FIELD DESCRIPTORS
C COMBINE HOLLERITH, NUMERIC AND X FIELD DESCRIPTORS IN
C ONE FORMAT STATEMENT
C
IF (ICZERO) 31650, 1650, 31650
1650 CONTINUE
IVON01=113
IVON02=8
WRITE (I02,90002)
WRITE (I02,80001) IVTNUM
WRITE (I02,80421)
80421 FORMAT (10X,28HNEXT TWO LINES ARE IDENTICAL)
WRITE (I02,80422)
80422 FORMAT (35H IVON01 = 113 IVON02 = 8)
WRITE (I02,80420) IVON01, IVON02
80420 FORMAT (6X,8HIVON01 =,I5,3X,8HIVON02 =,I5)
GO TO 1661
31650 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
1661 CONTINUE
IVTNUM = 166
C
C **** TEST 166 ****
C TEST 166 - NUMERIC FIELD DESCRIPTOR I2
C PRINT NEGATIVE INTEGER
C
IF (ICZERO) 31660, 1660, 31660
1660 CONTINUE
IVON01 = -1
WRITE (I02,90002)
WRITE (I02,80001) IVTNUM
WRITE (I02,80431)
80431 FORMAT (11X,39HTHIS TEST PRINTS -1 UNDER I2 DESCRIPTOR)
WRITE (I02,80430) IVON01
80430 FORMAT (11X,I2)
GO TO 1671
31660 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
1671 CONTINUE
IVTNUM = 167
C
C **** TEST 167 ****
C TEST 167 - NUMERIC FIELD DESCRIPTOR I3
C PRINT NEGATIVE INTEGER
C
IF (ICZERO) 31670, 1670, 31670
1670 CONTINUE
IVON01 = -22
WRITE (I02,90002)
WRITE (I02,80001) IVTNUM
WRITE (I02,80441)
80441 FORMAT (11X,40HTHIS TEST PRINTS -22 UNDER I3 DESCRIPTOR)
WRITE (I02,80440) IVON01
80440 FORMAT (11X,I3)
GO TO 1681
31670 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
1681 CONTINUE
IVTNUM = 168
C
C **** TEST 168 ****
C TEST 168 - NUMERIC FIELD DESCRIPTOR I4
C PRINT NEGATIVE INTEGER
C
IF (ICZERO) 31680, 1680, 31680
1680 CONTINUE
IVON01 = -333
WRITE (I02,90002)
WRITE (I02,80001) IVTNUM
WRITE (I02,80451)
80451 FORMAT (11X,41HTHIS TEST PRINTS -333 UNDER I4 DESCRIPTOR)
WRITE (I02,80450) IVON01
80450 FORMAT (11X,I4)
GO TO 1691
31680 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
1691 CONTINUE
IVTNUM = 169
C
C **** TEST 169 ****
C TEST 169 - NUMERIC FIELD DESCRIPTOR I5
C PRINT NEGATIVE INTEGER
C
IF (ICZERO) 31690, 1690, 31690
1690 CONTINUE
IVON01 = -4444
WRITE (I02,90002)
WRITE (I02,80001) IVTNUM
WRITE (I02,80461)
80461 FORMAT (11X,42HTHIS TEST PRINTS -4444 UNDER I5 DESCRIPTOR)
WRITE (I02,80460) IVON01
80460 FORMAT (11X,I5)
GO TO 1701
31690 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
1701 CONTINUE
IVTNUM = 170
C
C **** TEST 170 ****
C TEST 170 - NUMERIC FIELD DESCRIPTOR I6
C PRINT NEGATIVE INTEGER
C
IF (ICZERO) 31700, 1700, 31700
1700 CONTINUE
IVON01 = -15555
WRITE (I02,90002)
WRITE (I02,80001) IVTNUM
WRITE (I02,80471)
80471 FORMAT (11X,43HTHIS TEST PRINTS -15555 UNDER DESCRIPTOR I6)
WRITE (I02,80470) IVON01
80470 FORMAT (11X,I6)
GO TO 1711
31700 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
1711 CONTINUE
IVTNUM = 171
C
C **** TEST 171 ****
C TEST 171 - NUMERIC FIELD DESCRIPTORS, INTEGER CONVERSION
C PRINT NEGATIVE INTEGERS
C
IF (ICZERO) 31710, 1710, 31710
1710 CONTINUE
IVON01 = -9
IVON02 = -88
IVON03 = -777
IVON04 = -6666
IVON05 = -25555
WRITE (I02,90002)
WRITE (I02,80001) IVTNUM
WRITE (I02,80481)
80481 FORMAT (8X,49HTHIS TEST PRINTS -9, -88, -777, -6666, AND -25555)
WRITE (I02,80482)
80482 FORMAT (11X,43HUNDER FORMAT 10X,I2,3X,I3,3X,I4,3X,I5,3X,I6)
WRITE (I02,80480) IVON01,IVON02,IVON03,IVON04,IVON05
80480 FORMAT (10X,I2,3X,I3,3X,I4,3X,I5,3X,I6)
GO TO 1721
31710 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
1721 CONTINUE
IVTNUM = 172
C
C **** TEST 172 ****
C TEST 172 - NUMERIC FIELD DESCRIPTOR I5
C MIX POSITIVE AND NEGATIVE INTEGER OUTPUT IN ONE FORMAT
C STATEMENT ALL UNDER I5 DESCRIPTOR
C
IF (ICZERO) 31720, 1720, 31720
1720 CONTINUE
IVON01 =5
IVON02 = -54
IVON03 = 543
IVON04 = -5432
IVON05=32000
WRITE (I02,90002)
WRITE (I02,80001) IVTNUM
WRITE (I02,80491)
80491 FORMAT (18X,46HTHIS TEST PRINTS 5, -54, 543, -5432, AND 32000)
WRITE (I02,80492)
80492 FORMAT (11X,33HUNDER I5 NUMERIC FIELD DESCRIPTOR)
WRITE (I02,80490) IVON01,IVON02,IVON03,IVON04,IVON05
80490 FORMAT (11X,I5,3X,I5,3X,I5,3X,I5,3X,I5)
GO TO 1731
31720 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
1731 CONTINUE
IVTNUM = 173
C
C **** TEST 173 ****
C TEST 173 - VERTICAL SPACING TEST USING THE 1H0 AS A DOUBLE
C SPACE BEFORE PRINT ( ADVANCE TWO LINES BEFORE WRITING ). THE 0
C AS A CARRIAGE CONTROL CHARACTER IS USED WITH THE BLANK CHARACTER
C TO GET AN ODD NUMBER OF LINES TO ADVANCE BEFORE WRITING.
C
IF (ICZERO) 31730, 1730, 31730
1730 CONTINUE
WRITE (I02,90002)
WRITE (I02,80001) IVTNUM
WRITE (I02,81730)
81730 FORMAT (1H , 10X)
WRITE (I02,81731)
81731 FORMAT (41H THERE IS ONE BLANK LINE BEFORE THIS LINE)
WRITE ( I02, 81732 )
81732 FORMAT ( 1H0,10X)
WRITE ( I02, 81733 )
81733 FORMAT (43H THERE ARE TWO BLANK LINES BEFORE THIS LINE)
WRITE ( I02, 81730 )
WRITE ( I02, 81732 )
WRITE ( I02, 81735 )
81735 FORMAT (45H THERE ARE THREE BLANK LINES BEFORE THIS LINE)
WRITE ( I02, 81732 )
WRITE ( I02, 81732 )
WRITE ( I02, 81736 )
81736 FORMAT (45H THERE ARE FOUR BLANK LINES BEFORE THIS LINE)
GO TO 1741
31730 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
1741 CONTINUE
IVTNUM = 174
C
C **** TEST 174 ****
C TEST 174 - VERTICAL SPACING TEST USING THE + CHARACTER TO
C SUPPRESS ADVANCING BEFORE THE PRINT AND THIS SHOULD CAUSE TWO AND
C THEN THREE SUCCESSIVE LINES TO OVERPRINT
C
IF (ICZERO) 31740, 1740, 31740
1740 CONTINUE
WRITE ( I02, 90002 )
WRITE ( I02, 80001 ) IVTNUM
WRITE ( I02, 81740 )
81740 FORMAT ( 1H )
WRITE ( I02, 81741 )
81741 FORMAT ( 1H ,10X, 19H1ST LINE - AABBCCDD)
WRITE ( I02, 81742 )
81742 FORMAT ( 1H+, 25X, 30HWWXXYYZZ OVERPRINTS - 2ND LINE)
WRITE ( I02, 81743 )
81743 FORMAT ( /////1H )
C SKIP DOWN A FEW LINES TO GET SET - OK AWAY WE GO..
WRITE ( I02, 81740 )
WRITE ( I02, 81744 )
81744 FORMAT ( 1H , 10X, 29H11 44 1ST LINE)
WRITE ( I02, 81745 )
81745 FORMAT ( 1H+, 10X, 20H 22 55 2ND)
WRITE ( I02, 81746 )
81746 FORMAT ( 1H+, 10X, 24H 33 66 3RD)
GO TO 1751
31740 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
1751 CONTINUE
IVTNUM = 175
C
C **** TEST 175 ****
C TEST 175 - NUMERIC FIELD DESCRIPTOR F3.0
C
IF (ICZERO) 31750, 1750, 31750
1750 CONTINUE
WRITE ( I02, 90002 )
WRITE ( I02, 80001 ) IVTNUM
WRITE ( I02, 81751 )
81751 FORMAT (1H ,10X,42HTHIS TESTS PRINTS 3. UNDER F3.0 DESCRIPTOR)
RVON01 = 3.
WRITE ( I02, 81752 ) RVON01
81752 FORMAT ( 1H ,10X, F3.0 )
GO TO 1761
31750 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
1761 CONTINUE
IVTNUM = 176
C
C **** TEST 176 ****
C TEST 176 - SIGNED NUMERIC FIELD DESCRIPTOR F4.0
C
IF (ICZERO) 31760, 1760, 31760
1760 CONTINUE
WRITE ( I02, 90002 )
WRITE ( I02, 80001 ) IVTNUM
WRITE ( I02, 81761 )
81761 FORMAT ( 1H ,10X,43HTHIS TEST PRINTS -15. WITH F4.0 DESCRIPTOR)
RVON01 = -15.
WRITE ( I02, 81762 ) RVON01
81762 FORMAT ( 1H ,10X, F4.0)
GO TO 1771
31760 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
1771 CONTINUE
IVTNUM = 177
C
C **** TEST 177 ****
C TEST 177 - SIGNED NUMERIC FIELD DESCRIPTOR E12.5
C
IF (ICZERO) 31770, 1770, 31770
1770 CONTINUE
WRITE ( I02, 90002 )
WRITE ( I02, 80001 ) IVTNUM
WRITE ( I02, 81771 )
81771 FORMAT ( 1H , 10X,41HTHIS TEST PRINTS -0.12345E+03 USING E12.5)
RVON01 = -123.45
WRITE ( I02, 81772 ) RVON01
81772 FORMAT ( 1H , 10X, E12.5 )
GO TO 1781
31770 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
1781 CONTINUE
C
C WRITE PAGE FOOTINGS
99999 CONTINUE
WRITE (I02,90002)
WRITE (I02,90006)
WRITE (I02,90002)
WRITE (I02,90007)
C
C TERMINATE ROUTINE EXECUTION
STOP
C
C FORMAT STATEMENTS FOR PAGE HEADERS
90000 FORMAT (1H1)
90002 FORMAT (1H )
90001 FORMAT (1H ,10X,34HFORTRAN COMPILER VALIDATION SYSTEM)
90003 FORMAT (1H ,21X,11HVERSION 1.0)
90004 FORMAT (1H ,10X,38HFOR OFFICIAL USE ONLY - COPYRIGHT 1978)
90005 FORMAT (1H ,5X,4HTEST,5X,9HPASS/FAIL, 5X,8HCOMPUTED,8X,7HCORRECT)
90006 FORMAT (1H ,5X,46H----------------------------------------------)
90011 FORMAT (1H ,18X,17HSUBSET LEVEL TEST)
C FORMAT STATEMENTS FOR THIS ROUTINE
80001 FORMAT (10X,5HTEST ,I5)
80003 FORMAT ( 1H ,4X,I5,7X,7HDELETED)
90007 FORMAT (1H ,20X,20HEND OF PROGRAM FM109)
END
*END-OF,FM109
FM110.f 480976104 170 2 100666 26302 `
*HEADER,FORTR,FM110
*FILES1,FORTR,FM110,XX
C***********************************************************************
C***** FORTRAN 77
C***** FM110 IOFMT - (350)
C*****
C***********************************************************************
C***** GENERAL PURPOSE SUBSET REFS
C***** TO TEST ADDITIONAL FEATURES OF READ AND WRITE 12.8
C***** STATEMENTS, FORMATTED RECORDS AND FORMAT STATEMENTS 12.1.1
C***** FOR INTEGER AND REAL DATA TYPES
C***** RESTRICTIONS OBSERVED
C***** * ALL FORMAT STATEMENTS ARE LABELED 13.1.1
C***** * H AND X DESCRIPTORS ARE NEVER REPEATED 13.2.1
C***** * FOR W.D DESCRIPTORS, D IS ALWAYS SPECIFIED AND
C***** W IS EQUAL TO OR GREATER THAN D
C***** * FIELD WIDTH IS NEVER ZERO
C***** * IF AN I/O LIST SPECIFIES AT LEAST ONE ITEM 13.3
C***** AT LEAST ONE REPEATABLE EDIT DESCRIPTOR MUST EXIST
C***** IN THE FORMAT SPECIFICATION
C***** * ITEMS IN I/O LIST CORRESPOND TO EDIT DESCRIPTORS
C***** * NEGATIVE OUTPUT VALUES ARE SIGNED 13.5.9
C***** * AN H EDIT DESCRIPTOR IS NEVER USED ON INPUT 13.5.2
C***** * IN THE INPUT FIELD, FOR THE IW EDIT DESCRIPTOR 13.5.9.1
C***** THE CHARACTER STRING MUST BE AN OPTIONALLY SIGNED
C***** INTEGER CONSTANT
CBB** ********************** BBCCOMNT **********************************
C****
C**** 1978 FORTRAN COMPILER VALIDATION SYSTEM
C**** VERSION 2.0
C****
C****
C**** SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO
C**** GENERAL SERVICES ADMINISTRATION
C**** FEDERAL SOFTWARE TESTING CENTER
C**** 5203 LEESBURG PIKE, SUITE 1100
C**** FALLS CHURCH, VA. 22041
C****
C**** (703) 756-6153
C****
CBE** ********************** BBCCOMNT **********************************
C INPUT DATA TO THIS SEGMENT CONSISTS OF 40 CARD IMAGES IN COL. 1 - 80
C COLS. 22 25 31 34-35 40-43 55 67 69 74-76
CARD 1 . . . 0. E+00 + + . E00
C COLS. 16 31 33 42-45 50 59-60
CARD 2 + + . D+00 . D0
C COLS. 1-----------14 18-----26 28-------38
CARD 3 1.23456987654. +1.234E-0 -98.7654E+0
C COLS 1---5
CARDS 4,5,6,7,8 12345
C COLS. 1-3
CARDS 9,10,11,12 1.1
C COLS. 1------------------------------------------------------58
CARD 13 +0.339567E+02
CARD 14 + .339567+2
CARD 15 + 3.395670E1
CARD 16 0.96295134244D+04
CARD 17 .96295134244D04
CARD 18 0.96295134244+4
CARD 19 +.96295134244D4
CARD 20 31.23+0.14E+04+0.2D+02
CARD 21 31.23 .14D+4 +.2+2
CARD 22 -0.13579E+054444
CARD 23 4444
CARD 24 4444
CARD 25 4444
CARD 26 4444
CARD 27 -333 5.555+0.4545E-04
CARD 28 -6.666 .9989E+12
CARD 29 7.77-0.747E-02 +0.549E022
CARD 30 +0.662E-00 0.468-1011
CARD 31 0.59542D+04-44.6666-0.1234560000D-03
CARD 32 54.9327-0.1395624534D+00
CARD 33 65432.1
CARD 34 +0.848E+03 .848E3 + .1290D7+0.129D+07 0.412D21
CARD 35 22222222222222222222222222222222222222222222222222
CARD 36 -.987E0-0.987E+00 -.987D0
CARD 37 5 5
CARD 38 987654 8647.86 987.654
CARD 39 1.2345E0 1.2345 1234.5
CARD 40 12345.
CARD COLS. NOT MENTIONED ARE BLANK
C*****
C***** S P E C I F I C A T I O N S SEGMENT 350
C*****
REAL A1S(5),A2S(2,2),A3S(3,3,3),AC1S(25),AC2S(5,6)
DIMENSION IAC1I(5),IAC2I(2,7),EP1S(33)
INTEGER MCA3I(2,3,3)
REAL MVS
C CHARACTER*80 IDATA
C***** IDATA USED BY TEST 3 TO BYPASS CARDS 4-21 TO DELETE TEST
C*****
CBB** ********************** BBCINITA **********************************
C**** SPECIFICATION STATEMENTS
C****
CHARACTER ZVERS*13, ZVERSD*17, ZDATE*17, ZPROG*5, ZCOMPL*20,
1 ZNAME*20, ZTAPE*10, ZPROJ*13, REMRKS*31, ZTAPED*13
CBE** ********************** BBCINITA **********************************
CBB** ********************** BBCINITB **********************************
C**** INITIALIZE SECTION
DATA ZVERS, ZVERSD, ZDATE
1 /'VERSION 2.0 ', '82/08/02*18.33.46', '*NO DATE*TIME'/
DATA ZCOMPL, ZNAME, ZTAPE
1 /'*NONE SPECIFIED*', '*NO COMPANY NAME*', '*NO TAPE*'/
DATA ZPROJ, ZTAPED, ZPROG
1 /'*NO PROJECT*', '*NO TAPE DATE', 'XXXXX'/
DATA REMRKS /' '/
C**** THE FOLLOWING 9 COMMENT LINES (CZ01, CZ02, ...) CAN BE REPLACED
C**** FOR IDENTIFYING THE TEST ENVIRONMENT
C****
CZ01 ZVERS = 'VERSION OF THE COMPILER VALIDATION SYSTEM'
CZ02 ZVERSD = 'CREATION DATE/TIME OF THE COMPILER VALIDATION SYSTEM'
CZ03 ZPROG = 'PROGRAM NAME'
CZ04 ZDATE = 'DATE OF TEST'
CZ05 ZCOMPL = 'COMPILER IDENTIFICATION'
CZ06 ZPROJ = 'PROJECT NUMBER/IDENTIFICATION'
CZ07 ZNAME = 'NAME OF USER'
CZ08 ZTAPE = 'TAPE OWNER/ID'
CZ09 ZTAPED = 'DATE TAPE COPIED'
C
IVPASS = 0
IVFAIL = 0
IVDELE = 0
IVINSP = 0
IVTOTL = 0
IVTOTN = 0
ICZERO = 0
C
C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER.
I01 = 05
C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER.
I02 = 06
C
CX010 REPLACED BY FEXEC X-010 CONTROL CARD (CARD-READER UNIT NUMBER).
C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5
CX011 REPLACED BY FEXEC X-011 CONTROL CARD. CX011 IS FOR SYSTEMS
C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX010.
C
CX020 REPLACED BY FEXEC X-020 CONTROL CARD (PRINTER UNIT NUMBER).
C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02= 6
CX021 REPLACED BY FEXEC X-021 CONTROL CARD. CX021 IS FOR SYSTEMS
C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX020.
C
CBE** ********************** BBCINITB **********************************
IRVI = I01
NUVI = I02
IVTOTL = 11
ZPROG='FM110'
CBB** ********************** BBCHED0A **********************************
C****
C**** WRITE REPORT TITLE
C****
WRITE (I02, 90002)
WRITE (I02, 90006)
WRITE (I02, 90007)
WRITE (I02, 90008) ZVERS, ZVERSD
WRITE (I02, 90009) ZPROG, ZPROG
WRITE (I02, 90010) ZDATE, ZCOMPL
CBE** ********************** BBCHED0A **********************************
C***** ALL VARIABLES AND ARRAY ELEMENTS USED IN THIS SEGMENT
C***** ARE FIRST SET TO A NON-ZERO VALUE
C*****
C***** HEADER FOR SEGMENT 350 WRITTEN
35000 FORMAT (//2X,38HIOFMT - (350) ADDITIONAL FORMATTED I/O //16X,
1 14HDATA TRANSFERS,//2X, 24HSUBSET REFS - 12.8 13.)
WRITE (NUVI,35000)
C*****
CBB** ********************** BBCHED0B **********************************
C**** WRITE DETAIL REPORT HEADERS
C****
WRITE (I02,90004)
WRITE (I02,90004)
WRITE (I02,90013)
WRITE (I02,90014)
WRITE (I02,90015) IVTOTL
CBE** ********************** BBCHED0B **********************************
JACVI = 11111
IAC1I(1) = -2345
IAC2I(1,1) = 9999
MCA3I(1,1,1) = 2
ACVS = 1.2
BCVS = -.34E-3
A1S(1) = 34.56
A1S(2) = 456.789E+02
A2S(1,1) = -7899.3
A2S(2,1) = +9876.543E-01
A3S(1,1,1) = .543
A3S(2,1,1) = 4.33E+1
MVS = +2.22E+01
A1S(3) = -.33456E-01
A2S(1,2) = 9987.76E+2
A3S(3,1,1) = 44.E-2
C****
C
CT001* TEST 1
IVTNUM = 1
C******
C***** TEST THAT BLANK INPUT FIELDS ARE TREATED AS ZERO 13.5.9
C***** I, E, and F EDIT DESCRIPTORS ARE TESTED
C***** CARDS 1 AND 2
C*****
35001 FORMAT (4(I5), 4(F3.1), 4(F11.4)/ 4(E15.8))
READ (IRVI,35001) JACVI, IAC1I(1), IAC2I(1,1), MCA3I(1,1,1), ACVS,
1 A1S(1), A2S(1,1), A3S(1,1,1), BCVS, A1S(2), A2S(2,1),
2 A3S(2,1,1), MVS, A1S(3), A2S(1,2), A3S(3,1,1)
C**** TO DELETE TEST INSERT THE FOLLOWING CODE:
C**** IVDELE=IVDELE+1
C**** WRITE (NUVI,80000) IVTNUM
C**** COMMENT OUT FOLLOWING CODE UNTIL NEXT TEST
IVINSP=IVINSP+1
WRITE (NUVI,80004) IVTNUM
70010 FORMAT (/49X,27HTHIS TEST CONTAINS 4 GROUPS,
1 /49X,26HALL ANSWERS SHOULD BE ZERO)
C**************************
WRITE (NUVI,70010)
35002 FORMAT (1H ,16X,10HCOMPUTED: ,22X,
1 25H4 COMPUTED LINES EXPECTED,4(/23X,I6),
2 /17X,10HCOMPUTED: ,22X,25H4 COMPUTED LINES EXPECTED,
3 4(/23X,F8.1),/17X,10HCOMPUTED: ,22X,
4 25H4 COMPUTED LINES EXPECTED,4(/23X,F12.5),
5 /17X,10HCOMPUTED: ,22X,25H4 COMPUTED LINES EXPECTED,
6 4(/23X,E12.1))
WRITE (NUVI,35002) JACVI, IAC1I(1), IAC2I(1,1), MCA3I(1,1,1),ACVS,
1 A1S(1), A2S(1,1), A3S(1,1,1), BCVS, A1S(2), A2S(2,1),
2 A3S(2,1,1), MVS, A1S(3), A2S(1,2), A3S(3,1,1)
C*****
CT002* TEST 2
IVTNUM = 2
C***** TEST THAT DECIMAL POINTS APPEARING IN INPUT FIELDS 13.5.9.2.1
C***** OVERRIDE THE SPECIFICATIONS SUPPLIED BY E AND F
C***** EDIT DESCRIPTORS
70020 FORMAT (1H ,48X,27HTHIS TEST CONTAINS 4 GROUPS)
CMAVS = 1.23456
CMBVS = 987654.
CMEVS = 0.1234E+01
CMFVS = -0.987654E+02
C***** CARD 3
35004 FORMAT (2(F7.3), 2(E12.5))
READ (IRVI,35004) ACVS, BCVS, FFCVS, GGCVS
35005 FORMAT (1H ,16X,10HCOMPUTED: ,22X,25H2 COMPUTED LINES EXPECTED,
1 2(/23X,F12.5),/17X,10HCORRECT: ,8H 1.23456,
2 //17X,10HCOMPUTED: ,22X,25H2 COMPUTED LINES EXPECTED,
3 2(/23X,F13.1),/17X,10HCORRECT: ,9H 987654.0,
4 //17X,10HCOMPUTED: ,22X,25H2 COMPUTED LINES EXPECTED,
5 2(/23X,E15.4),/17X,10HCORRECT: ,11H 0.1234E+01,4H OR ,
6 10H .1234+001,//17X,10HCOMPUTED: ,22X,
7 25H2 COMPUTED LINES EXPECTED,2(/23X,E17.6),
8 /17X,10HCORRECT: ,13H-0.987654E+02,4H OR ,12H-.987654+002)
C**** SEE TEST 1 TO DELETE TEST (ENTER CODE HERE)
IVINSP=IVINSP+1
WRITE (NUVI,80004) IVTNUM
WRITE (NUVI,70020)
WRITE (NUVI,35005) CMAVS, ACVS, CMBVS, BCVS, CMEVS, FFCVS,
1 CMFVS, GGCVS
C*****
CT003* TEST 3
IVTNUM=3
C***** TEST COMPLETE FORMAT RESCAN 13.3
C***** WHEN ADDITIONAL ITEMS REMAIN IN AN I/O LIST
C***** AND THE LAST RIGHT PARENTHESIS HAS BEEN REACHED
C***** IN THE CORRESPONDING FORMAT STATEMENT
JACVI = +12345
KBCVI = 3
CMAVS = 1.1
CMBVS = 1.23
CMEVS = 33.9567
CMGVS = 1.4E+03
AVS = .962951E+4
BVS = 2.0E1
C***** CARDS 4, 5, 6, 7, 8
70030 FORMAT (/49X,27HTHIS TEST CONTAINS 5 GROUPS)
C***********************
C**** TO DELETE TEST 3 - CARDS 4 THRU 21 MUST BE BYPASS
C**** USE THE FOLLOWING CODE:
C**** IVDELE=IVDELE+1
C**** WRITE (NUVI,80000) IVTNUM
C**** DO 0031 IPASS=1,18
C0032 FORMAT (A80)
C**** READ (IRVI,0032) IDATA
C0031 CONTINUE
C**** COMMENT OUT REMAINING CODE UNTIL NEXT TEST
C*************************
IVINSP=IVINSP+1
WRITE (NUVI,80004) IVTNUM
WRITE (NUVI,70030)
35007 FORMAT (I5)
READ (IRVI,35007) IAC1I
3509 FORMAT (1H ,16X,10HCOMPUTED: ,22X,25H6 COMPUTED LINES EXPECTED)
WRITE (NUVI,3509)
35009 FORMAT(23X,I10)
WRITE(NUVI,35009)JACVI,IAC1I
35008 FORMAT (1H ,16X,10HC0RRECT: ,6H 12345)
WRITE(NUVI,35008)
C***** CARDS 9, 10, 11, 12
35010 FORMAT(F3.1)
READ (IRVI,35010) A2S
3501 FORMAT (/17X,10HCOMPUTED: ,22X,25H5 COMPUTED LINES EXPECTED)
WRITE (NUVI,3501)
35012 FORMAT(23X,F8.1)
WRITE(NUVI,35012)CMAVS,A2S
35011 FORMAT (1H ,16X,10HC0RRECT: ,4H 1.1)
WRITE (NUVI,35011)
C***** CARDS 13, 14, 15
35013 FORMAT (E13.6)
READ (IRVI,35013) A1S(1), HHCVS, A1S(2)
3504 FORMAT (/17X,10HCOMPUTED: ,22X,25H4 COMPUTED LINES EXPECTED)
WRITE (NUVI,3504)
35015 FORMAT(23X,E17.6)
WRITE(NUVI,35015) CMEVS, A1S(1), HHCVS, A1S(2)
35014 FORMAT (1H ,16X,10HC0RRECT: ,13H 0.339567E+02,4H OR ,
1 12H .339567+002)
WRITE (NUVI,35014)
C***** CARDS 16, 17, 18, 19 WITH D EXPONENTS
35016 FORMAT (F18.11/E18.11)
READ (IRVI,35016) A2S
3507 FORMAT (/17X,10HCOMPUTED: ,22X,25H5 COMPUTED LINES EXPECTED)
WRITE (NUVI,3507)
35018 FORMAT (23X,E17.6)
WRITE (NUVI,35018) AVS, A2S
35017 FORMAT (1H ,16X,10HCORRECT: ,13H 0.962951E+04,
1 4H OR ,12H .962951+004)
WRITE (NUVI,35017)
C***** CARDS 20, 21
35019 FORMAT (I1,F4.2,E9.2,F8.1)
READ (IRVI,35019) LCCVI, DCVS, AC2S(5,6), A3S(1,2,2), MDCVI,
1 FFCVS, GGCVS, AAVS
70033 FORMAT (/17X,10HCOMPUTED: ,22X,25H3 COMPUTED LINES EXPECTED)
WRITE (NUVI,70033)
35021 FORMAT (23X,I6, F6.2, E10.2, E9.1)
WRITE (NUVI,35021) KBCVI, CMBVS, CMGVS, BVS, LCCVI, DCVS,
1 AC2S(5,6), A3S(1,2,2), MDCVI, FFCVS, GGCVS, AAVS
35020 FORMAT (1H ,16X,10HCORRECT: ,22X,
1 26H2 CORRECT ANSWERS POSSIBLE,
2 /28X,26H3 1.23 0.14E+04 0.2E+02,
3 /28X,26H3 1.23 0.14+004 0.2+002)
WRITE (NUVI,35020)
C**********************************
CT004* TEST 4
IVTNUM=4
C*****
C************************************
C***** TEST THAT FORMAT CONTROL PASSES TO THE GROUP
C***** ENCLOSED BY THE LAST PRECEDING RIGHT PARENTHESIS
C***** WHEN THE I/O LIST CONTAINS MORE ELEMENTS THAN
C***** THE NUMBER OF DESCRIPTORS IN THE FORMAT STATEMENT
C***************************************
JACVI = +4444
KBCVI = -333
LCCVI = 22
MDCVI = 11
ACVS = 5.555
BCVS = -6.666
CCVS = +7.77
DCVS = 65432.1
CMAVS = -0.13579E+5
CMBVS = 0.4545E-04
CMCVS = 0.9989E12
CMDVS = -0.747E-2
CMEVS = +0.549E+00
CMFVS = 0.662E-0
CMGVS = 0.468E-10
RAVS = +59.542E02
RBVS = -0.01234560E-2
RCVS = -1395624534.E-10
RDVS = +129.E4
REVS = 4.12E+20
FFCVS = -44.6666
GGCVS = +.549327E+2
HHCVS = 848.
MVS = -.987
C***** CARDS 22, 23, 24, 25, 26
35022 FORMAT ( E12.5, (I4))
C***** SEE NOTES TEST1 & TEST 3 TO BYPASS TEST
C***** CARDS 22 THRU 26 MUST BE BYPASSED
IVINSP=IVINSP+1
WRITE (NUVI,80004) IVTNUM
WRITE (NUVI,70040)
READ (IRVI,35022) A1S(2), IAC1I
70040 FORMAT (1H ,48X,27HTHIS TEST CONTAINS 2 GROUPS)
35023 FORMAT (1H ,16X,10HCOMPUTED: ,22X,25H2 COMPUTED LINES EXPECTED,
1 2(/23X,E16.5),
2 /17X,10HCORRECT: ,12H-0.13579E+05,4H OR ,12H -.13579+005,
3 //17X,10HCOMPUTED: ,22X,25H6 COMPUTED LINES EXPECTED,
4 /(23X,I9))
70041 FORMAT (1H ,16X,10HCORRECT: ,5H 4444)
WRITE (NUVI,35023) CMAVS, A1S(2), JACVI, IAC1I
WRITE (NUVI,70041)
CT005* TEST 5
C*****
IVTNUM = 5
C***** CARDS 27, 28
C***** SEE NOTES TEST 1 & TEST 3 TO DELETE TEST
C***** CARDS 27,28 SHOULD BE BYPASSED
IVINSP=IVINSP+1
WRITE (NUVI,80004) IVTNUM
WRITE (NUVI,70050)
70050 FORMAT (1H ,48X,27HTHIS TEST CONTAINS 5 GROUPS)
35025 FORMAT (I4, (F6.3), E11.4)
READ (IRVI,35025) MRRVI, AC1S(1), EP1S(1), A3S(1,1,1), AC2S(2,2)
35026 FORMAT (1H ,16X,10HCOMPUTED: ,22X,25H2 COMPUTED LINES EXPECTED,
1 2(/23X,I8),/17X,10HCORRECT: ,4H-333,//17X,10HCOMPUTED: ,
2 22X,25H2 COMPUTED LINES EXPECTED,2(/23X,F10.3),
3 /17X,10HCORRECT: ,6H 5.555,//17X,10HCOMPUTED: ,
4 22X,25H2 COMPUTED LINES EXPECTED,2(/23X,E15.4),
5 /17X,10HCORRECT: ,11H 0.4545E-04,4H OR ,9H.4545-004,//17X,
6 10HCOMPUTED: ,22X,25H2 COMPUTED LINES EXPECTED,2(/23X,F10.3),
7 /17X,10HCORRECT: ,6H-6.666,//17X,
8 10HCOMPUTED: ,22X,25H2 COMPUTED LINES EXPECTED,2(/23X,E15.4),
9 /17X,10HCORRECT: ,11H 0.9989E+12,4H OR ,9H.9989+012)
WRITE (NUVI,35026) KBCVI, MRRVI, ACVS, AC1S(1), CMBVS, EP1S(1),
1 BCVS, A3S(1,1,1),CMCVS,AC2S(2,2)
CT006* TEST 6
C***** CARDS 29, 30
IVTNUM = 6
C***** SEE NOTES TEST 1 & 3 TO DELETE TEST
C***** CARDS 29 & 30 MUST BE BYPASSED
IVINSP=IVINSP+1
WRITE (NUVI,80004) IVTNUM
70060 FORMAT (1H ,48X,27HTHIS TEST CONTAINS 7 GROUPS)
WRITE (NUVI,70060)
35027 FORMAT (F4.2, (2(E10.3)), I2)
READ (IRVI,35027) A2S(2,2), A3S(2,1,1), EP1S(2), MCA3I(1,1,1),
1 BVS, AC2S(2,1), NECVI
35028 FORMAT (1H ,16X,10HCOMPUTED: ,22X,25H2 COMPUTED LINES EXPECTED,
1 2(/23X,F9.2),/17X,10HCORRECT: ,5H 7.77,//17X,10HCOMPUTED: ,
222X,25H2 COMPUTED LINES EXPECTED,2(/23X,E14.3),/17X,10HCORRECT: ,
310H-0.747E-02,4H OR ,9H-.747-002,//17X,10HCOMPUTED: ,22X,
425H2 COMPUTED LINES EXPECTED,2(/23X,E14.3),/17X,10HCORRECT: ,
510H 0.549E+00,4H OR ,8H.549+000,//17X,10HCOMPUTED: ,22X,
625H2 COMPUTED LINES EXPECTED,2(/23X,I7),/17X,10HCORRECT: ,3H 22,
7//17X,10HCOMPUTED: ,22X,25H2 COMPUTED LINES EXPECTED,
82(/23X,E14.3), /17X,10HCORRECT: ,10H 0.662E+00,4H OR ,8H.662+000)
75028 FORMAT (//17X,10HCOMPUTED: ,22X,
1 25H2 COMPUTED LINES EXPECTED,2(/23X,E14.3),
2 /17X,10HCORRECT: ,10H 0.468E-10,4H OR ,8H.468-010,
3 //17X,10HCOMPUTED: ,22X,25H2 COMPUTED LINES EXPECTED,2(/23X,I7),
4 /17X,10HCORRECT: ,3H 11)
WRITE (NUVI,35028) CCVS, A2S(2,2), CMDVS, A3S(2,1,1), CMEVS,
1 EP1S(2), LCCVI, MCA3I(1,1,1), CMFVS, BVS
C
WRITE (NUVI,75028) CMGVS,AC2S(2,1),MDCVI,NECVI
C
CT007* TEST 7
IVTNUM = 7
C***** CARDS 31, 32
C***** SEE NOTES TEST 1 & TEST 3 TO DELETE TEST
C***** CARDS 31,& 32 SHOULD BE BYPASSED
IVINSP=IVINSP+1
WRITE (NUVI,80004) IVTNUM
WRITE (NUVI,70070)
70070 FORMAT (1H ,48X,27HTHIS TEST CONTAINS 5 GROUPS)
35029 FORMAT (E12.5, (F8.4, E17.10))
READ (IRVI,35029) CAVS, EP1S(3), A1S(1), A2S(1,2), A2S(2,1)
35030 FORMAT (1H ,16X,10HCOMPUTED: ,22X,25H2 COMPUTED LINES EXPECTED,
1 /(23X, E16.5))
70071 FORMAT (/17X,10HCORRECT: ,12H 0.59542E+04,4H OR ,
1 10H.59542+004)
WRITE (NUVI,35030) RAVS, CAVS
WRITE (NUVI,70071)
35031 FORMAT (1H ,16X,10HCOMPUTED: ,22X,25H2 COMPUTED LINES EXPECTED,
1 2(/23X,F12.4),/17X,10HCORRECT: ,8H-44.6666,
2 //17X,10HCOMPUTED: ,22X,25H2 COMPUTED LINES EXPECTED,
3 2(/23X,E17.6),
4 /17X,10HCORRECT: ,13H-0.123456E-03,4H OR ,12H-.123456-003,
5 //17X,10HCOMPUTED: ,22X,25H2 COMPUTED LINES EXPECTED,
6 2(/23X,F12.4),/17X,10HCORRECT: ,8H 54.9327,//17X,
7 10HCOMPUTED: ,22X,25H2 COMPUTED LINES EXPECTED,/(23X,E17.6))
C
70072 FORMAT (/17X,10HCORRECT: ,13H-0.139562E+00,4H OR ,
1 12H-.139562+000)
WRITE (NUVI,35031) FFCVS, EP1S(3), RBVS, A1S(1), GGCVS, A2S(1,2),
1 RCVS, A2S(2,1)
WRITE (NUVI,70072)
C****
CT008* TEST 8
IVTNUM = 8
C***** CARDS 33, 34, 35, 36
C***** SEE NOTES TEST 1 & TEST 3 TO DELETE TEST
C***** CARDS 33 THRU 36 SHOULD BE BYPASSED
IVINSP=IVINSP+1
WRITE (NUVI,80004) IVTNUM
WRITE (NUVI,70080)
70080 FORMAT (1H ,48X,27HTHIS TEST CONTAINS 5 GROUPS)
C***** THIS READ CAUSES AN INPUT DATA CARD TO BE SKIPPED
35032 FORMAT( F7.1, (/2(E10.3), 2(E10.3)), E10.3)
READ (IRVI,35032) CVS, A2S(2,1), A3S(1,2,2), A3S(1,1,1),
1 A3S(2,2,1), A2S(1,1), A3S(1,2,1), EP1S(4),A1S(2)
35033 FORMAT (1H ,16X,10HCOMPUTED: ,22X,25H2 COMPUTED LINES EXPECTED,
1 2(/23X,F12.1),/17X,10HCORRECT: ,8H 65432.1,//17X,
2 10HCOMPUTED: ,22X,25H3 COMPUTED LINES EXPECTED,3(/23X,E14.3),
3 /17X,10HCORRECT: ,10H 0.848E+03,4H OR ,8H.848+003,//17X,
4 10HCOMPUTED: ,22X,25H3 COMPUTED LINES EXPECTED,3(/23X,E14.3),
5 /17X,10HCORRECT: ,10H 0.129E+07,4H OR ,8H.129+007,//17X,
6 10HCOMPUTED: ,22X,25H2 COMPUTED LINES EXPECTED,2(/23X,E14.3),
7 /17X,10HCORRECT: ,10H 0.412E+21,4H OR ,8H.412+021,//17X,
8 10HCOMPUTED: ,22X,25H4 COMPUTED LINES EXPECTED,4(/23X,E14.3),
9 /17X,10HCORRECT: ,10H-0.987E+00,4H OR ,9H-.987+000)
WRITE (NUVI,35033) DCVS, CVS, HHCVS, A2S(2,1), A3S(1,2,2),RDVS,
1 A3S(1,1,1), A3S(2,2,1), REVS, A2S(1,1),
2 MVS, A3S(1,2,1), EP1S(4),A1S(2)
CT009* TEST 9
IVTNUM = 9
C***** TEST FOR EMPTY FORMAT STATEMENT
C***** SEE NOTES TEST 1 TO DELETE TEST
IVINSP=IVINSP+1
WRITE (NUVI,80004) IVTNUM
35034 FORMAT (1H ,48X,22HEMPTY FORMAT ( ) WRITE,
1 //2X,34HTHE FOLLOWING LINE SHOULD BE BLANK)
WRITE (NUVI,35034)
35035 FORMAT ( )
WRITE (NUVI,35035)
35036 FORMAT (2X,23H END EMPTY FORMAT TEST)
WRITE (NUVI,35036)
C***** POSITION INPUT TO INSURE CORRECT RECORD FOR NEXT TESTS
35037 IF (MRRVI - 5) 35038, 35039, 35038
C***** CARD 37
35038 READ (IRVI, 35025) MRRVI
GO TO 35037
35039 CONTINUE
CT010* TEST 10
IVTNUM = 10
C*****
C***** ADDITIONAL SCALE FACTOR ON INPUT-OUTPUT 13.5.7
C***** CARD 38
IVINSP=IVINSP+1
WRITE (NUVI,80004) IVTNUM
35040 FORMAT (1PE10.3, -1PE10.2, E10.3)
READ (IRVI,35040) A1S(3), A1S(4), A1S(5)
C**** SEE NOTES TEST 1 TO DELETE TEST (INSERT CODE HERE)
35041 FORMAT (1H ,16X,10HCOMPUTED: ,
1 E12.3, E12.4, E12.4,
2 /17X,10HCORRECT: ,22X,26H2 CORRECT ANSWERS POSSIBLE,
3 /30X,33H0.988E+02 0.8648E+05 0.9877E+04,
4 /30X,33H .988+002 .8648+005 .9877+004)
WRITE(NUVI, 35041) A1S(3), A1S(4), A1S(5)
CT011* TEST 11
IVTNUM = 11
C***** CARDS 39 & 40
C***** SCALE FACTOR HAS NO EFFECT ON FORMAT RESCAN OR F EDIT
C***** DESCRIPTOR WITH INPUT DATA CONTAINING AN EXPONENT
AAVS = .087654
BAVS = .87654
35042 FORMAT (-1P2F8.1, +1P, 2X,(F8.1))
READ (IRVI, 35042) AVS, BVS, CVS, DVS
C**** SEE NOTES TEST 1 TO DELETE TEST
IVINSP=IVINSP+1
WRITE (NUVI,80004) IVTNUM
35043 FORMAT (1H ,16X,10HCOMPUTED: ,22X,
1 25H3 COMPUTED LINES EXPECTED,/25X,F8.4, F8.3, F8.2, F8.1, 1P,
2 /26X, F5.4, 3X, 2P, F5.3, +3P, 1H , (23X,F6.2),3X)
5043 FORMAT (17X,10HCORRECT: ,22X,26H ,
1 /25X,32H 1.2345 12.345 123.45 1234.5,/24X,
2 45H .8765 8.765 87.65/21X,
3 8H 876.54)
WRITE (NUVI,35043) AVS,BVS,CVS,DVS,AAVS,AAVS,AAVS,BAVS
WRITE (NUVI,5043)
CBB** ********************** BBCSUM0 **********************************
C**** WRITE OUT TEST SUMMARY
C****
IVTOTN = IVPASS + IVFAIL + IVDELE + IVINSP
WRITE (I02, 90004)
WRITE (I02, 90014)
WRITE (I02, 90004)
WRITE (I02, 90020) IVPASS
WRITE (I02, 90022) IVFAIL
WRITE (I02, 90024) IVDELE
WRITE (I02, 90026) IVINSP
WRITE (I02, 90028) IVTOTN, IVTOTL
CBE** ********************** BBCSUM0 **********************************
CBB** ********************** BBCFOOT0 **********************************
C**** WRITE OUT REPORT FOOTINGS
C****
WRITE (I02,90016) ZPROG, ZPROG
WRITE (I02,90018) ZPROJ, ZNAME, ZTAPE, ZTAPED
WRITE (I02,90019)
CBE** ********************** BBCFOOT0 **********************************
CBB** ********************** BBCFMT0A **********************************
C**** FORMATS FOR TEST DETAIL LINES
C****
80000 FORMAT (1H ,2X,I3,4X,7HDELETED,32X,A31)
80002 FORMAT (1H ,2X,I3,4X,7H PASS ,32X,A31)
80004 FORMAT (1H ,2X,I3,4X,7HINSPECT,32X,A31)
80008 FORMAT (1H ,2X,I3,4X,7H FAIL ,32X,A31)
80010 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,15X,10HCOMPUTED= ,
1I6,/,1H ,15X,10HCORRECT= ,I6)
80012 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
1E12.5,/,1H ,16X,10HCORRECT= ,E12.5)
80018 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
1A21,/,1H ,16X,10HCORRECT= ,A21)
80020 FORMAT (1H ,16X,10HCOMPUTED= ,A21,1X,A31)
80022 FORMAT (1H ,16X,10HCORRECT= ,A21,1X,A31)
80024 FORMAT (1H ,16X,10HCOMPUTED= ,I6,16X,A31)
80026 FORMAT (1H ,16X,10HCORRECT= ,I6,16X,A31)
80028 FORMAT (1H ,16X,10HCOMPUTED= ,E12.5,10X,A31)
80030 FORMAT (1H ,16X,10HCORRECT= ,E12.5,10X,A31)
80050 FORMAT (1H ,48X,A31)
CBE** ********************** BBCFMT0A **********************************
CBB** ********************** BBCFMAT1 **********************************
C**** FORMATS FOR TEST DETAIL LINES - FULL LANGUAGE
C****
80031 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
1D17.10,/,1H ,16X,10HCORRECT= ,D17.10)
80033 FORMAT (1H ,16X,10HCOMPUTED= ,D17.10,10X,A31)
80035 FORMAT (1H ,16X,10HCORRECT= ,D17.10,10X,A31)
80037 FORMAT (1H ,16X,10HCOMPUTED= ,1H(,E12.5,2H, ,E12.5,1H),6X,A31)
80039 FORMAT (1H ,16X,10HCORRECT= ,1H(,E12.5,2H, ,E12.5,1H),6X,A31)
80041 FORMAT (1H ,16X,10HCOMPUTED= ,1H(,F12.5,2H, ,F12.5,1H),6X,A31)
80043 FORMAT (1H ,16X,10HCORRECT= ,1H(,F12.5,2H, ,F12.5,1H),6X,A31)
80045 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
11H(,F12.5,2H, ,F12.5,1H)/,1H ,16X,10HCORRECT= ,
21H(,F12.5,2H, ,F12.5,1H))
CBE** ********************** BBCFMAT1 **********************************
CBB** ********************** BBCFMT0B **********************************
C**** FORMAT STATEMENTS FOR PAGE HEADERS
C****
90002 FORMAT (1H1)
90004 FORMAT (1H )
90006 FORMAT (1H ,20X,31HFEDERAL SOFTWARE TESTING CENTER)
90007 FORMAT (1H ,19X,34HFORTRAN COMPILER VALIDATION SYSTEM)
90008 FORMAT (1H ,21X,A13,A17)
90009 FORMAT (1H ,/,2H *,A5,6HBEGIN*,12X,15HTEST RESULTS - ,A5,/)
90010 FORMAT (1H ,8X,16HTEST DATE*TIME= ,A17,15H - COMPILER= ,A20)
90013 FORMAT (1H ,8H TEST ,10HPASS/FAIL ,6X,17HDISPLAYED RESULTS,
1 7X,7HREMARKS,24X)
90014 FORMAT (1H ,46H----------------------------------------------,
1 33H---------------------------------)
90015 FORMAT (1H ,48X,17HTHIS PROGRAM HAS ,I3,6H TESTS,/)
C****
C**** FORMAT STATEMENTS FOR REPORT FOOTINGS
C****
90016 FORMAT (1H ,/,2H *,A5,4HEND*,14X,14HEND OF TEST - ,A5,/)
90018 FORMAT (1H ,A13,13X,A20,7H * ,A10,1H/,
1 A13)
90019 FORMAT (1H ,26HFOR OFFICIAL USE ONLY ,35X,15HCOPYRIGHT 1982)
C****
C**** FORMAT STATEMENTS FOR RUN SUMMARY
C****
90020 FORMAT (1H ,21X,I5,13H TESTS PASSED)
90022 FORMAT (1H ,21X,I5,13H TESTS FAILED)
90024 FORMAT (1H ,21X,I5,14H TESTS DELETED)
90026 FORMAT (1H ,21X,I5,25H TESTS REQUIRE INSPECTION)
90028 FORMAT (1H ,21X,I5,4H OF ,I3,15H TESTS EXECUTED)
CBE** ********************** BBCFMT0B **********************************
C***** END OF TEST SEGMENT 350
STOP
END
*END-OF,FM110
FM111.f 480976106 170 2 100666 14987 `
*HEADER,FORTR,FM111
*FILES1,FORTR,FM111,XX
C***********************************************************************
C***** FORTRAN 77
C***** FM111 IOFMTS - (353)
C*****
C***********************************************************************
C***** GENERAL PURPOSE SUBSET REFS
C***** TO TEST ADDITIONAL FEATURES OF READ AND WRITE 12.8
C***** STATEMENTS, FORMATTED RECORDS AND FORMAT STATEMENTS 12.1.1
C***** FOR INTEGER AND REAL DATA TYPES
C***** TO TEST CHARACTER CONSTANTS AS FORMAT SPECIFIERS. 13.1.2
C***** RESTRICTIONS OBSERVED
C***** * H AND X DESCRIPTORS ARE NEVER REPEATED 13.2.1
C***** * FOR W.D DESCRIPTORS, D IS ALWAYS SPECIFIED AND
C***** W IS EQUAL TO OR GREATER THAN D
C***** * FIELD WIDTH IS NEVER ZERO
C***** * IF AN I/O LIST SPECIFIES AT LEAST ONE ITEM 13.3
C***** AT LEAST ONE REPEATABLE EDIT DESCRIPTOR MUST EXIST
C***** IN THE FORMAT SPECIFICATION
C***** * ITEMS IN I/O LIST CORRESPOND TO EDIT DESCRIPTORS
C***** * NEGATIVE OUTPUT VALUES ARE SIGNED 13.5.9
C***** * AN H EDIT DESCRIPTOR IS NEVER USED ON INPUT 13.5.2
C***** * IN THE INPUT FIELD, FOR THE IW EDIT DESCRIPTOR 13.5.9.1
C***** THE CHARACTER STRING MUST BE AN OPTIONALLY SIGNED
C***** INTEGER CONSTANT
C***** GENERAL COMMENTS
C***** PLUS SIGNS FOR INPUT FIELDS ARE USUALLY OMITTED 13.5.9
C INPUT DATA TO THIS SEGMENT CONSISTS OF 8 CARD IMAGES IN COL. 1 - 39
COL. 1-------------------------------------------46
CARD 1 111 2 2 3 3. 3E-1 44 5 5 6 . 67 . 78 8. 8E-1
CARD 2 9 9
CARD 3 2345 1 34512 45123 51234
CARD 4 2345 1 34512 45123 51234
CARD 5
CARD 6 246801357912345678901234
CARD 7 .10203040506070809010E+0233.33
CARD 8 1 2 3 4 5 6
C*****
C***** S P E C I F I C A T I O N S SEGMENT 353
C*****
INTEGER I2I(2,2), I3I(2,2,2), J3I(1,2,3)
REAL A1S(5)
CHARACTER*80 IDATA
C*****
C***** I N P U T - O U T P U T TAPE ASSIGNMENT STATEMENTS
CBB** ********************** BBCCOMNT **********************************
C****
C**** 1978 FORTRAN COMPILER VALIDATION SYSTEM
C**** VERSION 2.0
C****
C****
C**** SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO
C**** GENERAL SERVICES ADMINISTRATION
C**** FEDERAL SOFTWARE TESTING CENTER
C**** 5203 LEESBURG PIKE, SUITE 1100
C**** FALLS CHURCH, VA. 22041
C****
C**** (703) 756-6153
C****
CBE** ********************** BBCCOMNT **********************************
CBB** ********************** BBCINITA **********************************
C**** SPECIFICATION STATEMENTS
C****
CHARACTER ZVERS*13, ZVERSD*17, ZDATE*17, ZPROG*5, ZCOMPL*20,
1 ZNAME*20, ZTAPE*10, ZPROJ*13, REMRKS*31, ZTAPED*13
CBE** ********************** BBCINITA **********************************
CBB** ********************** BBCINITB **********************************
C**** INITIALIZE SECTION
DATA ZVERS, ZVERSD, ZDATE
1 /'VERSION 2.0 ', '82/08/02*18.33.46', '*NO DATE*TIME'/
DATA ZCOMPL, ZNAME, ZTAPE
1 /'*NONE SPECIFIED*', '*NO COMPANY NAME*', '*NO TAPE*'/
DATA ZPROJ, ZTAPED, ZPROG
1 /'*NO PROJECT*', '*NO TAPE DATE', 'XXXXX'/
DATA REMRKS /' '/
C**** THE FOLLOWING 9 COMMENT LINES (CZ01, CZ02, ...) CAN BE REPLACED
C**** FOR IDENTIFYING THE TEST ENVIRONMENT
C****
CZ01 ZVERS = 'VERSION OF THE COMPILER VALIDATION SYSTEM'
CZ02 ZVERSD = 'CREATION DATE/TIME OF THE COMPILER VALIDATION SYSTEM'
CZ03 ZPROG = 'PROGRAM NAME'
CZ04 ZDATE = 'DATE OF TEST'
CZ05 ZCOMPL = 'COMPILER IDENTIFICATION'
CZ06 ZPROJ = 'PROJECT NUMBER/IDENTIFICATION'
CZ07 ZNAME = 'NAME OF USER'
CZ08 ZTAPE = 'TAPE OWNER/ID'
CZ09 ZTAPED = 'DATE TAPE COPIED'
C
IVPASS = 0
IVFAIL = 0
IVDELE = 0
IVINSP = 0
IVTOTL = 0
IVTOTN = 0
ICZERO = 0
C
C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER.
I01 = 05
C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER.
I02 = 06
C
CX010 REPLACED BY FEXEC X-010 CONTROL CARD (CARD-READER UNIT NUMBER).
C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5
CX011 REPLACED BY FEXEC X-011 CONTROL CARD. CX011 IS FOR SYSTEMS
C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX010.
C
CX020 REPLACED BY FEXEC X-020 CONTROL CARD (PRINTER UNIT NUMBER).
C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02= 6
CX021 REPLACED BY FEXEC X-021 CONTROL CARD. CX021 IS FOR SYSTEMS
C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX020.
C
CBE** ********************** BBCINITB **********************************
IRVI = I01
NUVI = I02
C***** TOTAL NUMBER OF EXPECTED TEST
IVTOTL =4
ZPROG='FM111'
CBB** ********************** BBCHED0A **********************************
C****
C**** WRITE REPORT TITLE
C****
WRITE (I02, 90002)
WRITE (I02, 90006)
WRITE (I02, 90007)
WRITE (I02, 90008) ZVERS, ZVERSD
WRITE (I02, 90009) ZPROG, ZPROG
WRITE (I02, 90010) ZDATE, ZCOMPL
CBE** ********************** BBCHED0A **********************************
C***** HEADER FORMAT STATEMENT
WRITE(NUVI, 35300)
35300 FORMAT(/1X, 35HIOFMTS - (353) ADDITIONAL FORMATTED/16X,
1 14HDATA TRANSFERS,//2X,
2 32HSUBSET REFS 12.9.5.2 13.1 13.5)
CBB** ********************** BBCHED0B **********************************
C**** WRITE DETAIL REPORT HEADERS
C****
WRITE (I02,90004)
WRITE (I02,90004)
WRITE (I02,90013)
WRITE (I02,90014)
WRITE (I02,90015) IVTOTL
CBE** ********************** BBCHED0B **********************************
C*****
C*******************************************************
C**** TO DELETE A TEST USED CODE SHOWN IN TEST 1 *
C**** REPLACE THE DELETE COMMENT WITH DELETE CODE *
C*******************************************************
CT001* TEST 1
C***** TEST VARIOUS COMBINATION OF BZ AND BN EDIT 13.5.8
C***** DESCRIPTORS, INCLUDING USING EACH AS A LEADING 13.5.9(1)
C***** DESCRIPTOR, AND PRECEDING IW, EW.D, AND FW.D DESCRIPTORS.
C***** BN AND BZ HAVE NO EFFECT ON OUTPUT. 13.5.8
C***** CARDS 1-2
C*****
IVTNUM = 1
C**** TO DELETE TEST 1 - CARDS 1 THRU 5 MUST BE BYPASS
C**** USE THE FOLLOWING CODE:
C**** IVDELE=IVDELE+1
C**** WRITE (NUVI,80000) IVTNUM
C**** DO 0031 IPASS=1,5
C0011 FORMAT (A80)
C**** READ (IRVI,0011) IDATA
C0031 CONTINUE
C**** COMMENT OUT OUT FOLLOWING LINES UNTIL NEXT TEST
C*************************
IVINSP=IVINSP+1
WRITE (NUVI,80004) IVTNUM
READ(IRVI, 35301)I2I(1,2), IVI, A1S(3), JVI, KVI, A1S(2), AVS,
1 A1S(1), I2I(1,1)
35301 FORMAT(BZ,(2I4, E10.1, BN, 2I4, F5.2, BZ, F5.2, BN, E10.1))
WRITE(NUVI, 35302)I2I(1,2), IVI, A1S(3), JVI, KVI, A1S(2), AVS,
1 A1S(1), I2I(1,1)
C****************************TEST 1 ********************
35302 FORMAT (1H ,10X,11HCOMPUTED: , 2I5, 1X, E10.5, BN, 2I5, F6.1,
1 BZ, F6.2, BN, 1X, E8.3, I5)
70010 FORMAT (1H ,10X,10HCORRECT: ,
1 44H 1110 2020 .30303E-07 44 55 6.6 70.07,
2 14H .888E+01 99)
WRITE (NUVI,70010)
C***** CARDS 3-4
READ(IRVI, 35303) I3I(1,2,1), A1S(3), AVS, IVI, I2I(1,1),
1 JVI, BVS, A1S(2), (I3I(KVI,1,1), KVI=1,2)
35303 FORMAT(BZ, (I5, F5.0, BN, F5.2, 2I5))
C*****************************************************************
WRITE(NUVI, 35304) I3I(1,2,1), A1S(3), AVS, IVI, I2I(1,1),
1 JVI, BVS, A1S(2), I3I(1,1,1), I3I(2,1,1)
35304 FORMAT ( /BN, 11X,11HCOMPUTED: , I5, F7.0, BZ, 1X, F5.2,
1 2(1X,I4),I5, F7.0, BZ, 1X, F5.2, 2(1X, I4))
70011 FORMAT (1H ,10X,10HCORRECT: ,
1 29H 23450 10345. 12.45 1235 1234,
2 28H 2345 1345. 12.45 1235 1234)
WRITE (NUVI,70011)
C**** CARD 5
CVS = -0.0044
READ(IRVI, 35305) IVI, AVS, A1S(2), JVI, BVS
35305 FORMAT(BZ, I5, F5.1, BN, F5.1, I5, BZ, F5.1, I5)
C**************************************************************
WRITE(NUVI, 35306) IVI, AVS, A1S(2), JVI, BVS, CVS, CVS
35306 FORMAT (/11X,11HCOMPUTED: ,
1 I5, 2(3X, F2.1), I5, 3X, E5.1E1, 3X, F2.1, 3X, E6.1E1)
70012 FORMAT (1H ,10X,10HCORRECT: ,
1 42H 0 .0 .0 0 .0E+0 .0 .0E+0/)
WRITE (NUVI,70012)
C*****
CT002* TEST 2
C***** TEST CASES WHERE THE NUMBER OF CHARACTERS TO BE 13.5.9(3)
C***** OUTPUT EXCEEDS THE SPECIFIED OUTPUT FIELD WIDTH,
C***** OR AN EXPONENT EXCEEDS ITS SPECIFIED LENGTH.
C***************************************
IVTNUM = 2
C***** SEE NOTES TEST 1 TO DELETE TEST (NO READS REQUIRED)
IVINSP=IVINSP+1
WRITE (NUVI,80004) IVTNUM
AVS = 0.12345E+10
C*********************************************************
WRITE(NUVI, 35307) AVS, AVS, AVS, AVS, AVS
35307 FORMAT (1H ,10X,10HCOMPUTED: ,
1 E9.5E1, 1X, E10.5E2, 1X, E11.5E3,1X,E11.5E4,1X,E10.5)
70020 FORMAT (1H ,10X,10HCORRECT: ,
1 44H********* .12345E+10 .12345E+010 ***********,
2 11H .12345E+10/)
WRITE (NUVI,70020)
CT003* TEST 3
C*****
C***** - TEST THAT FW.D AND EW.D MAY HAVE MORE DIGITS 13.5.9(2)
C***** ON INPUT THAN THE PROCESSOR CAN USE.
C***** - READ IN AN ARRAY USING AN IMPLIED DO-LOOP, AND 12.8.2.3
C***** AND TEST VALUE OF THE IMPLIED DO-PARAMETER. 11.10
C***** - USE AS A FORMAT AN INTEGER VARIABLE WHOSE VALUE 10.3
C***** IS ASSIGNED USING AN ASSIGNMENT STATEMENT. 12.4(2)
C***** - TEST THAT ON INPUT, THE X-EDIT DESCRIPTOR MAY 13.5.3
C***** SPECIFY A POSITION BEYOND COLUMN 80 IF THERE ARE
C***** NO MORE ITEMS IN THE I/O LIST.
C*****
IVTNUM = 3
C***** CARDS 6-7
C***** SEE NOTES TEST 1 TO DELETE TEST
C***** CARDS 6 & 7 MUST BE BYPASSED
IVINSP=IVINSP+1
WRITE (NUVI,80004) IVTNUM
ASSIGN 35308 TO JVI
35308 FORMAT(2F5.2, F14.0 / E25.20, F5.2, 51X)
READ(IRVI, JVI) (A1S(IVI), IVI=1,5)
C*************************************************************
ASSIGN 35309 TO JVI
35309 FORMAT (11X,10HCOMPUTED: ,I5,1X,F5.2)
70030 FORMAT (1H ,10X,10HCORRECT: ,
1 11H 6 33.33/)
WRITE(NUVI, JVI) IVI, A1S(5)
WRITE (NUVI,70030)
C*****
CT004* TEST 4
C***** - TEST NESTING OF 3 LEVELS OF PARENTHESES WITHIN A
C***** FORMAT STATEMENT.
C***** - TEST DIFFERENT FORMS OF CHARACTER CONSTANTS USED 12.4(2)
C***** AS A FORMAT SPECIFIER, INCLUDING BLANKS BEFORE 13.1.2
C***** THE FIRST PARENTHESIS, AND CHARCTERS AFTER THE
C***** LAST PARENTHESIS.
C***** - 2 CONSECUTIVE APOSTROPHES IN A H-EDIT DESCRIPTOR 13.5.2
C***** CARD 8
IVTNUM = 4
C***** SEE NOTES TEST 1 TO DELETE TEST
C***** NO READS REQUIRED
IVINSP=IVINSP+1
WRITE (NUVI,80004) IVTNUM
READ(IRVI, ' (3(1(2(I5))))')
1 (((J3I(IVI,JVI,KVI),IVI=1,1),JVI=1,2),KVI=1,3)
C***************************************************
WRITE(NUVI,
1 '(/11X, 10HCOMPUTED: ,4(2X, I3) )JUNK')
2 (J3I(1,2,IVI),IVI=1,3)
WRITE (NUVI,
1 '(11X,10HCORRECT: , 15H 2 4 6) ')
WRITE (NUVI,
1 '(/11X,9HCOMPUTED:,21H ''THAT''S ALL FOR NOW'')')
70040 FORMAT (11X,10HCORRECT: ,
1 20H'THAT'S ALL FOR NOW')
WRITE (NUVI,70040)
C*****
0041 CONTINUE
C***** END OF TEST SEGMENT 353
CBB** ********************** BBCSUM0 **********************************
C**** WRITE OUT TEST SUMMARY
C****
IVTOTN = IVPASS + IVFAIL + IVDELE + IVINSP
WRITE (I02, 90004)
WRITE (I02, 90014)
WRITE (I02, 90004)
WRITE (I02, 90020) IVPASS
WRITE (I02, 90022) IVFAIL
WRITE (I02, 90024) IVDELE
WRITE (I02, 90026) IVINSP
WRITE (I02, 90028) IVTOTN, IVTOTL
CBE** ********************** BBCSUM0 **********************************
CBB** ********************** BBCFOOT0 **********************************
C**** WRITE OUT REPORT FOOTINGS
C****
WRITE (I02,90016) ZPROG, ZPROG
WRITE (I02,90018) ZPROJ, ZNAME, ZTAPE, ZTAPED
WRITE (I02,90019)
CBE** ********************** BBCFOOT0 **********************************
CBB** ********************** BBCFMT0A **********************************
C**** FORMATS FOR TEST DETAIL LINES
C****
80000 FORMAT (1H ,2X,I3,4X,7HDELETED,32X,A31)
80002 FORMAT (1H ,2X,I3,4X,7H PASS ,32X,A31)
80004 FORMAT (1H ,2X,I3,4X,7HINSPECT,32X,A31)
80008 FORMAT (1H ,2X,I3,4X,7H FAIL ,32X,A31)
80010 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,15X,10HCOMPUTED= ,
1I6,/,1H ,15X,10HCORRECT= ,I6)
80012 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
1E12.5,/,1H ,16X,10HCORRECT= ,E12.5)
80018 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
1A21,/,1H ,16X,10HCORRECT= ,A21)
80020 FORMAT (1H ,16X,10HCOMPUTED= ,A21,1X,A31)
80022 FORMAT (1H ,16X,10HCORRECT= ,A21,1X,A31)
80024 FORMAT (1H ,16X,10HCOMPUTED= ,I6,16X,A31)
80026 FORMAT (1H ,16X,10HCORRECT= ,I6,16X,A31)
80028 FORMAT (1H ,16X,10HCOMPUTED= ,E12.5,10X,A31)
80030 FORMAT (1H ,16X,10HCORRECT= ,E12.5,10X,A31)
80050 FORMAT (1H ,48X,A31)
CBE** ********************** BBCFMT0A **********************************
CBB** ********************** BBCFMT0B **********************************
C**** FORMAT STATEMENTS FOR PAGE HEADERS
C****
90002 FORMAT (1H1)
90004 FORMAT (1H )
90006 FORMAT (1H ,20X,31HFEDERAL SOFTWARE TESTING CENTER)
90007 FORMAT (1H ,19X,34HFORTRAN COMPILER VALIDATION SYSTEM)
90008 FORMAT (1H ,21X,A13,A17)
90009 FORMAT (1H ,/,2H *,A5,6HBEGIN*,12X,15HTEST RESULTS - ,A5,/)
90010 FORMAT (1H ,8X,16HTEST DATE*TIME= ,A17,15H - COMPILER= ,A20)
90013 FORMAT (1H ,8H TEST ,10HPASS/FAIL ,6X,17HDISPLAYED RESULTS,
1 7X,7HREMARKS,24X)
90014 FORMAT (1H ,46H----------------------------------------------,
1 33H---------------------------------)
90015 FORMAT (1H ,48X,17HTHIS PROGRAM HAS ,I3,6H TESTS,/)
C****
C**** FORMAT STATEMENTS FOR REPORT FOOTINGS
C****
90016 FORMAT (1H ,/,2H *,A5,4HEND*,14X,14HEND OF TEST - ,A5,/)
90018 FORMAT (1H ,A13,13X,A20,7H * ,A10,1H/,
1 A13)
90019 FORMAT (1H ,26HFOR OFFICIAL USE ONLY ,35X,15HCOPYRIGHT 1982)
C****
C**** FORMAT STATEMENTS FOR RUN SUMMARY
C****
90020 FORMAT (1H ,21X,I5,13H TESTS PASSED)
90022 FORMAT (1H ,21X,I5,13H TESTS FAILED)
90024 FORMAT (1H ,21X,I5,14H TESTS DELETED)
90026 FORMAT (1H ,21X,I5,25H TESTS REQUIRE INSPECTION)
90028 FORMAT (1H ,21X,I5,4H OF ,I3,15H TESTS EXECUTED)
CBE** ********************** BBCFMT0B **********************************
STOP
END
*END-OF,FM111
FM200.f 480976109 170 2 100666 15448 `
*HEADER,FORTR,FM200
*FILES1,FORTR,FM200,X
PROGRAM FM200
C
C
C THIS ROUTINE IS THE FIRST AUDIT PROGRAM TO CONTAIN A PROGRAM
C STATEMENT. THE FOLLOWING FEATURES FROM CHAPTER 3., CHARACTERS,
C LINES AND EXECUTION SEQUENCE ARE TESTED.
C
C (1) ASTERISK (*) IN COLUMN 1 TO DESIGNATE A COMMENT LINE.
C (2) USE OF NON-FORTRAN CHARACTERS WITHIN A COMMENT LINE.
C (3) STATEMENT LABELS ON NONEXECUTABLE STATEMENTS.
C (4) DIGIT 0 IN COLUMN 6 OF AN INITIAL LINE.
C (5) CONTINUATION LINES - MAXIMUM OF NINE CONTINUATION LINES
C (660 CHARACTERS).
C (6) BLANK CHARACTERS WITHIN STATEMENTS.
C (7) BLANK COMMENT LINE, BLANK CHARACTERS IN COLUMNS 1-72.
C
C THE BASIC FEATURES OF SUBSET FORTRAN WHICH ARE TESTED BY THIS
C PROGRAM ARE USED THROUGHOUT THE REST OF THE SUBSET ROUTINES.
C
C REFERENCES
C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN,
C X3.9-1978
C
C SECTION 3.1.6, BLANK CHARACTER
C SECTION 3.2.1, COMMENT LINE
C SECTION 3.2.2, INITIAL LINE
C SECTION 3.2.3, CONTINUATION LINE
C SECTION 3.3, STATEMENTS
C SECTION 3.4, STATEMENT LABEL
C SECTION 14.1, PROGRAM STATEMENT
C
C
C ******************************************************************
C A COMPILER VALIDATION SYSTEM FOR THE FORTRAN LANGUAGE
C BASED ON SPECIFICATIONS AS DEFINED IN AMERICAN STANDARD FORTRAN
C X3.9-1978, HAS BEEN DEVELOPED BY THE DEPARTMENT OF THE NAVY. THE
C FORTRAN COMPILER VALIDATION SYSTEM (FCVS) CONSISTS OF AUDIT
C ROUTINES, THEIR RELATED DATA, AND AN EXECUTIVE SYSTEM. EACH AUDIT
C ROUTINE IS A FORTRAN PROGRAM OR SUBPROGRAM WHICH INCLUDES TESTS
C OF SPECIFIC LANGUAGE ELEMENTS AND SUPPORTING PROCEDURES INDICATING
C THE RESULT OF EXECUTING THESE TESTS.
C
C THIS PARTICULAR PROGRAM OR SUBPROGRAM CONTAINS ONLY FEATURES
C FOUND IN THE SUBSET LEVEL OF THE STANDARD.
C
C SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO
C DEPARTMENT OF THE NAVY
C FEDERAL COBOL COMPILER TESTING SERVICE
C WASHINGTON, D.C. 20376
C
C ******************************************************************
C
C
IMPLICIT LOGICAL (L)
IMPLICIT CHARACTER*14 (C)
C
12 INTEGER XVTN01
22 DATA IVON02/5/
C THE PRECEDING STATEMENTS ARE NONEXECUTABLE STATEMENTS WHICH
C CONTAIN STATEMENT LABELS. THEY ARE REFERENCED IN TESTS 1 AND 2.
C
C
C
C INITIALIZATION SECTION.
C
C INITIALIZE CONSTANTS
C ********************
C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER
I01 = 5
C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER
I02 = 6
C SYSTEM ENVIRONMENT SECTION
C
CX010 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-010 CONTROL CARD.
C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5
C (UNIT NUMBER FOR CARD READER).
CX011 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-011 CONTROL CARD
C THE CX011 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL
C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX010 ABOVE.
C
CX020 THIS CARD IS PEPLACED BY CONTENTS OF FEXEC X-020 CONTROL CARD.
C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02 = 6
C (UNIT NUMBER FOR PRINTER).
CX021 THIS CARD IS PEPLACED BY CONTENTS OF FEXEC X-021 CONTROL CARD.
C THE CX021 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL
C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX020 ABOVE.
C
IVPASS = 0
IVFAIL = 0
IVDELE = 0
ICZERO = 0
C
C WRITE OUT PAGE HEADERS
C
WRITE (I02,90002)
WRITE (I02,90006)
WRITE (I02,90008)
WRITE (I02,90004)
WRITE (I02,90010)
WRITE (I02,90004)
WRITE (I02,90016)
WRITE (I02,90001)
WRITE (I02,90004)
WRITE (I02,90012)
WRITE (I02,90014)
WRITE (I02,90004)
C
C
C TEST 1 AND TEST 2 REFERENCE VARIABLES DEFINED IN NONEXECUTABLE
C STATEMENTS WHICH CONTAIN STATEMENT LABELS. THE NONEXECUTABLE
C STATEMENTS WHICH APPEAR AT THE BEGINNING OF THE PROGRAM ARE
C 12 INTEGER XVTN01
C 22 DATA IVON02/5/
C
C REFERENCE X3.9-1977, SECTION 3.4, STATEMENT LABELS
C
C
C **** FCVS PROGRAM 200 - TEST 001 ****
C
C TEST 001 ASSIGNS AN INTEGER VALUE TO XVTN01 WHICH WAS SPECIFIED
C AS TYPE INTEGER IN AN INTEGER STATEMENT CONTAINING A STATEMENT
C LABEL.
C
IVTNUM = 1
IF (ICZERO) 30010, 0010, 30010
0010 CONTINUE
IVCOMP = 0
XVTN01 = 1
IVCOMP = XVTN01
IVCORR = 1
40010 IF (IVCOMP - 1) 20010, 10010, 20010
30010 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10010, 0021, 20010
10010 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0021
20010 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0021 CONTINUE
C
C **** FCVS PROGRAM 200 - TEST 002 ****
C
C TEST 002 CHECKS THE VALUE WHICH WAS ASSIGNED TO IVON02 BY A
C DATA STATEMENT WITH A STATEMENT LABEL.
C
IVTNUM = 2
IF (ICZERO) 30020, 0020, 30020
0020 CONTINUE
IVCOMP = 0
IVCOMP = IVON02
IVCORR = 5
40020 IF (IVCOMP - 5) 20020, 10020, 20020
30020 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10020, 0031, 20020
10020 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0031
20020 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0031 CONTINUE
C
C TEST 3 THROUGH TEST 5 USE AN ASTERISK (*) IN COLUMN 1 TO
C DENOTE A COMMENT LINE.
C
C REFERENCE X3.9-1977, SECTION 3.2.1, COMMENT LINE
C
C
C **** FCVS PROGRAM 200 - TEST 003 ****
C
C GO TO STATEMENT IN ASTERISK COMMENT LINE.
C
IVTNUM = 3
IF (ICZERO) 30030, 0030, 30030
0030 CONTINUE
IVCOMP = 1
* GO TO 20030
IVCOMP = 0
IVCORR = 0
40030 IF (IVCOMP) 20030, 10030, 20030
30030 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10030, 0041, 20030
10030 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0041
20030 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0041 CONTINUE
C
C **** FCVS PROGRAM 200 - TEST 004 ****
C
C SEVERAL * COMMENT LINES INTERMIXED WITH EXECUTABLE STATEMENTS.
C
IVTNUM = 4
IF (ICZERO) 30040, 0040, 30040
0040 CONTINUE
IVCOMP = 0
* THE * COMMENT LINE IS THE SAME AS A C COMMENT LINE.
IVCOMP = 1
* THE * COMMENT LINES HAVE NO EFFECT ON THE PROGRAM EXECUTION.
* THEIR USE IS STRICTLY FOR DOCUMENTATION PURPOSES.
IVCOMP = 2
* IVCOMP = 3
* 40 ANY STATEMENT LABELS ON COMMENT LINES ARE IGNORED.
IVCORR = 2
40040 IF (IVCOMP - 2) 20040, 10040, 20040
30040 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10040, 0051, 20040
10040 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0051
20040 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0051 CONTINUE
C
C **** FCVS PROGRAM 200 - TEST 005 ****
C
C NONFORTRAN CHARACTERS WITHIN C AND * COMMENT LINES.
C
IVTNUM = 5
IF (ICZERO) 30050, 0050, 30050
0050 CONTINUE
IVCOMP = 1
* <>%? NONFORTRAN CHARACTER
C <>%? NONFORTRAN CHARACTER
IVCOMP = 0
IVCORR = 0
40050 IF (IVCOMP) 20050, 10050, 20050
30050 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10050, 0061, 20050
10050 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0061
20050 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0061 CONTINUE
C
C **** FCVS PROGRAM 200 - TEST 006 ****
C
C LINES CONTAINING ONLY BLANK CHARACTERS IN COLUMNS 1 THROUGH
C 72 ARE COMMENT LINES.
C
C REFERENCE X3.9-1977, SECTION 3.2.1, COMMENT LINE
C
IVTNUM = 6
IF (ICZERO) 30060, 0060, 30060
0060 CONTINUE
IVCOMP = 0
IVCORR = 3
IVCOMP = 9
* ASTERISK COMMENT LINE FOLLOWED BY BLANK COMMENT LINE.
* ASTERISK COMMENT LINE.
IVCOMP = 3
40060 IF (IVCOMP - 3) 20060, 10060, 20060
30060 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10060, 0071, 20060
10060 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0071
20060 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0071 CONTINUE
C
C TEST 7 AND TEST 8 CONTAIN THE DIGIT 0 IN COLUMN 6 OF INITIAL
C LINES.
C
C REFERENCE X3.9-1977, SECTION 3.2.2, INITIAL LINE
C
C
C **** FCVS PROGRAM 200 - TEST 007 ****
C
C TEST 007 USES THE DIGIT 0 IN COLUMN 6 OF TWO SUCCESSIVE
C INITIAL LINES.
C
IVTNUM = 7
IF (ICZERO) 30070, 0070, 30070
0070 CONTINUE
IVCOMP = 0
0IVON01 = 5
0IVON02 = 6
IVCOMP = IVON01 + IVON02
IVCORR = 11
40070 IF (IVCOMP - 11) 20070, 10070, 20070
30070 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10070, 0081, 20070
10070 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0081
20070 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0081 CONTINUE
C
C **** FCVS PROGRAM 200 - TEST 008 ****
C
C TEST 008 MIXES STATEMENTS WITH DIGIT 0 IN COLUMN 6 OF INITIAL
C LINE AND COMMENT LINES WITH * IN COLUMN 1.
C
IVTNUM = 8
IF (ICZERO) 30080, 0080, 30080
0080 CONTINUE
IVCOMP = 0
* FIRST INITIAL LINE FOLLOWS.
0IVON01 = 5
* TWO SUCCESSIVE COMMENT LINES,
* FOLLOWED BY TWO INITIAL LINES.
0IVON02=4
0IVCOMP=IVON01+IVON02
* FALL THROUGH TO VERIFICATION CODE
IVCORR = 9
40080 IF (IVCOMP - 9) 20080, 10080, 20080
30080 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10080, 0091, 20080
10080 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0091
20080 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0091 CONTINUE
C
C TEST 9 THROUGH TEST 13 VERIFY THAT CONTINUATION LINES ARE
C PERMITTED.
C
C REFERENCE X3.9-1977, SECTION 3.2.3, CONTINUATION LINE
C
C
C **** FCVS PROGRAM 200 - TEST 009 ****
C
C STATEMENT WITH TWO CONTINUATION LINES.
C
IVTNUM = 9
IF (ICZERO) 30090, 0090, 30090
0090 CONTINUE
IVON01 = 0
IVON
1 01
2 = 2
IVCOMP = IVON01
IVCORR = 2
40090 IF (IVCOMP - 2) 20090, 10090, 20090
30090 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10090, 0101, 20090
10090 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0101
20090 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0101 CONTINUE
C
C **** FCVS PROGRAM 200 - TEST 010 ****
C
C STATEMENT WITH NINE CONTINUATION LINES.
C
IVTNUM = 10
IF (ICZERO) 30100, 0100, 30100
0100 CONTINUE
IVON01 = 0
IVON01 =
1 1
2 +1
3 +1
4 +1
5 +1
6 +1
7 +1
8 +1
9+1
IVCOMP = IVON01
IVCORR = 9
40100 IF (IVCOMP - 9) 20100, 10100, 20100
30100 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10100, 0111, 20100
10100 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0111
20100 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0111 CONTINUE
C
C **** FCVS PROGRAM 200 - TEST 011 ****
C
C TEST 011 CONTAINS THE MAXIMUM NUMBER OF CONTINUATION LINES
C PERMITTED IN THE SUBSET LANGUAGE AND EACH OF THE 660 CHARACTERS
C IN THE STATEMENT ARE NONBLANK.
C
IVTNUM = 11
IF (ICZERO) 30110, 0110, 30110
0110 CONTINUE
IVON01 = 1
IVCOMP = 0
IVCOMP=IVON01+IVON01+IVON01+IVON01+IVON01+IVON01+IVON01+IVON01+IVO
1N01+IVON01+IVON01+IVON01+IVON01+IVON01+IVON01+IVON01+IVON01+IVON01
2+IVON01+IVON01+IVON01+IVON01+IVON01+IVON01+IVON01+IVON01+IVON01+IV
3ON01+IVON01+IVON01+IVON01+IVON01+IVON01+IVON01+IVON01+IVON01+IVON0
41+IVON01+IVON01+IVON01+IVON01+IVON01+IVON01+IVON01+IVON01+IVON01+I
5VON01+IVON01+IVON01+IVON01+IVON01+IVON01+IVON01+IVON01+IVON01+IVON
601+IVON01+IVON01+IVON01+IVON01+IVON01+IVON01+IVON01+IVON01+IVON01+
7IVON01+IVON01+IVON01+IVON01+IVON01+IVON01+IVON01+IVON01+IVON01+IVO
8N01+IVON01+IVON01+IVON01+IVON01+IVON01+IVON01+IVON01+IVON01+IVON01
9+IVON01+IVON01+IVON01+IVON01+IVON01+IVON01+IVON01+IVON01+IVON01+12
IVCORR = 105
40110 IF (IVCOMP - 105) 20110, 10110, 20110
30110 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10110, 0121, 20110
10110 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0121
20110 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0121 CONTINUE
C
C **** FCVS PROGRAM 200 - TEST 012 ****
C
C TEST 012 SPLITS A STATEMENT ACROSS 8 CONTINUATION LINES.
C THERE IS A STATEMENT LABEL IN COLUMNS 1-5 AND 0 IN COLUMN 6
C OF THE INITIAL LINE.
C
IVTNUM = 12
IF (ICZERO) 30120, 0120, 30120
0120 CONTINUE
IVON01 = 0
GO TO 0122
01220 I
1 V
2 O
3 N
4 0
5 1
6 =
7 8
8 9
IVCOMP = IVON01
IVCORR = 89
40120 IF (IVCOMP - 89) 20120, 10120, 20120
30120 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10120, 0131, 20120
10120 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0131
20120 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0131 CONTINUE
C
C **** FCVS PROGRAM 200 - TEST 013 ****
C
C TEST 013 CONSISTS OF AN INITIAL LINE WHICH CONTAINS ONLY A
C STATEMENT LABEL AND A CONTINUATION LINE WHICH CONTAINS THE
C EXECUTABLE STATEMENT.
C
IVTNUM = 13
IF (ICZERO) 30130, 0130, 30130
0130 CONTINUE
IVCOMP = 0
0132
1IVCOMP = 4
IVCORR = 4
40130 IF (IVCOMP - 4) 20130, 10130, 20130
30130 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10130, 0141, 20130
10130 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0141
20130 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0141 CONTINUE
C
C
C WRITE OUT TEST SUMMARY
C
WRITE (I02,90004)
WRITE (I02,90014)
WRITE (I02,90004)
WRITE (I02,90000)
WRITE (I02,90004)
WRITE (I02,90020) IVFAIL
WRITE (I02,90022) IVPASS
WRITE (I02,90024) IVDELE
STOP
90001 FORMAT (1H ,24X,5HFM200)
90000 FORMAT (1H ,20X,20HEND OF PROGRAM FM200)
C
C FORMATS FOR TEST DETAIL LINES
C
80000 FORMAT (1H ,4X,I5,6X,7HDELETED)
80002 FORMAT (1H ,4X,I5,7X,4HPASS)
80010 FORMAT (1H ,4X,I5,7X,4HFAIL,10X,I6,9X,I6)
80012 FORMAT (1H ,4X,I5,7X,4HFAIL,4X,E12.5,3X,E12.5)
80018 FORMAT (1H ,4X,I5,7X,4HFAIL,2X,A14,1X,A14)
C
C FORMAT STATEMENTS FOR PAGE HEADERS
C
90002 FORMAT (1H1)
90004 FORMAT (1H )
90006 FORMAT (1H ,10X,34HFORTRAN COMPILER VALIDATION SYSTEM)
90008 FORMAT (1H ,21X,11HVERSION 1.0)
90010 FORMAT (1H ,8X,38HFOR OFFICIAL USE ONLY - COPYRIGHT 1978)
90012 FORMAT (1H ,5X,4HTEST,5X,9HPASS/FAIL,5X,8HCOMPUTED,8X,7HCORRECT)
90014 FORMAT (1H ,5X,46H----------------------------------------------)
90016 FORMAT (1H ,18X,17HSUBSET LEVEL TEST)
C
C FORMAT STATEMENTS FOR RUN SUMMARY
C
90020 FORMAT (1H ,19X,I5,13H TESTS FAILED)
90022 FORMAT (1H ,19X,I5,13H TESTS PASSED)
90024 FORMAT (1H ,19X,I5,14H TESTS DELETED)
END
*END-OF,FM200
FM201.f 480976111 170 2 100666 18703 `
*HEADER,FORTR,FM201
*FILES1,FORTR,FM201,X
PROGRAM FM201
C
C
C THIS ROUTINE VERIFIES THAT
C
C (1) THE VALUE OF A SIGNED ZERO IS THE SAME AS THE VALUE OF
C AN UNSIGNED ZERO FOR INTEGER AND REAL VARIABLES.
C
C (2) A BASIC REAL CONSTANT MAY BE WRITTEN WITH MORE DIGITS
C THAN A PROCESSOR WILL USE TO APPROXIMATE THE VALUE OF
C THE CONSTANT.
C
C (3) AN IMPLICIT STATEMENT CAN BE USED TO CHANGE THE DEFAULT
C IMPLICIT INTEGER AND REAL TYPING.
C
C (4) THE IMPLICIT INTEGER AND REAL TYPING OF AN IMPLICIT
C STATEMENT MAY BE OVERRIDDEN BY THE APPEARANCE OF A
C VARIABLE NAME IN A TYPE-STATEMENT.
C
C REFERENCES
C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN,
C X3.9-1978
C
C SECTION 4.1.3, DATA TYPE PROPERTIES
C SECTION 4.4.1, BASIC REAL CONSTANT
C SECTION 6.1.5, INTEGER DIVISION
C SECTION 8.4, TYPE-STATEMENTS
C SECTION 8.5, IMPLICIT STATEMENT
C
C
C ******************************************************************
C A COMPILER VALIDATION SYSTEM FOR THE FORTRAN LANGUAGE
C BASED ON SPECIFICATIONS AS DEFINED IN AMERICAN STANDARD FORTRAN
C X3.9-1978, HAS BEEN DEVELOPED BY THE DEPARTMENT OF THE NAVY. THE
C FORTRAN COMPILER VALIDATION SYSTEM (FCVS) CONSISTS OF AUDIT
C ROUTINES, THEIR RELATED DATA, AND AN EXECUTIVE SYSTEM. EACH AUDIT
C ROUTINE IS A FORTRAN PROGRAM OR SUBPROGRAM WHICH INCLUDES TESTS
C OF SPECIFIC LANGUAGE ELEMENTS AND SUPPORTING PROCEDURES INDICATING
C THE RESULT OF EXECUTING THESE TESTS.
C
C THIS PARTICULAR PROGRAM OR SUBPROGRAM CONTAINS ONLY FEATURES
C FOUND IN THE SUBSET LEVEL OF THE STANDARD.
C
C SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO
C DEPARTMENT OF THE NAVY
C FEDERAL COBOL COMPILER TESTING SERVICE
C WASHINGTON, D.C. 20376
C
C ******************************************************************
C
C
IMPLICIT LOGICAL (L)
IMPLICIT CHARACTER*14 (C)
C
IMPLICIT INTEGER (Y, V-X), REAL (M)
REAL RVTN01, RVTN02, RVTN03, YVTN02
INTEGER IVTN01, IVTN02, MVTN02
C THE ABOVE THREE STATEMENTS ARE REFERENCED IN TESTS 29 THRU 35.
C
C
C
C INITIALIZATION SECTION.
C
C INITIALIZE CONSTANTS
C ********************
C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER
I01 = 5
C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER
I02 = 6
C SYSTEM ENVIRONMENT SECTION
C
CX010 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-010 CONTROL CARD.
C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5
C (UNIT NUMBER FOR CARD READER).
CX011 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-011 CONTROL CARD
C THE CX011 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL
C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX010 ABOVE.
C
CX020 THIS CARD IS PEPLACED BY CONTENTS OF FEXEC X-020 CONTROL CARD.
C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02 = 6
C (UNIT NUMBER FOR PRINTER).
CX021 THIS CARD IS PEPLACED BY CONTENTS OF FEXEC X-021 CONTROL CARD.
C THE CX021 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL
C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX020 ABOVE.
C
IVPASS = 0
IVFAIL = 0
IVDELE = 0
ICZERO = 0
C
C WRITE OUT PAGE HEADERS
C
WRITE (I02,90002)
WRITE (I02,90006)
WRITE (I02,90008)
WRITE (I02,90004)
WRITE (I02,90010)
WRITE (I02,90004)
WRITE (I02,90016)
WRITE (I02,90001)
WRITE (I02,90004)
WRITE (I02,90012)
WRITE (I02,90014)
WRITE (I02,90004)
C
C
C TEST 14 THROUGH TEST 17 COMPARE INTEGER VARIABLES WHICH ARE
C SET TO SIGNED ZERO AND UNSIGNED ZERO VALUES BY THE FOLLOWING
C STATEMENTS
C
IVON01 = 0
IVON02 = -0
IVON03 = +0
C
C REFERENCE X3.9-1978, SECTION 4.1.3, DATA TYPE PROPERTIES
C
C **** FCVS PROGRAM 201 - TEST 014 ****
C
C COMPARE 0 TO -0
C
IVTNUM = 14
IF (ICZERO) 30140, 0140, 30140
0140 CONTINUE
IVCOMP = 1
IVCORR = 0
IF (IVON01 .EQ. IVON02) IVCOMP = 0
40140 IF (IVCOMP) 20140, 10140, 20140
30140 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10140, 0151, 20140
10140 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0151
20140 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0151 CONTINUE
C
C **** FCVS PROGRAM 201 - TEST 015 ****
C
C COMPARE 0 TO +0
C
IVTNUM = 15
IF (ICZERO) 30150, 0150, 30150
0150 CONTINUE
IVCOMP = 1
IVCORR = 0
IF (IVON01 .EQ. IVON03) IVCOMP = 0
40150 IF (IVCOMP) 20150, 10150, 20150
30150 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10150, 0161, 20150
10150 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0161
20150 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0161 CONTINUE
C
C **** FCVS PROGRAM 201 - TEST 016 ****
C
C COMPARE -0 TO +0
C
IVTNUM = 16
IF (ICZERO) 30160, 0160, 30160
0160 CONTINUE
IVCOMP = 1
IVCORR = 0
IF (IVON02 .EQ. IVON03) IVCOMP = 0
40160 IF (IVCOMP) 20160, 10160, 20160
30160 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10160, 0171, 20160
10160 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0171
20160 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0171 CONTINUE
C
C **** FCVS PROGRAM 201 - TEST 017 ****
C
C MINUS ZERO (-0) SHOULD NOT BE LESS THAN PLUS ZERO (+0)
C
IVTNUM = 17
IF (ICZERO) 30170, 0170, 30170
0170 CONTINUE
IVCOMP = 1
IVCORR = 0
IF (IVON02 .LT. IVON03) GO TO 20170
IVCOMP = 0
GO TO 10170
30170 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10170, 0181, 20170
10170 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0181
20170 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0181 CONTINUE
C
C TEST 18 THROUGH TEST 24 COMPARE REAL VARIABLES WHICH ARE SET
C TO SIGNED ZERO AND UNSIGNED ZERO VALUES BY THE FOLLOWING
C STATEMENTS
C
RVON01 = 0.0
RVON02 = -0.0
RVON03 = +0.0
RVON04 = -0.0E+01
RVON05 = -0E+10
C
C REFERENCE X3.9-1978, SECTION 4.1.3, DATA TYPE PROPERTIES
C
C **** FCVS PROGRAM 201 - TEST 018 ****
C
C COMPARE 0.0 TO -0.0
C
IVTNUM = 18
IF (ICZERO) 30180, 0180, 30180
0180 CONTINUE
IVCOMP = 1
IVCORR = 0
IF (RVON01 .EQ. RVON02) IVCOMP = 0
40180 IF (IVCOMP) 20180, 10180, 20180
30180 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10180, 0191, 20180
10180 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0191
20180 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0191 CONTINUE
C
C **** FCVS PROGRAM 201 - TEST 019 ****
C
C COMPARE 0.0 TO +0.0
C
IVTNUM = 19
IF (ICZERO) 30190, 0190, 30190
0190 CONTINUE
IVCOMP = 1
IVCORR = 0
IF (RVON01 .EQ. RVON03) IVCOMP = 0
40190 IF (IVCOMP) 20190, 10190, 20190
30190 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10190, 0201, 20190
10190 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0201
20190 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0201 CONTINUE
C
C **** FCVS PROGRAM 201 - TEST 020 ****
C
C COMPARE -0.0 TO +0.0
C
IVTNUM = 20
IF (ICZERO) 30200, 0200, 30200
0200 CONTINUE
IVCOMP = 1
IVCORR = 0
IF (RVON02 .EQ. RVON03) IVCOMP = 0
40200 IF (IVCOMP) 20200, 10200, 20200
30200 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10200, 0211, 20200
10200 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0211
20200 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0211 CONTINUE
C
C **** FCVS PROGRAM 201 - TEST 021 ****
C
C MINUS ZERO (-0.0) SHOULD NOT BE LESS THAN PLUS ZERO (+0.0)
C
IVTNUM = 21
IF (ICZERO) 30210, 0210, 30210
0210 CONTINUE
IVCOMP = 1
IVCORR = 0
IF (RVON02 .LT. RVON03) GO TO 20210
IVCOMP = 0
GO TO 10210
30210 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10210, 0221, 20210
10210 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0221
20210 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0221 CONTINUE
C
C **** FCVS PROGRAM 201 - TEST 022 ****
C
C COMPARE -0.0E+01 TO 0.0
C
IVTNUM = 22
IF (ICZERO) 30220, 0220, 30220
0220 CONTINUE
IVCOMP = 1
IVCORR = 0
IF (RVON04 .EQ. RVON01) IVCOMP = 0
40220 IF (IVCOMP) 20220, 10220, 20220
30220 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10220, 0231, 20220
10220 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0231
20220 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0231 CONTINUE
C
C **** FCVS PROGRAM 201 - TEST 023 ****
C
C COMPARE -0E+10 TO 0.0
C
IVTNUM = 23
IF (ICZERO) 30230, 0230, 30230
0230 CONTINUE
IVCOMP = 1
IVCORR = 0
IF (RVON05 .EQ. RVON01) IVCOMP = 0
40230 IF (IVCOMP) 20230, 10230, 20230
30230 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10230, 0241, 20230
10230 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0241
20230 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0241 CONTINUE
C
C **** FCVS PROGRAM 201 - TEST 024 ****
C
C COMPARE -0E+10 TO +0.0
C
IVTNUM = 24
IF (ICZERO) 30240, 0240, 30240
0240 CONTINUE
IVCOMP = 1
IVCORR = 0
IF (RVON05 .NE. RVON03) GO TO 20240
IVCOMP = 0
GO TO 10240
30240 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10240, 0251, 20240
10240 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0251
20240 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0251 CONTINUE
C
C TEST 25 THROUGH TEST 28 VERIFY THAT A BASIC REAL CONSTANT MAY
C BE WRITTEN WITH MORE DIGITS THAN A PROCESSOR WILL USE TO APPROXI-
C MATE THE VALUE OF THE CONSTANT.
C
C REFERENCE X3.9-1978, SECTION 4.4.1, BASIC REAL CONSTANT
C
C
C **** FCVS PROGRAM 201 - TEST 025 ****
C
C EIGHT DIGITS IN BASIC REAL CONSTANT
C
IVTNUM = 25
IF (ICZERO) 30250, 0250, 30250
0250 CONTINUE
RVON06 = 0.0
RVCOMP = 0.0
RVON06 = 3.1561234
RVCOMP = RVON06
RVCORR = 3.1561
40250 IF (RVCOMP - 3.1556) 20250, 10250, 40251
40251 IF (RVCOMP - 3.1566) 10250, 10250, 20250
30250 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10250, 0261, 20250
10250 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0261
20250 IVFAIL = IVFAIL + 1
WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR
0261 CONTINUE
C
C **** FCVS PROGRAM 201 - TEST 026 ****
C
C EIGHT DIGITS IN BASIC REAL CONSTANT PLUS A REAL EXPONENT.
C
IVTNUM = 26
IF (ICZERO) 30260, 0260, 30260
0260 CONTINUE
RVON06 = 0.0
RVCOMP = 0.0
RVON06 = .31561234E+01
RVCOMP = RVON06
RVCORR = 3.1561
40260 IF (RVCOMP - 3.1556) 20260, 10260, 40261
40261 IF (RVCOMP - 3.1566) 10260, 10260, 20260
30260 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10260, 0271, 20260
10260 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0271
20260 IVFAIL = IVFAIL + 1
WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR
0271 CONTINUE
C
C **** FCVS PROGRAM 201 - TEST 027 ****
C
C TWELVE DIGITS IN BASIC REAL CONSTANT.
C
IVTNUM = 27
IF (ICZERO) 30270, 0270, 30270
0270 CONTINUE
RVON06 = 0.0
RVCOMP = 0.0
RVON06 = 315612347833 E-11
RVCOMP = RVON06
RVCORR = 3.1561
40270 IF (RVCOMP - 3.1556) 20270, 10270, 40271
40271 IF (RVCOMP - 3.1566) 10270, 10270, 20270
30270 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10270, 0281, 20270
10270 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0281
20270 IVFAIL = IVFAIL + 1
WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR
0281 CONTINUE
C
C **** FCVS PROGRAM 201 - TEST 028 ****
C
C TWENTY-FIVE DIGITS IN BASIC REAL CONSTANT.
C
IVTNUM = 28
IF (ICZERO) 30280, 0280, 30280
0280 CONTINUE
RVON06 = 0.0
RVCOMP = 0.0
RVON06 = 31.56123478334867532834672E-1
RVCOMP = RVON06
RVCORR = 3.1561
40280 IF (RVCOMP - 3.1556) 20280, 10280, 40281
40281 IF (RVCOMP - 3.1566) 10280, 10280, 20280
30280 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10280, 0291, 20280
10280 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0291
20280 IVFAIL = IVFAIL + 1
WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR
0291 CONTINUE
C
C TEST 29 THROUGH TEST 33 REFERENCE VARIABLES WHOSE TYPE WAS
C SPECIFIED BY AN IMPLICIT STATEMENT. DIVISION IS USED TO VERIFY
C THAT THE TYPE IS INTEGER OR REAL.
C
C REFERENCE X3.9-1978, SECTION 8.5, IMPLICIT STATEMENT
C
C
C **** FCVS PROGRAM 201 - TEST 029 ****
C
C VERIFY YVIN01 IS AN INTEGER VARIABLE.
C
IVTNUM = 29
IF (ICZERO) 30290, 0290, 30290
0290 CONTINUE
RVCOMP = 10.0
YVIN01 = 4.0
RVCOMP = YVIN01/5
RVCORR = 0.0
40290 IF (RVCOMP) 20290, 10290, 20290
30290 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10290, 0301, 20290
10290 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0301
20290 IVFAIL = IVFAIL + 1
WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR
0301 CONTINUE
C
C **** FCVS PROGRAM 201 - TEST 030 ****
C
C VERIFY VVIN01 IS AN INTEGER VARIABLE
C
IVTNUM = 30
IF (ICZERO) 30300, 0300, 30300
0300 CONTINUE
RVCOMP = 10.0
VVIN01 = 4.0
RVCOMP = VVIN01/5
RVCORR = 0.0
40300 IF (RVCOMP) 20300, 10300, 20300
30300 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10300, 0311, 20300
10300 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0311
20300 IVFAIL = IVFAIL + 1
WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR
0311 CONTINUE
C
C **** FCVS PROGRAM 201 - TEST 031 ****
C
C VERIFY WVIN01 IS AN INTEGER VARIABLE.
C
IVTNUM = 31
IF (ICZERO) 30310, 0310, 30310
0310 CONTINUE
RVCOMP = 10.0
WVIN01 = 4.0
RVCOMP = WVIN01/5
RVCORR = 0.0
40310 IF (RVCOMP) 20310, 10310, 20310
30310 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10310, 0321, 20310
10310 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0321
20310 IVFAIL = IVFAIL + 1
WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR
0321 CONTINUE
C
C **** FCVS PROGRAM 201 - TEST 032 ****
C
C VERIFY XVIN01 IS AN INTEGER VARIABLE.
C
IVTNUM = 32
IF (ICZERO) 30320, 0320, 30320
0320 CONTINUE
XVIN01 = 4
RVCOMP = 10.0
RVCOMP = XVIN01/5
RVCORR = 0.0
40320 IF (RVCOMP) 20320, 10320, 20320
30320 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10320, 0331, 20320
10320 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0331
20320 IVFAIL = IVFAIL + 1
WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR
0331 CONTINUE
C
C **** FCVS PROGRAM 201 - TEST 033 ****
C
C VERIFY MVIN01 IS A REAL VARIABLE.
C
IVTNUM = 33
IF (ICZERO) 30330, 0330, 30330
0330 CONTINUE
RVCOMP = 10.0
MVIN01 = 4
RVCOMP = MVIN01/5
RVCORR = 0.8
40330 IF (RVCOMP - 0.79995) 20330, 10330, 40331
40331 IF (RVCOMP - 0.80005) 10330, 10330, 20330
30330 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10330, 0341, 20330
10330 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0341
20330 IVFAIL = IVFAIL + 1
WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR
0341 CONTINUE
C
C TEST 34 AND TEST 35 VERIFY THAT THE IMPLICIT TYPE SPECIFICA-
C TION FOR A VARIABLE IS OVERRIDDEN BY THE APPEARANCE OF THAT
C VARIABLE NAME IN A TYPE-STATEMENT.
C
C REFERENCE X3.9-1977, SECTION 8.4, TYPE-STATEMENTS
C SECTION 8.5, IMPLICIT STATEMENT
C
C
C **** FCVS PROGRAM 201 - TEST 034 ****
C
C VERIFY YVTN02 IS A REAL VARIABLE.
C
IVTNUM = 34
IF (ICZERO) 30340, 0340, 30340
0340 CONTINUE
RVCOMP = 10.0
YVTN02 = 4
RVCOMP = YVTN02/5
RVCORR = 0.8
40340 IF (RVCOMP - 0.79995) 20340, 10340, 40341
40341 IF (RVCOMP - 0.80005) 10340, 10340, 20340
30340 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10340, 0351, 20340
10340 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0351
20340 IVFAIL = IVFAIL + 1
WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR
0351 CONTINUE
C
C **** FCVS PROGRAM 201 - TEST 035 ****
C
C VERIFY MVTN02 IS AN INTEGER VARIABLE.
C
IVTNUM = 35
IF (ICZERO) 30350, 0350, 30350
0350 CONTINUE
RVCOMP = 10.0
MVTN02 = 4.0
RVCOMP = MVTN02/5
RVCORR = 0.0
40350 IF (RVCOMP) 20350, 10350, 20350
30350 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10350, 0361, 20350
10350 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0361
20350 IVFAIL = IVFAIL + 1
WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR
0361 CONTINUE
C
C
C WRITE OUT TEST SUMMARY
C
WRITE (I02,90004)
WRITE (I02,90014)
WRITE (I02,90004)
WRITE (I02,90000)
WRITE (I02,90004)
WRITE (I02,90020) IVFAIL
WRITE (I02,90022) IVPASS
WRITE (I02,90024) IVDELE
STOP
90001 FORMAT (1H ,24X,5HFM201)
90000 FORMAT (1H ,20X,20HEND OF PROGRAM FM201)
C
C FORMATS FOR TEST DETAIL LINES
C
80000 FORMAT (1H ,4X,I5,6X,7HDELETED)
80002 FORMAT (1H ,4X,I5,7X,4HPASS)
80010 FORMAT (1H ,4X,I5,7X,4HFAIL,10X,I6,9X,I6)
80012 FORMAT (1H ,4X,I5,7X,4HFAIL,4X,E12.5,3X,E12.5)
80018 FORMAT (1H ,4X,I5,7X,4HFAIL,2X,A14,1X,A14)
C
C FORMAT STATEMENTS FOR PAGE HEADERS
C
90002 FORMAT (1H1)
90004 FORMAT (1H )
90006 FORMAT (1H ,10X,34HFORTRAN COMPILER VALIDATION SYSTEM)
90008 FORMAT (1H ,21X,11HVERSION 1.0)
90010 FORMAT (1H ,8X,38HFOR OFFICIAL USE ONLY - COPYRIGHT 1978)
90012 FORMAT (1H ,5X,4HTEST,5X,9HPASS/FAIL,5X,8HCOMPUTED,8X,7HCORRECT)
90014 FORMAT (1H ,5X,46H----------------------------------------------)
90016 FORMAT (1H ,18X,17HSUBSET LEVEL TEST)
C
C FORMAT STATEMENTS FOR RUN SUMMARY
C
90020 FORMAT (1H ,19X,I5,13H TESTS FAILED)
90022 FORMAT (1H ,19X,I5,13H TESTS PASSED)
90024 FORMAT (1H ,19X,I5,14H TESTS DELETED)
END
*END-OF,FM201
FM202.f 480976114 170 2 100666 23719 `
*HEADER,FORTR,FM202
*FILES1,FORTR,FM202,X
PROGRAM FM202
C
C
C THIS ROUTINE IS THE FIRST ROUTINE TO TEST CHARACTER DATA
C TYPES. CHARACTER TYPE-STATEMENTS SPECIFY CHARACTER VARIABLES OF
C LENGTH ONE AND LENGTH TWO. THE TESTS IN THIS ROUTINE DETERMINE
C THAT THE FOLLOWING LANGUAGE FEATURES FUNCTION CORRECTLY.
C
C (1) CHARACTER ASSIGNMENT STATEMENTS OF THE FORM
C
C CHARACTER VARIABLE = CHARACTER CONSTANT
C CHARACTER VARIABLE = CHARACTER VARIABLE
C
C WHERE THE VARIABLES AND CONSTANTS ARE THE SAME LENGTH.
C
C (2) THE REPRESENTATION OF AN APOSTROPHE IN A CHARACTER
C CONSTANT IS TWO CONSECUTIVE APOSTROPHES WITH NO INTERVENING
C BLANKS.
C
C (3) CHARACTER RELATIONAL EXPRESSION OF THE FORM
C
C CHARACTER VARIABLE RELOP CHARACTER CONSTANT
C CHARACTER CONSTANT RELOP CHARACTER VARIABLE
C CHARACTER VARIABLE RELOP CHARACTER VARIABLE
C
C WHERE THE CHARACTER ENTITIES ARE THE SAME LENGTH.
C
C (4) CHARACTER RELATIONAL EXPRESSIONS OF THE FORM
C
C CHARACTER VARIABLE .EQ. CHARACTER CONSTANT
C
C ARE USED IN THIS ROUTINE TO VERIFY THE CHARACTER ASSIGNMENT
C STATEMENTS.
C
C REFERENCES
C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN,
C X3.9-1978
C
C SECTION 4.8, CHARACTER TYPE
C SECTION 4.8.1, CHARACTER CONSTANT
C SECTION 6.2, CHARACTER EXPRESSIONS
C SECTION 6.3.4, CHARACTER RELATIONAL EXPRESSION
C SECTION 6.3.5, INTERPRETATION OF CHARACTER RELATIONAL
C EXPRESSIONS
C SECTION 8.4.2, CHARACTER TYPE-STATEMENT
C SECTION 10.4, CHARACTER ASSIGNMENT STATEMENT
C
C
C
C ******************************************************************
C A COMPILER VALIDATION SYSTEM FOR THE FORTRAN LANGUAGE
C BASED ON SPECIFICATIONS AS DEFINED IN AMERICAN STANDARD FORTRAN
C X3.9-1978, HAS BEEN DEVELOPED BY THE DEPARTMENT OF THE NAVY. THE
C FORTRAN COMPILER VALIDATION SYSTEM (FCVS) CONSISTS OF AUDIT
C ROUTINES, THEIR RELATED DATA, AND AN EXECUTIVE SYSTEM. EACH AUDIT
C ROUTINE IS A FORTRAN PROGRAM OR SUBPROGRAM WHICH INCLUDES TESTS
C OF SPECIFIC LANGUAGE ELEMENTS AND SUPPORTING PROCEDURES INDICATING
C THE RESULT OF EXECUTING THESE TESTS.
C
C THIS PARTICULAR PROGRAM OR SUBPROGRAM CONTAINS ONLY FEATURES
C FOUND IN THE SUBSET LEVEL OF THE STANDARD.
C
C SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO
C DEPARTMENT OF THE NAVY
C FEDERAL COBOL COMPILER TESTING SERVICE
C WASHINGTON, D.C. 20376
C
C ******************************************************************
C
C
IMPLICIT LOGICAL (L)
IMPLICIT CHARACTER*14 (C)
C
CHARACTER *1 CVTN01, CVTN02
CHARACTER *2 CVTN03, CVTN04
C
C
C
C INITIALIZATION SECTION.
C
C INITIALIZE CONSTANTS
C ********************
C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER
I01 = 5
C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER
I02 = 6
C SYSTEM ENVIRONMENT SECTION
C
CX010 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-010 CONTROL CARD.
C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5
C (UNIT NUMBER FOR CARD READER).
CX011 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-011 CONTROL CARD
C THE CX011 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL
C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX010 ABOVE.
C
CX020 THIS CARD IS PEPLACED BY CONTENTS OF FEXEC X-020 CONTROL CARD.
C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02 = 6
C (UNIT NUMBER FOR PRINTER).
CX021 THIS CARD IS PEPLACED BY CONTENTS OF FEXEC X-021 CONTROL CARD.
C THE CX021 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL
C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX020 ABOVE.
C
IVPASS = 0
IVFAIL = 0
IVDELE = 0
ICZERO = 0
C
C WRITE OUT PAGE HEADERS
C
WRITE (I02,90002)
WRITE (I02,90006)
WRITE (I02,90008)
WRITE (I02,90004)
WRITE (I02,90010)
WRITE (I02,90004)
WRITE (I02,90016)
WRITE (I02,90001)
WRITE (I02,90004)
WRITE (I02,90012)
WRITE (I02,90014)
WRITE (I02,90004)
C
C
C TEST 1 THROUGH TEST 6 VERIFY THAT THE CHARACTER ASSIGNMENT
C STATEMENT
C
C CHARACTER VARIABLE (LEN 1) = CHARACTER CONSTANT (LEN 1)
C
C IS CORRECT. THE CHARACTER RELATIONAL EXPRESSION
C
C CHARACTER VARIABLE (LEN 1) RELOP CHARACTER CONSTANT (LEN 1)
C
C IS USED TO VERIFY THE ASSIGNMENT STATEMENT. BOTH OF THE ABOVE
C STATEMENTS MUST MEET THE LANGUAGE SPECIFICATIONS FOR THESE TESTS
C TO PASS.
C
C
C **** FCVS PROGRAM 202 - TEST 001 ****
C
C
IVTNUM = 1
IF (ICZERO) 30010, 0010, 30010
0010 CONTINUE
IVCOMP = 0
CVTN01 = ' '
IVCORR = 1
IF (CVTN01 .EQ. ' ') IVCOMP = 1
40010 IF (IVCOMP - 1) 20010,10010,20010
30010 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10010, 0021, 20010
10010 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0021
20010 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0021 CONTINUE
C
C **** FCVS PROGRAM 202 - TEST 002 ****
C
C
IVTNUM = 2
IF (ICZERO) 30020, 0020, 30020
0020 CONTINUE
IVCOMP = 0
CVTN01 = 'M'
IVCORR = 1
IF (CVTN01 .EQ. 'M') IVCOMP = 1
40020 IF (IVCOMP - 1) 20020,10020,20020
30020 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10020, 0031, 20020
10020 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0031
20020 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0031 CONTINUE
C
C **** FCVS PROGRAM 202 - TEST 003 ****
C
C
IVTNUM = 3
IF (ICZERO) 30030, 0030, 30030
0030 CONTINUE
IVCOMP = 0
IVCORR = 1
CVTN01 = '4'
IF (CVTN01 .EQ. '4') IVCOMP = 1
40030 IF (IVCOMP - 1) 20030,10030,20030
30030 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10030, 0041, 20030
10030 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0041
20030 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0041 CONTINUE
C
C **** FCVS PROGRAM 202 - TEST 004 ****
C
C
IVTNUM = 4
IF (ICZERO) 30040, 0040, 30040
0040 CONTINUE
IVCOMP = 0
IVCORR = 1
CVTN01 = '='
IF (CVTN01 .EQ. '=') IVCOMP = 1
40040 IF (IVCOMP - 1) 20040,10040,20040
30040 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10040, 0051, 20040
10040 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0051
20040 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0051 CONTINUE
C
C **** FCVS PROGRAM 202 - TEST 005 ****
C
C
IVTNUM = 5
IF (ICZERO) 30050, 0050, 30050
0050 CONTINUE
IVCOMP = 0
IVCORR = 1
CVTN01 = '/'
IF (CVTN01 .EQ. '/') IVCOMP = 1
40050 IF (IVCOMP - 1) 20050,10050,20050
30050 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10050, 0061, 20050
10050 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0061
20050 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0061 CONTINUE
C
C **** FCVS PROGRAM 202 - TEST 006 ****
C
C AN APOSTROPHE IN A CHARACTER CONSTANT IS REPRESENTED BY TWO
C CONSECUTIVE APOSTROPHES WITH NO INTERVENING BLANKS.
C
IVTNUM = 6
IF (ICZERO) 30060, 0060, 30060
0060 CONTINUE
IVCOMP = 0
IVCORR = 1
CVTN01 = ''''
IF (CVTN01 .EQ. '''') IVCOMP = 1
40060 IF (IVCOMP - 1) 20060,10060,20060
30060 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10060, 0071, 20060
10060 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0071
20060 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0071 CONTINUE
C
C TEST 7 THROUGH TEST 12 VERIFY THAT THE CHARACTER ASSIGNMENT
C STATEMENTS
C
C CHARACTER VARIABLE (LEN 1) = CHARACTER CONSTANT (LEN 1)
C CHARACTER VARIABLE (LEN 1) = CHARACTER VARIABLE (LEN 1)
C
C ARE CORRECT. THE CHARACTER RELATIONAL EXPRESSION
C
C CHARACTER VARIABLE (LEN 1) .EQ. CHARACTER CONSTANT (LEN 1)
C
C IS USED TO VERIFY THE RESULT OF THE ASSIGNMENT STATEMENTS.
C
C
C **** FCVS PROGRAM 202 - TEST 007 ****
C
C
IVTNUM = 7
IF (ICZERO) 30070, 0070, 30070
0070 CONTINUE
IVCOMP = 0
IVCORR = 1
CVTN01 = ' '
CVTN02 = CVTN01
IF (CVTN02 .EQ. ' ') IVCOMP = 1
40070 IF (IVCOMP - 1) 20070, 10070, 20070
30070 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10070, 0081, 20070
10070 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0081
20070 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0081 CONTINUE
C
C **** FCVS PROGRAM 202 - TEST 008 ****
C
C
IVTNUM = 8
IF (ICZERO) 30080, 0080, 30080
0080 CONTINUE
IVCOMP = 0
IVCORR = 1
CVTN01 = 'M'
CVTN02 = CVTN01
IF (CVTN02 .EQ. 'M') IVCOMP = 1
40080 IF (IVCOMP - 1) 20080,10080,20080
30080 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10080, 0091, 20080
10080 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0091
20080 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0091 CONTINUE
C
C **** FCVS PROGRAM 202 - TEST 009 ****
C
C
IVTNUM = 9
IF (ICZERO) 30090, 0090, 30090
0090 CONTINUE
IVCOMP = 0
IVCORR = 1
CVTN01 = '4'
CVTN02 = CVTN01
IF (CVTN02 .EQ. '4') IVCOMP = 1
40090 IF (IVCOMP - 1) 20090,10090,20090
30090 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10090, 0101, 20090
10090 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0101
20090 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0101 CONTINUE
C
C **** FCVS PROGRAM 202 - TEST 010 ****
C
C
IVTNUM = 10
IF (ICZERO) 30100, 0100, 30100
0100 CONTINUE
IVCOMP = 0
IVCORR = 1
CVTN01 = '='
CVTN02 = CVTN01
IF (CVTN02 .EQ. '=') IVCOMP = 1
40100 IF (IVCOMP - 1) 20100,10100,20100
30100 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10100, 0111, 20100
10100 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0111
20100 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0111 CONTINUE
C
C **** FCVS PROGRAM 202 - TEST 011 ****
C
C
IVTNUM = 11
IF (ICZERO) 30110, 0110, 30110
0110 CONTINUE
IVCOMP =0
IVCORR = 1
CVTN01 = '/'
CVTN02 = CVTN01
IF (CVTN02 .EQ. '/') IVCOMP = 1
40110 IF (IVCOMP - 1) 20110,10110,20110
30110 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10110, 0121, 20110
10110 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0121
20110 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0121 CONTINUE
C
C **** FCVS PROGRAM 202 - TEST 012 ****
C
C AN APOSTROPHE IN A CHARACTER CONSTANT IS REPRESENTED BY TWO
C CONSECUTIVE APOSTROPHES WITH NO INTERVENING BLANKS.
C
IVTNUM = 12
IF (ICZERO) 30120, 0120, 30120
0120 CONTINUE
IVCOMP = 0
IVCORR = 1
CVTN01 = ''''
CVTN02 = CVTN01
IF (CVTN02 .EQ. '''') IVCOMP = 1
40120 IF (IVCOMP - 1) 20120,10120,20120
30120 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10120, 0131, 20120
10120 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0131
20120 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0131 CONTINUE
C
C TEST 13 THROUGH TEST 18 VERIFY THE RESULTS OF THE CHARACTER
C RELATIONAL EXPRESSION USING EACH OF THE SIX RELATIONAL OPERATORS
C IN THE STATEMENT FORM
C
C CHARACTER VARIABLE (LEN 1) RELOP CHARACTER CONSTANT (LEN 1).
C
C THE VARIABLE AND CONSTANT CONTAIN THE CHARACTER DATUM C.
C
CVTN01 = 'C'
C
C **** FCVS PROGRAM 202 - TEST 013 ****
C
C RELATIONAL OPERATOR .EQ.
C
IVTNUM = 13
IF (ICZERO) 30130, 0130, 30130
0130 CONTINUE
IVCOMP = 0
IVCORR = 1
IF (CVTN01 .EQ. 'C') IVCOMP = 1
40130 IF (IVCOMP - 1) 20130,10130,20130
30130 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10130, 0141, 20130
10130 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0141
20130 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0141 CONTINUE
C
C **** FCVS PROGRAM 202 - TEST 014 ****
C
C RELATIONAL OPERATOR .NE.
C
IVTNUM = 14
IF (ICZERO) 30140, 0140, 30140
0140 CONTINUE
IVCOMP = 0
IVCORR = 0
IF (CVTN01 .NE. 'C') IVCOMP = 1
40140 IF (IVCOMP) 20140,10140,20140
30140 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10140, 0151, 20140
10140 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0151
20140 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0151 CONTINUE
C
C **** FCVS PROGRAM 202 - TEST 015 ****
C
C RELATIONAL OPERATOR .LE.
C
IVTNUM = 15
IF (ICZERO) 30150, 0150, 30150
0150 CONTINUE
IVCOMP = 0
IVCORR = 1
IF (CVTN01 .LE. 'C') IVCOMP = 1
IF (IVCOMP - 1) 20150,10150,20150
30150 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10150, 0161, 20150
10150 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0161
20150 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0161 CONTINUE
C
C **** FCVS PROGRAM 202 - TEST 016 ****
C
C RELATIONAL OPERATOR .LT.
C
IVTNUM = 16
IF (ICZERO) 30160, 0160, 30160
0160 CONTINUE
IVCOMP=0
IVCORR=0
IF (CVTN01 .LT. 'C') IVCOMP = 1
IF (IVCOMP) 20160,10160,20160
30160 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10160, 0171, 20160
10160 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0171
20160 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0171 CONTINUE
C
C **** FCVS PROGRAM 202 - TEST 017 ****
C
C RELATIONAL OPERATOR .GE.
C
IVTNUM = 17
IF (ICZERO) 30170, 0170, 30170
0170 CONTINUE
IVCOMP = 0
IVCORR = 1
IF (CVTN01 .GE. 'C') IVCOMP = 1
40170 IF (IVCOMP - 1) 20170,10170,20170
30170 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10170, 0181, 20170
10170 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0181
20170 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0181 CONTINUE
C
C **** FCVS PROGRAM 202 - TEST 018 ****
C
C RELATIONAL OPERATOR .GT.
C
IVTNUM = 18
IF (ICZERO) 30180, 0180, 30180
0180 CONTINUE
IVCOMP = 0
IVCORR = 0
IF (CVTN01 .GT. 'C') IVCOMP = 1
40180 IF (IVCOMP) 20180,10180,20180
30180 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10180, 0191, 20180
10180 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0191
20180 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0191 CONTINUE
C
C TEST 19 THROUGH TEST 21 VERIFY THAT THE CHARACTER ASSIGNMENT
C STATEMENT
C
C CHARACTER VARIABLE (LEN 2) = CHARACTER CONSTANT (LEN 2)
C
C OPERATES CORRECTLY. THE CHARACTER RELATIONAL EXPRESSION
C
C CHARACTER VARIABLE (LEN 2) .EQ. CHARACTER CONSTANT (LEN 2)
C
C IS USED TO VERIFY THE RESULT OF THE ASSIGNMENT STATEMENT.
C
C
C **** FCVS PROGRAM 202 - TEST 019 ****
C
C
IVTNUM = 19
IF (ICZERO) 30190, 0190, 30190
0190 CONTINUE
IVCOMP =0
IVCORR =1
CVTN03 = 'AZ'
IF (CVTN03 .EQ. 'AZ') IVCOMP = 1
40190 IF (IVCOMP - 1) 20190,10190,20190
30190 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10190, 0201, 20190
10190 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0201
20190 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0201 CONTINUE
C
C **** FCVS PROGRAM 202 - TEST 020 ****
C
C
IVTNUM = 20
IF (ICZERO) 30200, 0200, 30200
0200 CONTINUE
IVCOMP = 0
IVCORR = 1
CVTN03 = 'B'''
IF (CVTN03 .EQ. 'B''') IVCOMP = 1
40200 IF (IVCOMP - 1) 20200,10200,20200
30200 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10200, 0211, 20200
10200 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0211
20200 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0211 CONTINUE
C
C **** FCVS PROGRAM 202 - TEST 021 ****
C
C
IVTNUM = 21
IF (ICZERO) 30210, 0210, 30210
0210 CONTINUE
IVCOMP = 0
IVCORR = 1
CVTN03 = '//'
IF (CVTN03 .EQ. '//') IVCOMP = 1
40210 IF (IVCOMP - 1) 20210,10210,20210
30210 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10210, 0221, 20210
10210 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0221
20210 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0221 CONTINUE
C
C TEST 22 THROUGH TEST 24 VERIFY THAT THE CHARACTER ASSIGNMENT
C STATEMENTS
C
C CHARACTER VARIABLE (LEN 2) = CHARACTER CONSTANT (LEN 2)
C CHARACTER VARIABLE (LEN 2) = CHARACTER VARIABLE (LEN 2)
C
C OPERATE CORRECTLY.
C
C
C **** FCVS PROGRAM 202 - TEST 022 ****
C
C
IVTNUM = 22
IF (ICZERO) 30220, 0220, 30220
0220 CONTINUE
IVCOMP = 0
IVCORR = 1
CVTN03 = 'AZ'
CVTN04 = CVTN03
IF (CVTN04 .EQ. 'AZ') IVCOMP=1
40220 IF (IVCOMP - 1) 20220,10220,20220
30220 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10220, 0231, 20220
10220 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0231
20220 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0231 CONTINUE
C
C **** FCVS PROGRAM 202 - TEST 023 ****
C
C
IVTNUM = 23
IF (ICZERO) 30230, 0230, 30230
0230 CONTINUE
IVCOMP = 0
IVCORR = 1
CVTN03 = 'B'''
CVTN04 = CVTN03
IF (CVTN04 .EQ. 'B''') IVCOMP = 1
40230 IF (IVCOMP - 1) 20230,10230,20230
30230 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10230, 0241, 20230
10230 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0241
20230 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0241 CONTINUE
C
C **** FCVS PROGRAM 202 - TEST 024 ****
C
C
IVTNUM = 24
IF (ICZERO) 30240, 0240, 30240
0240 CONTINUE
IVCOMP = 0
IVCORR = 1
CVTN03 = '//'
CVTN04 = CVTN03
IF (CVTN04 .EQ. '//') IVCOMP = 1
40240 IF (IVCOMP - 1) 20240,10240,20240
30240 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10240, 0251, 20240
10240 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0251
20240 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0251 CONTINUE
C
C TEST 25 THROUGH TEST 30 VERIFY THE RESULTS OF THE CHARACTER
C RELATIONAL EXPRESSION USING EACH OF THE SIX RELATIONAL OPERATORS
C IN THE EXPRESSION FORM
C
C CHARACTER VARIABLE (LEN 2) RELOP CHARACTER VARIABLE (LEN 2)
C
C THE VARIABLES CONTAIN THE CHARACTER DATUM CC.
C
CVTN03 = 'CC'
CVTN04 = 'CC'
C
C **** FCVS PROGRAM 202 - TEST 025 ****
C
C RELATIONAL OPERATOR .EQ.
C
IVTNUM = 25
IF (ICZERO) 30250, 0250, 30250
0250 CONTINUE
IVCOMP = 0
IVCORR = 1
IF (CVTN03 .EQ. CVTN04) IVCOMP = 1
40250 IF (IVCOMP - 1) 20250,10250,20250
30250 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10250, 0261, 20250
10250 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0261
20250 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0261 CONTINUE
C
C **** FCVS PROGRAM 202 - TEST 026 ****
C
C RELATIONAL OPERATOR .NE.
C
IVTNUM = 26
IF (ICZERO) 30260, 0260, 30260
0260 CONTINUE
IVCOMP = 0
IVCORR = 0
IF (CVTN03 .NE. CVTN04) IVCOMP = 1
40260 IF (IVCOMP) 20260,10260,20260
30260 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10260, 0271, 20260
10260 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0271
20260 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0271 CONTINUE
C
C **** FCVS PROGRAM 202 - TEST 027 ****
C
C RELATIONAL OPERATOR .LE.
C
IVTNUM = 27
IF (ICZERO) 30270, 0270, 30270
0270 CONTINUE
IVCOMP = 0
IVCORR = 1
IF (CVTN03 .LE. CVTN04) IVCOMP = 1
40270 IF (IVCOMP - 1) 20270,10270,20270
30270 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10270, 0281, 20270
10270 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0281
20270 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0281 CONTINUE
C
C **** FCVS PROGRAM 202 - TEST 028 ****
C
C RELATIONAL OPERATOR .LT.
C
IVTNUM = 28
IF (ICZERO) 30280, 0280, 30280
0280 CONTINUE
IVCOMP = 0
IVCORR = 0
IF (CVTN03 .LT. CVTN04) IVCOMP=1
40280 IF (IVCOMP) 20280,10280,20280
30280 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10280, 0291, 20280
10280 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0291
20280 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0291 CONTINUE
C
C **** FCVS PROGRAM 202 - TEST 029 ****
C
C RELATIONAL OPERATOR .GE.
C
IVTNUM = 29
IF (ICZERO) 30290, 0290, 30290
0290 CONTINUE
IVCOMP = 0
IVCORR = 1
IF (CVTN03 .GE. CVTN04) IVCOMP = 1
40290 IF (IVCOMP - 1) 20290,10290,20290
30290 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10290, 0301, 20290
10290 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0301
20290 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0301 CONTINUE
C
C **** FCVS PROGRAM 202 - TEST 030 ****
C
C RELATIONAL OPERATOR .GT.
C
IVTNUM = 30
IF (ICZERO) 30300, 0300, 30300
0300 CONTINUE
IVCOMP = 0
IVCORR = 0
IF (CVTN03 .GT. CVTN04) IVCOMP = 1
40300 IF (IVCOMP) 20300,10300,20300
30300 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10300, 0311, 20300
10300 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0311
20300 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0311 CONTINUE
C
C
C WRITE OUT TEST SUMMARY
C
WRITE (I02,90004)
WRITE (I02,90014)
WRITE (I02,90004)
WRITE (I02,90000)
WRITE (I02,90004)
WRITE (I02,90020) IVFAIL
WRITE (I02,90022) IVPASS
WRITE (I02,90024) IVDELE
STOP
90001 FORMAT (1H ,24X,5HFM202)
90000 FORMAT (1H ,20X,20HEND OF PROGRAM FM202)
C
C FORMATS FOR TEST DETAIL LINES
C
80000 FORMAT (1H ,4X,I5,6X,7HDELETED)
80002 FORMAT (1H ,4X,I5,7X,4HPASS)
80010 FORMAT (1H ,4X,I5,7X,4HFAIL,10X,I6,9X,I6)
80012 FORMAT (1H ,4X,I5,7X,4HFAIL,4X,E12.5,3X,E12.5)
80018 FORMAT (1H ,4X,I5,7X,4HFAIL,2X,A14,1X,A14)
C
C FORMAT STATEMENTS FOR PAGE HEADERS
C
90002 FORMAT (1H1)
90004 FORMAT (1H )
90006 FORMAT (1H ,10X,34HFORTRAN COMPILER VALIDATION SYSTEM)
90008 FORMAT (1H ,21X,11HVERSION 1.0)
90010 FORMAT (1H ,8X,38HFOR OFFICIAL USE ONLY - COPYRIGHT 1978)
90012 FORMAT (1H ,5X,4HTEST,5X,9HPASS/FAIL,5X,8HCOMPUTED,8X,7HCORRECT)
90014 FORMAT (1H ,5X,46H----------------------------------------------)
90016 FORMAT (1H ,18X,17HSUBSET LEVEL TEST)
C
C FORMAT STATEMENTS FOR RUN SUMMARY
C
90020 FORMAT (1H ,19X,I5,13H TESTS FAILED)
90022 FORMAT (1H ,19X,I5,13H TESTS PASSED)
90024 FORMAT (1H ,19X,I5,14H TESTS DELETED)
END
*END-OF,FM202
FM203.f 480976116 170 2 100666 28009 `
*HEADER,FORTR,FM203
*FILES1,FORTR,FM203,X
PROGRAM FM203
C
C
C THIS ROUTINE CONTINUES THE TESTING OF CHARACTER DATA TYPES
C WHICH WAS STARTED IN FM202. THE CHARACTER TYPE-STATEMENTS SPECIFY
C CHARACTER VARIABLES AND ONE-DIMENSIONAL CHARACTER ARRAYS OF
C LENGTH ONE AND LENGTH TWO. THE TESTS IN THIS ROUTINE DETERMINE
C THAT THE FOLLOWING LANGUAGE FEATURES FUNCTION CORRECTLY.
C
C (1) CHARACTER ASSIGNMENT STATEMENTS OF THE FORM
C
C CHARACTER ARRAY ELEMENT = CHARACTER CONSTANT
C CHARACTER ARRAY ELEMENT = CHARACTER VARIABLE
C CHARACTER ARRAY ELEMENT = CHARACTER ARRAY ELEMENT
C CHARACTER VARIABLE = CHARACTER ARRAY ELEMENT
C
C WHERE THE ARRAY ELEMENTS, VARIABLES AND CONSTANTS ARE OF LENGTH
C ONE OR TWO.
C
C (2) CHARACTER RELATIONAL EXPRESSIONS OF THE FORM
C
C CHARACTER ARRAY ELEMENT RELOP CHARACTER CONSTANT
C CHARACTER ARRAY ELEMENT RELOP CHARACTER VARIABLE
C CHARACTER ARRAY ELEMENT RELOP CHARACTER ARRAY ELEMENT
C
C WHERE THE ARRAY ELEMENTS, VARIABLES AND CONSTANTS ARE OF LENGTH
C ONE OR TWO.
C
C (3) CHARACTER EXPRESSIONS ENCLOSED IN PARENTHESES. THE FORMS
C TESTED ARE
C
C (CHARACTER CONSTANT)
C (CHARACTER VARIABLE)
C (CHARACTER ARRAY ELEMENT)
C ((CHARACTER ARRAY ELEMENT))
C
C (4) CHARACTER RELATIONAL EXPRESSIONS OF THE FORM
C
C CHARACTER ARRAY ELEMENT .EQ. CHARACTER CONSTANT
C
C ARE USED IN THIS ROUTINE TO VERIFY THE CHARACTER ASSIGNMENT
C STATEMENTS.
C
C REFERENCES
C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN,
C X3.9-1978
C
C SECTION 4.8, CHARACTER TYPE
C SECTION 4.8.1, CHARACTER CONSTANT
C SECTION 6.2, CHARACTER EXPRESSIONS
C SECTION 6.3.4, CHARACTER RELATIONAL EXPRESSION
C SECTION 6.3.5, INTERPRETATION OF CHARACTER RELATIONAL
C EXPRESSIONS
C SECTION 8.4.2, CHARACTER TYPE-STATEMENT
C SECTION 10.4, CHARACTER ASSIGNMENT STATEMENT
C
C
C
C ******************************************************************
C A COMPILER VALIDATION SYSTEM FOR THE FORTRAN LANGUAGE
C BASED ON SPECIFICATIONS AS DEFINED IN AMERICAN STANDARD FORTRAN
C X3.9-1978, HAS BEEN DEVELOPED BY THE DEPARTMENT OF THE NAVY. THE
C FORTRAN COMPILER VALIDATION SYSTEM (FCVS) CONSISTS OF AUDIT
C ROUTINES, THEIR RELATED DATA, AND AN EXECUTIVE SYSTEM. EACH AUDIT
C ROUTINE IS A FORTRAN PROGRAM OR SUBPROGRAM WHICH INCLUDES TESTS
C OF SPECIFIC LANGUAGE ELEMENTS AND SUPPORTING PROCEDURES INDICATING
C THE RESULT OF EXECUTING THESE TESTS.
C
C THIS PARTICULAR PROGRAM OR SUBPROGRAM CONTAINS ONLY FEATURES
C FOUND IN THE SUBSET LEVEL OF THE STANDARD.
C
C SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO
C DEPARTMENT OF THE NAVY
C FEDERAL COBOL COMPILER TESTING SERVICE
C WASHINGTON, D.C. 20376
C
C ******************************************************************
C
C
IMPLICIT LOGICAL (L)
IMPLICIT CHARACTER*14 (C)
C
CHARACTER CATN11(5), CVTN01, CATN12(5), CVTN02
CHARACTER*2 CATN13, CVTN03, CATN14(5), CVTN04
DIMENSION CATN13(5)
C
C
C
C INITIALIZATION SECTION.
C
C INITIALIZE CONSTANTS
C ********************
C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER
I01 = 5
C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER
I02 = 6
C SYSTEM ENVIRONMENT SECTION
C
CX010 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-010 CONTROL CARD.
C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5
C (UNIT NUMBER FOR CARD READER).
CX011 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-011 CONTROL CARD
C THE CX011 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL
C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX010 ABOVE.
C
CX020 THIS CARD IS PEPLACED BY CONTENTS OF FEXEC X-020 CONTROL CARD.
C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02 = 6
C (UNIT NUMBER FOR PRINTER).
CX021 THIS CARD IS PEPLACED BY CONTENTS OF FEXEC X-021 CONTROL CARD.
C THE CX021 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL
C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX020 ABOVE.
C
IVPASS = 0
IVFAIL = 0
IVDELE = 0
ICZERO = 0
C
C WRITE OUT PAGE HEADERS
C
WRITE (I02,90002)
WRITE (I02,90006)
WRITE (I02,90008)
WRITE (I02,90004)
WRITE (I02,90010)
WRITE (I02,90004)
WRITE (I02,90016)
WRITE (I02,90001)
WRITE (I02,90004)
WRITE (I02,90012)
WRITE (I02,90014)
WRITE (I02,90004)
C
C
C TEST 31 THROUGH TEST 33 VERIFY THAT THE CHARACTER ASSIGNMENT
C STATEMENT
C
C CHARACTER ARRAY ELEMENT (LEN 1) = CHARACTER CONSTANT (LEN 1)
C
C IS CORRECT. THE CHARACTER RELATIONAL EXPRESSION
C
C CHARACTER ARRAY ELEMENT (LEN 1) .EQ. CHARACTER CONSTANT (LEN 1)
C
C IS USED TO VERIFY THE ASSIGNMENT STATEMENT. BOTH OF THE ABOVE
C STATEMENT FORMS MUST MEET THE LANGUAGE SPECIFICATIONS FOR THESE
C TESTS TO PASS.
C
C THE TWO ARRAYS USED IN THESE TESTS ARE CATN11(5) AND CATN12(5)
C THE ARRAYS ARE INITIALIZED TO A BLANK CHARACTER BY THE DO-LOOP
C
DO 312 I= 1,5
CATN11(I) = ' '
CATN12(I) = ' '
312 CONTINUE
C
C **** FCVS PROGRAM 203 - TEST 031 ****
C
C
IVTNUM = 31
IF (ICZERO) 30310, 0310, 30310
0310 CONTINUE
IVCOMP = 0
IVCORR = 1
CATN11(2) = 'V'
IF (CATN11(2) .EQ. 'V') IVCOMP = 1
40310 IF (IVCOMP - 1) 20310,10310,20310
30310 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10310, 0321, 20310
10310 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0321
20310 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0321 CONTINUE
C
C **** FCVS PROGRAM 203 - TEST 032 ****
C
C
IVTNUM = 32
IF (ICZERO) 30320, 0320, 30320
0320 CONTINUE
IVCOMP=0
IVCORR=1
CATN11(3) = '+'
IF (CATN11(3) .EQ. '+') IVCOMP = 1
40320 IF (IVCOMP - 1) 20320,10320,20320
30320 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10320, 0331, 20320
10320 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0331
20320 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0331 CONTINUE
C
C **** FCVS PROGRAM 203 - TEST 033 ****
C
C
IVTNUM = 33
IF (ICZERO) 30330, 0330, 30330
0330 CONTINUE
IVCOMP = 0
IVCORR = 1
CATN11 (4) = '7'
IF (CATN11 (4) .EQ. '7') IVCOMP = 1
40330 IF (IVCOMP -1) 20330,10330,20330
30330 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10330, 0341, 20330
10330 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0341
20330 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0341 CONTINUE
C
C TEST 34 THROUGH TEST 36 VERIFY THAT THE CHARACTER ASSIGNMENT
C STATEMENTS
C
C CHARACTER VARIABLE (LEN 1) = CHARACTER CONSTANT (LEN 1)
C CHARACTER ARRAY ELEMENT (LEN1) = CHARACTER VARIABLE (LEN1)
C
C ARE CORRECT. THE CHARACTER RELATIONAL EXPRESSION
C
C CHARACTER ARRAY ELEMENT (LEN1) .EQ. CHAR. CONSTANT (LEN1)
C
C IS USED TO VERIFY THE RESULT OF THE ASSIGNMENT STATEMENTS.
C
C
C **** FCVS PROGRAM 203 - TEST 034 ****
C
C
IVTNUM = 34
IF (ICZERO) 30340, 0340, 30340
0340 CONTINUE
IVCOMP = 0
IVCORR = 1
CVTN01 = 'V'
CATN12(2) = CVTN01
IF (CATN12(2) .EQ. 'V') IVCOMP = 1
40340 IF (IVCOMP - 1) 20340,10340,20340
30340 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10340, 0351, 20340
10340 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0351
20340 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0351 CONTINUE
C
C **** FCVS PROGRAM 203 - TEST 035 ****
C
C
IVTNUM = 35
IF (ICZERO) 30350, 0350, 30350
0350 CONTINUE
IVCOMP = 0
IVCORR = 1
CVTN01 = '+'
CATN12(3) = CVTN01
IF (CATN12(3) .EQ. '+') IVCOMP = 1
40350 IF (IVCOMP - 1) 20350,10350,20350
30350 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10350, 0361, 20350
10350 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0361
20350 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0361 CONTINUE
C
C **** FCVS PROGRAM 203 - TEST 036 ****
C
C
IVTNUM = 36
IF (ICZERO) 30360, 0360, 30360
0360 CONTINUE
IVCOMP = 0
IVCORR = 1
CVTN01 = '7'
CATN12(4) = CVTN01
IF (CATN12(4) .EQ. '7') IVCOMP = 1
40360 IF (IVCOMP - 1) 20360,10360,20360
30360 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10360, 0371, 20360
10360 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0371
20360 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0371 CONTINUE
C
C TEST 37 THROUGH TEST 39 VERIFY THAT THE CHARACTER ASSIGNMENT
C STATEMENTS
C
C CHAR. ARRAY ELEMENT (LEN 1) = CHAR. CONSTANT (LEN 1)
C CHAR. ARRAY ELEMENT (LEN 1) = CHAR. ARRAY ELEMENT (LEN 1)
C
C ARE CORRECT. THE CHARACTER RELATIONAL EXPRESSION
C
C CHAR. ARRAY ELEMENT (LEN 1) .EQ. CHAR. CONSTANT (LEN 1)
C
C IS USED TO VERIFY THE RESULT OF THE ASSIGNMENT STATEMENTS.
C
C
C **** FCVS PROGRAM 203 - TEST 037 ****
C
C
IVTNUM = 37
IF (ICZERO) 30370, 0370, 30370
0370 CONTINUE
IVCOMP = 1
IVCORR = 6
CATN11 (1) = 'V'
CATN12 (1) = CATN11 (1)
IF (CATN12(1) .EQ. 'V') IVCOMP=IVCOMP*2
IF (CATN11(1) .EQ. 'V') IVCOMP=IVCOMP*3
40370 IF (IVCOMP-6) 20370,10370,20370
30370 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10370, 0381, 20370
10370 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0381
20370 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0381 CONTINUE
C
C **** FCVS PROGRAM 203 - TEST 038 ****
C
C
IVTNUM = 38
IF (ICZERO) 30380, 0380, 30380
0380 CONTINUE
IVCOMP=1
IVCORR=6
CATN11(2) = '+'
CATN12(2) = CATN11(2)
IF (CATN12(2) .EQ. '+') IVCOMP=IVCOMP*2
IF (CATN11(2) .EQ. '+') IVCOMP=IVCOMP*3
40380 IF (IVCOMP - 6) 20380,10380,20380
30380 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10380, 0391, 20380
10380 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0391
20380 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0391 CONTINUE
C
C **** FCVS PROGRAM 203 - TEST 039 ****
C
C
IVTNUM = 39
IF (ICZERO) 30390, 0390, 30390
0390 CONTINUE
IVCOMP = 1
IVCORR = 6
CATN11 (3) = '7'
CATN12 (3) = CATN11 (3)
IF (CATN12(3) .EQ. '7') IVCOMP = IVCOMP * 2
IF (CATN11(3) .EQ. '7') IVCOMP = IVCOMP * 3
40390 IF (IVCOMP - 6) 20390,10390,20390
30390 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10390, 0401, 20390
10390 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0401
20390 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0401 CONTINUE
C
C TEST 40 AND TEST 41 VERIFY THAT THE CHARACTER ASSIGNMENT
C STATEMENTS
C
C CHAR. ARRAY ELEMENT (LEN 1) = CHAR. CONSTANT (LEN 1)
C CHAR. VARIABLE (LEN 1) = CHAR. ARRAY ELEMENT (LEN 1)
C
C ARE CORRECT.
C
C
C **** FCVS PROGRAM 203 - TEST 040 ****
C
C
IVTNUM = 40
IF (ICZERO) 30400, 0400, 30400
0400 CONTINUE
IVCOMP = 0
IVCORR = 1
CATN11(4) = 'X'
CVTN02 = CATN11 (4)
IF (CVTN02 .EQ. 'X') IVCOMP = 1
40400 IF (IVCOMP - 1) 20400,10400,20400
30400 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10400, 0411, 20400
10400 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0411
20400 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0411 CONTINUE
C
C **** FCVS PROGRAM 203 - TEST 041 ****
C
C
IVTNUM = 41
IF (ICZERO) 30410, 0410, 30410
0410 CONTINUE
IVCOMP = 0
IVCORR = 1
CATN11(3) = '-'
CVTN02 = CATN11(3)
IF (CVTN02 .EQ. '-') IVCOMP=1
40410 IF (IVCOMP - 1) 20410,10410,20410
30410 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10410, 0421, 20410
10410 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0421
20410 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0421 CONTINUE
C
C TEST 42 THROUGH TEST 44 VERIFY THE RESULTS OF CHARACTER
C RELATIONAL EXPRESSIONS USING EACH OF THE SIX RELATIONAL OPERATORS.
C THE CHARACTER DATA 'A' AND '1' ARE COMPARED IN THE EXPRESSION
C AND ARE INITIALIZED BY THE CHARACTER ASSIGNMENT STATEMENTS
C
CATN11 (4) = 'A'
CATN12 (3) = '1'
CVTN01 = 'A'
CVTN02 = '1'
C
C **** FCVS PROGRAM 203 - TEST 042 ****
C
C RELATIONAL OPERATORS .NE. AND .EQ.
C CHAR. ARRAY ELEMENT (LEN 1) RELOP CHAR. CONSTANT (LEN 1)
C
IVTNUM = 42
IF (ICZERO) 30420, 0420, 30420
0420 CONTINUE
IVCOMP = 1
IVCORR = 3
IF (CATN11(4) .EQ. '1') IVCOMP=IVCOMP*2
IF ('A' .NE. CATN12(3)) IVCOMP=IVCOMP*3
40420 IF (IVCOMP - 3) 20420,10420,20420
30420 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10420, 0431, 20420
10420 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0431
20420 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0431 CONTINUE
C
C **** FCVS PROGRAM 203 - TEST 043 ****
C
C RELATIONAL OPERATORS .LE. AND .GE.
C CHAR. ARRAY ELEMENT (LEN 1) RELOP CHAR. VARIABLE (LEN 1)
C
IVTNUM = 43
IF (ICZERO) 30430, 0430, 30430
0430 CONTINUE
IVCOMP = 0
IVCORR = 1
IF (CATN11(4) .LE. CVTN02) IVCOMP=IVCOMP+1
IF (CVTN01 .GE. CATN12(3)) IVCOMP=IVCOMP+1
40430 IF (IVCOMP - 1) 20430,10430,20430
30430 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10430, 0441, 20430
10430 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0441
20430 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0441 CONTINUE
C
C **** FCVS PROGRAM 203 - TEST 044 ****
C
C RELATIONAL OPERATORS .LT. AND .GT.
C CHAR. ARRAY ELEMENT (LEN 1) RELOP CHAR. ARRAY ELEMENT (LEN 1)
C
IVTNUM = 44
IF (ICZERO) 30440, 0440, 30440
0440 CONTINUE
IVCOMP = 0
IVCORR = 1
IF (CATN11(4) .LT. CATN12(3)) IVCOMP=IVCOMP+1
IF (CATN11(4) .GT. CATN12(3)) IVCOMP=IVCOMP+1
40440 IF (IVCOMP - 1) 20440,10440,20440
30440 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10440, 0451, 20440
10440 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0451
20440 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0451 CONTINUE
C
C **** FCVS PROGRAM 203 - TEST 045 ****
C
C TEST 45 VERIFIES THAT THE LAST ELEMENTS OF THE ARRAYS USED
C IN TEST 31 THROUGH TEST 44 WERE NOT AFFECTED BY THE SETTING
C OF OTHER CHARACTER ARRAY ELEMENTS.
C
IVTNUM = 45
IF (ICZERO) 30450, 0450, 30450
0450 CONTINUE
IVCOMP = 1
IVCORR = 30
IF (CATN11(5) .EQ. ' ') IVCOMP=IVCOMP*2
IF (CATN12(5) .EQ. ' ') IVCOMP=IVCOMP*3
IF (CATN11(5) .EQ. CATN12(5)) IVCOMP=IVCOMP*5
40450 IF (IVCOMP - 30) 20450,10450,20450
30450 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10450, 0461, 20450
10450 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0461
20450 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0461 CONTINUE
C
C TEST 46 THROUGH TEST 49 CONTAIN CHARACTER ARRAY ELEMENTS OF
C LENGTH TWO IN CHARACTER ASSIGNMENT STATEMENTS. THE CHARACTER
C RELATIONAL EXPRESSION
C
C CHAR. ARRAY ELEMENT (LEN 2) .EQ. CHAR. CONSTANT (LEN 2)
C
C IS USED TO VERIFY THE TEST RESULTS.
C
C THE TWO ARRAYS USED IN THESE TESTS ARE CATN13(5) AND CATN14(5)
C THE ARRAYS ARE INITIALIZED TO TWO BLANK CHARACTERS BY THE DO-LOOP
C
DO 462 I=1,5
CATN13(I) = ' '
CATN14(I) = ' '
462 CONTINUE
C
C **** FCVS PROGRAM 203 - TEST 046 ****
C
C CHAR. ARRAY ELEMENT (LEN 2) = CHAR. CONSTANT (LEN 2)
C
IVTNUM = 46
IF (ICZERO) 30460, 0460, 30460
0460 CONTINUE
IVCOMP = 0
IVCORR = 1
CATN13(1) = 'AB'
IF (CATN13(1) .EQ. 'AB') IVCOMP = 1
40460 IF (IVCOMP - 1) 20460,10460,20460
30460 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10460, 0471, 20460
10460 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0471
20460 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0471 CONTINUE
C
C **** FCVS PROGRAM 203 - TEST 047 ****
C
C CHAR. VARIABLE (LEN 2) = CHAR. CONSTANT (LEN 2)
C CHAR. ARRAY ELEMENT (LEN 2) = CHAR. VARIABLE (LEN 2)
C
IVTNUM = 47
IF (ICZERO) 30470, 0470, 30470
0470 CONTINUE
IVCOMP = 0
IVCORR = 1
CVTN03 = '+-'
CATN13(2) = CVTN03
IF (CATN13(2) .EQ. '+-') IVCOMP=1
40470 IF (IVCOMP - 1) 20470,10470,20470
30470 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10470, 0481, 20470
10470 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0481
20470 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0481 CONTINUE
C
C **** FCVS PROGRAM 203 - TEST 048 ****
C
C CHAR. ARRAY ELEMENT (LEN 2) = CHAR. CONSTANT (LEN 2)
C CHAR. ARRAY ELEMENT (LEN 2) = CHAR. ARRAY ELEMENT (LEN 2)
C
IVTNUM = 48
IF (ICZERO) 30480, 0480, 30480
0480 CONTINUE
IVCOMP = 0
IVCORR = 1
CATN13(4) = '24'
CATN13(3) = CATN13(4)
IF (CATN13(3) .EQ. '24') IVCOMP = 1
40480 IF (IVCOMP - 1) 20480,10480,20480
30480 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10480, 0491, 20480
10480 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0491
20480 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0491 CONTINUE
C
C **** FCVS PROGRAM 203 - TEST 049 ****
C
C CHAR. ARRAY ELEMENT (LEN 2) = CHAR. CONSTANT (LEN 2)
C CHAR. VARIABLE (LEN 2) = CHAR. ARRAY ELEMENT (LEN 2)
C
IVTNUM = 49
IF (ICZERO) 30490, 0490, 30490
0490 CONTINUE
IVCOMP = 0
IVCORR = 1
CATN14(1) = 'AB'
CVTN04 = CATN14(1)
IF (CVTN04 .EQ. 'AB') IVCOMP = 1
40490 IF (IVCOMP - 1) 20490,10490,20490
30490 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10490, 0501, 20490
10490 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0501
20490 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0501 CONTINUE
C
C TEST 50 THROUGH TEST 52 VERIFY THE RESULTS OF CHARACTER
C RELATIONAL EXPRESSIONS USING EACH OF THE SIX RELATIONAL OPERATORS.
C THE CHARACTER DATA 'ZA' AND 'Z1' ARE COMPARED IN THE EXPRESSION
C AND ARE INITIALIZED BY THE CHARACTER ASSIGNMENT STATEMENTS
C
CATN14(2) = 'ZA'
CATN14(3) = 'Z1'
CVTN03 = 'ZA'
CVTN04 = 'Z1'
C
C **** FCVS PROGRAM 203 - TEST 050 ****
C
C RELATIONAL OPERATORS .NE. AND .EQ.
C CHAR. ARRAY ELEMENT (LEN 2) RELOP CHAR. VARIABLE (LEN 2)
C
IVTNUM = 50
IF (ICZERO) 30500, 0500, 30500
0500 CONTINUE
IVCOMP = 1
IVCORR = 3
IF (CATN14(2) .EQ. 'Z1') IVCOMP=IVCOMP*2
IF ('ZA' .NE. CATN14(3)) IVCOMP=IVCOMP*3
40500 IF (IVCOMP - 3) 20500,10500,20500
30500 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10500, 0511, 20500
10500 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0511
20500 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0511 CONTINUE
C
C **** FCVS PROGRAM 203 - TEST 051 ****
C
C RELATIONAL OPERATORS .LE. AND .GE.
C CHAR. ARRAY ELEMENT (LEN 2) RELOP CHAR. VARIABLE (LEN 2)
C
IVTNUM = 51
IF (ICZERO) 30510, 0510, 30510
0510 CONTINUE
IVCOMP = 0
IVCORR = 1
IF (CATN14(2) .LE. CVTN04) IVCOMP=IVCOMP+1
IF (CVTN03 .GE. CATN14(3)) IVCOMP=IVCOMP+1
40510 IF (IVCOMP - 1) 20510,10510,20510
30510 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10510, 0521, 20510
10510 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0521
20510 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0521 CONTINUE
C
C **** FCVS PROGRAM 203 - TEST 052 ****
C
C RELATIONAL OPERATORS .LT. AND .GT.
C CHAR. ARRAY ELEMENT (LEN 2) RELOP CHAR. ARRAY ELEMENT (LEN 2)
C
IVTNUM = 52
IF (ICZERO) 30520, 0520, 30520
0520 CONTINUE
IVCOMP =0
IVCORR =1
IF (CATN14(2) .LT. CATN14(3)) IVCOMP=IVCOMP+1
IF (CATN14(2) .GT. CATN14(3)) IVCOMP=IVCOMP+1
40520 IF (IVCOMP - 1) 20520,10520,20520
30520 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10520, 0531, 20520
10520 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0531
20520 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0531 CONTINUE
C
C **** FCVS PROGRAM 203 - TEST 053 ****
C
C TEST 53 VERIFIES THAT THE LAST ELEMENTS OF THE ARRAYS USED IN
C TEST 46 THROUGH TEST 52 WERE NOT AFFECTED BY THE SETTING OF OTHER
C CHARACTER ARRAY ELEMENTS.
C
IVTNUM = 53
IF (ICZERO) 30530, 0530, 30530
0530 CONTINUE
IVCOMP = 1
IVCORR = 30
IF (CATN13(5) .EQ. ' ')IVCOMP=IVCOMP*2
IF (CATN14(5) .EQ. ' ') IVCOMP= IVCOMP * 3
IF (CATN14(5) .EQ. CATN13(5)) IVCOMP=IVCOMP*5
40530 IF (IVCOMP - 30) 20530,10530,20530
30530 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10530, 0541, 20530
10530 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0541
20530 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0541 CONTINUE
C
C TEST 54 THROUGH TEST 60 VERIFY THAT A CHARACTER PRIMARY CAN
C BE ENCLOSED IN PARENTHESES. THE CHARACTER PRIMARIES FOR THE
C SUBSET ARE CHARACTER CONSTANT, CHARACTER VARIABLE, CHARACTER ARRAY
C ELEMENT, AND CHARACTER EXPRESSION ENCLOSED IN PARENTHESES. THE
C FORM OF A CHARACTER EXPRESSION IS CHARACTER PRIMARY.
C
C
C **** FCVS PROGRAM 203 - TEST 054 ****
C
C CHARACTER ASSIGNMENT STATEMENT
C CHAR. VARIABLE = (CHARACTER CONSTANT) LENGTH 1
C
IVTNUM = 54
IF (ICZERO) 30540, 0540, 30540
0540 CONTINUE
CVTN01 = ' '
IVCOMP = 0
IVCORR = 1
CVTN01 = ('N')
IF (CVTN01 .EQ. 'N') IVCOMP = 1
40540 IF (IVCOMP - 1) 20540,10540,20540
30540 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10540, 0551, 20540
10540 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0551
20540 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0551 CONTINUE
C
C **** FCVS PROGRAM 203 - TEST 055 ****
C
C CHARACTER ASSIGNMENT STATEMENT
C CHAR. VARIABLE = (CHAR. VARIABLE) LENGTH 2
C
IVTNUM = 55
IF (ICZERO) 30550, 0550, 30550
0550 CONTINUE
CVTN04 = ' '
IVCOMP = 0
IVCORR = 1
CVTN03 = '/+'
CVTN04 = (CVTN03)
IF (CVTN04 .EQ. '/+') IVCOMP=1
40550 IF (IVCOMP - 1) 20550,10550,20550
30550 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10550, 0561, 20550
10550 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0561
20550 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0561 CONTINUE
C
C **** FCVS PROGRAM 203 - TEST 056 ****
C
C CHARACTER ASSIGNMENT STATEMENT
C CHAR. VARIABLE = (CHAR. ARRAY ELEMENT) LENGTH 2
C
IVTNUM = 56
IF (ICZERO) 30560, 0560, 30560
0560 CONTINUE
IVCOMP = 0
IVCORR = 1
CVTN04 = ' '
CATN13(1) = 'BC'
CVTN04 = (CATN13(1))
IF (CVTN04 .EQ. 'BC') IVCOMP = 1
40560 IF (IVCOMP - 1) 20560,10560,20560
30560 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10560, 0571, 20560
10560 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0571
20560 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0571 CONTINUE
C
C **** FCVS PROGRAM 203 - TEST 057 ****
C
C CHARACTER ASSIGNMENT STATEMENT
C CHAR. VARIABLE = ((CHAR. ARRAY ELEMENT)) LENGTH 2
C
IVTNUM = 57
IF (ICZERO) 30570, 0570, 30570
0570 CONTINUE
IVCOMP = 0
IVCORR = 1
CVTN04 = ' '
CATN13(3) = 'BC'
CVTN04 = ((CATN13(3)))
IF (CVTN04 .EQ. 'BC') IVCOMP=1
40570 IF (IVCOMP - 1) 20570,10570,20570
30570 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10570, 0581, 20570
10570 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0581
20570 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0581 CONTINUE
C
C **** FCVS PROGRAM 203 - TEST 058 ****
C
C RELATIONAL EXPRESSION, .NE.
C (CHAR. CONSTANT) .NE. (CHAR. VARIABLE) LENGTH 1
C
IVTNUM = 58
IF (ICZERO) 30580, 0580, 30580
0580 CONTINUE
IVCOMP = 0
IVCORR = 1
CVTN01 = '6'
IF (('9') .NE. (CVTN01)) IVCOMP=1
40580 IF (IVCOMP - 1) 20580,10580,20580
30580 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10580, 0591, 20580
10580 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0591
20580 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0591 CONTINUE
C
C **** FCVS PROGRAM 203 - TEST 059 ****
C
C RELATIONAL EXPRESSION, .GE.
C (CHAR. VARIABLE) .GE. (CHAR. ARRAY ELEMENT) LENGTH 2
C
IVTNUM = 59
IF (ICZERO) 30590, 0590, 30590
0590 CONTINUE
IVCOMP = 0
IVCORR = 1
CVTN03 = 'DE'
CATN13(5) = 'DE'
IF ((CVTN03) .GE. (CATN13(5))) IVCOMP=1
40590 IF (IVCOMP - 1) 20590,10590,20590
30590 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10590, 0601, 20590
10590 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0601
20590 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0601 CONTINUE
C
C **** FCVS PROGRAM 203 - TEST 060 ****
C
C RELATIONAL EXPRESSION, .LE.
C ((CHAR. ARRAY ELEMENT)) .LE. ((CHAR. ARRAY ELEMENT)) LEN 2
C
IVTNUM = 60
IF (ICZERO) 30600, 0600, 30600
0600 CONTINUE
IVCOMP = 0
IVCORR = 1
CATN13(4) = 'MC'
CATN13(5) = 'MC'
IF (((CATN13(4))) .LE. ((CATN13(5)))) IVCOMP = 1
40600 IF (IVCOMP - 1) 20600,10600,20600
30600 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10600, 0611, 20600
10600 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0611
20600 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0611 CONTINUE
C
C
C WRITE OUT TEST SUMMARY
C
WRITE (I02,90004)
WRITE (I02,90014)
WRITE (I02,90004)
WRITE (I02,90000)
WRITE (I02,90004)
WRITE (I02,90020) IVFAIL
WRITE (I02,90022) IVPASS
WRITE (I02,90024) IVDELE
STOP
90001 FORMAT (1H ,24X,5HFM203)
90000 FORMAT (1H ,20X,20HEND OF PROGRAM FM203)
C
C FORMATS FOR TEST DETAIL LINES
C
80000 FORMAT (1H ,4X,I5,6X,7HDELETED)
80002 FORMAT (1H ,4X,I5,7X,4HPASS)
80010 FORMAT (1H ,4X,I5,7X,4HFAIL,10X,I6,9X,I6)
80012 FORMAT (1H ,4X,I5,7X,4HFAIL,4X,E12.5,3X,E12.5)
80018 FORMAT (1H ,4X,I5,7X,4HFAIL,2X,A14,1X,A14)
C
C FORMAT STATEMENTS FOR PAGE HEADERS
C
90002 FORMAT (1H1)
90004 FORMAT (1H )
90006 FORMAT (1H ,10X,34HFORTRAN COMPILER VALIDATION SYSTEM)
90008 FORMAT (1H ,21X,11HVERSION 1.0)
90010 FORMAT (1H ,8X,38HFOR OFFICIAL USE ONLY - COPYRIGHT 1978)
90012 FORMAT (1H ,5X,4HTEST,5X,9HPASS/FAIL,5X,8HCOMPUTED,8X,7HCORRECT)
90014 FORMAT (1H ,5X,46H----------------------------------------------)
90016 FORMAT (1H ,18X,17HSUBSET LEVEL TEST)
C
C FORMAT STATEMENTS FOR RUN SUMMARY
C
90020 FORMAT (1H ,19X,I5,13H TESTS FAILED)
90022 FORMAT (1H ,19X,I5,13H TESTS PASSED)
90024 FORMAT (1H ,19X,I5,14H TESTS DELETED)
END
*END-OF,FM203
FM204.f 480976119 170 2 100666 25723 `
*HEADER,FORTR,FM204
*FILES1,FORTR,FM204,X
PROGRAM FM204
C
C
C THIS ROUTINE CONTINUES THE TESTING OF CHARACTER VARIABLES AND
C CHARACTER ARRAYS OF LENGTH ONE. THE CHARACTER FEATURES TESTED IN
C FM202 AND FM203 ARE USED IN THE TESTS IN THIS ROUTINE. THE
C FOLLOWING CHARACTER FEATURES ARE TESTED
C
C (1) INITIAL DEFINITION OF CHARACTER ENTITIES OF LENGTH ONE BY
C SPECIFYING THEM IN A DATA STATEMENT.
C
C (2) THE SUBSET FORTRAN LANGUAGE SPECIFIES THE FOLLOWING
C COLLATING SEQUENCE RULES.
C
C A LESS THAN B ... LESS THAN Z,
C 0 LESS THAN 1 ... LESS THAN 9,
C ALL OF THE DIGITS PRECEDE A OR ALL OF THE DIGITS FOLLOW
C Z,
C BLANK IS LESS THAN THE LETTER A AND BLANK IS LESS THAN
C THE DIGIT ZERO.
C
C (3) THE VALUE OF THE INTRINSIC FUNCTION ICHAR IS AN INTEGER
C IN THE RANGE (0, N-1), WHERE N IS THE NUMBER OF CHARACTERS IN
C THE COLLATING SEQUENCE FOR THE PROCESSOR. FOR ANY CHARACTERS
C C1 AND C2 CAPABLE OF REPRESENTATION IN THE PROCESSOR, C1 .LE. C2
C IS TRUE IF AND ONLY IF ICHAR(C1) .LE. ICHAR(C2) IS TRUE; AND
C C1 .EQ. C2 IF AND ONLY IF ICHAR(C1) .EQ. ICHAR(C2).
C
C REFERENCES
C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN,
C X3.9-1978
C
C SECTION 3.1.5, COLLATING SEQUENCE AND GRAPHICS
C SECTION 4.8, CHARACTER TYPE
C SECTION 6.2, CHARACTER EXPRESSIONS
C SECTION 6.3.4, CHARACTER RELATIONAL EXPRESSIONS
C SECTION 6.3.5, INTERPRETATION OF CHARACTER RELATIONAL
C EXPRESSIONS
C SECTION 8.4.2, CHARACTER TYPE-STATEMENT
C SECTION 9.4, CHARACTER CONSTANT IN A DATA STATEMENT
C SECTION 10.4, CHARACTER ASSIGNMENT STATEMENT
C SECTION 15.3, INTRINSIC FUNCTIONS
C SECTION 15.10, TABLE 5 INTRINSIC FUNCTIONS
C
C
C ******************************************************************
C A COMPILER VALIDATION SYSTEM FOR THE FORTRAN LANGUAGE
C BASED ON SPECIFICATIONS AS DEFINED IN AMERICAN STANDARD FORTRAN
C X3.9-1978, HAS BEEN DEVELOPED BY THE DEPARTMENT OF THE NAVY. THE
C FORTRAN COMPILER VALIDATION SYSTEM (FCVS) CONSISTS OF AUDIT
C ROUTINES, THEIR RELATED DATA, AND AN EXECUTIVE SYSTEM. EACH AUDIT
C ROUTINE IS A FORTRAN PROGRAM OR SUBPROGRAM WHICH INCLUDES TESTS
C OF SPECIFIC LANGUAGE ELEMENTS AND SUPPORTING PROCEDURES INDICATING
C THE RESULT OF EXECUTING THESE TESTS.
C
C THIS PARTICULAR PROGRAM OR SUBPROGRAM CONTAINS ONLY FEATURES
C FOUND IN THE SUBSET LEVEL OF THE STANDARD.
C
C SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO
C DEPARTMENT OF THE NAVY
C FEDERAL COBOL COMPILER TESTING SERVICE
C WASHINGTON, D.C. 20376
C
C ******************************************************************
C
C
IMPLICIT LOGICAL (L)
IMPLICIT CHARACTER*14 (C)
C
CHARACTER*1 CATN11(47), CATN12(26), CATN13(10)
CHARACTER CVTN10*1, CATN14(6)*1, CVTN01
DIMENSION IAON11(47)
DATA CATN11/'A','B','C','D','E','F','G','H','I','J','K','L','M',
1 'N','O','P','Q','R','S','T','U','V','W','X','Y','Z','0','1',
2 '2','3','4','5','6','7','8','9',' ','=','+','-','*','/','(',
3 ')',',','.',''''/
DATA CATN12/'A','B','C','D','E','F','G','H','I','J','K','L','M',
1 'N','O','P','Q','R','S','T','U','V','W','X','Y','Z'/
DATA CATN14(1),CATN14(2),CATN14(3),CATN14(4),CATN14(5),CATN14(6)
1 /6*'V'/,IAON11/47*7/, CATN13/'0','1','2','3','4','5','6',
2 '7','8','9'/,CVTN10/' '/
C
C
C
C INITIALIZATION SECTION.
C
C INITIALIZE CONSTANTS
C ********************
C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER
I01 = 5
C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER
I02 = 6
C SYSTEM ENVIRONMENT SECTION
C
CX010 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-010 CONTROL CARD.
C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5
C (UNIT NUMBER FOR CARD READER).
CX011 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-011 CONTROL CARD
C THE CX011 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL
C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX010 ABOVE.
C
CX020 THIS CARD IS PEPLACED BY CONTENTS OF FEXEC X-020 CONTROL CARD.
C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02 = 6
C (UNIT NUMBER FOR PRINTER).
CX021 THIS CARD IS PEPLACED BY CONTENTS OF FEXEC X-021 CONTROL CARD.
C THE CX021 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL
C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX020 ABOVE.
C
IVPASS = 0
IVFAIL = 0
IVDELE = 0
ICZERO = 0
C
C WRITE OUT PAGE HEADERS
C
WRITE (I02,90002)
WRITE (I02,90006)
WRITE (I02,90008)
WRITE (I02,90004)
WRITE (I02,90010)
WRITE (I02,90004)
WRITE (I02,90016)
WRITE (I02,90001)
WRITE (I02,90004)
WRITE (I02,90012)
WRITE (I02,90014)
WRITE (I02,90004)
C
C
C TEST 61 THROUGH TEST 73 VERIFY THE CONTENTS OF CHARACTER ARRAY
C ELEMENTS AND CHARACTER VARIABLES WHICH WERE INITIALLY DEFINED IN
C A DATA STATEMENT.
C
C TEST 61 THROUGH TEST 65 VERIFY THE CONTENTS OF SELECTED
C ELEMENTS OF THE ARRAY CATN11 WHICH WAS INITIALLY SET EQUAL TO THE
C 47 CHARACTERS OF THE FORTRAN SUBSET LANGUAGE CHARACTER SET.
C
C
C **** FCVS PROGRAM 204 - TEST 061 ****
C
C
IVTNUM = 61
IF (ICZERO) 30610, 0610, 30610
0610 CONTINUE
IVCOMP = 0
IVCORR = 1
IF (CATN11(1) .EQ. 'A') IVCOMP = 1
40610 IF (IVCOMP - 1) 20610, 10610, 20610
30610 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10610, 0621, 20610
10610 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0621
20610 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0621 CONTINUE
C
C **** FCVS PROGRAM 204 - TEST 062 ****
C
C
IVTNUM = 62
IF (ICZERO) 30620, 0620, 30620
0620 CONTINUE
IVCOMP = 0
IVCORR = 1
IF (CATN11(47) .EQ. '''') IVCOMP = 1
40620 IF (IVCOMP - 1) 20620, 10620, 20620
30620 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10620, 0631, 20620
10620 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0631
20620 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0631 CONTINUE
C
C **** FCVS PROGRAM 204 - TEST 063 ****
C
C
IVTNUM = 63
IF (ICZERO) 30630, 0630, 30630
0630 CONTINUE
IVCOMP = 0
IVCORR = 1
IF (CATN11(46) .EQ. '.') IVCOMP = 1
40630 IF (IVCOMP - 1) 20630, 10630, 20630
30630 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10630, 0641, 20630
10630 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0641
20630 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0641 CONTINUE
C
C **** FCVS PROGRAM 204 - TEST 064 ****
C
C
IVTNUM = 64
IF (ICZERO) 30640, 0640, 30640
0640 CONTINUE
IVCOMP = 0
IVCORR = 1
IF (CATN11(27) .EQ. '0') IVCOMP = 1
40640 IF (IVCOMP - 1) 20640, 10640, 20640
30640 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10640, 0651, 20640
10640 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0651
20640 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0651 CONTINUE
C
C **** FCVS PROGRAM 204 - TEST 065 ****
C
C
IVTNUM = 65
IF (ICZERO) 30650, 0650, 30650
0650 CONTINUE
IVCOMP = 0
IVCORR = 1
IF (CATN11(36) .EQ. '9') IVCOMP = 1
40650 IF (IVCOMP - 1) 20650, 10650, 20650
30650 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10650, 0661, 20650
10650 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0661
20650 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0661 CONTINUE
C
C TEST 66 THROUGH TEST 68 VERIFY THE CONTENTS OF SELECTED
C ELEMENTS OF THE ARRAY CATN12 WHICH WAS INITIALLY SET EQUAL TO THE
C 26 LETTERS OF THE ALPHABET.
C
C
C **** FCVS PROGRAM 204 - TEST 066 ****
C
C
IVTNUM = 66
IF (ICZERO) 30660, 0660, 30660
0660 CONTINUE
IVCOMP = 0
IVCORR = 1
IF (CATN12(1) .EQ. 'A') IVCOMP = 1
40660 IF (IVCOMP - 1) 20660, 10660, 20660
30660 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10660, 0671, 20660
10660 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0671
20660 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0671 CONTINUE
C
C **** FCVS PROGRAM 204 - TEST 067 ****
C
C
IVTNUM = 67
IF (ICZERO) 30670, 0670, 30670
0670 CONTINUE
IVCOMP = 0
IVCORR = 1
IF (CATN12(26) .EQ. 'Z') IVCOMP = 1
40670 IF (IVCOMP - 1) 20670, 10670, 20670
30670 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10670, 0681, 20670
10670 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0681
20670 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0681 CONTINUE
C
C **** FCVS PROGRAM 204 - TEST 068 ****
C
C
IVTNUM = 68
IF (ICZERO) 30680, 0680, 30680
0680 CONTINUE
IVCOMP = 0
IVCORR = 1
IF (CATN12(20) .EQ. 'T') IVCOMP = 1
40680 IF (IVCOMP - 1) 20680, 10680, 20680
30680 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10680, 0691, 20680
10680 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0691
20680 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0691 CONTINUE
C
C TEST 69 AND TEST 70 VERIFY THE CONTENTS OF SELECTED ELEMENTS
C OF THE ARRAY CATN13 WHICH WAS INITIALLY SET EQUAL TO THE TEN
C NUMERIC DIGITS.
C
C
C **** FCVS PROGRAM 204 - TEST 069 ****
C
C
IVTNUM = 69
IF (ICZERO) 30690, 0690, 30690
0690 CONTINUE
IVCOMP = 0
IVCORR = 1
IF (CATN13(1) .EQ. '0') IVCOMP = 1
40690 IF (IVCOMP - 1) 20690, 10690, 20690
30690 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10690, 0701, 20690
10690 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0701
20690 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0701 CONTINUE
C
C **** FCVS PROGRAM 204 - TEST 070 ****
C
C
IVTNUM = 70
IF (ICZERO) 30700, 0700, 30700
0700 CONTINUE
IVCOMP = 0
IVCORR = 1
IF (CATN13(10) .EQ. '9') IVCOMP = 1
40700 IF (IVCOMP - 1) 20700, 10700, 20700
30700 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10700, 0711, 20700
10700 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0711
20700 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0711 CONTINUE
C
C **** FCVS PROGRAM 204 - TEST 071 ****
C
C TEST 71 VERIFIES THE CONTENTS OF THE VARIABLE CVTN10 WHICH
C WAS INITIALLY SET EQUAL TO BLANK.
C
IVTNUM = 71
IF (ICZERO) 30710, 0710, 30710
0710 CONTINUE
IVCOMP = 0
IVCORR = 1
IF (CVTN10 .EQ. ' ') IVCOMP = 1
40710 IF (IVCOMP - 1) 20710, 10710, 20710
30710 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10710, 0721, 20710
10710 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0721
20710 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0721 CONTINUE
C
C **** FCVS PROGRAM 204 - TEST 072 ****
C
C TEST 72 VERIFIES THE CONTENTS OF THE ARRAY CATN14 WHICH WAS
C INITIALLY SET EQUAL TO ALL V'S.
C
IVTNUM = 72
IF (ICZERO) 30720, 0720, 30720
0720 CONTINUE
IVCOMP = 0
IVCORR = 6
DO 722 I= 1,6
IF (CATN14(I) .EQ. 'V') IVCOMP = IVCOMP + 1
722 CONTINUE
40720 IF (IVCOMP - 6) 20720, 10720, 20720
30720 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10720, 0731, 20720
10720 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0731
20720 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0731 CONTINUE
C
C **** FCVS PROGRAM 204 - TEST 073 ****
C
C TEST 73 VERIFIES THE CONTENTS OF THE ARRAY IAON11 WHICH WAS
C INITIALLY SET EQUAL TO ALL 7'S.
C
IVTNUM = 73
IF (ICZERO) 30730, 0730, 30730
0730 CONTINUE
IVCOMP = 0
IVCORR = 47
DO 732 I= 1,47
IF (IAON11(I) - 7) 732, 733, 732
733 IVCOMP = IVCOMP + 1
732 CONTINUE
40730 IF (IVCOMP - 47) 20730, 10730, 20730
30730 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10730, 0741, 20730
10730 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0741
20730 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0741 CONTINUE
C
C TEST 74 THROUGH TEST 79 VERIFY THE COLLATING SEQUENCE
C SPECIFICATIONS FOR THE FORTRAN SUBSET LANGUAGE.
C
C TEST 74 AND TEST 75 VERIFY THE COLLATING SEQUENCE FOR LETTERS.
C
C
C **** FCVS PROGRAM 204 - TEST 074 ****
C
C
IVTNUM = 74
IF (ICZERO) 30740, 0740, 30740
0740 CONTINUE
IVCOMP = 1
IVCORR = 210
IF ('A' .LT. 'B') IVCOMP = IVCOMP * 2
IF ('B' .LT. 'M') IVCOMP = IVCOMP * 3
IF ('M' .LT. 'V') IVCOMP = IVCOMP * 5
IF ('V' .LT. 'Z') IVCOMP = IVCOMP * 7
40740 IF (IVCOMP - 210) 20740, 10740, 20740
30740 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10740, 0751, 20740
10740 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0751
20740 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0751 CONTINUE
C
C **** FCVS PROGRAM 204 - TEST 075 ****
C
C
IVTNUM = 75
IF (ICZERO) 30750, 0750, 30750
0750 CONTINUE
IVCOMP = 0
IVCORR = 25
DO 752 I=1,25
J= I + 1
IF (CATN12(J) .GT. CATN12(I)) IVCOMP = IVCOMP + 1
752 CONTINUE
40750 IF (IVCOMP - 25) 20750, 10750, 20750
30750 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10750, 0761, 20750
10750 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0761
20750 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0761 CONTINUE
C
C TEST 76 AND TEST 77 VERIFY THE COLLATING SEQUENCE FOR DIGITS.
C
C
C **** FCVS PROGRAM 204 - TEST 076 ****
C
C
IVTNUM = 76
IF (ICZERO) 30760, 0760, 30760
0760 CONTINUE
IVCOMP = 1
IVCORR = 30
IF ('0' .LT. '1') IVCOMP = IVCOMP * 2
IF ('1' .LT. '5') IVCOMP = IVCOMP * 3
IF ('5' .LT. '9') IVCOMP = IVCOMP * 5
40760 IF (IVCOMP - 30) 20760, 10760, 20760
30760 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10760, 0771, 20760
10760 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0771
20760 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0771 CONTINUE
C
C **** FCVS PROGRAM 204 - TEST 077 ****
C
C
IVTNUM = 77
IF (ICZERO) 30770, 0770, 30770
0770 CONTINUE
IVCOMP = 0
IVCORR = 9
DO 772 I=1,9
J = I + 1
IF (CATN13(I) .LT. CATN13(J)) IVCOMP = IVCOMP + 1
772 CONTINUE
40770 IF (IVCOMP - 9) 20770, 10770, 20770
30770 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10770, 0781, 20770
10770 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0781
20770 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0781 CONTINUE
C
C **** FCVS PROGRAM 204 - TEST 078 ****
C
C TEST 78 VERIFIES THAT BLANK IS LESS THAN THE LETTER A AND BLANK
C IS LESS THAN THE DIGIT ZERO.
C
IVTNUM = 78
IF (ICZERO) 30780, 0780, 30780
0780 CONTINUE
IVCOMP = 1
IVCORR = 6
IF (' ' .LT. 'A') IVCOMP = IVCOMP * 2
IF (' ' .LT. '0') IVCOMP = IVCOMP * 3
40780 IF (IVCOMP - 6) 20780, 10780, 20780
30780 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10780, 0791, 20780
10780 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0791
20780 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0791 CONTINUE
C
C **** FCVS PROGRAM 204 - TEST 079 ****
C
C TEST 79 VERIFIES THAT THE DIGITS AND LETTERS ARE NOT INTERMIXED
C IN THE COLLATING SEQUENCE. EITHER ALL OF THE DIGITS MUST PRECEDE
C A OR ALL OF THE DIGITS MUST FOLLOW Z.
C
IVTNUM = 79
IF (ICZERO) 30790, 0790, 30790
0790 CONTINUE
IVCOMP = 0
IVCORR = 10
IF ('0' .NE. 'A') GO TO 792
IVCOMP = 111
GO TO 40790
792 IF ('0' .GT. 'A') GO TO 793
C
C ZERO IS LESS THAN LETTER A, SO ALL DIGITS MUST BE LESS THAN A
C
DO 794 I= 1,10
IF (CATN13(I) .LT. 'A') IVCOMP = IVCOMP + 1
794 CONTINUE
GO TO 40790
C
C ZERO IS GREATER THAN LETTER A, SO ALL DIGITS MUST BE GREATER
C THAN LETTER Z.
C
793 DO 795 I=1,10
IF (CATN13(I) .GT. 'Z') IVCOMP = IVCOMP + 1
795 CONTINUE
40790 IF (IVCOMP - 10) 20790,10790, 20790
30790 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10790, 0801, 20790
10790 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0801
20790 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0801 CONTINUE
C
C TEST 80 THROUGH TEST 85 PERFORM THE SAME COMPARISONS AS TEST 74
C THROUGH TEST 79 EXCEPT THAT THE ICHAR INTRINSIC FUNCTION IS USED
C IN PLACE OF THE INDIVIDUAL CHARACTERS.
C
C TEST 80 AND TEST 81 VERIFY THE COLLATING SEQUENCE FOR LETTERS
C USING THE ICHAR INTRINSIC FUNCTION.
C
C
C **** FCVS PROGRAM 204 - TEST 080 ****
C
C
IVTNUM = 80
IF (ICZERO) 30800, 0800, 30800
0800 CONTINUE
IVCOMP = 1
IVCORR = 210
IVON01 = ICHAR('A')
IVON02 = ICHAR('B')
IVON03 = ICHAR('M')
IVON04 = ICHAR('V')
IVON05 = ICHAR('Z')
IF (IVON01 .LT. IVON02) IVCOMP = IVCOMP * 2
IF (IVON02 .LT. IVON03) IVCOMP = IVCOMP * 3
IF (IVON03 .LT. IVON04) IVCOMP = IVCOMP * 5
IF (IVON04 .LT. IVON05) IVCOMP = IVCOMP * 7
40800 IF (IVCOMP - 210) 20800, 10800, 20800
30800 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10800, 0811, 20800
10800 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0811
20800 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0811 CONTINUE
C
C **** FCVS PROGRAM 204 - TEST 081 ****
C
C
IVTNUM = 81
IF (ICZERO) 30810, 0810, 30810
0810 CONTINUE
IVON01 = 0
IVON02 = 0
IVCOMP = 0
IVCORR = 25
DO 812 I=1,25
J= I + 1
IVON01 = ICHAR(CATN12(J))
IVON02 = ICHAR(CATN12(I))
IF (IVON01 .GT. IVON02) IVCOMP = IVCOMP + 1
812 CONTINUE
40810 IF (IVCOMP - 25) 20810, 10810, 20810
30810 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10810, 0821, 20810
10810 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0821
20810 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0821 CONTINUE
C
C TEST 82 AND TEST 83 VERIFY THE COLLATING SEQUENCE FOR DIGITS
C USING THE ICHAR INTRINSIC FUNCTION.
C
C
C **** FCVS PROGRAM 204 - TEST 082 ****
C
C
IVTNUM = 82
IF (ICZERO) 30820, 0820, 30820
0820 CONTINUE
IVCOMP = 1
IVCORR = 30
IF (ICHAR('0') .LT. ICHAR('1')) IVCOMP = IVCOMP *2
IF (ICHAR('1') .LT. ICHAR('5')) IVCOMP = IVCOMP * 3
IF (ICHAR('5') .LT. ICHAR('9')) IVCOMP = IVCOMP * 5
40820 IF (IVCOMP - 30) 20820, 10820, 20820
30820 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10820, 0831, 20820
10820 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0831
20820 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0831 CONTINUE
C
C **** FCVS PROGRAM 204 - TEST 083 ****
C
C
IVTNUM = 83
IF (ICZERO) 30830, 0830, 30830
0830 CONTINUE
IVON01 = 0
IVON02 = 0
IVCOMP = 0
IVCORR = 9
DO 832 I=1,9
J = I + 1
IVON01 = ICHAR(CATN13(J))
IVON02 = ICHAR(CATN13(I))
IF (IVON02 .LT. IVON01) IVCOMP = IVCOMP + 1
832 CONTINUE
40830 IF (IVCOMP -9) 20830, 10830, 20830
30830 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10830, 0841, 20830
10830 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0841
20830 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0841 CONTINUE
C
C **** FCVS PROGRAM 204 - TEST 084 ****
C
C TEST 84 VERIFIES THAT BLANK IS LESS THAN THE LETTER A AND BLANK
C IS LESS THAN THE DIGIT ZERO. THE INTRINSIC FUNCTION ICHAR IS
C USED IN THIS TEST.
C
IVTNUM = 84
IF (ICZERO) 30840, 0840, 30840
0840 CONTINUE
IVCOMP = 1
IVCORR = 6
IF (ICHAR(' ') .LT. ICHAR('A')) IVCOMP = IVCOMP * 2
IF (ICHAR(' ') .LT. ICHAR('0')) IVCOMP = IVCOMP * 3
40840 IF (IVCOMP - 6) 20840, 10840, 20840
30840 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10840, 0851, 20840
10840 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0851
20840 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0851 CONTINUE
C
C **** FCVS PROGRAM 204 - TEST 085 ****
C
C TEST 85 VERIFIES THAT THE DIGITS AND LETTERS ARE NOT INTERMIXED
C IN THE COLLATING SEQUENCE. THE ICHAR INTRINSIC FUNCTION IS USED
C TO VERIFY THAT EITHER ALL OF THE DIGITS PRECEDE A OR ALL OF THE
C DIGITS FOLLOW Z.
C
IVTNUM = 85
IF (ICZERO) 30850, 0850, 30850
0850 CONTINUE
IVCOMP = 0
IVCORR = 10
IF (ICHAR('0') .NE. ICHAR('A')) GO TO 852
IVCOMP = 111
GO TO 40850
852 IF (ICHAR('0') .GT. ICHAR('A')) GO TO 853
C
C ZERO IS LESS THAN LETTER A ACCORDING TO ICHAR INTRINSIC
C FUNCTION VALUE. THUS, THE ICHAR VALUE FOR ALL DIGITS MUST BE
C LESS THAN ICHAR VALUE FOR LETTER A.
C
DO 854 I=1,10
IF (ICHAR(CATN13(I)) .LT. ICHAR('A')) IVCOMP = IVCOMP + 1
854 CONTINUE
GO TO 40850
C
C ZERO IS GREATER THAN LETTER A ACCORDING TO ICHAR INTRINSIC
C FUNCTION VALUE. THUS, THE ICHAR VALUE FOR ALL DIGITS MUST BE
C GREATER THAN ICHAR VALUE FOR LETTER Z.
C
853 DO 855 I=1,10
IF (ICHAR(CATN13(I)).GT. ICHAR('Z')) IVCOMP = IVCOMP + 1
855 CONTINUE
40850 IF (IVCOMP - 10) 20850, 10850, 20850
30850 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10850, 0861, 20850
10850 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0861
20850 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0861 CONTINUE
C
C **** FCVS PROGRAM 204 - TEST 086 ****
C
C THE ARRAY IAON11 IS SET EQUAL TO THE ICHAR INTRINSIC FUNCTION
C VALUE OF THE CORRESPONDING ELEMENT IN THE CATN11 ARRAY. THE
C IAON11 ARRAY IS THEN SORTED IN ASCENDING ORDER, AND ENTRIES IN
C THE CATN11 ARRAY ARE ARRANGED ACCORDING TO THE ASCENDING SORT
C ORDER IN IAON11. THE RESULTING ORDER OF THE CATN11 ARRAY GIVES
C THE PROCESSOR'S COLLATING SEQUENCE FOR THE FORTRAN SUBSET LANGUAGE
C CHARACTER SET. THE CATN11 ARRAY IS PRINTED AND MUST BE VISUALLY
C CHECKED TO DETERMINE IF THE COLLATING SEQUENCE RULES ARE FOLLOWED
C BY THE COMPILER.
C
IVTNUM = 86
IF (ICZERO) 30860, 0860, 30860
0860 CONTINUE
IVCOMP = 0
C
C INITIALIZE IAON11 TO ZERO.
DO 862 I=1,47
IAON11(I) = 0
862 CONTINUE
C
C PLACE ICHAR INTRINSIC VALUE IN IAON11.
C
DO 863 I= 1,47
IAON11(I) = ICHAR(CATN11(I))
863 CONTINUE
C
C SORT FORTRAN CHARACTERS ACCORDING TO THEIR POSITION IN THE
C COLLATING SEQUENCE.
C
DO 864 I=1,46
J=I
N = I + 1
DO 865 K = N,47
IF (IAON11(J) .LT. IAON11(K)) GO TO 865
J=K
865 CONTINUE
IVON01 = IAON11(J)
IAON11(J)= IAON11(I)
IAON11(I)= IVON01
CVTN01 = CATN11(J)
CATN11(J) = CATN11(I)
CATN11(I) = CVTN01
864 CONTINUE
WRITE (I02, 866) CATN11
WRITE (I02, 867) IAON11
866 FORMAT (3X,'FORTRAN CHARACTER SET IN ASCENDING ORDER',3X,/
1 3X, 'VISUAL VERIFICATION REQUIRED' //,3X, 12(A1,3X)/
2 3X, 12(A1,3X)/ 3X, 12(A1,3X)/ 3X, 11(A1,3X))
867 FORMAT ( 3X/3X, 'ICHAR INTRINSIC FUNCTION VALUES FOR FORTRAN ',
1 'CHARACTER SET'// 3X, 12I4/ 3X, 12I4/ 3X, 12I4/
2 3X,11I4//)
IVCOMP = 1
IVCORR = 1
40860 IF (IVCOMP - 1) 20860, 10860, 20860
30860 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10860, 0871, 20860
10860 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0871
20860 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0871 CONTINUE
C
C
C WRITE OUT TEST SUMMARY
C
WRITE (I02,90004)
WRITE (I02,90014)
WRITE (I02,90004)
WRITE (I02,90000)
WRITE (I02,90004)
WRITE (I02,90020) IVFAIL
WRITE (I02,90022) IVPASS
WRITE (I02,90024) IVDELE
STOP
90001 FORMAT (1H ,24X,5HFM204)
90000 FORMAT (1H ,20X,20HEND OF PROGRAM FM204)
C
C FORMATS FOR TEST DETAIL LINES
C
80000 FORMAT (1H ,4X,I5,6X,7HDELETED)
80002 FORMAT (1H ,4X,I5,7X,4HPASS)
80010 FORMAT (1H ,4X,I5,7X,4HFAIL,10X,I6,9X,I6)
80012 FORMAT (1H ,4X,I5,7X,4HFAIL,4X,E12.5,3X,E12.5)
80018 FORMAT (1H ,4X,I5,7X,4HFAIL,2X,A14,1X,A14)
C
C FORMAT STATEMENTS FOR PAGE HEADERS
C
90002 FORMAT (1H1)
90004 FORMAT (1H )
90006 FORMAT (1H ,10X,34HFORTRAN COMPILER VALIDATION SYSTEM)
90008 FORMAT (1H ,21X,11HVERSION 1.0)
90010 FORMAT (1H ,8X,38HFOR OFFICIAL USE ONLY - COPYRIGHT 1978)
90012 FORMAT (1H ,5X,4HTEST,5X,9HPASS/FAIL,5X,8HCOMPUTED,8X,7HCORRECT)
90014 FORMAT (1H ,5X,46H----------------------------------------------)
90016 FORMAT (1H ,18X,17HSUBSET LEVEL TEST)
C
C FORMAT STATEMENTS FOR RUN SUMMARY
C
90020 FORMAT (1H ,19X,I5,13H TESTS FAILED)
90022 FORMAT (1H ,19X,I5,13H TESTS PASSED)
90024 FORMAT (1H ,19X,I5,14H TESTS DELETED)
END
*END-OF,FM204
FM205.f 480976123 170 2 100666 27102 `
*HEADER,FORTR,FM205
*FILES1,FORTR,FM205,X
PROGRAM FM205
C
C
C THE ROUTINE FM205 TESTS CHARACTER CONSTANTS, CHARACTER
C VARIABLES, AND CHARACTER ARRAY ELEMENTS WITH A MAXIMUM LENGTH
C OF 57 CHARACTERS. CHARACTER ASSIGNMENT STATEMENTS AND CHARACTER
C RELATIONAL EXPRESSIONS OF THE FOLLOWING STATEMENT FORMS ARE
C TESTED IN THIS ROUTINE.
C
C (1) CHARACTER ASSIGNMENT STATEMENTS
C
C CHARACTER VARIABLE = CHARACTER CONSTANT,
C CHARACTER VARIABLE = CHARACTER VARIABLE,
C CHARACTER ARRAY ELEMENT = CHARACTER CONSTANT,
C CHARACTER ARRAY ELEMENT = CHARACTER VARIABLE,
C CHARACTER ARRAY ELEMENT = CHARACTER ARRAY ELEMENT,
C CHARACTER VARIABLE = CHARACTER ARRAY ELEMENT.
C
C THE CHARACTER ENTITIES IN AN ASSIGNMENT STATEMENT ARE THE
C SAME LENGTH.
C
C (2) CHARACTER RELATIONAL EXPRESSIONS
C
C CHARACTER VARIABLE RELOP CHARACTER CONSTANT,
C CHARACTER VARIABLE RELOP CHARACTER VARIABLE,
C CHARACTER ARRAY ELEMENT RELOP CHARACTER CONSTANT,
C CHARACTER ARRAY ELEMENT RELOP CHARACTER VARIABLE,
C CHARACTER ARRAY ELEMENT RELOP CHAR. ARRAY ELEMENT.
C
C THE CHARACTER ENTITIES IN A RELATIONAL EXPRESSION ARE THE
C SAME LENGTH.
C
C REFERENCES
C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN,
C X3.9-1978.
C
C SECTION 4.8, CHARACTER TYPE
C SECTION 4.8.1, CHARACTER CONSTANT
C SECTION 6.2, CHARACTER EXPRESSIONS
C SECTION 6.3.4, CHARACTER RELATIONAL EXPRESSION
C SECTION 6.3.5, INTERPRETATION OF CHARACTER RELATIONAL
C EXPRESSIONS
C SECTION 8.4,2, CHARACTER TYPE-STATEMENT
C SECTION 10.4, CHARACTER ASSIGNMENT STATEMENT
C
C
C ******************************************************************
C A COMPILER VALIDATION SYSTEM FOR THE FORTRAN LANGUAGE
C BASED ON SPECIFICATIONS AS DEFINED IN AMERICAN STANDARD FORTRAN
C X3.9-1978, HAS BEEN DEVELOPED BY THE DEPARTMENT OF THE NAVY. THE
C FORTRAN COMPILER VALIDATION SYSTEM (FCVS) CONSISTS OF AUDIT
C ROUTINES, THEIR RELATED DATA, AND AN EXECUTIVE SYSTEM. EACH AUDIT
C ROUTINE IS A FORTRAN PROGRAM OR SUBPROGRAM WHICH INCLUDES TESTS
C OF SPECIFIC LANGUAGE ELEMENTS AND SUPPORTING PROCEDURES INDICATING
C THE RESULT OF EXECUTING THESE TESTS.
C
C THIS PARTICULAR PROGRAM OR SUBPROGRAM CONTAINS ONLY FEATURES
C FOUND IN THE SUBSET LEVEL OF THE STANDARD.
C
C SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO
C DEPARTMENT OF THE NAVY
C FEDERAL COBOL COMPILER TESTING SERVICE
C WASHINGTON, D.C. 20376
C
C ******************************************************************
C
C
IMPLICIT LOGICAL (L)
IMPLICIT CHARACTER*14 (C)
C
CHARACTER CVTN01*3,CVTN02*7,CVTN03*12
CHARACTER CVTN04*25,CVTN05*41,CVTN06*57
CHARACTER CVTN07*3,CVTN08*7,CVTN09*12
CHARACTER CVTN10*25,CVTN11*41,CVTN12*57
CHARACTER CATN11(6)*3,CATN12(7)*7,CATN13(3)*12
CHARACTER CATN14(2)*25,CATN15(10)*41,CATN16(4)*57
C
C
C
C INITIALIZATION SECTION.
C
C INITIALIZE CONSTANTS
C ********************
C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER
I01 = 5
C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER
I02 = 6
C SYSTEM ENVIRONMENT SECTION
C
CX010 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-010 CONTROL CARD.
C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5
C (UNIT NUMBER FOR CARD READER).
CX011 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-011 CONTROL CARD
C THE CX011 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL
C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX010 ABOVE.
C
CX020 THIS CARD IS PEPLACED BY CONTENTS OF FEXEC X-020 CONTROL CARD.
C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02 = 6
C (UNIT NUMBER FOR PRINTER).
CX021 THIS CARD IS PEPLACED BY CONTENTS OF FEXEC X-021 CONTROL CARD.
C THE CX021 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL
C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX020 ABOVE.
C
IVPASS = 0
IVFAIL = 0
IVDELE = 0
ICZERO = 0
C
C WRITE OUT PAGE HEADERS
C
WRITE (I02,90002)
WRITE (I02,90006)
WRITE (I02,90008)
WRITE (I02,90004)
WRITE (I02,90010)
WRITE (I02,90004)
WRITE (I02,90016)
WRITE (I02,90001)
WRITE (I02,90004)
WRITE (I02,90012)
WRITE (I02,90014)
WRITE (I02,90004)
C
C
C TEST 87 THROUGH TEST 92 VERIFY THE CHARACTER ASSIGNMENT
C STATEMENT
C
C CHARACTER VARIABLE = CHARACTER CONSTANT
C
C IS CORRECT. THE VARIABLE AND CONSTANT ARE THE SAME LENGTH, AND
C THE LENGTHS 3, 7, 12, 25, 41, AND 57 ARE USED IN THESE TESTS.
C
C
C **** FCVS PROGRAM 205 - TEST 087 ****
C
C
IVTNUM = 87
IF (ICZERO) 30870, 0870, 30870
0870 CONTINUE
IVCOMP = 0
CVTN01 = 'ABC'
IF (CVTN01 .EQ. 'ABC') IVCOMP = 1
IVCORR = 1
40870 IF (IVCOMP - 1) 20870, 10870, 20870
30870 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10870, 0881, 20870
10870 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0881
20870 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0881 CONTINUE
C
C **** FCVS PROGRAM 205 - TEST 088 ****
C
C
IVTNUM = 88
IF (ICZERO) 30880, 0880, 30880
0880 CONTINUE
IVCOMP = 0
IVCORR = 1
CVTN02 = 'ABCDEFG'
IF (CVTN02 .EQ. 'ABCDEFG') IVCOMP = 1
40880 IF (IVCOMP - 1) 20880, 10880, 20880
30880 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10880, 0891, 20880
10880 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0891
20880 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0891 CONTINUE
C
C **** FCVS PROGRAM 205 - TEST 089 ****
C
C
IVTNUM = 89
IF (ICZERO) 30890, 0890, 30890
0890 CONTINUE
IVCOMP = 0
IVCORR = 1
CVTN03 = 'ABCDEFGHIJKL'
IF (CVTN03 .EQ. 'ABCDEFGHIJKL') IVCOMP = 1
40890 IF (IVCOMP - 1) 20890, 10890, 20890
30890 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10890, 0901, 20890
10890 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0901
20890 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0901 CONTINUE
C
C **** FCVS PROGRAM 205 - TEST 090 ****
C
C
IVTNUM = 90
IF (ICZERO) 30900, 0900, 30900
0900 CONTINUE
IVCOMP = 0
IVCORR = 1
CVTN04 = 'ABCDEFGHIJKLMNOPQRSTUVWXY'
IF (CVTN04 .EQ. 'ABCDEFGHIJKLMNOPQRSTUVWXY') IVCOMP = 1
40900 IF (IVCOMP - 1) 20900, 10900, 20900
30900 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10900, 0911, 20900
10900 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0911
20900 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0911 CONTINUE
C
C **** FCVS PROGRAM 205 - TEST 091 ****
C
C
IVTNUM = 91
IF (ICZERO) 30910, 0910, 30910
0910 CONTINUE
IVCOMP = 0
IVCORR = 1
CVTN05 = 'ABCDEFGHIJKLMNOPQRSTUVWXYZABCDEFGHIJKLMNO'
IF (CVTN05 .EQ. 'ABCDEFGHIJKLMNOPQRSTUVWXYZABCDEFGHIJKLMNO')
1 IVCOMP = 1
40910 IF (IVCOMP - 1) 20910, 10910, 20910
30910 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10910, 0921, 20910
10910 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0921
20910 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0921 CONTINUE
C
C **** FCVS PROGRAM 205 - TEST 092 ****
C
C
IVTNUM = 92
IF (ICZERO) 30920, 0920, 30920
0920 CONTINUE
IVCOMP = 0
IVCORR = 1
CVTN06 =
1 'ABCDEFGHIJKLMNOPQRSTUVWXYZABCDEFGHIJKLMNOPQRSTUVWXYZABCDE'
IF (CVTN06 .EQ.
1 'ABCDEFGHIJKLMNOPQRSTUVWXYZABCDEFGHIJKLMNOPQRSTUVWXYZABCDE')
2 IVCOMP = 1
40920 IF (IVCOMP - 1) 20920, 10920, 20920
30920 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10920, 0931, 20920
10920 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0931
20920 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0931 CONTINUE
C
C TEST 93 THROUGH TEST 96 VERIFY THE CHARACTER ASSIGNMENT
C STATEMENTS
C
C CHARACTER VARIABLE = CHARACTER CONSTANT
C CHARACTER VARIABLE = CHARACTER VARIABLE
C
C ARE CORRECT. THE VARIABLES AND CONSTANT ARE THE SAME LENGTH,
C AND THE LENGTHS 3, 12, 25, AND 57 ARE USED IN THESE TESTS.
C
C
C **** FCVS PROGRAM 205 - TEST 093 ****
C
C
IVTNUM = 93
IF (ICZERO) 30930, 0930, 30930
0930 CONTINUE
IVCOMP = 0
IVCORR = 1
CVTN07 = ' '
CVTN01 = 'ABC'
CVTN07 = CVTN01
IF (CVTN07 .EQ. 'ABC') IVCOMP = 1
40930 IF (IVCOMP - 1) 20930, 10930, 20930
30930 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10930, 0941, 20930
10930 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0941
20930 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0941 CONTINUE
C
C **** FCVS PROGRAM 205 - TEST 094 ****
C
C
IVTNUM = 94
IF (ICZERO) 30940, 0940, 30940
0940 CONTINUE
IVCOMP = 0
IVCORR = 1
CVTN03 = 'ABCDEFGHIJKL'
CVTN09 = ' '
CVTN09 = CVTN03
IF (CVTN09 .EQ. 'ABCDEFGHIJKL') IVCOMP = 1
40940 IF (IVCOMP - 1) 20940, 10940, 20940
30940 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10940, 0951, 20940
10940 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0951
20940 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0951 CONTINUE
C
C **** FCVS PROGRAM 205 - TEST 095 ****
C
C
IVTNUM = 95
IF (ICZERO) 30950, 0950, 30950
0950 CONTINUE
IVCOMP = 0
IVCORR = 1
CVTN04 = 'ABCDEFGHIJKLMNOPQRSTUVWXY'
CVTN10 = ' '
CVTN10 = CVTN04
IF (CVTN10 .EQ. 'ABCDEFGHIJKLMNOPQRSTUVWXY') IVCOMP = 1
40950 IF (IVCOMP - 1) 20950, 10950, 20950
30950 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10950, 0961, 20950
10950 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0961
20950 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0961 CONTINUE
C
C **** FCVS PROGRAM 205 - TEST 096 ****
C
C
IVTNUM = 96
IF (ICZERO) 30960, 0960, 30960
0960 CONTINUE
IVCOMP = 0
IVCORR = 1
CVTN12 = ' '
CVTN06 =
1 'ABCDEFGHIJKLMNOPQRSTUVWXYZABCDEFGHIJKLMNOPQRSTUVWXYZABCDE'
CVTN12 = CVTN06
IF (CVTN12 .EQ.
1 'ABCDEFGHIJKLMNOPQRSTUVWXYZABCDEFGHIJKLMNOPQRSTUVWXYZABCDE')
2 IVCOMP = 1
40960 IF (IVCOMP - 1) 20960, 10960, 20960
30960 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10960, 0971, 20960
10960 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0971
20960 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0971 CONTINUE
C
C TEST 97 AND TEST 98 VERIFY THE CHARACTER ASSIGNMENT
C STATEMENT
C
C CHARACTER ARRAY ELEMENT = CHARACTER CONSTANT
C
C IS CORRECT. THE ARRAY ELEMENT AND CONSTANT ARE THE SAME LENGTH,
C AND THE LENGTHS 25 AND 41 ARE USED IN THESE TESTS.
C
C
C **** FCVS PROGRAM 205 - TEST 097 ****
C
C
IVTNUM = 97
IF (ICZERO) 30970, 0970, 30970
0970 CONTINUE
IVCOMP = 0
IVCORR = 1
CATN14(1) = 'ABCDEFGHIJKLMNOPQRSTUVWXY'
IF (CATN14(1) .EQ. 'ABCDEFGHIJKLMNOPQRSTUVWXY') IVCOMP = 1
40970 IF (IVCOMP - 1) 20970, 10970, 20970
30970 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10970, 0981, 20970
10970 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0981
20970 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0981 CONTINUE
C
C **** FCVS PROGRAM 205 - TEST 098 ****
C
C
IVTNUM = 98
IF (ICZERO) 30980, 0980, 30980
0980 CONTINUE
IVCOMP = 0
IVCORR = 1
CATN15(8) = 'ABCDEFGHIJKLMNOPQRSTUVWXYZABCDEFGHIJKLMNO'
IF (CATN15(8) .EQ.
1 'ABCDEFGHIJKLMNOPQRSTUVWXYZABCDEFGHIJKLMNO') IVCOMP = 1
40980 IF (IVCOMP - 1) 20980, 10980, 20980
30980 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10980, 0991, 20980
10980 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0991
20980 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0991 CONTINUE
C
C TEST 99 AND TEST 100 VERIFY THE CHARACTER ASSIGNMENT
C STATEMENTS
C
C CHARACTER VARIABLE = CHARACTER CONSTANT
C CHARACTER ARRAY ELEMENT = CHARACTER VARIABLE
C
C ARE CORRECT. THE CHARACTER ENTITIES ARE THE SAME LENGTH,
C AND THE LENGTHS 3 AND 57 ARE USED IN THESE TESTS.
C
C
C **** FCVS PROGRAM 205 - TEST 099 ****
C
C
IVTNUM = 99
IF (ICZERO) 30990, 0990, 30990
0990 CONTINUE
IVCOMP = 0
IVCORR = 1
CVTN01 = 'ABC'
CATN11(5) = CVTN01
IF (CATN11(5) .EQ. 'ABC') IVCOMP = 1
40990 IF (IVCOMP - 1) 20990, 10990, 20990
30990 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10990, 1001, 20990
10990 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 1001
20990 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
1001 CONTINUE
C
C **** FCVS PROGRAM 205 - TEST 100 ****
C
C
IVTNUM = 100
IF (ICZERO) 31000, 1000, 31000
1000 CONTINUE
IVCOMP = 0
IVCORR = 1
CVTN06 =
1 'ABCDEFGHIJKLMNOPQRSTUVWXYZABCDEFGHIJKLMNOPQRSTUVWXYZABCDE'
CATN16(3) = CVTN06
IF (CATN16(3) .EQ.
1 'ABCDEFGHIJKLMNOPQRSTUVWXYZABCDEFGHIJKLMNOPQRSTUVWXYZABCDE')
2 IVCOMP = 1
41000 IF (IVCOMP - 1) 21000, 11000, 21000
31000 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 11000, 1011, 21000
11000 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 1011
21000 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
1011 CONTINUE
C
C TEST 101 AND TEST 102 VERIFY THE CHARACTER ASSIGNMENT
C STATEMENTS
C
C CHARACTER ARRAY ELEMENT = CHARACTER CONSTANT
C CHARACTER ARRAY ELEMENT = CHARACTER ARRAY ELEMENT
C
C ARE CORRECT. THE CHARACTER ENTITIES ARE THE SAME LENGTH, AND
C THE LENGTHS 7 AND 41 ARE USED IN THESE TESTS.
C
C
C **** FCVS PROGRAM 205 - TEST 101 ****
C
C
IVTNUM = 101
IF (ICZERO) 31010, 1010, 31010
1010 CONTINUE
IVCOMP = 0
IVCORR = 1
CATN12(3) = 'ABCDEFG'
CATN12(4) = CATN12(3)
IF (CATN12(4) .EQ. 'ABCDEFG') IVCOMP = 1
41010 IF (IVCOMP - 1) 21010, 11010, 21010
31010 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 11010, 1021, 21010
11010 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 1021
21010 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
1021 CONTINUE
C
C **** FCVS PROGRAM 205 - TEST 102 ****
C
C
IVTNUM = 102
IF (ICZERO) 31020, 1020, 31020
1020 CONTINUE
IVCOMP = 0
IVCORR = 1
CATN15(3) = 'ABCDEFGHIJKLMNOPQRSTUVWXYZABCDEFGHIJKLMNO'
CATN15(4) = CATN15(3)
IF (CATN15(4) .EQ.
1 'ABCDEFGHIJKLMNOPQRSTUVWXYZABCDEFGHIJKLMNO') IVCOMP = 1
41020 IF (IVCOMP - 1) 21020, 11020, 21020
31020 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 11020, 1031, 21020
11020 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 1031
21020 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
1031 CONTINUE
C
C TEST 103 AND TEST 104 VERIFY THE CHARACTER ASSIGNMENT
C STATEMENTS
C
C CHARACTER ARRAY ELEMENT = CHARACTER CONSTANT
C CHARACTER VARIABLE = CHARACTER ARRAY ELEMENT
C
C ARE CORRECT. THE CHARACTER ENTITIES ARE THE SAME LENGTH, AND
C THE LENGTHS 12 AND 25 ARE USED.
C
C
C **** FCVS PROGRAM 205 - TEST 103 ****
C
C
IVTNUM = 103
IF (ICZERO) 31030, 1030, 31030
1030 CONTINUE
IVCOMP = 0
IVCORR = 1
CATN13(1) = 'ABCDEFGHIJKL'
CVTN09 = ' '
CVTN09 = CATN13(1)
IF (CVTN09 .EQ. 'ABCDEFGHIJKL') IVCOMP = 1
41030 IF (IVCOMP - 1) 21030, 11030, 21030
31030 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 11030, 1041, 21030
11030 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 1041
21030 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
1041 CONTINUE
C
C **** FCVS PROGRAM 205 - TEST 104 ****
C
C
IVTNUM = 104
IF (ICZERO) 31040, 1040, 31040
1040 CONTINUE
IVCOMP = 0
IVCORR = 1
CATN14(1) = 'ABCDEFGHIJKLMNOPQRSTUVWXY'
CVTN10 = ' '
CVTN10 = CATN14(1)
IF (CVTN10 .EQ. 'ABCDEFGHIJKLMNOPQRSTUVWXY') IVCOMP = 1
41040 IF (IVCOMP - 1) 21040, 11040, 21040
31040 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 11040, 1051, 21040
11040 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 1051
21040 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
1051 CONTINUE
C
C TEST 105 THROUGH TEST 110 VERIFY THE CHARACTER RELATIONAL
C EXPRESSION USING EACH OF THE SIX RELATIONAL OPERATORS IN THE
C STATEMENT FORM
C
C CHARACTER VARIABLE RELOP CHARACTER CONSTANT
C
C THE CHARACTER ENTITIES ARE THE SAME LENGTH, AND THE LENGTHS
C 3, 7, 12, 25, 41, AND 57 ARE USED IN THESE TESTS.
C
C
C **** FCVS PROGRAM 205 - TEST 105 ****
C
C
IVTNUM = 105
IF (ICZERO) 31050, 1050, 31050
1050 CONTINUE
IVCOMP = 0
IVCORR = 1
CVTN07 = 'ZAB'
IF (CVTN07 .EQ. 'ZAB') IVCOMP = 1
41050 IF (IVCOMP - 1) 21050, 11050, 21050
31050 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 11050, 1061, 21050
11050 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 1061
21050 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
1061 CONTINUE
C
C **** FCVS PROGRAM 205 - TEST 106 ****
C
C
IVTNUM = 106
IF (ICZERO) 31060, 1060, 31060
1060 CONTINUE
IVCOMP = 0
IVCORR = 1
CVTN08 = 'ABDDEEF'
IF (CVTN08 .GT. 'ABCDEEF') IVCOMP = 1
41060 IF (IVCOMP - 1) 21060, 11060, 21060
31060 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 11060, 1071, 21060
11060 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 1071
21060 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
1071 CONTINUE
C
C **** FCVS PROGRAM 205 - TEST 107 ****
C
C
IVTNUM = 107
IF (ICZERO) 31070, 1070, 31070
1070 CONTINUE
IVCOMP = 0
IVCORR = 1
CVTN09 = 'ZXYZZZABCDEF'
IF (CVTN09 .LT. 'ZXYZZZACCDEF') IVCOMP = 1
41070 IF (IVCOMP - 1) 21070, 11070, 21070
31070 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 11070, 1081, 21070
11070 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 1081
21070 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
1081 CONTINUE
C
C **** FCVS PROGRAM 205 - TEST 108 ****
C
C
IVTNUM = 108
IF (ICZERO) 31080, 1080, 31080
1080 CONTINUE
IVCOMP = 0
IVCORR = 1
CVTN10 = 'ABCDEFGHIJKKMNOPQRSTUVWXY'
IF ('ABCDEFGHIJKLMNOPQRSTUVWXY' .NE. CVTN10) IVCOMP = 1
41080 IF (IVCOMP - 1) 21080, 11080, 21080
31080 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 11080, 1091, 21080
11080 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 1091
21080 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
1091 CONTINUE
C
C **** FCVS PROGRAM 205 - TEST 109 ****
C
C
IVTNUM = 109
IF (ICZERO) 31090, 1090, 31090
1090 CONTINUE
IVCOMP = 0
IVCORR = 1
CVTN11 = 'ABCDEFGHIJKLMNOPQRSTUVWXYZAABCDEFGHIJKLMN'
IF ('ABCDEFGHIJKLMNOPQRSTUVWXYZABBCDEFGHIJKLMN' .GE. CVTN11)
1 IVCOMP = 1
41090 IF (IVCOMP - 1) 21090, 11090, 21090
31090 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 11090, 1101, 21090
11090 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 1101
21090 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
1101 CONTINUE
C
C **** FCVS PROGRAM 205 - TEST 110 ****
C
C
IVTNUM = 110
IF (ICZERO) 31100, 1100, 31100
1100 CONTINUE
IVCOMP = 0
IVCORR = 1
CVTN12 =
1 'ABCDEFGHIJKLMNOPQRSTUVWXYZABCDEFGHIJKLMNOPQRSTUVWXYZAAAAA'
IF ('ABCDEFGHIJKLMNOPQRSTUVWXYZABCDEFGHIJKLMNOPQRSTUVWXYAAAAAA'
1 .LE. CVTN12) IVCOMP = 1
41100 IF (IVCOMP - 1) 21100, 11100, 21100
31100 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 11100, 1111, 21100
11100 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 1111
21100 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
1111 CONTINUE
C
C TEST 111 AND TEST 112 VERIFY THE CHARACTER RELATIONAL
C EXPRESSION OF THE FORM
C
C CHARACTER VARIABLE RELOP CHARACTER VARIABLE
C
C THE CHARACTER ENTITIES ARE THE SAME LENGTH, AND THE LENGTHS 3
C AND 41 ARE USED IN THESE TESTS.
C
C
C **** FCVS PROGRAM 205 - TEST 111 ****
C
C
IVTNUM = 111
IF (ICZERO) 31110, 1110, 31110
1110 CONTINUE
IVCOMP = 1
IVCORR = 3
CVTN01 = 'ABC'
CVTN07 = 'BBC'
IF (CVTN01 .EQ. CVTN07) IVCOMP = IVCOMP * 2
IF (CVTN01 .NE. CVTN07) IVCOMP = IVCOMP * 3
41110 IF (IVCOMP - 3) 21110, 11110, 21110
31110 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 11110, 1121, 21110
11110 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 1121
21110 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
1121 CONTINUE
C
C **** FCVS PROGRAM 205 - TEST 112 ****
C
C
IVTNUM = 112
IF (ICZERO) 31120, 1120, 31120
1120 CONTINUE
IVCOMP = 1
IVCORR = 6
CVTN05 = 'ABCDEFGHIJKLMNOPQRSTUVWXYZABCDEFGHIJKLMNO'
CVTN11 = 'ABCDEFGHIJKLMNOPQRSTUVWXYZABCDEFGHIJKLMNO'
IF (CVTN05 .GE. CVTN11) IVCOMP = IVCOMP * 2
IF (CVTN05 .LE. CVTN11) IVCOMP = IVCOMP * 3
41120 IF (IVCOMP - 6) 21120, 11120, 21120
31120 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 11120, 1131, 21120
11120 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 1131
21120 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
1131 CONTINUE
C
C TEST 113 AND TEST 114 VERIFY THE CHARACTER RELATIONAL
C EXPRESSION OF THE FORM
C
C CHARACTER ARRAY ELEMENT RELOP CHARACTER CONSTANT
C
C THE CHARACTER ENTITIES ARE THE SAME LENGTH, AND THE LENGTHS 7 AND
C 25 ARE USED IN THESE TESTS.
C
C
C **** FCVS PROGRAM 205 - TEST 113 ****
C
C
IVTNUM = 113
IF (ICZERO) 31130, 1130, 31130
1130 CONTINUE
IVCOMP = 1
IVCORR = 6
CATN12(3) = 'AB012CD'
IF (CATN12(3) .LT. 'AB013CD') IVCOMP = IVCOMP * 2
IF ('AB013CD' .GT. CATN12(3)) IVCOMP = IVCOMP * 3
41130 IF (IVCOMP - 6) 21130, 11130, 21130
31130 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 11130, 1141, 21130
11130 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 1141
21130 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
1141 CONTINUE
C
C **** FCVS PROGRAM 205 - TEST 114 ****
C
C
IVTNUM = 114
IF (ICZERO) 31140, 1140, 31140
1140 CONTINUE
IVCOMP = 1
IVCORR = 2
CATN14(1) = 'ABCDEFGHIJKLMNOPQRSTUVWXX'
IF (CATN14(1) .NE. 'ABCDEFGHIJKLMNOPQRSTUVWXY')
1 IVCOMP = IVCOMP * 2
IF (CATN14(1) .EQ. 'ABCDEFGHIJKLMNOPQRSTUVWXY')
1 IVCOMP = IVCOMP * 3
41140 IF (IVCOMP - 2) 21140, 11140, 21140
31140 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 11140, 1151, 21140
11140 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 1151
21140 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
1151 CONTINUE
C
C **** FCVS PROGRAM 205 - TEST 115 ****
C
C TEST 115 VERIFIES THE CHARACTER RELATIONAL EXPRESSION
C OF THE FORM
C
C CHARACTER ARRAY ELEMENT RELOP CHARACTER VARIABLE
C
C THE CHARACTER ENTITIES ARE 12 CHARACTERS IN LENGTH.
C
IVTNUM = 115
IF (ICZERO) 31150, 1150, 31150
1150 CONTINUE
IVCOMP = 1
IVCORR = 2
CATN13(3) = 'ABC+AAB/CDDF'
IF (CATN13(3) .LT. 'BBC+AAB/CCCC') IVCOMP = IVCOMP * 2
IF (CATN13(3) .GT. 'BBC+AAB/CCCC') IVCOMP = IVCOMP * 3
41150 IF (IVCOMP - 2) 21150, 11150, 21150
31150 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 11150, 1161, 21150
11150 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 1161
21150 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
1161 CONTINUE
C
C **** FCVS PROGRAM 205 - TEST 116 ****
C
C TEST 116 VERIFIES THE CHARACTER RELATIONAL EXPRESSION
C OF THE FORM
C
C CHARACTER ARRAY ELEMENT RELOP CHARACTER ARRAY ELEMENT
C
C THE CHARACTER ENTITIES ARE 57 CHARACTERS IN LENGTH.
C
IVTNUM = 116
IF (ICZERO) 31160, 1160, 31160
1160 CONTINUE
IVCOMP = 1
IVCORR = 30
CATN16(1) =
1 'ABCDEFGHIJKLMNOPQRSTUVWXYZABCDEFGHIJKLMNOPQRSTUVWXYZ//012'
CATN16(2) =
1 'ABCDEFGHIJKLMNOPQRSTUVWXYZABCDEFGHIJKLMNOPQRSTUVWXYZ//112'
IF (CATN16 (1) .LT. CATN16 (2)) IVCOMP = IVCOMP * 2
IF (CATN16 (1) .NE. CATN16 (2)) IVCOMP = IVCOMP * 3
IF (CATN16 (1) .LE. CATN16 (2)) IVCOMP = IVCOMP * 5
41160 IF (IVCOMP - 30) 21160, 11160, 21160
31160 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 11160, 1171, 21160
11160 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 1171
21160 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
1171 CONTINUE
C
C
C WRITE OUT TEST SUMMARY
C
WRITE (I02,90004)
WRITE (I02,90014)
WRITE (I02,90004)
WRITE (I02,90000)
WRITE (I02,90004)
WRITE (I02,90020) IVFAIL
WRITE (I02,90022) IVPASS
WRITE (I02,90024) IVDELE
STOP
90001 FORMAT (1H ,24X,5HFM205)
90000 FORMAT (1H ,20X,20HEND OF PROGRAM FM205)
C
C FORMATS FOR TEST DETAIL LINES
C
80000 FORMAT (1H ,4X,I5,6X,7HDELETED)
80002 FORMAT (1H ,4X,I5,7X,4HPASS)
80010 FORMAT (1H ,4X,I5,7X,4HFAIL,10X,I6,9X,I6)
80012 FORMAT (1H ,4X,I5,7X,4HFAIL,4X,E12.5,3X,E12.5)
80018 FORMAT (1H ,4X,I5,7X,4HFAIL,2X,A14,1X,A14)
C
C FORMAT STATEMENTS FOR PAGE HEADERS
C
90002 FORMAT (1H1)
90004 FORMAT (1H )
90006 FORMAT (1H ,10X,34HFORTRAN COMPILER VALIDATION SYSTEM)
90008 FORMAT (1H ,21X,11HVERSION 1.0)
90010 FORMAT (1H ,8X,38HFOR OFFICIAL USE ONLY - COPYRIGHT 1978)
90012 FORMAT (1H ,5X,4HTEST,5X,9HPASS/FAIL,5X,8HCOMPUTED,8X,7HCORRECT)
90014 FORMAT (1H ,5X,46H----------------------------------------------)
90016 FORMAT (1H ,18X,17HSUBSET LEVEL TEST)
C
C FORMAT STATEMENTS FOR RUN SUMMARY
C
90020 FORMAT (1H ,19X,I5,13H TESTS FAILED)
90022 FORMAT (1H ,19X,I5,13H TESTS PASSED)
90024 FORMAT (1H ,19X,I5,14H TESTS DELETED)
END
*END-OF,FM205
FM251.f 480976125 170 2 100666 16469 `
*HEADER,FORTR,FM251
*FILES1,FORTR,FM251,X
PROGRAM FM251
C
C
C
C THIS ROUTINE TESTS THE IMPLICIT STATEMENT FOR DECLARING
C VARIABLES AS TYPE LOGICAL. THE TYPE OF A VARIABLE ( LOGICAL,
C INTEGER, OR REAL ) IS SET BY BOTH IMPLICIT STATEMENTS AND ALSO
C BY EXPLICIT TYPE STATEMENTS. TESTS ARE MADE TO CHECK THAT
C EXPLICIT TYPE STATEMENTS OVERIDE THE TYPE SET BY AN IMPLICIT
C STATEMENT FOR THE VARIABLES LISTED.
C
C REFERENCES
C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN,
C X3.9-1977
C SECTION 4.7, LOGICAL TYPE
C SECTION 8.4.1, LOGICAL TYPE STAEMENT
C SECTION 8.5, IMPLICIT STATEMENT
C SECTION 11.5, LOGICAL IF STATEMENT
C
C
C FM016 - TESTS LOGICAL TYPE STATEMENTS WITH VARIOUS FORMS OF
C LOGICAL CONSTANTS AND VARIABLES.
C
C
C
C
C ******************************************************************
C A COMPILER VALIDATION SYSTEM FOR THE FORTRAN LANGUAGE
C BASED ON SPECIFICATIONS AS DEFINED IN AMERICAN STANDARD FORTRAN
C X3.9-1978, HAS BEEN DEVELOPED BY THE DEPARTMENT OF THE NAVY. THE
C FORTRAN COMPILER VALIDATION SYSTEM (FCVS) CONSISTS OF AUDIT
C ROUTINES, THEIR RELATED DATA, AND AN EXECUTIVE SYSTEM. EACH AUDIT
C ROUTINE IS A FORTRAN PROGRAM OR SUBPROGRAM WHICH INCLUDES TESTS
C OF SPECIFIC LANGUAGE ELEMENTS AND SUPPORTING PROCEDURES INDICATING
C THE RESULT OF EXECUTING THESE TESTS.
C
C THIS PARTICULAR PROGRAM OR SUBPROGRAM CONTAINS ONLY FEATURES
C FOUND IN THE SUBSET LEVEL OF THE STANDARD.
C
C SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO
C DEPARTMENT OF THE NAVY
C FEDERAL COBOL COMPILER TESTING SERVICE
C WASHINGTON, D.C. 20376
C
C ******************************************************************
C
C
IMPLICIT LOGICAL (L)
IMPLICIT CHARACTER*14 (C)
C
IMPLICIT LOGICAL (M,N)
IMPLICIT LOGICAL ( E-H, O, P-Q, S-T, X-Y ), INTEGER ( U-W )
IMPLICIT INTEGER (A, B), REAL (I, J)
INTEGER IVCOMP, IVPASS, IVCORR, IVTNUM, IVDELE, IVFAIL, I01, I02
INTEGER ICZERO
INTEGER MVTN01
REAL NVTN01
LOGICAL MVTN02, NVTN02, MATN21(3,3)
LOGICAL AVTN01
LOGICAL IVTN01
C
C
C
C INITIALIZATION SECTION.
C
C INITIALIZE CONSTANTS
C ********************
C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER
I01 = 5
C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER
I02 = 6
C SYSTEM ENVIRONMENT SECTION
C
CX010 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-010 CONTROL CARD.
C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5
C (UNIT NUMBER FOR CARD READER).
CX011 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-011 CONTROL CARD
C THE CX011 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL
C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX010 ABOVE.
C
CX020 THIS CARD IS PEPLACED BY CONTENTS OF FEXEC X-020 CONTROL CARD.
C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02 = 6
C (UNIT NUMBER FOR PRINTER).
CX021 THIS CARD IS PEPLACED BY CONTENTS OF FEXEC X-021 CONTROL CARD.
C THE CX021 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL
C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX020 ABOVE.
C
IVPASS = 0
IVFAIL = 0
IVDELE = 0
ICZERO = 0
C
C WRITE OUT PAGE HEADERS
C
WRITE (I02,90002)
WRITE (I02,90006)
WRITE (I02,90008)
WRITE (I02,90004)
WRITE (I02,90010)
WRITE (I02,90004)
WRITE (I02,90016)
WRITE (I02,90001)
WRITE (I02,90004)
WRITE (I02,90012)
WRITE (I02,90014)
WRITE (I02,90004)
C
C
C **** FCVS PROGRAM 251 - TEST 001 ****
C
C TEST 001 ASSIGNS A LOGICAL VALUE OF .TRUE. TO MVIN01 WHICH WAS
C SPECIFIED AS TYPE LOGICAL IN AN IMPLICIT STATEMENT.
C IMPLICIT LOGICAL (M,N)
C
IVTNUM = 1
IF (ICZERO) 30010, 0010, 30010
0010 CONTINUE
IVCOMP = 0
MVIN01 = .TRUE.
IF ( MVIN01 ) IVCOMP = 1
IVCORR = 1
40010 IF ( IVCOMP - 1 ) 20010, 10010, 20010
30010 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10010, 0021, 20010
10010 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0021
20010 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0021 CONTINUE
C
C **** FCVS PROGRAM 251 - TEST 002 ****
C
C TEST 002 ASSIGNS A LOGICAL VALUE OF .FALSE. TO NVIN01 WHICH
C WAS SPECIFIED AS TYPE LOGICAL IN AN IMPLICIT STATEMENT.
C IMPLICIT LOGICAL (M,N)
C
IVTNUM = 2
IF (ICZERO) 30020, 0020, 30020
0020 CONTINUE
IVCOMP = 1
LCON01 = .FALSE.
NVIN01 = LCON01
IF ( NVIN01 ) IVCOMP = 0
IVCORR = 1
40020 IF ( IVCOMP - 1 ) 20020, 10020, 20020
30020 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10020, 0031, 20020
10020 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0031
20020 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0031 CONTINUE
C
C **** FCVS PROGRAM 251 - TEST 003 ****
C
C TEST 003 ASSIGNS AN INTEGER VALUE OF 4 TO MVTN01 WHICH
C WAS SPECIFIED AS TYPE INTEGER EXPLICITLY IN A TYPE STATEMENT.
C INTEGER MVTN01
C THIS TEST IS TO DETERMINE WHETHER AN EXPLICIT INTEGER TYPE
C STATEMENT CAN OVERRIDE THE IMPLICIT STATEMENT WHICH WOULD
C SET THE TYPE AS LOGICAL.
C IMPLICIT LOGICAL (M,N)
C
IVTNUM = 3
IF (ICZERO) 30030, 0030, 30030
0030 CONTINUE
RVCOMP = 10.0
MVTN01 = 4
RVCOMP = MVTN01/5
RVCORR = 0.0
40030 IF ( RVCOMP ) 20030, 10030, 20030
30030 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10030, 0041, 20030
10030 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0041
20030 IVFAIL = IVFAIL + 1
WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR
0041 CONTINUE
C
C **** FCVS PROGRAM 251 - TEST 004 ****
C
C TEST 004 ASSIGNS A REAL VALUE OF 4.0 TO NVTN01 WHICH
C WAS SPECIFIED AS TYPE REAL EXPLICITLY IN A TYPE STATEMENT.
C REAL NVTN01
C THIS TEST IS TO DETERMINE WHETHER AN EXPLICIT REAL TYPE
C STATEMENT CAN OVERRIDE THE IMPLICIT STATEMENT WHICH WOULD
C SET THE TYPE AS LOGICAL.
C IMPLICIT LOGICAL (M,N)
C
IVTNUM = 4
IF (ICZERO) 30040, 0040, 30040
0040 CONTINUE
RVCOMP = 10.0
NVTN01 = 4.0
RVCOMP = NVTN01/5
RVCORR = 0.8
40040 IF ( RVCOMP - 0.79995 ) 20040, 10040, 40041
40041 IF ( RVCOMP - 0.80005 ) 10040, 10040, 20040
30040 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10040, 0051, 20040
10040 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0051
20040 IVFAIL = IVFAIL + 1
WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR
0051 CONTINUE
C
C **** FCVS PROGRAM 251 - TEST 005 ****
C
C TEST 005 ASSIGNS A LOGICAL VALUE OF .TRUE. TO MVTN02 WHICH WAS
C SPECIFIED AS TYPE LOGICAL IN AN EXPLICIT TYPE STATEMENT AFTER ALSO
C HAVING ITS FIRST LETTER M SPECIFIED AS TYPE LOGICAL IN AN
C IMPLICIT STATEMENT.
C IMPLICIT LOGICAL (M,N)
C LOGICAL MVTN02
C
IVTNUM = 5
IF (ICZERO) 30050, 0050, 30050
0050 CONTINUE
IVCOMP = 0
LCON02 = .TRUE.
MVTN02 = LCON02
IF ( MVTN02 ) IVCOMP = 1
IVCORR = 1
40050 IF ( IVCOMP - 1 ) 20050, 10050, 20050
30050 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10050, 0061, 20050
10050 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0061
20050 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0061 CONTINUE
C
C **** FCVS PROGRAM 251 - TEST 006 ****
C
C TEST 006 ASSIGNS A LOGICAL VALUE OF .FALSE. TO NVTN02 WHICH WAS
C SPECIFIED AS TYPE LOGICAL IN AN EXPLICIT TYPE STATEMENT AFTER ALSO
C HAVING ITS FIRST LETTER N SPECIFIED AS TYPE LOGICAL IN AN
C IMPLICIT STATEMENT.
C IMPLICIT LOGICAL (M,N)
C LOGICAL NVTN02
C
IVTNUM = 6
IF (ICZERO) 30060, 0060, 30060
0060 CONTINUE
IVCOMP = 1
NVTN02 = .FALSE.
IF ( NVTN02 ) IVCOMP = 0
IVCORR = 1
40060 IF ( IVCOMP - 1 ) 20060, 10060, 20060
30060 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10060, 0071, 20060
10060 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0071
20060 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0071 CONTINUE
C
C **** FCVS PROGRAM 251 - TEST 007 ****
C
C TEST 007 ASSIGNS A LOGICAL VALUE OF .TRUE. TO THE ARRAY ELEMENT
C MATN21(1,1) WHICH WAS SPECIFIED AS TYPE LOGICAL IN AN EXPLICIT
C TYPE STATEMENT AFTER ALSO HAVING ITS FIRST LETTER M SPECIFIED AS
C TYPE LOGICAL IN AN IMPLICIT STATEMENT.
C IMPLICIT LOGICAL (M,N)
C LOGICAL MATN21(3,3)
C
IVTNUM = 7
IF (ICZERO) 30070, 0070, 30070
0070 CONTINUE
IVCOMP = 0
MATN21(1,1) = .TRUE.
IF ( MATN21(1,1) ) IVCOMP = 1
IVCORR = 1
40070 IF ( IVCOMP - 1 ) 20070, 10070, 20070
30070 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10070, 0081, 20070
10070 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0081
20070 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0081 CONTINUE
C
C **** FCVS PROGRAM 251 - TEST 008 ****
C
C TEST 008 ASSIGNS AN INTEGER VALUE OF 4 TO AVIN01 WHICH WAS
C SPECIFIED AS TYPE INTEGER IN AN IMPLICIT STATEMENT.
C IMPLICIT INTEGER (A,B)
C
IVTNUM = 8
IF (ICZERO) 30080, 0080, 30080
0080 CONTINUE
RVCOMP = 10.0
AVIN01 = 4
RVCOMP = AVIN01/5
RVCORR = 0.0
40080 IF ( RVCOMP ) 20080, 10080, 20080
30080 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10080, 0091, 20080
10080 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0091
20080 IVFAIL = IVFAIL + 1
WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR
0091 CONTINUE
C
C **** FCVS PROGRAM 251 - TEST 009 ****
C
C TEST 009 ASSIGNS A LOGICAL VALUE OF .TRUE. TO AVTN01 WHICH WAS
C SPECIFIED AS TYPE LOGICAL EXPLICITLY IN A TYPE STATEMENT.
C LOGICAL AVTN01
C THIS TEST IS TO DETERMINE WHETHER AN EXPLICIT LOGICAL TYPE
C STATEMENT CAN OVERRIDE THE IMPLICIT STATEMENT WHICH WOULD
C SET THE TYPE AS INTEGER.
C IMPLICIT INTEGER (A,B)
C
IVTNUM = 9
IF (ICZERO) 30090, 0090, 30090
0090 CONTINUE
IVCOMP = 0
AVTN01 = .TRUE.
IF ( AVTN01 ) IVCOMP = 1
IVCORR = 1
40090 IF ( IVCOMP - 1 ) 20090, 10090, 20090
30090 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10090, 0101, 20090
10090 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0101
20090 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0101 CONTINUE
C
C **** FCVS PROGRAM 251 - TEST 010 ****
C
C TEST 010 ASSIGNS A REAL VALUE OF 4.0 TO IVIN01 WHICH WAS
C SPECIFIED AS REAL IMPLICITLY IN AN IMPLICIT STATEMENT.
C IMPLICIT REAL (I,J)
C
IVTNUM = 10
IF (ICZERO) 30100, 0100, 30100
0100 CONTINUE
RVCOMP = 10.0
IVIN01 = 4.0
RVCOMP = IVIN01/5
RVCORR = 0.8
40100 IF ( RVCOMP - 0.79995 ) 20100, 10100, 40101
40101 IF ( RVCOMP - 0.80005 ) 10100, 10100, 20100
30100 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10100, 0111, 20100
10100 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0111
20100 IVFAIL = IVFAIL + 1
WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR
0111 CONTINUE
C
C **** FCVS PROGRAM 251 - TEST 011 ****
C
C TEST 011 ASSIGNS A LOGICAL VALUE OF .FALSE. TO IVTN01 WHICH WAS
C SPECIFIED AS TYPE LOGICAL IN AN EXPLICIT TYPE STATEMENT.
C LOGICAL IVTN01
C THIS TEST IS TO DETERMINE WHETHER AN EXPLICIT TYPE STATEMENT
C CAN OVERRIDE THE IMPLICIT STATEMENT WHICH WOULD SET THE TYPE
C AS REAL.
C IMPLICIT REAL (I,J)
C
IVTNUM = 11
IF (ICZERO) 30110, 0110, 30110
0110 CONTINUE
IVCOMP = 1
IVTN01 = .FALSE.
IF ( IVTN01 ) IVCOMP = 0
IVCORR = 1
40110 IF ( IVCOMP - 1 ) 20110, 10110, 20110
30110 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10110, 0121, 20110
10110 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0121
20110 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0121 CONTINUE
C
C
C THE NEXT TWO TESTS CHECK THE RANGE OF LETTERS THAT
C ARE SET BY THE IMPLICIT STATEMENT AS FOLLOWS -
C IMPLICIT LOGICAL ( E-H, O, P-Q, S-T, X-Y ), INTEGER ( U-W )
C
C
C
C **** FCVS PROGRAM 251 - TEST 012 ****
C
C TEST 012 ASSIGNS A LOGICAL VALUE OF .TRUE. TO A SERIES OF
C VARIABLES THAT BEGIN WITH THE FOLLOWING LETTERS -
C
C E F G H O P Q S T X Y
C
C VARIABLES THAT BEGIN WITH THESE LETTERS SHOULD BE IMPLICITLY TYPED
C LOGICAL BECAUSE OF THE IMPLICIT STATEMENT USING BOTH THE RANGE AND
C SINGLE LETTER SPECIFICATION FOR TYPE LOGICAL. THE VARIABLE XVIN01
C IS FIRST USED IN A LOGICAL IF STATEMENT. THE TRUE BRANCH SHOULD
C BE TAKEN TO SET IVCOMP = 1. THEN EACH OF THE VARIABLES SET TO
C .TRUE. ARE USED IN A SECOND LOGICAL IF STATEMENT WHICH IS ONE
C LARGE LOGICAL CONJUNCTION ( VARIABLE .AND. VARIABLE .AND. ... ).
C THE TRUE BRANCH SHOULD BE TAKEN TO INCREMENT THE VALUE OF IVCOMP
C TO A FINAL VALUE OF THREE (3).
C
C
IVTNUM = 12
IF (ICZERO) 30120, 0120, 30120
0120 CONTINUE
IVCOMP = 0
IVCORR = 3
EVIN01 = .TRUE.
FVIN01 = .TRUE.
GVIN01 = .TRUE.
HVIN01 = .TRUE.
OVIN01 = .TRUE.
PVIN01 = .TRUE.
QVIN01 = .TRUE.
SVIN01 = .TRUE.
TVIN01 = .TRUE.
XVIN01 = .TRUE.
YVIN01 = .TRUE.
IF ( XVIN01 ) IVCOMP = 1
IF ( EVIN01 .AND. FVIN01 .AND. GVIN01 .AND. HVIN01 .AND. OVIN01
1.AND. PVIN01 .AND. QVIN01 .AND. SVIN01 .AND. TVIN01 .AND. XVIN01
2.AND. YVIN01 ) IVCOMP = IVCOMP + 2
40120 IF ( IVCOMP - 3 ) 20120, 10120, 20120
30120 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10120, 0131, 20120
10120 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0131
20120 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0131 CONTINUE
C
C **** FCVS PROGRAM 251 - TEST 013 ****
C
C TEST 013 ASSIGNS AN INTEGER VALUE OF 4 TO VVIN01 WHICH
C WAS SPECIFIED AS TYPE INTEGER IMPLICITLY USING THE RANGE OF
C LETTERS U-W IN THE IMPLICIT INTEGER SPECIFICATION STATEMENT.
C DIVISION IS USED TO DETERMINE WHETHER VVIN01 IS TYPE INTEGER.
C
C
IVTNUM = 13
IF (ICZERO) 30130, 0130, 30130
0130 CONTINUE
RVCOMP = 10.0
VVIN01 = 4
RVCOMP = VVIN01/5
RVCORR = 0.0
40130 IF ( RVCOMP ) 20130, 10130, 20130
30130 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10130, 0141, 20130
10130 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0141
20130 IVFAIL = IVFAIL + 1
WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR
0141 CONTINUE
C
C
C WRITE OUT TEST SUMMARY
C
WRITE (I02,90004)
WRITE (I02,90014)
WRITE (I02,90004)
WRITE (I02,90000)
WRITE (I02,90004)
WRITE (I02,90020) IVFAIL
WRITE (I02,90022) IVPASS
WRITE (I02,90024) IVDELE
STOP
90001 FORMAT (1H ,24X,5HFM251)
90000 FORMAT (1H ,20X,20HEND OF PROGRAM FM251)
C
C FORMATS FOR TEST DETAIL LINES
C
80000 FORMAT (1H ,4X,I5,6X,7HDELETED)
80002 FORMAT (1H ,4X,I5,7X,4HPASS)
80010 FORMAT (1H ,4X,I5,7X,4HFAIL,10X,I6,9X,I6)
80012 FORMAT (1H ,4X,I5,7X,4HFAIL,4X,E12.5,3X,E12.5)
80018 FORMAT (1H ,4X,I5,7X,4HFAIL,2X,A14,1X,A14)
C
C FORMAT STATEMENTS FOR PAGE HEADERS
C
90002 FORMAT (1H1)
90004 FORMAT (1H )
90006 FORMAT (1H ,10X,34HFORTRAN COMPILER VALIDATION SYSTEM)
90008 FORMAT (1H ,21X,11HVERSION 1.0)
90010 FORMAT (1H ,8X,38HFOR OFFICIAL USE ONLY - COPYRIGHT 1978)
90012 FORMAT (1H ,5X,4HTEST,5X,9HPASS/FAIL,5X,8HCOMPUTED,8X,7HCORRECT)
90014 FORMAT (1H ,5X,46H----------------------------------------------)
90016 FORMAT (1H ,18X,17HSUBSET LEVEL TEST)
C
C FORMAT STATEMENTS FOR RUN SUMMARY
C
90020 FORMAT (1H ,19X,I5,13H TESTS FAILED)
90022 FORMAT (1H ,19X,I5,13H TESTS PASSED)
90024 FORMAT (1H ,19X,I5,14H TESTS DELETED)
END
*END-OF,FM251
FM252.f 480976127 170 2 100666 15130 `
*HEADER,FORTR,FM252
*FILES1,FORTR,FM252,X
PROGRAM FM252
C
C
C
C
C THIS PROGRAM TESTS REDEFINITION OF STATEMENT LABELS WITH THE
C ASSIGN STATEMENT IN CONJUNCTION WITH THE ASSIGNED GO TO STATEMENT.
C THE OPTIONAL COMMA IN THE SYNTAX OF THE ASSIGNED GO TO IS TESTED.
C THE RANGE OF STATEMENT LABELS ( FROM 00001 TO 99999 ) IS TESTED
C USING THE ASSIGN STATEMENT AND THE ASSIGNED GO TO STATEMENT.
C IT ALSO TESTS THE OPTIONAL COMMA IN THE SYNTAX OF THE COMPUTED
C GO TO STATEMENT AND HAS TESTS ON THE RANGE OF THE INDEX IN THE
C COMPUTED GO TO.
C
C
C REFERENCES
C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN,
C X3.9-1978
C SECTION 10.3, STATEMENT LABEL ASSIGNMENT (ASSIGN)
C SECTION 11.2, COMPUTED GO TO STATEMENT
C SECTION 11.3, ASSIGNED GO TO STATEMENT
C
C
C FM013 - SUBSET LEVEL TESTS OF THE ASSIGN STATEMENT AND THE
C ASSIGNED GO TO STATEMENT.
C
C FM014, FM052, AND FM053 - SUBSET LEVEL TESTS OF THE COMPUTED
C GO TO STATEMENT.
C
C
C
C
C ******************************************************************
C A COMPILER VALIDATION SYSTEM FOR THE FORTRAN LANGUAGE
C BASED ON SPECIFICATIONS AS DEFINED IN AMERICAN STANDARD FORTRAN
C X3.9-1978, HAS BEEN DEVELOPED BY THE DEPARTMENT OF THE NAVY. THE
C FORTRAN COMPILER VALIDATION SYSTEM (FCVS) CONSISTS OF AUDIT
C ROUTINES, THEIR RELATED DATA, AND AN EXECUTIVE SYSTEM. EACH AUDIT
C ROUTINE IS A FORTRAN PROGRAM OR SUBPROGRAM WHICH INCLUDES TESTS
C OF SPECIFIC LANGUAGE ELEMENTS AND SUPPORTING PROCEDURES INDICATING
C THE RESULT OF EXECUTING THESE TESTS.
C
C THIS PARTICULAR PROGRAM OR SUBPROGRAM CONTAINS ONLY FEATURES
C FOUND IN THE SUBSET LEVEL OF THE STANDARD.
C
C SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO
C DEPARTMENT OF THE NAVY
C FEDERAL COBOL COMPILER TESTING SERVICE
C WASHINGTON, D.C. 20376
C
C ******************************************************************
C
C
IMPLICIT LOGICAL (L)
IMPLICIT CHARACTER*14 (C)
C
C
C
C INITIALIZATION SECTION.
C
C INITIALIZE CONSTANTS
C ********************
C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER
I01 = 5
C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER
I02 = 6
C SYSTEM ENVIRONMENT SECTION
C
CX010 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-010 CONTROL CARD.
C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5
C (UNIT NUMBER FOR CARD READER).
CX011 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-011 CONTROL CARD
C THE CX011 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL
C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX010 ABOVE.
C
CX020 THIS CARD IS PEPLACED BY CONTENTS OF FEXEC X-020 CONTROL CARD.
C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02 = 6
C (UNIT NUMBER FOR PRINTER).
CX021 THIS CARD IS PEPLACED BY CONTENTS OF FEXEC X-021 CONTROL CARD.
C THE CX021 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL
C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX020 ABOVE.
C
IVPASS = 0
IVFAIL = 0
IVDELE = 0
ICZERO = 0
C
C WRITE OUT PAGE HEADERS
C
WRITE (I02,90002)
WRITE (I02,90006)
WRITE (I02,90008)
WRITE (I02,90004)
WRITE (I02,90010)
WRITE (I02,90004)
WRITE (I02,90016)
WRITE (I02,90001)
WRITE (I02,90004)
WRITE (I02,90012)
WRITE (I02,90014)
WRITE (I02,90004)
C
C
C **** FCVS PROGRAM 252 - TEST 001 ****
C
C TEST 001 IS AN ASSIGN STATEMENT IN WHICH THE STATEMENT
C LABEL IS ACTUALLY FOR A FORMAT STATEMENT. IN 10.3 - THE STATEMENT
C LABEL MUST BE THE LABEL OF AN EXECUTABLE STATEMENT OR A FORMAT
C STATEMENT. THE ASSIGN STATEMENT IS FOLLOWED BY A SIMPLE WRITE
C TO THE PRINTER.
C
C
IVTNUM = 1
IF (ICZERO) 30010, 0010, 30010
0010 CONTINUE
ASSIGN 0012 TO I
0012 FORMAT (51H **** ASSIGN FORMAT NUMBER TO INTEGER VARIABLE ****)
WRITE (I02, I)
C ***** VISUALLY CHECK THE OUTPUT PRINTER LISTING *****
IVCOMP = 0
IVCORR = 0
40010 IF ( IVCOMP ) 20010, 10010, 20010
30010 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10010, 0021, 20010
10010 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0021
20010 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0021 CONTINUE
C
C **** FCVS PROGRAM 252 - TEST 002 ****
C
C TEST 002 IS A TEST OF THE ASSIGNED GO TO STATEMENT WITH THE
C OPTIONAL COMMA INTENTIONALLY DELETED FROM THE SYNTAX.
C GO TO I (S1, S2, S3)
C
C
IVTNUM = 2
IF (ICZERO) 30020, 0020, 30020
0020 CONTINUE
IVCOMP = 0
IVCORR = 1
ASSIGN 0023 TO J
GO TO 0025
0022 IVCOMP = 0
GO TO 40020
0023 IVCOMP = 1
GO TO 40020
0024 IVCOMP = 0
GO TO 40020
0025 GO TO J (0022, 0023, 0024)
C NOTE THAT THE OPTIONAL COMMA IS NOT PRESENT AFTER THE J IN
C PREVIOUS ASSIGNED GO TO STATEMENT.
40020 IF ( IVCOMP - 1 ) 20020, 10020, 20020
30020 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10020, 0031, 20020
10020 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0031
20020 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0031 CONTINUE
C
C **** FCVS PROGRAM 252 - TEST 003 ****
C
C TEST 003 USES A SERIES OF ASSIGN STATEMENTS TO TEST THAT THE
C SAME STATEMENT LABEL AND INTEGER VARIABLE CAN BE USED IN A
C MULTIPLE REDEFINITION TO THE SAME VALUES. A SIMPLE ASSIGNED
C GO TO IS USED TO TEST THE VALUE OF THE INTEGER VARIABLE M.
C
C
IVTNUM = 3
IF (ICZERO) 30030, 0030, 30030
0030 CONTINUE
IVCOMP = 0
IVCORR = 1
ASSIGN 0033 TO M
ASSIGN 0033 TO M
ASSIGN 0033 TO M
GO TO 0035
0032 IVCOMP = 0
GO TO 40030
0033 IVCOMP = 1
GO TO 40030
0034 IVCOMP = 0
GO TO 40030
0035 GO TO M, (0032, 0033, 0034)
40030 IF ( IVCOMP - 1 ) 20030, 10030, 20030
30030 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10030, 0041, 20030
10030 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0041
20030 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0041 CONTINUE
C
C **** FCVS PROGRAM 252 - TEST 004 ****
C
C TEST 004 USES A SERIES OF ASSIGN STATEMENTS TO SET THE INTEGER
C VARIABLE K TO A STATEMENT LABEL IN THE PARENTHESIZED LIST OF
C STATEMENT LABELS FOR THE ASSIGNED GO TO STATEMENT, THEN TO A
C STATEMENT LABEL NOT IN THE LIST AND FINALLY BACK TO A PROPER
C STATEMENT LABEL WITHIN THE PARENTHESIZED LIST. SECTION 11.3
C REQUIRES - IF THE PARENTHESIZED LIST IS PRESENT, THE STATEMENT
C LABEL ASSIGNED TO I MUST BE ONE OF THE STATEMENT LABELS IN
C THE LIST. AN ASSIGNED GO TO STATEMENT IS USED TO TEST THE FINAL
C ASSIGNMENT OF STATEMENT LABELS TO THE INTEGER VARIABLE K.
C
C
IVTNUM = 4
IF (ICZERO) 30040, 0040, 30040
0040 CONTINUE
IVCOMP = 0
IVCORR = 1
ASSIGN 0043 TO K
ASSIGN 0042 TO K
0042 ASSIGN 0043 TO K
GO TO 0045
0043 IVCOMP = 1
GO TO 40040
0044 IVCOMP = 0
GO TO 40040
0045 GO TO K, (0044, 0043)
40040 IF ( IVCOMP - 1 ) 20040, 10040, 20040
30040 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10040, 0051, 20040
10040 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0051
20040 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0051 CONTINUE
C
C
C THE FOLLOWING TWO TESTS CHECK THE POSSIBLE RANGE OF STATEMENT
C LABELS ( FROM 00001 TO 99999 ) BY USING THEM IN ASSIGN STATEMENTS
C AND ASSIGNED GO TO STATEMENTS.
C
C
C
C **** FCVS PROGRAM 252 - TEST 005 ****
C
C TEST 005 USES A STATEMENT LABEL OF 00001 WHICH IS THE SMALLEST
C ALLOWABLE STATEMENT LABEL.
C
C
IVTNUM = 5
IF (ICZERO) 30050, 0050, 30050
0050 CONTINUE
IVCOMP = 0
IVCORR = 1
ASSIGN 00001 TO I
GO TO 0054
0052 IVCOMP = 0
GO TO 40050
00001 IVCOMP = 1
GO TO 40050
0053 IVCOMP = 0
GO TO 40050
0054 GO TO I, ( 0052, 00001, 0053 )
40050 IF ( IVCOMP - 1 ) 20050, 10050, 20050
30050 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10050, 0061, 20050
10050 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0061
20050 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0061 CONTINUE
C
C **** FCVS PROGRAM 252 - TEST 006 ****
C
C TEST 006 USES A STATEMENT LABEL OF 99999 WHICH IS THE LARGEST
C ALLOWABLE STATEMENT LABEL.
C
C
IVTNUM = 6
IF (ICZERO) 30060, 0060, 30060
0060 CONTINUE
IVCOMP = 0
IVCORR = 1
ASSIGN 99999 TO J
GO TO 0064
0062 IVCOMP = 0
GO TO 40060
99999 IVCOMP = 1
GO TO 40060
0063 IVCOMP = 0
GO TO 40060
0064 GO TO J, ( 0062, 99999, 0063 )
40060 IF ( IVCOMP - 1 ) 20060, 10060, 20060
30060 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10060, 0071, 20060
10060 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0071
20060 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0071 CONTINUE
C
C **** FCVS PROGRAM 252 - TEST 007 ****
C
C TEST 007 IS A SYNTAX CHECK ON THE OPTIONAL COMMA IN THE
C COMPUTED GO TO STATEMENT. THE COMMA FOLLOWING THE PARENTHESIZED
C LIST OF STATEMENT LABELS IS INTENTIONALLY OMITTED.
C GO TO ( S1, S2, S3 ) I
C
C
IVTNUM = 7
IF (ICZERO) 30070, 0070, 30070
0070 CONTINUE
IVCOMP = 0
IVCORR = 1
I = 3
GO TO 0075
0072 IVCOMP = 0
I = 1
GO TO 0075
0073 IVCOMP = 1
GO TO 40070
0074 IVCOMP = 0
I = 2
GO TO 0075
0075 GO TO ( 0074, 0073, 0072 ) I
40070 IF ( I - 2 ) 20070, 40071, 20070
40071 IF ( IVCOMP - 1 ) 20070, 10070, 20070
30070 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10070, 0081, 20070
10070 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0081
20070 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0081 CONTINUE
C
C **** FCVS PROGRAM 252 - TEST 008 ****
C
C TEST 008 USES THE COMPUTED GO TO WITHOUT THE OPTIONAL COMMA
C AND HAS A SINGLE STATEMENT LABEL IN THE PARENTHESIZED LIST OF
C STATEMENT LABELS.
C GO TO ( S1 ) I
C
C
IVTNUM = 8
IF (ICZERO) 30080, 0080, 30080
0080 CONTINUE
IVCOMP = 0
IVCORR = 1
J = 1
GO TO 0083
0082 IVCOMP = 1
GO TO 40080
0083 GO TO ( 0082 ) J
40080 IF ( IVCOMP - 1 ) 20080, 10080, 20080
30080 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10080, 0091, 20080
10080 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0091
20080 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0091 CONTINUE
C
C
C THE NEXT THREE TESTS OF THE COMPUTED GO TO TEST THE RANGE OF
C THE INDEX.
C
C FORTRAN 77 HAS THE REQUIREMENT IN SECTION 11.2 - IF THE INDEX
C IS LESS THAN ONE OR GREATER THAN THE NUMBER OF STATEMENT LABELS IN
C THE PARENTHESIZED LIST, THE EXECUTION SEQUENCE CONTINUES AS THOUGH
C A CONTINUE STATEMENT WERE EXECUTED.
C
C
C
C **** FCVS PROGRAM 252 - TEST 009 ****
C
C
C TEST 009 USES A VALUE OF THE INDEX OF THE COMPUTED GO TO
C STATEMENT GREATER THAN THE NUMBER OF STATEMENT LABELS IN THE
C PARENTHESIZED LIST.
C
C
IVTNUM = 9
IF (ICZERO) 30090, 0090, 30090
0090 CONTINUE
IVCOMP = 0
IVCORR = 1
K = 3
GO TO 0094
0092 IVCOMP = 0
GO TO 40090
0093 IVCOMP = 0
GO TO 40090
0094 GO TO ( 0092, 0093 ) K
C
C TO REACH THIS STATEMENT THE COMPUTED GO TO WILL HAVE TO BE
C EXECUTED AS IF IT WERE A CONTINUE STATEMENT.
C
IVCOMP = 1
40090 IF ( IVCOMP - 1 ) 20090, 10090, 20090
30090 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10090, 0101, 20090
10090 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0101
20090 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0101 CONTINUE
C
C **** FCVS PROGRAM 252 - TEST 010 ****
C
C TEST 010 USES A VALUE OF THE INDEX OF THE COMPUTED GO TO
C STATEMENT EQUAL TO ZERO.
C
C
IVTNUM = 10
IF (ICZERO) 30100, 0100, 30100
0100 CONTINUE
IVCOMP = 0
IVCORR = 1
I = 0
GO TO 0104
0102 IVCOMP = 0
GO TO 40100
0103 IVCOMP = 0
GO TO 40100
0104 GO TO ( 0103, 0102 ), I
C
C THIS STATEMENT CAN ONLY BE REACHED IF THE COMPUTED GO TO
C IS EXECUTED AS IF IT WERE A CONTINUE STATEMENT.
C
IVCOMP = 1
40100 IF ( IVCOMP - 1 ) 20100, 10100, 20100
30100 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10100, 0111, 20100
10100 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0111
20100 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0111 CONTINUE
C
C **** FCVS PROGRAM 252 - TEST 011 ****
C
C TEST 011 USES A VALUE OF THE INDEX OF THE COMPUTED GO TO
C EQUAL TO -1.
C
IVTNUM = 11
IF (ICZERO) 30110, 0110, 30110
0110 CONTINUE
IVCOMP = 0
IVCORR = 1
J = -1
GO TO 0114
0112 IVCOMP = 0
GO TO 40110
0113 IVCOMP = 0
GO TO 40110
0114 GO TO (0112,0113),J
C
C THIS STATEMENT CAN ONLY BE REACHED IF THE COMPUTED GO TO
C IS EXECUTED AS IF IT WERE A CONTINUE STATEMENT.
C
IVCOMP = 1
40110 IF ( IVCOMP - 1 ) 20110, 10110, 20110
30110 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10110, 0121, 20110
10110 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0121
20110 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0121 CONTINUE
C
C
C WRITE OUT TEST SUMMARY
C
WRITE (I02,90004)
WRITE (I02,90014)
WRITE (I02,90004)
WRITE (I02,90000)
WRITE (I02,90004)
WRITE (I02,90020) IVFAIL
WRITE (I02,90022) IVPASS
WRITE (I02,90024) IVDELE
STOP
90001 FORMAT (1H ,24X,5HFM252)
90000 FORMAT (1H ,20X,20HEND OF PROGRAM FM252)
C
C FORMATS FOR TEST DETAIL LINES
C
80000 FORMAT (1H ,4X,I5,6X,7HDELETED)
80002 FORMAT (1H ,4X,I5,7X,4HPASS)
80010 FORMAT (1H ,4X,I5,7X,4HFAIL,10X,I6,9X,I6)
80012 FORMAT (1H ,4X,I5,7X,4HFAIL,4X,E12.5,3X,E12.5)
80018 FORMAT (1H ,4X,I5,7X,4HFAIL,2X,A14,1X,A14)
C
C FORMAT STATEMENTS FOR PAGE HEADERS
C
90002 FORMAT (1H1)
90004 FORMAT (1H )
90006 FORMAT (1H ,10X,34HFORTRAN COMPILER VALIDATION SYSTEM)
90008 FORMAT (1H ,21X,11HVERSION 1.0)
90010 FORMAT (1H ,8X,38HFOR OFFICIAL USE ONLY - COPYRIGHT 1978)
90012 FORMAT (1H ,5X,4HTEST,5X,9HPASS/FAIL,5X,8HCOMPUTED,8X,7HCORRECT)
90014 FORMAT (1H ,5X,46H----------------------------------------------)
90016 FORMAT (1H ,18X,17HSUBSET LEVEL TEST)
C
C FORMAT STATEMENTS FOR RUN SUMMARY
C
90020 FORMAT (1H ,19X,I5,13H TESTS FAILED)
90022 FORMAT (1H ,19X,I5,13H TESTS PASSED)
90024 FORMAT (1H ,19X,I5,14H TESTS DELETED)
END
*END-OF,FM252
FM253.f 480976130 170 2 100666 36190 `
*HEADER,FORTR,FM253
*FILES1,FORTR,FM253,X
PROGRAM FM253
C
C
C
C THIS ROUTINE IS A TEST OF THE IF-BLOCK. TESTS WITHIN THIS
C ROUTINE ARE FOR THE SYNTAX OF THE BASIC IF ( ) THEN THROUGH
C END IF BLOCK STRUCTURE.
C
C THERE IS ALSO A SERIES OF TESTS TO CHECK THE HIERARCHY AND
C ORDER OF EVALUATION IN EXPRESSIONS THAT CONTAIN A COMBINATION OF
C ARITHMETIC, RELATIONAL, AND LOGICAL OPERATORS.
C
C REFERENCES
C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN,
C X3.9-1978
C SECTION 11.6, BLOCK IF STATEMENT
C SECTION 11.6.1, IF-LEVEL
C SECTION 11.6.2, IF-BLOCK
C SECTION 11.6.3, EXECUTION OF A BLOCK IF STATEMENT
C
C
C
C
C ******************************************************************
C A COMPILER VALIDATION SYSTEM FOR THE FORTRAN LANGUAGE
C BASED ON SPECIFICATIONS AS DEFINED IN AMERICAN STANDARD FORTRAN
C X3.9-1978, HAS BEEN DEVELOPED BY THE DEPARTMENT OF THE NAVY. THE
C FORTRAN COMPILER VALIDATION SYSTEM (FCVS) CONSISTS OF AUDIT
C ROUTINES, THEIR RELATED DATA, AND AN EXECUTIVE SYSTEM. EACH AUDIT
C ROUTINE IS A FORTRAN PROGRAM OR SUBPROGRAM WHICH INCLUDES TESTS
C OF SPECIFIC LANGUAGE ELEMENTS AND SUPPORTING PROCEDURES INDICATING
C THE RESULT OF EXECUTING THESE TESTS.
C
C THIS PARTICULAR PROGRAM OR SUBPROGRAM CONTAINS ONLY FEATURES
C FOUND IN THE SUBSET LEVEL OF THE STANDARD.
C
C SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO
C DEPARTMENT OF THE NAVY
C FEDERAL COBOL COMPILER TESTING SERVICE
C WASHINGTON, D.C. 20376
C
C ******************************************************************
C
C
IMPLICIT LOGICAL (L)
IMPLICIT CHARACTER*14 (C)
C
DIMENSION LADN11(2)
LOGICAL LVTN01, LVTN02, LATN11(2), LADN11
DATA LADN11/.TRUE., .FALSE./
C
C
C **** LOGICAL STATEMENT FUNCTION REFERENCED IN TEST 20 ****
C
LFIS01 ( L ) = .NOT. L
C
C
C
C
C
C INITIALIZATION SECTION.
C
C INITIALIZE CONSTANTS
C ********************
C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER
I01 = 5
C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER
I02 = 6
C SYSTEM ENVIRONMENT SECTION
C
CX010 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-010 CONTROL CARD.
C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5
C (UNIT NUMBER FOR CARD READER).
CX011 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-011 CONTROL CARD
C THE CX011 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL
C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX010 ABOVE.
C
CX020 THIS CARD IS PEPLACED BY CONTENTS OF FEXEC X-020 CONTROL CARD.
C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02 = 6
C (UNIT NUMBER FOR PRINTER).
CX021 THIS CARD IS PEPLACED BY CONTENTS OF FEXEC X-021 CONTROL CARD.
C THE CX021 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL
C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX020 ABOVE.
C
IVPASS = 0
IVFAIL = 0
IVDELE = 0
ICZERO = 0
C
C WRITE OUT PAGE HEADERS
C
WRITE (I02,90002)
WRITE (I02,90006)
WRITE (I02,90008)
WRITE (I02,90004)
WRITE (I02,90010)
WRITE (I02,90004)
WRITE (I02,90016)
WRITE (I02,90001)
WRITE (I02,90004)
WRITE (I02,90012)
WRITE (I02,90014)
WRITE (I02,90004)
C
C
C **** FCVS PROGRAM 253 - TEST 001 ****
C
C TEST 001 USES A VERY SIMPLE BLOCK IF STATEMENT. THE EXPRESSION
C WITHIN THE PARENTHESES IS THE LOGICAL CONSTANT .TRUE. AND THE
C EXECUTABLE STATEMENT WITHIN THE IF-BLOCK OF LEVEL ONE IS AN
C INTEGER ARITHMETIC ASSIGNMENT STATEMENT. SINCE THE LOGICAL
C EXPRESSION IS TRUE, THEN THE INTEGER ASSIGNMENT STATEMENT ( TRUE
C PATH ) SHOULD BE EXECUTED.
C
C THIS IS A SYNTAX CHECK FOR THE BLOCK IF STATEMENT. SHOULD A
C COMPILER NOT BE ABLE TO ACCEPT THE SYNTAX OF THIS BASIC TEST,
C THEN ROUTINES FM253, THRU FMXXX NEED NOT BE RUN.
C
C
IVTNUM = 1
IF (ICZERO) 30010, 0010, 30010
0010 CONTINUE
IVCOMP = 0
IF ( .TRUE. ) THEN
IVCOMP = 1
END IF
IVCORR = 1
40010 IF ( IVCOMP - 1 ) 20010, 10010, 20010
30010 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10010, 0021, 20010
10010 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0021
20010 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0021 CONTINUE
C
C **** FCVS PROGRAM 253 - TEST 002 ****
C
C TEST 002 USES A LOGICAL VARIABLE SET .FALSE. AS THE LOGICAL
C EXPRESSION IN THE BLOCK IF STATEMENT. BECAUSE THE EXPRESSION
C IS FALSE, THE IF-BLOCK (WHICH IS AN INTEGER ARITHMETIC ASSIGNMENT
C STATEMENT AND A LOGICAL ASSIGNMENT STATEMENT) SHOULD NOT BE
C EXECUTED.
C
C
IVTNUM = 2
IF (ICZERO) 30020, 0020, 30020
0020 CONTINUE
IVCOMP = 0
IVON01 = 1
LVON01 = .FALSE.
LVTN01 = .FALSE.
IF ( LVON01 ) THEN
IVON01 = 0
LVTN01 = .TRUE.
END IF
IVCORR = 1
40020 IF ( IVON01 .EQ. 1 ) IVCOMP = 1
40021 IF ( IVCOMP - 1 ) 20020, 10020, 20020
30020 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10020, 0031, 20020
10020 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0031
20020 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0031 CONTINUE
C
C **** FCVS PROGRAM 253 - TEST 003 ****
C
C TEST 003 IS A BLOCK IF STATEMENT WITH AN EMPTY IF-BLOCK. THE
C LOGICAL EXPRESSION IS A LOGICAL ARRAY ELEMENT REFERENCE SET TO
C .TRUE. SECTION 11.6.2 STATES THAT, AN IF-BLOCK MAY BE EMPTY.
C BECAUSE THE LOGICAL EXPRESSION IS TRUE, THE IF-BLOCK SHOULD BE
C EXECUTED. IF THE VALUE OF THE EXPRESSION IS TRUE AND THE IF-BLOCK
C IS EMPTY, CONTROL IS TRANSFERRED TO THE NEXT END IF STATEMENT
C THAT HAS THE SAME IF-LEVEL AS THE BLOCK IF STATEMENT ACCORDING
C TO SECTION 11.6.3. IN THIS TEST THE EMPTY IF-BLOCK IS OF LEVEL ONE
C
C
IVTNUM = 3
IF (ICZERO) 30030, 0030, 30030
0030 CONTINUE
IVCOMP = 0
LATN11(1) = .TRUE.
IF ( LATN11(1) ) THEN
END IF
IVCOMP = 1
IVCORR = 1
40030 IF ( IVCOMP - 1 ) 20030, 10030, 20030
30030 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10030, 0041, 20030
10030 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0041
20030 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0041 CONTINUE
C
C **** FCVS PROGRAM 253 - TEST 004 ****
C
C TEST 004 IS LIKE THE PREVIOUS TEST USING A LOGICAL ARRAY
C ELEMENT REFERENCE AS THE LOGICAL EXPRESSION OF THE BLOCK IF
C STATEMENT THAT HAS AN EMPTY IF-BLOCK STRUCTURE OF LEVEL ONE.
C IN THIS TEST THE LOGICAL EXPRESSION IS FALSE SO CONTROL SHOULD
C BE TRANSFERRED TO THE END IF STATEMENT THAT HAS THE SAME IF-LEVEL
C AS THE BLOCK IF STATEMENT ACCORDING TO SECTION 11.6.3.
C
C THE LOGICAL ARRAY ELEMENT REFERENCE LADN11(2) IS SET TO .FALSE.
C IN THE DATA STATEMENT AS FOLLOWS
C
C DATA LADN11/.TRUE., .FALSE./
C
C
IVTNUM = 4
IF (ICZERO) 30040, 0040, 30040
0040 CONTINUE
IVCOMP = 0
IF ( LADN11(2) ) THEN
END IF
IVCOMP = 1
IVCORR = 1
40040 IF ( IVCOMP - 1 ) 20040, 10040, 20040
30040 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10040, 0051, 20040
10040 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0051
20040 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0051 CONTINUE
C
C
C THE NEXT FOUR TESTS ARE FOR A BLOCK IF STRUCTURE OF LEVEL
C TWO IN THE INNERMOST IF-BLOCK. THIS STRUCTURE IS SHOWN BELOW -
C
C IF ( E1 ) THEN
C IF-BLOCK 1
C IF ( E2 ) THEN
C IF-BLOCK 2
C END IF
C END IF
C TESTS WILL USE THE FOUR COMBINATIONS OF TRUE AND FALSE FOR E1 AND
C E2 RESPECTIVELY TO TEST THE TRANSFER OF CONTROL AS DESCRIBED
C IN SECTION 11.6.3.
C
C
C
C **** FCVS PROGRAM 253 - TEST 005 ****
C
C TEST 005 USES A FALSE VALUE FOR E1 AND A FALSE VALUE FOR E2.
C CONTROL SHOULD BE TRANSFERRED TO THE END IF STATEMENT OF LEVEL 1
C WHICH MEANS IF-BLOCK 1 AND IF-BLOCK 2 SHOULD NOT BE EXECUTED.
C
C
IVTNUM = 5
IF (ICZERO) 30050, 0050, 30050
0050 CONTINUE
IVCOMP = 1
LADN11(2) = .FALSE.
IF ( 76 .LT. 3 ) THEN
IVCOMP = IVCOMP * 2
IF ( ( LADN11(2) ) ) THEN
IVCOMP = IVCOMP * 3
END IF
END IF
IVCORR = 1
40051 IF ( IVCOMP - 1 ) 20050, 10050, 20050
30050 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10050, 0061, 20050
10050 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0061
20050 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0061 CONTINUE
C
C **** FCVS PROGRAM 253 - TEST 006 ****
C
C TEST 006 USES A FALSE VALUE FOR E1 AND A TRUE VALUE FOR E2.
C CONTROL SHOULD BE TRANSFERRED TO THE END IF STATEMENT OF LEVEL 1
C WHICH MEANS IF-BLOCK 1 AND IF-BLOCK 2 SHOULD NOT BE EXECUTED.
C
C
IVTNUM = 6
IF (ICZERO) 30060, 0060, 30060
0060 CONTINUE
IVCOMP = 1
IVON03 = 32767
LVTN01 = .TRUE.
LVON01 = .TRUE.
IF ( .NOT. LVTN01 ) THEN
IVCOMP = IVCOMP * 2
IF ( LVON01 .AND. IVON03 .GE. 587 ) THEN
IVCOMP = IVCOMP * 3
END IF
END IF
IVCORR = 1
40061 IF ( IVCOMP - 1 ) 20060, 10060, 20060
30060 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10060, 0071, 20060
10060 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0071
20060 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0071 CONTINUE
C
C **** FCVS PROGRAM 253 - TEST 007 ****
C
C TEST 007 USES A TRUE VALUE FOR E1 AND A FALSE VALUE FOR E2.
C IF-BLOCK 1 SHOULD BE EXECUTED, BUT IF-BLOCK 2 SHOULD NOT BE
C EXECUTED.
C
C IF-BLOCK 1 ALSO CONTAINS AN UNCONDITIONAL GO TO AND A CONTINUE
C STATEMENT WHICH SHOULD BOTH BE EXECUTED.
C
C
IVTNUM = 7
IF (ICZERO) 30070, 0070, 30070
0070 CONTINUE
IVCOMP = 1
IVON03 = 587
IVON04 = 3
LATN11(1) = .TRUE.
LATN11(2) = .FALSE.
IF ( (LATN11(1)) .OR. ((7 * IVON04) .EQ. 21) ) THEN
IVCOMP = IVCOMP * 2
GO TO 0072
0072 CONTINUE
IF ( 7 .GT. IVON03 .OR. LATN11(2) ) THEN
IVCOMP = IVCOMP * 3
END IF
END IF
C
C **** IVCOMP IS DETERMINED BY IVCOMP = 2 = 1 * 2 ****
C
IVCORR = 2
40070 IF ( IVCOMP - 2 ) 20070, 10070, 20070
30070 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10070, 0081, 20070
10070 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0081
20070 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0081 CONTINUE
C
C **** FCVS PROGRAM 253 - TEST 008 ****
C
C TEST 008 USES A TRUE VALUE FOR E1 AND A TRUE VALUE FOR E2.
C BOTH IF-BLOCK 1 AND IF-BLOCK 2 SHOULD BE EXECUTED.
C
C IF-BLOCK 1 CONTAINS AN ASSIGN STATEMENT PLUS AN ASSIGNED GO TO
C STATEMENT WHICH SHOULD BOTH BE EXECUTED.
C
C
IVTNUM = 8
IF (ICZERO) 30080, 0080, 30080
0080 CONTINUE
IVCOMP = 1
IVON04 = 4
IVON05 = 2
LVON01 = .FALSE.
LVTN01 = LVON01
C
IF ( IVON04 - 1 .LE. 6 .AND. 7 .GE. 5 / IVON05 ) THEN
IVCOMP = IVCOMP * 2
ASSIGN 0083 TO I
GO TO 0084
0082 IVCOMP = IVCOMP * 3
GO TO 0085
0083 IVCOMP = IVCOMP * 5
GO TO 0085
0084 GO TO I, ( 0082, 0083 )
0085 IF ( .NOT. ( LVTN01 ) ) THEN
IVCOMP = IVCOMP * 7
END IF
END IF
C
C **** IVCOMP IS DETERMINED BY IVCOMP = 70 = 1 * 2 * 5 * 7 ****
C
IVCORR = 70
40080 IF ( IVCOMP - 70 ) 20080, 10080, 20080
30080 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10080, 0091, 20080
10080 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0091
20080 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0091 CONTINUE
C
C THE NEXT FIVE TESTS ARE FOR A BLOCK IF STRUCTURE OF LEVEL
C THREE IN THE INNERMOST IF-BLOCK. THIS STRUCTURE IS SHOWN BELOW -
C
C IF ( E1 ) THEN
C IF-BLOCK 1
C IF ( E2 ) THEN
C IF-BLOCK 2
C IF ( E3 ) THEN
C IF-BLOCK 3
C END IF
C END IF
C END IF
C
C THE FIVE TESTS WILL USE THE FOLLOWING COMBINATIONS OF TRUE AND
C FALSE FOR E1, E2, AND E3 AS SHOWN BELOW -
C TEST NUMBER 9 10 11 12 13
C E1 T T T T F
C E2 T T F F T
C E3 T F T F T
C
C CONTROL SHOULD BE AS DESCRIBED IN SECTION 11.6.3.
C
C
C
C **** FCVS PROGRAM 253 - TEST 009 ****
C
C TEST 009 HAS E1, E2, AND E3 AS TRUE. IF-BLOCK 1, 2, AND 3
C SHOULD BE EXECUTED. IF-BLOCK 1 HAS A COMPUTED GO TO STATEMENT
C WHICH SHOULD BE EXECUTED.
C
C
IVTNUM = 9
IF (ICZERO) 30090, 0090, 30090
0090 CONTINUE
IVCOMP = 1
IVON01 = 4
IVON02 = 3
C
IF ( .NOT. IVON01 .EQ. 3 .OR. .NOT. IVON02 .EQ. 4 ) THEN
IVCOMP = IVCOMP * 2
J = 2
GO TO 0095
0092 IVCOMP = IVCOMP * 3
GO TO 0096
0093 IVCOMP = IVCOMP * 5
GO TO 0096
0094 IVCOMP = IVCOMP * 7
GO TO 0096
0095 GO TO ( 0092, 0093, 0094 ), J
0096 IF ( IVON01 .EQ. 4 .AND. IVON02 .NE. 2 ) THEN
IVCOMP = IVCOMP * 11
IF ( IVON01 .EQ. 4 .AND. .NOT. IVON02 .EQ. 2 ) THEN
IVCOMP = IVCOMP * 13
END IF
END IF
END IF
C
C **** IVCOMP IS DETERMINED BY IVCOMP = 1430 = 1*2*5*11*13 ****
C
IVCORR = 1430
40090 IF ( IVCOMP - 1430 ) 20090, 10090, 20090
30090 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10090, 0101, 20090
10090 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0101
20090 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0101 CONTINUE
C
C **** FCVS PROGRAM 253 - TEST 010 ****
C
C
C TEST 010 HAS E1 AND E2 AS TRUE. E3 IS FALSE. IF-BLOCK 1 HAS
C A LOGICAL IF STATEMENT WHICH SHOULD BE EXECUTED BY TAKING THE
C TRUE PATH. IF-BLOCK 2 HAS AN ARITHMETIC IF STATEMENT WITH THE
C VALUE INSIDE THE PARENTHESIS EQUAL TO ZERO. IF-BLOCK 3 SHOULD NOT
C BE EXECUTED.
C
C
IVTNUM = 10
IF (ICZERO) 30100, 0100, 30100
0100 CONTINUE
IVCOMP = 1
IVON01 = +3
LVON01 = .FALSE.
C
IF ( .NOT. LVON01 .AND. .TRUE. .OR. .TRUE. .AND. .NOT. LVON01 )
1THEN
IVCOMP = IVCOMP * 2
IF ( 3 .LE. IVON01 ) IVCOMP = IVCOMP * 3
IF ( .NOT.(LVON01.AND..TRUE.).OR.(.TRUE..AND..NOT.LVON01) )
1 THEN
IF ( 3 - IVON01 ) 0103, 0102, 0103
0102 IVCOMP = IVCOMP * 5
GO TO 0104
0103 IVCOMP = IVCOMP * 7
0104 CONTINUE
IF ( .NOT.(.NOT.(LVON01.AND..TRUE.)).OR..FALSE..AND.
1 .NOT.LVON01 ) THEN
IVCOMP = IVCOMP * 11
END IF
END IF
END IF
C
C **** IVCOMP IS DETERMINED BY IVCOMP = 30 = 1 * 2 * 3 * 5 ****
C
IVCORR = 30
40100 IF ( IVCOMP - 30 ) 20100, 10100, 20100
30100 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10100, 0111, 20100
10100 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0111
20100 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0111 CONTINUE
C
C **** FCVS PROGRAM 253 - TEST 011 ****
C
C
C TEST 011 HAS E1 AND E3 AS TRUE. E2 IS FALSE. ONLY IF-BLOCK 1
C SHOULD BE EXECUTED. THIS SET OF BLOCK IF STATEMENTS HAS INTEGER
C ASSIGNMENT STATEMENTS BETWEEN THE END IF STATEMENTS. A CHECK IS
C MADE TO DETERMINE IF THESE STATEMENTS HAVE BEEN EXECUTED.
C
C
IVTNUM = 11
IF (ICZERO) 30110, 0110, 30110
0110 CONTINUE
IVCOMP = 1
LVON01 = .TRUE.
LVON02 = .FALSE.
LVON03 = .TRUE.
C
IF ( LVON01 ) THEN
IVCOMP = IVCOMP * 2
IF ( LVON02 ) THEN
IVCOMP = IVCOMP * 3
IF ( LVON03 ) THEN
IVCOMP = IVCOMP * 5
END IF
IVCOMP = IVCOMP * 7
END IF
IVCOMP = IVCOMP * 11
END IF
IVCOMP = IVCOMP * 13
C
C **** IVCOMP IS DETERMINED BY IVCOMP = 286 = 1*2*11*13 ****
C
IVCORR = 286
40110 IF ( IVCOMP - 286 ) 20110, 10110, 20110
30110 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10110, 0121, 20110
10110 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0121
20110 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0121 CONTINUE
C
C **** FCVS PROGRAM 253 - TEST 012 ****
C
C
C TEST 012 HAS E1 AS TRUE. E2 AND E3 ARE FALSE. ONLY IF-BLOCK 1
C SHOULD BE EXECUTED. INTEGER ASSIGNMENT STATEMENTS ARE USED TO
C DETERMINE THE FLOW OF LOGIC THROUGH THE BLOCK IF STRUCTURE.
C
C
IVTNUM = 12
IF (ICZERO) 30120, 0120, 30120
0120 CONTINUE
IVCOMP = 1
LVON01 = .TRUE.
LVON02 = .FALSE.
LVON03 = .FALSE.
C
IF ( LVON01 ) THEN
IVCOMP = IVCOMP * 2
IF ( LVON02 ) THEN
IVCOMP = IVCOMP * 3
IF ( LVON03 ) THEN
IVCOMP = IVCOMP * 5
END IF
IVCOMP = IVCOMP * 7
END IF
IVCOMP = IVCOMP * 11
END IF
IVCOMP = IVCOMP * 13
C
C **** IVCOMP IS DETERMINED BY IVCOMP = 286 = 1*2*11*13 ****
C
IVCORR = 286
40120 IF ( IVCOMP - 286 ) 20120, 10120, 20120
30120 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10120, 0131, 20120
10120 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0131
20120 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0131 CONTINUE
C
C **** FCVS PROGRAM 253 - TEST 013 ****
C
C
C TEST 013 HAS E1 FALSE. E2 AND E3 ARE TRUE. NONE OF THE IF-
C BLOCKS SHOULD BE EXECUTED. INTEGER ASSIGNMENT STATEMENTS ARE
C USED TO TRACE THE FLOW OF LOGIC THROUGH THE BLOCK IF STRUCTURE.
C
C
IVTNUM = 13
IF (ICZERO) 30130, 0130, 30130
0130 CONTINUE
IVCOMP = 1
LVON01 = .FALSE.
LVON02 = .TRUE.
LVON03 = .TRUE.
C
IF ( LVON01 ) THEN
IVCOMP = IVCOMP * 2
IF ( LVON02 ) THEN
IVCOMP = IVCOMP * 3
IF ( LVON03 ) THEN
IVCOMP = IVCOMP * 5
END IF
IVCOMP = IVCOMP * 7
END IF
IVCOMP = IVCOMP * 11
END IF
IVCOMP = IVCOMP * 13
C
C **** IVCOMP IS DETERMINED BY IVCOMP = 13 = 1 * 13 ****
C
IVCORR = 13
40130 IF ( IVCOMP - 13 ) 20130, 10130, 20130
30130 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10130, 0141, 20130
10130 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0141
20130 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0141 CONTINUE
C
C **** FCVS PROGRAM 253 - TEST 014 ****
C
C TEST 014 IS TO CHECK FOR PROPER TRANSFER OF CONTROL USING
C LOGICAL IF STATEMENTS WITHIN IF-BLOCKS AND BRANCHING TO THE
C OUTERMOST IF-LEVEL FROM THE INNERMOST IF-LEVEL IN A CONTROLLED
C LOOP. THE INNERMOST IF-LEVEL SHOULD BE EXECUTED 10 TIMES. A
C LOGICAL IF STATEMENT IS USED IN EACH OF THE IF-LEVELS IN CASE
C THE EXECUTION LOGIC BRANCHES INCORRECTLY. THIS SHOULD PREVENT
C AN INFINITE LOOP DURING THE EXECUTION OF THIS ROUTINE.
C
C
IVTNUM = 14
IF (ICZERO) 30140, 0140, 30140
0140 CONTINUE
IVCOMP = 0
IVON01 = 0
IVON02 = 0
IVON03 = 0
0142 IF ( IVON03 .LT. 10 ) THEN
IVON01 = IVON01 + 1
IF ( IVON01 .GT. 11 ) GO TO 0143
IF ( IVON03 .LT. 10 ) THEN
IVON02 = IVON02 + 1
IF ( IVON02 .GT. 11 ) GO TO 0143
IF ( IVON03 .LT. 10 ) THEN
IVON03 = IVON03 + 1
IF ( IVON03 .GT. 11 ) GO TO 0143
IF ( IVON03 .LE. 10 ) GO TO 0142
END IF
END IF
END IF
0143 CONTINUE
IVCOMP = IVON01
IVCORR = 10
40140 IF ( IVCOMP - 10 ) 20140, 10140, 20140
30140 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10140, 0151, 20140
10140 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0151
20140 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0151 CONTINUE
C
C THE NEXT TWO TESTS ARE TO CHECK THE COUNTERS IN IF-LEVEL 2 AND
C IF-LEVEL 3 RESPECTIVELY IN THE PREVIOUS TEST.
C
C
C
C **** FCVS PROGRAM 253 - TEST 015 ****
C
C TEST 015 CHECKS THAT THE INTEGER COUNTER IN IF-LEVEL 2 IN THE
C PREVIOUS TEST IS EQUAL TO TEN (10).
C
C
IVTNUM = 15
IF (ICZERO) 30150, 0150, 30150
0150 CONTINUE
IVCOMP = IVON02
IVCORR = 10
40150 IF ( IVCOMP - 10 ) 20150, 10150, 20150
30150 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10150, 0161, 20150
10150 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0161
20150 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0161 CONTINUE
C
C **** FCVS PROGRAM 253 - TEST 016 ****
C
C TEST 016 CHECKS THAT THE INTEGER COUNTER IN IF-LEVEL 3 IN THE
C PREVIOUS TEST IS EQUAL TO TEN (10).
C
C
IVTNUM = 16
IF (ICZERO) 30160, 0160, 30160
0160 CONTINUE
IVCOMP = IVON03
IVCORR = 10
40160 IF ( IVCOMP - 10 ) 20160, 10160, 20160
30160 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10160, 0171, 20160
10160 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0171
20160 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0171 CONTINUE
C
C THE NEXT THREE TESTS ARE SIMILAR TO THE PREVIOUS THREE TESTS
C IN THAT THEY TEST THE TRANSFER OF CONTROL WITHIN A THREE LEVEL
C BLOCK IF STRUCTURE. EACH OF THE IF-LEVELS ARE EXECUTED AS IF THEY
C WERE A LOOP USING LOGICAL IF STATEMENTS WITHIN EACH IF-LEVEL.
C
C
C
C **** FCVS PROGRAM 253 - TEST 017 ****
C
C TEST 017 CHECKS THAT THE VALUE OF THE INTEGER COUNTER IVON04 IN
C IF-LEVEL 1 IN THIS TEST EQUALS 10.
C
C
IVTNUM = 17
IF (ICZERO) 30170, 0170, 30170
0170 CONTINUE
IVCOMP = 0
IVON01 = 0
IVON02 = 0
IVON03 = 0
IVON04 = 0
IVON05 = 0
IVON06 = 0
C
0172 IF ( IVON01 .LT. 10 ) THEN
IVON01 = IVON01 + 1
IVON04 = IVON04 + 1
IF ( IVON01 .GT. 11 ) GO TO 0175
0173 IF ( IVON02 .LT. 10 ) THEN
IVON02 = IVON02 + 1
IVON05 = IVON05 + 1
IF ( IVON02 .GT. 11 ) GO TO 0175
0174 IF ( IVON03 .LT. 10 ) THEN
IVON03 = IVON03 + 1
IVON06 = IVON06 + 1
IF ( IVON03 .GT. 11 ) GO TO 0175
IF ( IVON03 .LE. 10 ) GO TO 0174
END IF
IVON03 = 0
IF ( IVON02 .LE. 10 ) GO TO 0173
END IF
IVON02 = 0
IF ( IVON01 .LE. 10 ) GO TO 0172
END IF
0175 CONTINUE
IVCOMP = IVON04
IVCORR = 10
40170 IF ( IVCOMP - 10 ) 20170, 10170, 20170
30170 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10170, 0181, 20170
10170 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0181
20170 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0181 CONTINUE
C
C **** FCVS PROGRAM 253 - TEST 018 ****
C
C TEST 018 CHECKS THAT THE VALUE OF THE INTEGER COUNTER IVON05 IN
C IF-LEVEL 2 OF THE PREVIOUS TEST EQUALS 100.
C
C
IVTNUM = 18
IF (ICZERO) 30180, 0180, 30180
0180 CONTINUE
IVCOMP = IVON05
IVCORR = 100
40180 IF ( IVCOMP - 100 ) 20180, 10180, 20180
30180 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10180, 0191, 20180
10180 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0191
20180 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0191 CONTINUE
C
C **** FCVS PROGRAM 253 - TEST 019 ****
C
C TEST 019 CHECKS THAT THE VALUE OF THE INTEGER COUNTER IVON06 IN
C IF-LEVEL 3 OF THE PREVIOUS TEST EQUALS 1000.
C
C
IVTNUM = 19
IF (ICZERO) 30190, 0190, 30190
0190 CONTINUE
IVCOMP = IVON06
IVCORR = 1000
40190 IF ( IVCOMP - 1000 ) 20190, 10190, 20190
30190 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10190, 0201, 20190
10190 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0201
20190 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0201 CONTINUE
C
C **** FCVS PROGRAM 253 - TEST 020 ****
C
C TEST 020 USES A LOGICAL STATEMENT FUNCTION LFIS01(L) AS
C THE LOGICAL EXPRESSION IN A BLOCK IF STRUCTURE. THE LOGICAL
C STATEMENT FUNCTION TAKES THE LOGICAL COMPLEMENT OF THE LOGICAL
C VALUE SUPPLIED. THE VALUE OF .FALSE. IS SUPPLIED AND THE LOGICAL
C VALUE OF .TRUE. SHOULD BE RETURNED AS THE LOGICAL FUNCTION
C REFERENCE. THE IF-BLOCK OF LEVEL ONE SHOULD BE EXECUTED.
C
C
IVTNUM = 20
IF (ICZERO) 30200, 0200, 30200
0200 CONTINUE
IVCOMP = 0
LVON01 = .FALSE.
IF ( LFIS01( LVON01 ) ) THEN
IVCOMP = 1
END IF
IVCORR = 1
40200 IF ( IVCOMP - 1 ) 20200, 10200, 20200
30200 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10200, 0211, 20200
10200 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0211
20200 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0211 CONTINUE
C
C
C THE FOLLOWING SERIES OF TESTS ARE TO CHECK THE PRECEDENCE OF
C OPERATORS. THESE INCLUDE ARITHMETIC, RELATIONAL, AND LOGICAL
C OPERATORS. ARITHMETIC OPERATORS ARE CHECKED FIRST FROM THE
C EVALUATION OF CERTAIN ARITHMETIC EXPRESSIONS THAT USE ONLY INTEGER
C VALUES IN THE COMPUTATIONS. ALL INTERMEDIATE AND FINAL VALUES ARE
C LESS THAN 32767. AFTER EACH OF THE STATEMENTS IS TESTED BY ITSELF
C THEN THE RELATIONAL OPERATORS ARE TESTED USING THE INTEGER VALUES
C OBTAINED IN EACH OF THE ARITHMETIC EXPRESSIONS. IN THIS TEST THE
C RELATIONAL EXPRESSIONS ARE COMBINED WITH LOGICAL OPERATORS TO
C PRODUCE A LOGICAL EXPRESSION. FINALLY THE ENTIRE SET OF SIX (6)
C ARITHMETIC , RELATIONAL, AND LOGICAL EXPRESSIONS IS COMBINED INTO
C ONE LOGICAL IF STATEMENT.
C
C
C
C **** FCVS PROGRAM 253 - TEST 021 ****
C
C TEST 021 CHECKS THE ORDER OF EVALUATION WHEN AN ARITHMETIC
C EXPRESSION HAS PARENTHESES AND A SERIES OF EXPONENTIATION. THE
C ORDER OF EVALUATION IS SHOWN BELOW -
C
C 1 + 2 * ( 4 - 2 ) ** 2 ** 3 - 4 / 2
C 1 + 2 * ( 2 ) ** 2 ** 3 - 4 / 2
C 1 + 2 * 2 ** 8 - 4 / 2
C 1 + 2 * 256 - 4 / 2
C 1 + 512 - 2
C 513 - 2
C 511
C
IVTNUM = 21
IF (ICZERO) 30210, 0210, 30210
0210 CONTINUE
IVON01 = 1
IVON02 = 2
IVON03 = 4
IVON04 = 2
IVON05 = 4
IVON06 = 2
IVCOMP = IVON01 + IVON02 * ( IVON03 - IVON04 ) ** 2 ** 3 - IVON05
1 / IVON06
IVCORR = 511
40210 IF ( IVCOMP - 511 ) 20210, 10210, 20210
30210 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10210, 0221, 20210
10210 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0221
20210 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0221 CONTINUE
C
C **** FCVS PROGRAM 253 - TEST 022 ****
C
C TEST 022 IS A SERIES OF DIVISIONS FOLLOWED BY A SERIES OF
C MULTIPLICATIONS ALL WITHOUT ANY PARENTHESES.
C
C 16 / 2 / 2 / 2 * 4 * 8
C 8 / 2 / 2 * 4 * 8
C 4 / 2 * 4 * 8
C 2 * 4 * 8
C 8 * 8
C 64
C
C
IVTNUM = 22
IF (ICZERO) 30220, 0220, 30220
0220 CONTINUE
IVON07 = 16
IVON08 = 2
IVON09 = 2
IVON10 = 2
IVON11 = 4
IVON12 = 8
IVCOMP = IVON07 / IVON08 / IVON09 / IVON10 * IVON11 * IVON12
IVCORR = 64
40220 IF ( IVCOMP - 64 ) 20220, 10220, 20220
30220 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10220, 0231, 20220
10220 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0231
20220 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0231 CONTINUE
C
C **** FCVS PROGRAM 253 - TEST 023 ****
C
C TEST 023 HAS ONE SUBTRACTION IMBEDDED IN A SERIES OF ADDITIONS
C WITHOUT ANY PARENTHESES.
C
C 3 + 4 - 1 + 5
C 7 - 1 + 5
C 6 + 5
C 11
C
C
IVTNUM = 23
IF (ICZERO) 30230, 0230, 30230
0230 CONTINUE
IVON13 = 3
IVON14 = 4
IVON15 = 1
IVON16 = 5
IVCOMP = IVON13 + IVON14 - IVON15 + IVON16
IVCORR = 11
40230 IF ( IVCOMP - 11 ) 20230, 10230, 20230
30230 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10230, 0241, 20230
10230 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0241
20230 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0241 CONTINUE
C
C **** FCVS PROGRAM 253 - TEST 024 ****
C
C TEST 024 HAS ADDITION, SUBTRACTION, MULTIPLICATION, DIVISION,
C AND EXPONENTIATION WITHOUT PARENTHESES.
C
C 4 + 4 - 6 * 3 / 3 ** 2
C 4 + 4 - 6 * 3 / 9
C 4 + 4 - 18 / 9
C 4 + 4 - 2
C 8 - 2
C 6
C
C
IVTNUM = 24
IF (ICZERO) 30240, 0240, 30240
0240 CONTINUE
IVON17 = 4
IVON18 = 4
IVON19 = 6
IVON20 = 3
IVON21 = 3
IVON22 = 2
IVCOMP = IVON17 + IVON18 - IVON19 * IVON20 / IVON21 ** IVON22
IVCORR = 6
40240 IF ( IVCOMP - 6 ) 20240, 10240, 20240
30240 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10240, 0251, 20240
10240 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0251
20240 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0251 CONTINUE
C
C **** FCVS PROGRAM 253 - TEST 025 ****
C
C TEST 025 IS LIKE TEST NUMBER 021 EXCEPT THAT THE PARENTHESES
C HAVE BEEN REMOVED. THE INTEGER VALUES USED AS INPUT ARE THE SAME.
C REMOVAL OF THE PARENTHESES CHANGES THE ORDER OF EVALUATION SO THE
C FINAL INTEGER RESULT IS DIFFERENT.
C
C 1 + 2 * 4 - 2 ** 2 ** 3 - 4 / 2
C 1 + 2 * 4 - 2 ** 8 - 4 / 2
C 1 + 2 * 4 - 256 - 4 / 2
C 1 + 8 - 256 - 2
C 9 - 256 - 2
C -247 - 2
C -249
C
IVTNUM = 25
IF (ICZERO) 30250, 0250, 30250
0250 CONTINUE
IVON23 = 1
IVON24 = 2
IVON25 = 4
IVON26 = 2
IVON27 = 4
IVON28 = 2
IVCOMP = IVON23 + IVON24 * IVON25 - IVON26 ** 2 ** 3 - IVON27
1 / IVON28
IVCORR = -249
40250 IF ( IVCOMP + 249 ) 20250, 10250, 20250
30250 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10250, 0261, 20250
10250 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0261
20250 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0261 CONTINUE
C
C **** FCVS PROGRAM 253 - TEST 026 ****
C
C TEST 026 IS JUST LIKE TEST NUMBER 022 EXCEPT THAT PARENTHESES
C HAVE BEEN ADDED. ALTHOUGH THE INTEGER VALUES ARE THE SAME, THE
C PARENTHESES CHANGE THE ORDER OF EVALUATION SO THAT THE FINAL
C INTEGER RESULT IS DIFFERENT.
C
C 16 / ( 2 / 2 ) / 2 * ( 4 * 8 )
C 16 / ( 1 ) / 2 * ( 32 )
C 16 / 2 * 32
C 8 * 32
C 256
C
IVTNUM = 26
IF (ICZERO) 30260, 0260, 30260
0260 CONTINUE
IVON29 = 16
IVON30 = 2
IVON31 = 2
IVON32 = 2
IVON33 = 4
IVON34 = 8
IVCOMP = IVON29 / ( IVON30 / IVON31 ) / IVON32 * ( IVON33 *
1 IVON34 )
IVCORR = 256
40260 IF ( IVCOMP - 256 ) 20260, 10260, 20260
30260 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10260, 0271, 20260
10260 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0271
20260 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0271 CONTINUE
C
C **** FCVS PROGRAM 253 - TEST 027 ****
C
C TEST 027 COMBINES THE INTEGER RESULTS OBTAINED IN THE PREVIOUS
C SIX TESTS AND USES RELATIONAL AND LOGICAL OPERATORS IN ONE
C LOGICAL EXPRESSION. RELATIONAL EXPRESSIONS ARE EVALUATED FIRST
C FOLLOWED BY THE LOGICAL OPERATORS .NOT. , .AND., AND .OR. IN THAT
C ORDER.
C
C 511 .LT. 64 .OR. .NOT. 11 .LE. 6 .AND. -249 .LE. 256
C F .OR. .NOT. F .AND. T
C F .OR. T .AND. T
C F .OR. T
C T
C
C
IVTNUM = 27
IF (ICZERO) 30270, 0270, 30270
0270 CONTINUE
IVON35 = 511
IVON36 = 64
IVON37 = 11
IVON38 = 6
IVON39 = -249
IVON40 = 256
IVCOMP = 0
LVON01 = IVON35 .LT. IVON36 .OR. .NOT. IVON37 .LE. IVON38 .AND.
1 IVON39 .LE. IVON40
IF ( LVON01 ) IVCOMP = 1
IVCORR = 1
40270 IF ( IVCOMP - 1 ) 20270, 10270, 20270
30270 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10270, 0281, 20270
10270 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0281
20270 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0281 CONTINUE
C
C **** FCVS PROGRAM 253 - TEST 028 ****
C
C TEST 028 IS THE BIGGIE. IT COMBINES ALL OF THE INTEGER VALUES
C AND RESULTS IN THE PREVIOUS SEVEN (7) TESTS. IF THERE WERE ANY
C ERRORS IN ANY OF THE PREVIOUS SEVEN TESTS, THEN THIS TEST SHOULD
C ALSO FAIL.
C
C
IVTNUM = 28
IF (ICZERO) 30280, 0280, 30280
0280 CONTINUE
IVCOMP = 0
IF ( IVON01 + IVON02 * ( IVON03 - IVON04 ) ** 2 ** 3 - IVON05 /
1IVON06 .LT. IVON07 / IVON08 / IVON09 / IVON10 * IVON11 * IVON12
2.OR. .NOT. IVON13 + IVON14 - IVON15 + IVON16 .LE. IVON17 + IVON18
3- IVON19 * IVON20 / IVON21 ** IVON22 .AND. IVON23 + IVON24 *
4IVON25 - IVON26 ** 2 ** 3 - IVON27 / IVON28 .LE. IVON29 / ( IVON30
5 / IVON31 ) / IVON32 * ( IVON33 * IVON34 ) ) IVCOMP = 1
IVCORR = 1
40280 IF ( IVCOMP - 1 ) 20280, 10280, 20280
30280 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10280, 0291, 20280
10280 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0291
20280 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0291 CONTINUE
C
C
C WRITE OUT TEST SUMMARY
C
WRITE (I02,90004)
WRITE (I02,90014)
WRITE (I02,90004)
WRITE (I02,90000)
WRITE (I02,90004)
WRITE (I02,90020) IVFAIL
WRITE (I02,90022) IVPASS
WRITE (I02,90024) IVDELE
STOP
90001 FORMAT (1H ,24X,5HFM253)
90000 FORMAT (1H ,20X,20HEND OF PROGRAM FM253)
C
C FORMATS FOR TEST DETAIL LINES
C
80000 FORMAT (1H ,4X,I5,6X,7HDELETED)
80002 FORMAT (1H ,4X,I5,7X,4HPASS)
80010 FORMAT (1H ,4X,I5,7X,4HFAIL,10X,I6,9X,I6)
80012 FORMAT (1H ,4X,I5,7X,4HFAIL,4X,E12.5,3X,E12.5)
80018 FORMAT (1H ,4X,I5,7X,4HFAIL,2X,A14,1X,A14)
C
C FORMAT STATEMENTS FOR PAGE HEADERS
C
90002 FORMAT (1H1)
90004 FORMAT (1H )
90006 FORMAT (1H ,10X,34HFORTRAN COMPILER VALIDATION SYSTEM)
90008 FORMAT (1H ,21X,11HVERSION 1.0)
90010 FORMAT (1H ,8X,38HFOR OFFICIAL USE ONLY - COPYRIGHT 1978)
90012 FORMAT (1H ,5X,4HTEST,5X,9HPASS/FAIL,5X,8HCOMPUTED,8X,7HCORRECT)
90014 FORMAT (1H ,5X,46H----------------------------------------------)
90016 FORMAT (1H ,18X,17HSUBSET LEVEL TEST)
C
C FORMAT STATEMENTS FOR RUN SUMMARY
C
90020 FORMAT (1H ,19X,I5,13H TESTS FAILED)
90022 FORMAT (1H ,19X,I5,13H TESTS PASSED)
90024 FORMAT (1H ,19X,I5,14H TESTS DELETED)
END
*END-OF,FM253
FM254.f 480976133 170 2 100666 18706 `
*HEADER,FORTR,FM254
*FILES1,FORTR,FM254,X
PROGRAM FM254
C
C
C
C THIS ROUTINE IS A TEST OF THE ELSE IF-BLOCK. TESTS WITHIN THIS
C ROUTINE ARE FOR THE SYNTAX OF THE BASIC ELSE IF STATEMENT AND
C ELSE IF-BLOCK STRUCTURE.
C
C REFERENCES
C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN,
C X3.9-1977
C SECTION 11.7, ELSE IF STATEMENT
C SECTION 11.7.1, ELSE IF-BLOCK
C SECTION 11.7.2, EXECUTION OF THE ELSE IF STATEMENT
C
C
C
C
C ******************************************************************
C A COMPILER VALIDATION SYSTEM FOR THE FORTRAN LANGUAGE
C BASED ON SPECIFICATIONS AS DEFINED IN AMERICAN STANDARD FORTRAN
C X3.9-1978, HAS BEEN DEVELOPED BY THE DEPARTMENT OF THE NAVY. THE
C FORTRAN COMPILER VALIDATION SYSTEM (FCVS) CONSISTS OF AUDIT
C ROUTINES, THEIR RELATED DATA, AND AN EXECUTIVE SYSTEM. EACH AUDIT
C ROUTINE IS A FORTRAN PROGRAM OR SUBPROGRAM WHICH INCLUDES TESTS
C OF SPECIFIC LANGUAGE ELEMENTS AND SUPPORTING PROCEDURES INDICATING
C THE RESULT OF EXECUTING THESE TESTS.
C
C THIS PARTICULAR PROGRAM OR SUBPROGRAM CONTAINS ONLY FEATURES
C FOUND IN THE SUBSET LEVEL OF THE STANDARD.
C
C SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO
C DEPARTMENT OF THE NAVY
C FEDERAL COBOL COMPILER TESTING SERVICE
C WASHINGTON, D.C. 20376
C
C ******************************************************************
C
C
IMPLICIT LOGICAL (L)
IMPLICIT CHARACTER*14 (C)
C
DIMENSION LADN11(2)
LOGICAL LVTN01, LVTN02, LATN11(2), LADN11
DATA LADN11/.TRUE., .FALSE./
C
C
C **** LOGICAL STATEMENT FUNCTION REFERENCED IN TEST 4 ****
C
LFIS01 ( L ) = L .AND. L
C
C
C
C
C
C INITIALIZATION SECTION.
C
C INITIALIZE CONSTANTS
C ********************
C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER
I01 = 5
C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER
I02 = 6
C SYSTEM ENVIRONMENT SECTION
C
CX010 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-010 CONTROL CARD.
C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5
C (UNIT NUMBER FOR CARD READER).
CX011 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-011 CONTROL CARD
C THE CX011 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL
C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX010 ABOVE.
C
CX020 THIS CARD IS PEPLACED BY CONTENTS OF FEXEC X-020 CONTROL CARD.
C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02 = 6
C (UNIT NUMBER FOR PRINTER).
CX021 THIS CARD IS PEPLACED BY CONTENTS OF FEXEC X-021 CONTROL CARD.
C THE CX021 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL
C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX020 ABOVE.
C
IVPASS = 0
IVFAIL = 0
IVDELE = 0
ICZERO = 0
C
C WRITE OUT PAGE HEADERS
C
WRITE (I02,90002)
WRITE (I02,90006)
WRITE (I02,90008)
WRITE (I02,90004)
WRITE (I02,90010)
WRITE (I02,90004)
WRITE (I02,90016)
WRITE (I02,90001)
WRITE (I02,90004)
WRITE (I02,90012)
WRITE (I02,90014)
WRITE (I02,90004)
C
C
C
C THE SYNTAX OF THE ELSE IF STATEMENTS IN THE TESTS TO FOLLOW IS
C
C IF ( E1 ) THEN
C IF-BLOCK
C ELSE IF ( E2 ) THEN
C ELSE IF-BLOCK
C END IF
C
C THE NEXT FOUR TESTS WILL USE THE FOLLOWING COMBINATIONS OF TRUE
C AND FALSE FOR E1 AND E2 AS SHOWN BELOW -
C TEST NUMBER 1 2 3 4
C E1 F F T T
C E2 T F T F
C
C
C
C
C **** FCVS PROGRAM 254 - TEST 001 ****
C
C TEST 001 USES A VERY SIMPLE ELSE IF STATEMENT. THE EXPRESSION
C WITHIN THE PARENTHESES IS THE LOGICAL CONSTANT .TRUE. AND THE
C EXECUTABLE STATEMENT WITHIN THE ELSE IF-BLOCK OF LEVEL ONE IS AN
C INTEGER ARITHMETIC ASSIGNMENT STATEMENT. IN THIS TEST THE LOGICAL
C EXPRESSION E1 IS .FALSE. SO THE IF-BLOCK SHOULD NOT BE EXECUTED.
C THE LOGICAL EXPRESSION E2 IS .TRUE. SO THE ELSE IF-BLOCK SHOULD
C BE EXECUTED.
C
C
IVTNUM = 1
IF (ICZERO) 30010, 0010, 30010
0010 CONTINUE
IVCOMP = 1
IF ( .FALSE. ) THEN
IVCOMP = IVCOMP * 2
ELSE IF ( .TRUE. ) THEN
IVCOMP = IVCOMP * 3
END IF
C
C **** IVCOMP IS DETERMINED BY IVCOMP = 3 = 1 * 3
C
IVCORR = 3
40010 IF ( IVCOMP - 3 ) 20010, 10010, 20010
30010 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10010, 0021, 20010
10010 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0021
20010 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0021 CONTINUE
C
C **** FCVS PROGRAM 254 - TEST 002 ****
C
C TEST 002 HAS E1 .FALSE. AND E2 .FALSE.. NEITHER THE IF-BLOCK
C NOR THE ELSE IF-BLOCK SHOULD BE EXECUTED.
C
C
IVTNUM = 2
IF (ICZERO) 30020, 0020, 30020
0020 CONTINUE
IVCOMP = 1
LVON01 = .FALSE.
LVON02 = .FALSE.
IF ( LVON01 ) THEN
IVCOMP = IVCOMP * 2
ELSE IF ( LVON02 ) THEN
IVCOMP = IVCOMP * 3
END IF
IVCORR = 1
40020 IF ( IVCOMP - 1 ) 20020, 10020, 20020
30020 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10020, 0031, 20020
10020 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0031
20020 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0031 CONTINUE
C
C **** FCVS PROGRAM 254 - TEST 003 ****
C
C TEST 003 HAS E1 AS .TRUE. AND E2 AS .TRUE.. ONLY THE IF-BLOCK
C SHOULD BE EXECUTED. THE ELSE IF-BLOCK SHOULD NOT BE EXECUTED.
C
C
IVTNUM = 3
IF (ICZERO) 30030, 0030, 30030
0030 CONTINUE
IVCOMP = 1
LVON01 = .TRUE.
LVON02 = .TRUE.
LVTN01 = LVON01
LVTN02 = LVON02
IF ( LVTN01 ) THEN
IVCOMP = IVCOMP * 2
ELSE IF ( LVTN02 ) THEN
IVCOMP = IVCOMP * 3
END IF
C
C **** IVCOMP IS DETERMINED BY IVCOMP = 2 = 1 * 2 ****
C
IVCORR = 2
40030 IF ( IVCOMP - 2 ) 20030, 10030, 20030
30030 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10030, 0041, 20030
10030 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0041
20030 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0041 CONTINUE
C
C **** FCVS PROGRAM 254 - TEST 004 ****
C
C TEST 004 HAS E1 AS .TRUE. AND E2 AS .FALSE.. ONLY THE IF-BLOCK
C SHOULD BE EXECUTED. THE ELSE IF-BLOCK SHOULD NOT BE EXECUTED.
C
C
IVTNUM = 4
IF (ICZERO) 30040, 0040, 30040
0040 CONTINUE
IVCOMP = 1
LVON01 = .TRUE.
LVTN01 = LFIS01 ( LVON01 )
LVON02 = .FALSE.
IF ( LVTN01 ) THEN
IVCOMP = IVCOMP * 2
ELSE IF ( LFIS01 ( LVON02 ) ) THEN
IVCOMP = IVCOMP * 3
END IF
C
C **** IVCOMP IS DETERMINED BY IVCOMP = 2 = 1 * 2 ****
C
IVCORR = 2
40040 IF ( IVCOMP - 2 ) 20040, 10040, 20040
30040 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10040, 0051, 20040
10040 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0051
20040 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0051 CONTINUE
C
C
C THE SYNTAX OF THE ELSE IF STATEMENTS IN THE TESTS TO FOLLOW IS
C
C IF ( E1 ) THEN
C IF-BLOCK 1
C ELSE IF ( E2 ) THEN
C ELSE IF-BLOCK 1
C ELSE IF ( E3 ) THEN
C ELSE IF-BLOCK 2
C END IF
C
C
C
C **** FCVS PROGRAM 254 - TEST 005 ****
C
C TEST 005 HAS E1 AS TRUE. E2 AND E3 ARE FALSE. ONLY IF-BLOCK 1
C SHOULD BE EXECUTED. ELSE IF-BLOCKS 1 AND 2 SHOULD NOT EXECUTE.
C
C
IVTNUM = 5
IF (ICZERO) 30050, 0050, 30050
0050 CONTINUE
IVCOMP = 1
C LADN11(1) IS SET TO .TRUE. IN A DATA STATEMENT.
LVON02 = .FALSE.
LVON03 = .FALSE.
IF ( LADN11(1) ) THEN
IVCOMP = IVCOMP * 2
ELSE IF ( LVON02 ) THEN
IVCOMP = IVCOMP * 3
ELSE IF ( LVON03 ) THEN
IVCOMP = IVCOMP * 5
END IF
C
C **** IVCOMP IS DETERMINED BY IVCOMP = 2 = 1 * 2 ****
C
IVCORR = 2
40050 IF ( IVCOMP - 2 ) 20050, 10050, 20050
30050 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10050, 0061, 20050
10050 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0061
20050 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0061 CONTINUE
C
C **** FCVS PROGRAM 254 - TEST 006 ****
C
C TEST 006 HAS E1 AS FALSE, E2 AS TRUE, AND E3 AS FALSE. ONLY
C ELSE IF-BLOCK 1 SHOULD EXECUTE. IF-BLOCK 1 AND ELSE IF-BLOCK 2
C SHOULD NOT EXECUTE.
C
C
IVTNUM = 6
IF (ICZERO) 30060, 0060, 30060
0060 CONTINUE
IVCOMP = 1
LVON01 = .FALSE.
LATN11(2) = .TRUE.
LVON03 = .FALSE.
IF ( LVON01 ) THEN
IVCOMP = IVCOMP * 2
ELSE IF ( LATN11(2) ) THEN
IVCOMP = IVCOMP * 3
ELSE IF ( LVON03 ) THEN
IVCOMP = IVCOMP * 5
END IF
C
C **** IVCOMP IS DETERMINED BY IVCOMP = 3 = 1 * 3 ****
C
IVCORR = 3
40060 IF ( IVCOMP - 3 ) 20060, 10060, 20060
30060 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10060, 0071, 20060
10060 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0071
20060 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0071 CONTINUE
C
C **** FCVS PROGRAM 254 - TEST 007 ****
C
C TEST 007 HAS E1 AS FALSE, E2 AS FALSE, AND E3 AS TRUE. ONLY
C ELSE IF-BLOCK 2 SHOULD BE EXECUTED. IF-BLOCK 1 AND ELSE IF-BLOCK
C 1 SHOULD NOT EXECUTE.
C
C
IVTNUM = 7
IF (ICZERO) 30070, 0070, 30070
0070 CONTINUE
IVCOMP = 1
LVON01 = .FALSE.
LVON02 = .FALSE.
LVON03 = .TRUE.
IF ( LVON01 ) THEN
IVCOMP = IVCOMP * 2
ELSE IF ( LVON02 ) THEN
IVCOMP = IVCOMP * 3
ELSE IF ( LVON03 ) THEN
IVCOMP = IVCOMP * 5
END IF
C
C **** IVCOMP IS DETERMINED BY IVCOMP = 5 = 1 * 5 ****
C
IVCORR = 5
40070 IF ( IVCOMP - 5 ) 20070, 10070, 20070
30070 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10070, 0081, 20070
10070 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0081
20070 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0081 CONTINUE
C
C **** FCVS PROGRAM 254 - TEST 008 ****
C
C TEST 008 HAS E1 AS FALSE. BOTH E2 AND E3 ARE TRUE. ONLY ELSE
C IF-BLOCK 1 SHOULD EXECUTE. IF-BLOCK 1 AND ELSE IF-BLOCK 2 SHOULD
C NOT EXECUTE. THIS IS A TEST OF THE LOGIC FLOW WHEN ONE OF THE
C EXPRESSIONS IN A STRING OF ELSE IF BLOCK STRUCTURES IS TRUE. ONLY
C THAT PARTICULAR ELSE IF-BLOCK SHOULD BE EXECUTED. THE REST OF THE
C STRING SHOULD BE SKIPPED.
C
C
IVTNUM = 8
IF (ICZERO) 30080, 0080, 30080
0080 CONTINUE
IVCOMP = 1
LVON01 = .FALSE.
LVON02 = .TRUE.
LVON03 = .TRUE.
IF ( LVON01 ) THEN
IVCOMP = IVCOMP * 2
ELSE IF ( LVON02 ) THEN
IVCOMP = IVCOMP * 3
ELSE IF ( LVON03 ) THEN
IVCOMP = IVCOMP * 5
END IF
C
C **** IVCOMP IS DETERMINED BY IVCOMP = 3 = 1 * 3 ****
C
IVCORR = 3
40080 IF ( IVCOMP - 3 ) 20080, 10080, 20080
30080 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10080, 0091, 20080
10080 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0091
20080 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0091 CONTINUE
C
C
C THE FOLLOWING TWO TESTS ARE TO CHECK THE EXECUTION OF AN ELSE
C IF STATEMENT WITH AN EMPTY ELSE IF-BLOCK. THE SYNTAX FOR THE TWO
C TESTS IS AS FOLLOWS -
C
C IF ( E1 ) THEN
C IF-BLOCK 1
C ELSE IF ( E2 ) THEN
C ELSE IF ( E3 ) THEN
C ELSE IF-BLOCK 1
C END IF
C
C
C
C **** FCVS PROGRAM 254 - TEST 009 ****
C
C TEST 009 HAS E1 FALSE, E2 TRUE, AND E3 AS TRUE. THE STRUCTURE
C ELSE IF ( E2 ) THEN
C IS FOLLOWED BY AN EMPTY ELSE IF-BLOCK ALLOWED IN SECTION 11.7.1.
C IN SECTION 11.7.2, IF THE VALUE OF THE EXPRESSION IS TRUE AND THE
C ELSE IF-BLOCK IS EMPTY, CONTROL IS TRANSFERRED TO THE NEXT END IF
C STATEMENT THAT HAS THE SAME IF-LEVEL AS THE ELSE IF STATEMENT.
C NEITHER IF-BLOCK 1 NOR ELSE IF-BLOCK 1 SHOULD BE EXECUTED.
C
C
IVTNUM = 9
IF (ICZERO) 30090, 0090, 30090
0090 CONTINUE
IVCOMP = 1
LVON01 = .FALSE.
LVON02 = .TRUE.
LVON03 = .TRUE.
IF ( LVON01 ) THEN
IVCOMP = IVCOMP * 2
ELSE IF ( LVON02 ) THEN
ELSE IF ( LVON03 ) THEN
IVCOMP = IVCOMP * 3
END IF
IVCORR = 1
40090 IF ( IVCOMP - 1 ) 20090, 10090, 20090
30090 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10090, 0101, 20090
10090 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0101
20090 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0101 CONTINUE
C
C **** FCVS PROGRAM 254 - TEST 010 ****
C
C TEST 010 ALSO HAS AN EMPTY ELSE IF-BLOCK. E1 AND E2 ARE FALSE.
C E3 IS TRUE. ONLY ELSE IF-BLOCK 1 SHOULD BE EXECUTED. IF-BLOCK 1
C SHOULD NOT BE EXECUTED. IN SECTION 11.7.2, IF THE VALUE OF THE
C EXPRESSION IS FALSE, CONTROL IS TRANSFERRED TO THE NEXT ELSE IF,
C ELSE, OR END IF STATEMENT THAT HAS THE SAME IF-LEVEL AS THE ELSE
C IF STATEMENT.
C
C
IVTNUM = 10
IF (ICZERO) 30100, 0100, 30100
0100 CONTINUE
IVCOMP = 1
LVON01 = .FALSE.
LVON02 = .FALSE.
LVON03 = .TRUE.
IF ( LVON01 ) THEN
IVCOMP = IVCOMP * 2
ELSE IF ( LVON02 ) THEN
ELSE IF ( LVON03 ) THEN
IVCOMP = IVCOMP * 3
END IF
C
C **** IVCOMP IS DETERMINED BY IVCOMP = 3 = 1 * 3 ****
C
IVCORR = 3
40100 IF ( IVCOMP - 3 ) 20100, 10100, 20100
30100 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10100, 0111, 20100
10100 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0111
20100 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0111 CONTINUE
C
C
C THE NEXT TWO TESTS USE THE ELSE IF STRUCTURE INSIDE A BLOCKED
C IF STRUCTURE OF LEVEL 2 AS FOLLOWS -
C
C IF ( E1 ) THEN
C IF-BLOCK 1
C IF ( E2 ) THEN
C IF-BLOCK 2
C ELSE IF ( E3 ) THEN
C ELSE IF-BLOCK 1
C ELSE IF ( E4 ) THEN
C ELSE IF-BLOCK 2
C END IF
C ELSE IF ( E5 ) THEN
C ELSE IF-BLOCK 3
C ELSE IF ( E6 ) THEN
C ELSE IF-BLOCK 4
C END IF
C
C
C
C **** FCVS PROGRAM 254 - TEST 011 ****
C
C TEST 011 HAS E1 TRUE, E2 AND E3 AS FALSE, E4, E5, AND ALSO
C E6 AS TRUE. IF-BLOCK 1, AND ELSE IF-BLOCK 2 SHOULD BE EXECUTED.
C IF-BLOCK 2, ELSE IF-BLOCK 1, 3, AND 4 SHOULD NOT BE EXECUTED.
C
C
IVTNUM = 11
IF (ICZERO) 30110, 0110, 30110
0110 CONTINUE
IVCOMP = 1
LVON01 = .TRUE.
LVON02 = .FALSE.
LVON03 = .FALSE.
LVON04 = .TRUE.
LVON05 = .TRUE.
LVON06 = .TRUE.
IF ( LVON01 ) THEN
IVCOMP = IVCOMP * 2
IF ( LVON02 ) THEN
IVCOMP = IVCOMP * 3
ELSE IF ( LVON03 ) THEN
IVCOMP = IVCOMP * 5
ELSE IF ( LVON04 ) THEN
IVCOMP = IVCOMP * 7
END IF
ELSE IF ( LVON05 ) THEN
IVCOMP = IVCOMP * 11
ELSE IF ( LVON06 ) THEN
IVCOMP = IVCOMP * 13
END IF
C
C **** IVCOMP IS DETERMINED BY IVCOMP = 14 = 1 * 2 * 7 ****
C
IVCORR = 14
40110 IF ( IVCOMP - 14 ) 20110, 10110, 20110
30110 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10110, 0121, 20110
10110 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0121
20110 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0121 CONTINUE
C
C **** FCVS PROGRAM 254 - TEST 012 ****
C
C TEST 012 HAS E1 AS FALSE, E2, E3, AND E4 ARE TRUE, E5 AS FALSE,
C AND E6 IS TRUE. ONLY ELSE IF-BLOCK 4 SHOULD BE EXECUTED. NO
C OTHER IF-BLOCK OR ELSE IF-BLOCK SHOULD BE EXECUTED.
C
C
IVTNUM = 12
IF (ICZERO) 30120, 0120, 30120
0120 CONTINUE
IVCOMP = 1
LVON01 = .FALSE.
LVON02 = .TRUE.
LVON03 = .TRUE.
LVON04 = .TRUE.
LVON05 = .FALSE.
LVON06 = .TRUE.
IF ( LVON01 ) THEN
IVCOMP = IVCOMP * 2
IF ( LVON02 ) THEN
IVCOMP = IVCOMP * 3
ELSE IF ( LVON03 ) THEN
IVCOMP = IVCOMP * 5
ELSE IF ( LVON04 ) THEN
IVCOMP = IVCOMP * 7
END IF
ELSE IF ( LVON05 ) THEN
IVCOMP = IVCOMP * 11
ELSE IF ( LVON06 ) THEN
IVCOMP = IVCOMP * 13
END IF
C
C **** IVCOMP IS DETERMINED BY IVCOMP = 13 = 1 * 13 ****
C
IVCORR = 13
40120 IF ( IVCOMP - 13 ) 20120, 10120, 20120
30120 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10120, 0131, 20120
10120 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0131
20120 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0131 CONTINUE
C
C
C WRITE OUT TEST SUMMARY
C
WRITE (I02,90004)
WRITE (I02,90014)
WRITE (I02,90004)
WRITE (I02,90000)
WRITE (I02,90004)
WRITE (I02,90020) IVFAIL
WRITE (I02,90022) IVPASS
WRITE (I02,90024) IVDELE
STOP
90001 FORMAT (1H ,24X,5HFM254)
90000 FORMAT (1H ,20X,20HEND OF PROGRAM FM254)
C
C FORMATS FOR TEST DETAIL LINES
C
80000 FORMAT (1H ,4X,I5,6X,7HDELETED)
80002 FORMAT (1H ,4X,I5,7X,4HPASS)
80010 FORMAT (1H ,4X,I5,7X,4HFAIL,10X,I6,9X,I6)
80012 FORMAT (1H ,4X,I5,7X,4HFAIL,4X,E12.5,3X,E12.5)
80018 FORMAT (1H ,4X,I5,7X,4HFAIL,2X,A14,1X,A14)
C
C FORMAT STATEMENTS FOR PAGE HEADERS
C
90002 FORMAT (1H1)
90004 FORMAT (1H )
90006 FORMAT (1H ,10X,34HFORTRAN COMPILER VALIDATION SYSTEM)
90008 FORMAT (1H ,21X,11HVERSION 1.0)
90010 FORMAT (1H ,8X,38HFOR OFFICIAL USE ONLY - COPYRIGHT 1978)
90012 FORMAT (1H ,5X,4HTEST,5X,9HPASS/FAIL,5X,8HCOMPUTED,8X,7HCORRECT)
90014 FORMAT (1H ,5X,46H----------------------------------------------)
90016 FORMAT (1H ,18X,17HSUBSET LEVEL TEST)
C
C FORMAT STATEMENTS FOR RUN SUMMARY
C
90020 FORMAT (1H ,19X,I5,13H TESTS FAILED)
90022 FORMAT (1H ,19X,I5,13H TESTS PASSED)
90024 FORMAT (1H ,19X,I5,14H TESTS DELETED)
END
*END-OF,FM254
FM255.f 480976135 170 2 100666 27587 `
*HEADER,FORTR,FM255
*FILES1,FORTR,FM255,X
PROGRAM FM255
C
C
C
C THIS ROUTINE IS A TEST OF THE ELSE STATEMENT. TESTS WITHIN
C THIS ROUTINE ARE FOR THE SYNTAX OF THE BASIC ELSE STATEMENT AND
C ELSE BLOCK STRUCTURES. THE END IF STATEMENT IS USED IN ALL BLOCK
C IF STRUCTURES FOR THE ROUTINES FM253, FM254, AND FM255. FOR EACH
C BLOCK IF STATEMENT, THERE MUST BE A CORRESPONDING END IF STATEMENT
C IN THE SAME PROGRAM UNIT.
C
C REFERENCES
C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN,
C X3.9-1977
C SECTION 11.8, ELSE STATEMENT
C SECTION 11.8.1, ELSE BLOCK
C SECTION 11.8.2, EXECUTION OF AN ELSE STATEMENT
C SECTION 11.9, END IF STATEMENT
C
C
C
C
C ******************************************************************
C A COMPILER VALIDATION SYSTEM FOR THE FORTRAN LANGUAGE
C BASED ON SPECIFICATIONS AS DEFINED IN AMERICAN STANDARD FORTRAN
C X3.9-1978, HAS BEEN DEVELOPED BY THE DEPARTMENT OF THE NAVY. THE
C FORTRAN COMPILER VALIDATION SYSTEM (FCVS) CONSISTS OF AUDIT
C ROUTINES, THEIR RELATED DATA, AND AN EXECUTIVE SYSTEM. EACH AUDIT
C ROUTINE IS A FORTRAN PROGRAM OR SUBPROGRAM WHICH INCLUDES TESTS
C OF SPECIFIC LANGUAGE ELEMENTS AND SUPPORTING PROCEDURES INDICATING
C THE RESULT OF EXECUTING THESE TESTS.
C
C THIS PARTICULAR PROGRAM OR SUBPROGRAM CONTAINS ONLY FEATURES
C FOUND IN THE SUBSET LEVEL OF THE STANDARD.
C
C SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO
C DEPARTMENT OF THE NAVY
C FEDERAL COBOL COMPILER TESTING SERVICE
C WASHINGTON, D.C. 20376
C
C ******************************************************************
C
C
IMPLICIT LOGICAL (L)
IMPLICIT CHARACTER*14 (C)
C
C
C
C INITIALIZATION SECTION.
C
C INITIALIZE CONSTANTS
C ********************
C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER
I01 = 5
C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER
I02 = 6
C SYSTEM ENVIRONMENT SECTION
C
CX010 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-010 CONTROL CARD.
C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5
C (UNIT NUMBER FOR CARD READER).
CX011 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-011 CONTROL CARD
C THE CX011 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL
C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX010 ABOVE.
C
CX020 THIS CARD IS PEPLACED BY CONTENTS OF FEXEC X-020 CONTROL CARD.
C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02 = 6
C (UNIT NUMBER FOR PRINTER).
CX021 THIS CARD IS PEPLACED BY CONTENTS OF FEXEC X-021 CONTROL CARD.
C THE CX021 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL
C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX020 ABOVE.
C
IVPASS = 0
IVFAIL = 0
IVDELE = 0
ICZERO = 0
C
C WRITE OUT PAGE HEADERS
C
WRITE (I02,90002)
WRITE (I02,90006)
WRITE (I02,90008)
WRITE (I02,90004)
WRITE (I02,90010)
WRITE (I02,90004)
WRITE (I02,90016)
WRITE (I02,90001)
WRITE (I02,90004)
WRITE (I02,90012)
WRITE (I02,90014)
WRITE (I02,90004)
C
C
C
C THE SYNTAX OF THE ELSE STATEMENTS IN THE TESTS TO FOLLOW IS
C
C IF ( E1 ) THEN
C IF-BLOCK
C ELSE
C ELSE-BLOCK
C END IF
C
C THE NEXT TWO TESTS WILL USE THE FOLLOWING COMBINATIONS OF TRUE
C AND FALSE FOR E1 AS SHOWN BELOW -
C TEST NUMBER 1 2
C E1 T F
C
C
C
C **** FCVS PROGRAM 255 - TEST 001 ****
C
C TEST 001 USES A VALUE OF .TRUE. FOR E1. THE IF-BLOCK SHOULD BE
C EXECUTED. THE ELSE-BLOCK SHOULD NOT BE EXECUTED.
C
C
IVTNUM = 1
IF (ICZERO) 30010, 0010, 30010
0010 CONTINUE
IVCOMP = 1
IF ( .TRUE. ) THEN
IVCOMP = IVCOMP * 2
ELSE
IVCOMP = IVCOMP * 3
END IF
C
C **** IVCOMP IS DETERMINED BY IVCOMP = 2 = 1 * 2 ****
C
IVCORR = 2
40010 IF ( IVCOMP - 2 ) 20010, 10010, 20010
30010 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10010, 0021, 20010
10010 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0021
20010 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0021 CONTINUE
C
C **** FCVS PROGRAM 255 - TEST 002 ****
C
C TEST 002 HAS E1 AS FALSE. THE IF-BLOCK SHOULD NOT BE EXECUTED.
C THE ELSE-BLOCK SHOULD EXECUTE.
C
C
IVTNUM = 2
IF (ICZERO) 30020, 0020, 30020
0020 CONTINUE
IVCOMP = 1
LVON01 = .FALSE.
IF ( LVON01 ) THEN
IVCOMP = IVCOMP * 2
ELSE
IVCOMP = IVCOMP * 3
END IF
C
C **** IVCOMP IS DETERMINED BY IVCOMP = 3 = 1 * 3 ****
C
IVCORR = 3
40020 IF ( IVCOMP - 3 ) 20020, 10020, 20020
30020 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10020, 0031, 20020
10020 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0031
20020 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0031 CONTINUE
C
C **** FCVS PROGRAM 255 - TEST 003 ****
C
C TEST 003 HAS AN EMPTY ELSE-BLOCK. SECTION 11.8.1 STATES THAT
C AN ELSE-BLOCK MAY BE EMPTY. IN THIS TEST THE VALUE OF E1 IS TRUE.
C THE IF-BLOCK SHOULD BE EXECUTED.
C
C
IVTNUM = 3
IF (ICZERO) 30030, 0030, 30030
0030 CONTINUE
IVCOMP = 1
LVON01 = .TRUE.
IF ( LVON01 ) THEN
IVCOMP = IVCOMP * 2
ELSE
END IF
C
C **** IVCOMP IS DETERMINED BY IVCOMP = 2 = 1 * 2 ****
C
IVCORR = 2
40030 IF ( IVCOMP - 2 ) 20030, 10030, 20030
30030 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10030, 0041, 20030
10030 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0041
20030 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0041 CONTINUE
C
C **** FCVS PROGRAM 255 - TEST 004 ****
C
C TEST 004 IS SIMILAR TO THE PREVIOUS TEST EXCEPT THAT THE VALUE
C OF E1 IS FALSE. THE IF-BLOCK SHOULD NOT BE EXECUTED.
C
C
IVTNUM = 4
IF (ICZERO) 30040, 0040, 30040
0040 CONTINUE
IVCOMP = 1
LVON01 = .FALSE.
IF ( LVON01 ) THEN
IVCOMP = IVCOMP * 2
ELSE
END IF
IVCORR = 1
40040 IF ( IVCOMP - 1 ) 20040, 10040, 20040
30040 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10040, 0051, 20040
10040 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0051
20040 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0051 CONTINUE
C
C **** FCVS PROGRAM 255 - TEST 005 ****
C
C TEST 005 USES AN ELSE STATEMENT IN AN IF-LEVEL OF 2. THE
C SYNTAX FOR THIS STRUCTURE IS SHOWN BELOW -
C
C IF ( E1 ) THEN
C IF-BLOCK 1
C IF ( E2 ) THEN
C IF-BLOCK 2
C ELSE
C ELSE-BLOCK 1
C END IF
C ELSE
C ELSE-BLOCK 2
C END IF
C
C IN THIS TEST THE VALUES FOR E1 AND E2 ARE BOTH TRUE. IF-BLOCK
C 1 AND IF-BLOCK 2 SHOULD BE EXECUTED. ELSE-BLOCKS 1 AND 2 SHOULD
C NOT BE EXECUTED.
C
C
IVTNUM = 5
IF (ICZERO) 30050, 0050, 30050
0050 CONTINUE
IVCOMP = 1
LVON01 = .TRUE.
LVON02 = .TRUE.
IF ( LVON01 ) THEN
IVCOMP = IVCOMP * 2
IF ( LVON02 ) THEN
IVCOMP = IVCOMP * 3
ELSE
IVCOMP = IVCOMP * 5
END IF
ELSE
IVCOMP = IVCOMP * 7
END IF
C
C **** IVCOMP IS DETERMINED BY IVCOMP = 6 = 1 * 2 * 3
C
IVCORR = 6
40050 IF ( IVCOMP - 6 ) 20050, 10050, 20050
30050 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10050, 0061, 20050
10050 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0061
20050 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0061 CONTINUE
C
C **** FCVS PROGRAM 255 - TEST 006 ****
C
C TEST 006 IS SIMILAR TO THE PREVIOUS TEST EXCEPT THAT E1 IS TRUE
C AND E2 IS FALSE. IF-BLOCK 1 AND ELSE-BLOCK 1 SHOULD BE EXECUTED.
C
C
IVTNUM = 6
IF (ICZERO) 30060, 0060, 30060
0060 CONTINUE
IVCOMP = 1
LVON01 = .TRUE.
LVON02 = .FALSE.
IF ( LVON01 ) THEN
IVCOMP = IVCOMP * 2
IF ( LVON02 ) THEN
IVCOMP = IVCOMP * 3
ELSE
IVCOMP = IVCOMP * 5
END IF
ELSE
IVCOMP = IVCOMP * 7
END IF
C
C **** IVCOMP IS DETERMINED BY IVCOMP = 10 = 1 * 2 * 5 ****
C
IVCORR = 10
40060 IF ( IVCOMP - 10 ) 20060, 10060, 20060
30060 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10060, 0071, 20060
10060 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0071
20060 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0071 CONTINUE
C
C **** FCVS PROGRAM 255 - TEST 007 ****
C
C TEST 007 AGAIN USES THE SAME STRUCTURE AS THE PREVIOUS TWO
C TESTS. IN THIS TEST E1 IS FALSE AND E2 IS TRUE. ONLY ELSE-BLOCK
C 2 SHOULD BE EXECUTED.
C
C
IVTNUM = 7
IF (ICZERO) 30070, 0070, 30070
0070 CONTINUE
IVCOMP = 1
LVON01 = .FALSE.
LVON02 = .TRUE.
IF ( LVON01 ) THEN
IVCOMP = IVCOMP * 2
IF ( LVON02 ) THEN
IVCOMP = IVCOMP * 3
ELSE
IVCOMP = IVCOMP * 5
END IF
ELSE
IVCOMP = IVCOMP * 7
END IF
C
C **** IVCOMP IS DETERMINED BY IVCOMP = 7 = 1 * 7 ****
C
IVCORR = 7
40070 IF ( IVCOMP - 7 ) 20070, 10070, 20070
30070 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10070, 0081, 20070
10070 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0081
20070 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0081 CONTINUE
C
C
C THE FOLLOWING TESTS USE A BLOCK IF STRUCTURE OF IF-LEVEL 3.
C THE STRUCTURE AS SHOWN BELOW CONTAINS THE IF-THEN, ELSE IF-THEN,
C AND ELSE STRUCTURES.
C
C IF ( E1 ) THEN
C IF-BLOCK 1
C IF ( E2 ) THEN
C IF-BLOCK 2
C IF ( E3 ) THEN
C IF-BLOCK 3
C ELSE IF ( E4 ) THEN
C ELSE IF-BLOCK 1
C ELSE IF ( E5 ) THEN
C ELSE IF-BLOCK 2
C ELSE
C ELSE-BLOCK 1
C END IF
C MORE IF-BLOCK 2
C ELSE IF ( E6 ) THEN
C ELSE IF-BLOCK 3
C ELSE
C ELSE-BLOCK 2
C END IF
C MORE IF-BLOCK 1
C ELSE IF ( E7 ) THEN
C ELSE IF-BLOCK 4
C ELSE
C ELSE-BLOCK 3
C END IF
C
C THE TRUE AND FALSE VALUES FOR THE VARIOUS LOGICAL EXPRESSIONS
C USED IN THE TESTS TO FOLLOW ARE SHOWN BELOW -
C
C TEST NUMBER 8 9 10 11 12 13 14 15
C E1 T T T T T T F F
C E2 T T T T F F F F
C E3 T F F F F F F F
C E4 T F F T F F F F
C E5 T F T F F F F F
C E6 T F F F T F F F
C E7 T F F F F F T F
C
C
C
C **** FCVS PROGRAM 255 - TEST 008 ****
C
C TEST 008 SHOULD EXECUTE IF-BLOCKS 1, 2, AND 3. IT SHOULD ALSO
C EXECUTE MORE IF-BLOCKS 2 AND 1.
C
C
IVTNUM = 8
IF (ICZERO) 30080, 0080, 30080
0080 CONTINUE
IVCOMP = 1
LVON01 = .TRUE.
LVON02 = .TRUE.
LVON03 = .TRUE.
LVON04 = .TRUE.
LVON05 = .TRUE.
LVON06 = .TRUE.
LVON07 = .TRUE.
IF ( LVON01 ) THEN
IVCOMP = IVCOMP * 2
IF ( LVON02 ) THEN
IVCOMP = IVCOMP * 3
IF ( LVON03 ) THEN
IVCOMP = IVCOMP * 5
ELSE IF ( LVON04 ) THEN
IVCOMP = IVCOMP * 7
ELSE IF ( LVON05 ) THEN
IVCOMP = IVCOMP * 11
ELSE
IVCOMP = IVCOMP * 13
END IF
IVCOMP = IVCOMP * 17
ELSE IF ( LVON06 ) THEN
IVCOMP = IVCOMP * 19
ELSE
IVCOMP = IVCOMP * 23
END IF
IVCOMP = IVCOMP * 29
ELSE IF ( LVON07 ) THEN
IVCOMP = IVCOMP * 31
ELSE
GO TO 0082
END IF
GO TO 0083
0082 IVCOMP = IVCOMP * 37
0083 CONTINUE
C
C **** IVCOMP IS DETERMINED BY IVCOMP = 14790 = 1 * 2 * 3 * 5 *
C 17 * 29 ****
C
IVCORR = 14790
40080 IF ( IVCOMP - 14790 ) 20080, 10080, 20080
30080 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10080, 0091, 20080
10080 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0091
20080 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0091 CONTINUE
C
C **** FCVS PROGRAM 255 - TEST 009 ****
C
C TEST 009 SHOULD EXECUTE IF-BLOCKS 1 AND 2. IT SHOULD ALSO
C EXECUTE ELSE-BLOCK 1, PLUS MORE IF-BLOCKS 2 AND 1.
C
C
IVTNUM = 9
IF (ICZERO) 30090, 0090, 30090
0090 CONTINUE
IVCOMP = 1
LVON01 = .TRUE.
LVON02 = .TRUE.
LVON03 = .FALSE.
LVON04 = .FALSE.
LVON05 = .FALSE.
LVON06 = .FALSE.
LVON07 = .FALSE.
IF ( LVON01 ) THEN
IVCOMP = IVCOMP * 2
IF ( LVON02 ) THEN
IVCOMP = IVCOMP * 3
IF ( LVON03 ) THEN
IVCOMP = IVCOMP * 13
ELSE IF ( LVON04 ) THEN
IVCOMP = IVCOMP * 17
ELSE IF ( LVON05 ) THEN
IVCOMP = IVCOMP * 11
ELSE
IVCOMP = IVCOMP * 5
END IF
IVCOMP = IVCOMP * 7
ELSE IF ( LVON06 ) THEN
IVCOMP = IVCOMP * 19
ELSE
IVCOMP = IVCOMP * 23
END IF
IVCOMP = IVCOMP * 29
ELSE IF ( LVON07 ) THEN
IVCOMP = IVCOMP * 31
ELSE
IF ( .TRUE. ) GO TO 0092
END IF
GO TO 0093
0092 IVCOMP = IVCOMP * 37
0093 CONTINUE
C
C **** THE ORDER OF THE PRIME INTEGER MULTIPLIERS HAS BEEN
C CHANGED TO KEEP THE IVCOMP RESULT SMALLER THAN 32767 ****
C
C
C **** IVCOMP IS DETERMINED BY IVCOMP = 6090 = 1 * 2 * 3 * 5 * 7
C * 29 ****
C
IVCORR = 6090
40090 IF ( IVCOMP - 6090 ) 20090, 10090, 20090
30090 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10090, 0101, 20090
10090 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0101
20090 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0101 CONTINUE
C
C **** FCVS PROGRAM 255 - TEST 010 ****
C
C TEST 010 SHOULD EXECUTE IF-BLOCKS 1 AND 2. IT SHOULD ALSO
C EXECUTE ELSE IF-BLOCK 2, PLUS MORE IF-BLOCKS 2 AND 1.
C
C
IVTNUM = 10
IF (ICZERO) 30100, 0100, 30100
0100 CONTINUE
IVCOMP = 1
LVON01 = .TRUE.
LVON02 = .TRUE.
LVON03 = .FALSE.
LVON04 = .FALSE.
LVON05 = .TRUE.
LVON06 = .FALSE.
LVON07 = .FALSE.
IF ( LVON01 ) THEN
IVCOMP = IVCOMP * 2
IF ( LVON02 ) THEN
IVCOMP = IVCOMP * 3
IF ( LVON03 ) THEN
IVCOMP = IVCOMP * 5
ELSE IF ( LVON04 ) THEN
IVCOMP = IVCOMP * 7
ELSE IF ( LVON05 ) THEN
IVCOMP = IVCOMP * 11
ELSE
IVCOMP = IVCOMP * 13
END IF
IVCOMP = IVCOMP * 17
ELSE IF ( LVON06 ) THEN
IVCOMP = IVCOMP * 19
ELSE
IVCOMP = IVCOMP * 23
END IF
IVCOMP = IVCOMP * 29
ELSE IF ( LVON07 ) THEN
IVCOMP = IVCOMP * 31
ELSE
ICON01 = 1
IF ( ICON01 ) 0103, 0102, 0103
END IF
GO TO 0103
0102 IVCOMP = IVCOMP * 37
0103 CONTINUE
C
C **** IVCOMP IS DETERMINED BY IVCOMP = 32538 = 1 * 2 * 3 * 11 *
C 17 * 29 ****
C
IVCORR = 32538
40100 IF ( IVCOMP - 32538 ) 20100, 10100, 20100
30100 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10100, 0111, 20100
10100 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0111
20100 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0111 CONTINUE
C
C **** FCVS PROGRAM 255 - TEST 011 ****
C
C TEST 011 SHOULD EXECUTE IF-BLOCKS 1 AND 2. IT SHOULD ALSO
C EXECUTE ELSE IF-BLOCK 1, PLUS MORE IF-BLOCKS 2 AND 1.
C
C
IVTNUM = 11
IF (ICZERO) 30110, 0110, 30110
0110 CONTINUE
IVCOMP = 1
LVON01 = .TRUE.
LVON02 = .TRUE.
LVON03 = .FALSE.
LVON04 = .TRUE.
LVON05 = .FALSE.
LVON06 = .FALSE.
LVON07 = .FALSE.
IF ( LVON01 ) THEN
IVCOMP = IVCOMP * 2
IF ( LVON02 ) THEN
IVCOMP = IVCOMP * 3
IF ( LVON03 ) THEN
IVCOMP = IVCOMP * 5
ELSE IF ( LVON04 ) THEN
IVCOMP = IVCOMP * 7
ELSE IF ( LVON05 ) THEN
IVCOMP = IVCOMP * 11
ELSE
IVCOMP = IVCOMP * 13
END IF
IVCOMP = IVCOMP * 17
ELSE IF ( LVON06 ) THEN
IVCOMP = IVCOMP * 19
ELSE
IVCOMP = IVCOMP * 23
END IF
IVCOMP = IVCOMP * 29
ELSE IF ( LVON07 ) THEN
IVCOMP = IVCOMP * 31
ELSE
ASSIGN 0112 TO I
GO TO I, ( 0113, 0112)
END IF
GO TO 0113
0112 IVCOMP = IVCOMP * 37
0113 CONTINUE
C
C **** IVCOMP IS DETERMINED BY IVCOMP = 20706 = 1 * 2 * 3 * 7 *
C 17 * 29 ****
C
IVCORR = 20706
40110 IF ( IVCOMP - 20706 ) 20110, 10110, 20110
30110 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10110, 0121, 20110
10110 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0121
20110 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0121 CONTINUE
C
C **** FCVS PROGRAM 255 - TEST 012 ****
C
C TEST 012 SHOULD EXECUTE IF-BLOCK 1, ELSE IF-BLOCK 3, AND MORE
C IF-BLOCK 1.
C
C
IVTNUM = 12
IF (ICZERO) 30120, 0120, 30120
0120 CONTINUE
IVCOMP = 1
LVON01 = .TRUE.
LVON02 = .FALSE.
LVON03 = .FALSE.
LVON04 = .FALSE.
LVON05 = .FALSE.
LVON06 = .TRUE.
LVON07 = .FALSE.
IF ( LVON01 ) THEN
IVCOMP = IVCOMP * 2
IF ( LVON02 ) THEN
IVCOMP = IVCOMP * 3
IF ( LVON03 ) THEN
IVCOMP = IVCOMP * 5
ELSE IF ( LVON04 ) THEN
IVCOMP = IVCOMP * 7
ELSE IF ( LVON05 ) THEN
IVCOMP = IVCOMP * 11
ELSE
IVCOMP = IVCOMP * 13
END IF
IVCOMP = IVCOMP * 17
ELSE IF ( LVON06 ) THEN
IVCOMP = IVCOMP * 19
ELSE
IVCOMP = IVCOMP * 23
END IF
IVCOMP = IVCOMP * 29
ELSE IF ( LVON07 ) THEN
IVCOMP = IVCOMP * 31
ELSE
I = 2
GO TO ( 0123, 0122 ), I
END IF
GO TO 0123
0122 IVCOMP = IVCOMP * 37
0123 CONTINUE
C
C **** IVCOMP IS DETERMINED BY IVCOMP = 1102 = 1 * 2 * 19 * 29
C
IVCORR = 1102
40120 IF ( IVCOMP - 1102 ) 20120, 10120, 20120
30120 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10120, 0131, 20120
10120 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0131
20120 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0131 CONTINUE
C
C **** FCVS PROGRAM 255 - TEST 013 ****
C
C TEST 013 SHOULD EXECUTE IF-BLOCK 1, ELSE-BLOCK 2, AND MORE
C IF-BLOCK 1.
C
C
IVTNUM = 13
IF (ICZERO) 30130, 0130, 30130
0130 CONTINUE
IVCOMP = 1
LVON01 = .TRUE.
LVON02 = .FALSE.
LVON03 = .FALSE.
LVON04 = .FALSE.
LVON05 = .FALSE.
LVON06 = .FALSE.
LVON07 = .FALSE.
IF ( LVON01 ) THEN
IVCOMP = IVCOMP * 2
IF ( LVON02 ) THEN
IVCOMP = IVCOMP * 3
IF ( LVON03 ) THEN
IVCOMP = IVCOMP * 5
ELSE IF ( LVON04 ) THEN
IVCOMP = IVCOMP * 7
ELSE IF ( LVON05 ) THEN
IVCOMP = IVCOMP * 11
ELSE
IVCOMP = IVCOMP * 13
END IF
IVCOMP = IVCOMP * 17
ELSE IF ( LVON06 ) THEN
IVCOMP = IVCOMP * 19
ELSE
IVCOMP = IVCOMP * 23
END IF
IVCOMP = IVCOMP * 29
ELSE IF ( LVON07 ) THEN
IVCOMP = IVCOMP * 31
ELSE
GO TO 0132
END IF
GO TO 0133
0132 IVCOMP = IVCOMP * 37
0133 CONTINUE
C
C **** IVCOMP IS DETERMINED BY IVCOMP = 1334 = 1 * 2 * 23 * 29
C
IVCORR = 1334
40130 IF ( IVCOMP - 1334 ) 20130, 10130, 20130
30130 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10130, 0141, 20130
10130 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0141
20130 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0141 CONTINUE
C
C **** FCVS PROGRAM 255 - TEST 014 ****
C
C TEST 014 SHOULD ONLY EXECUTE ELSE IF-BLOCK 4.
C
C
IVTNUM = 14
IF (ICZERO) 30140, 0140, 30140
0140 CONTINUE
IVCOMP = 1
LVON01 = .FALSE.
LVON02 = .FALSE.
LVON03 = .FALSE.
LVON04 = .FALSE.
LVON05 = .FALSE.
LVON06 = .FALSE.
LVON07 = .TRUE.
IF ( LVON01 ) THEN
IVCOMP = IVCOMP * 2
IF ( LVON02 ) THEN
IVCOMP = IVCOMP * 3
IF ( LVON03 ) THEN
IVCOMP = IVCOMP * 5
ELSE IF ( LVON04 ) THEN
IVCOMP = IVCOMP * 7
ELSE IF ( LVON05 ) THEN
IVCOMP = IVCOMP * 11
ELSE
IVCOMP = IVCOMP * 13
END IF
IVCOMP = IVCOMP * 17
ELSE IF ( LVON06 ) THEN
IVCOMP = IVCOMP * 19
ELSE
IVCOMP = IVCOMP * 23
END IF
IVCOMP = IVCOMP * 29
ELSE IF ( LVON07 ) THEN
IVCOMP = IVCOMP * 31
ELSE
IF ( .NOT. .FALSE. ) GO TO 0142
END IF
GO TO 0143
0142 IVCOMP = IVCOMP * 37
0143 CONTINUE
C
C **** IVCOMP IS DETERMINED BY IVCOMP = 31 = 1 * 31 ****
C
IVCORR = 31
40140 IF ( IVCOMP - 31 ) 20140, 10140, 20140
30140 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10140, 0151, 20140
10140 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0151
20140 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0151 CONTINUE
C
C **** FCVS PROGRAM 255 - TEST 015 ****
C
C TEST 015 SHOULD ONLY EXECUTE THE LOGIC IN ELSE-BLOCK 3. THIS
C LOGIC CONSISTS OF AN ARITHMETIC IF STATEMENT WHICH SHOULD TAKE
C THE EXPRESSION EQUAL TO ZERO BRANCH TO STATEMENT 0152.
C
C
IVTNUM = 15
IF (ICZERO) 30150, 0150, 30150
0150 CONTINUE
IVCOMP = 1
LVON01 = .FALSE.
LVON02 = .FALSE.
LVON03 = .FALSE.
LVON04 = .FALSE.
LVON05 = .FALSE.
LVON06 = .FALSE.
LVON07 = .FALSE.
IF ( LVON01 ) THEN
IVCOMP = IVCOMP * 2
IF ( LVON02 ) THEN
IVCOMP = IVCOMP * 3
IF ( LVON03 ) THEN
IVCOMP = IVCOMP * 5
ELSE IF ( LVON04 ) THEN
IVCOMP = IVCOMP * 7
ELSE IF ( LVON05 ) THEN
IVCOMP = IVCOMP * 11
ELSE
IVCOMP = IVCOMP * 13
END IF
IVCOMP = IVCOMP * 17
ELSE IF ( LVON06 ) THEN
IVCOMP = IVCOMP * 19
ELSE
IVCOMP = IVCOMP * 23
END IF
IVCOMP = IVCOMP * 29
ELSE IF ( LVON07 ) THEN
IVCOMP = IVCOMP * 31
ELSE
ICON01 = 1
IF ( ICON01 - 1 ) 0153, 0152, 0153
END IF
GO TO 0153
0152 IVCOMP = IVCOMP * 37
0153 CONTINUE
C
C **** IVCOMP IS DETERMINED BY IVCOMP = 37 = 1 * 37 ****
C
IVCORR = 37
40150 IF ( IVCOMP - 37 ) 20150, 10150, 20150
30150 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10150, 0161, 20150
10150 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0161
20150 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0161 CONTINUE
C
C **** FCVS PROGRAM 255 - TEST 016 ****
C
C TEST 016 IS A TEST OF THE END IF STATEMENT. SECTION 11.9
C PERMITS TRANSFER OF CONTROL FROM ANYWHERE TO AN END IF STATEMENT.
C ALSO ACCORDING TO SECTION 11.9 - EXECUTION OF AN END IF STATEMENT
C HAS NO EFFECT.
C
C
IVTNUM = 16
IF (ICZERO) 30160, 0160, 30160
0160 CONTINUE
IVCOMP = 1
LVON01 = .TRUE.
IF ( ICZERO ) 0163, 0162, 0163
0162 GO TO 0164
0163 IF ( LVON01 ) THEN
IVCOMP = IVCOMP * 2
ELSE
IVCOMP = IVCOMP * 3
0164 END IF
C
C **** IVCOMP SHOULD REMAIN SET TO ONE (1). ****
C
IVCORR = 1
40160 IF ( IVCOMP - 1 ) 20160, 10160, 20160
30160 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10160, 0171, 20160
10160 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0171
20160 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0171 CONTINUE
C
C
C WRITE OUT TEST SUMMARY
C
WRITE (I02,90004)
WRITE (I02,90014)
WRITE (I02,90004)
WRITE (I02,90000)
WRITE (I02,90004)
WRITE (I02,90020) IVFAIL
WRITE (I02,90022) IVPASS
WRITE (I02,90024) IVDELE
STOP
90001 FORMAT (1H ,24X,5HFM255)
90000 FORMAT (1H ,20X,20HEND OF PROGRAM FM255)
C
C FORMATS FOR TEST DETAIL LINES
C
80000 FORMAT (1H ,4X,I5,6X,7HDELETED)
80002 FORMAT (1H ,4X,I5,7X,4HPASS)
80010 FORMAT (1H ,4X,I5,7X,4HFAIL,10X,I6,9X,I6)
80012 FORMAT (1H ,4X,I5,7X,4HFAIL,4X,E12.5,3X,E12.5)
80018 FORMAT (1H ,4X,I5,7X,4HFAIL,2X,A14,1X,A14)
C
C FORMAT STATEMENTS FOR PAGE HEADERS
C
90002 FORMAT (1H1)
90004 FORMAT (1H )
90006 FORMAT (1H ,10X,34HFORTRAN COMPILER VALIDATION SYSTEM)
90008 FORMAT (1H ,21X,11HVERSION 1.0)
90010 FORMAT (1H ,8X,38HFOR OFFICIAL USE ONLY - COPYRIGHT 1978)
90012 FORMAT (1H ,5X,4HTEST,5X,9HPASS/FAIL,5X,8HCOMPUTED,8X,7HCORRECT)
90014 FORMAT (1H ,5X,46H----------------------------------------------)
90016 FORMAT (1H ,18X,17HSUBSET LEVEL TEST)
C
C FORMAT STATEMENTS FOR RUN SUMMARY
C
90020 FORMAT (1H ,19X,I5,13H TESTS FAILED)
90022 FORMAT (1H ,19X,I5,13H TESTS PASSED)
90024 FORMAT (1H ,19X,I5,14H TESTS DELETED)
END
*END-OF,FM255
FM256.f 480976138 170 2 100666 24140 `
*HEADER,FORTR,FM256
*FILES1,FORTR,FM256,X
PROGRAM FM256
C
C
C
C THIS ROUTINE IS A TEST OF THE DO STATEMENT. THE DO IS TESTED
C BOTH OUTSIDE AND INSIDE THE BLOCK-IF STRUCTURE. TESTS ARE MADE OF
C THE DO-VARIABLE WHEN THE DO BECOMES INACTIVE. OTHER TESTS CHECK
C LOOP AND INCREMENTATION PROCESSING. THE DO-LOOP EXECUTION
C IS TESTED FOR THOSE CONDITIONS WHICH MAKE THE DO-LOOP INACTIVE.
C
C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN,
C X3.9-1978
C SECTION 11.10, DO STATEMENT
C SECTION 11.10.1, RANGE OF A DO-LOOP
C SECTION 11.10.2, ACTIVE AND INACTIVE DO-LOOPS
C SECTION 11.10.3, EXECUTING A DO STATEMENT
C SECTION 11.10.4, LOOP CONTROL PROCESSING
C SECTION 11.10.5, EXECUTION OF THE RANGE
C SECTION 11.10.6, TERMINAL STATEMENT EXECUTION
C SECTION 11.10.7, INCREMENTATION PROCESSING
C
C FM012 - TESTS THE DO STATEMENT WITH THE FORTRAN 66 CONCEPTS OF
C EXTENDED RANGE OF A DO STATEMENT.
C
C
C
C ******************************************************************
C A COMPILER VALIDATION SYSTEM FOR THE FORTRAN LANGUAGE
C BASED ON SPECIFICATIONS AS DEFINED IN AMERICAN STANDARD FORTRAN
C X3.9-1978, HAS BEEN DEVELOPED BY THE DEPARTMENT OF THE NAVY. THE
C FORTRAN COMPILER VALIDATION SYSTEM (FCVS) CONSISTS OF AUDIT
C ROUTINES, THEIR RELATED DATA, AND AN EXECUTIVE SYSTEM. EACH AUDIT
C ROUTINE IS A FORTRAN PROGRAM OR SUBPROGRAM WHICH INCLUDES TESTS
C OF SPECIFIC LANGUAGE ELEMENTS AND SUPPORTING PROCEDURES INDICATING
C THE RESULT OF EXECUTING THESE TESTS.
C
C THIS PARTICULAR PROGRAM OR SUBPROGRAM CONTAINS ONLY FEATURES
C FOUND IN THE SUBSET LEVEL OF THE STANDARD.
C
C SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO
C DEPARTMENT OF THE NAVY
C FEDERAL COBOL COMPILER TESTING SERVICE
C WASHINGTON, D.C. 20376
C
C ******************************************************************
C
C
IMPLICIT LOGICAL (L)
IMPLICIT CHARACTER*14 (C)
C
C
C
C INITIALIZATION SECTION.
C
C INITIALIZE CONSTANTS
C ********************
C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER
I01 = 5
C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER
I02 = 6
C SYSTEM ENVIRONMENT SECTION
C
CX010 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-010 CONTROL CARD.
C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5
C (UNIT NUMBER FOR CARD READER).
CX011 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-011 CONTROL CARD
C THE CX011 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL
C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX010 ABOVE.
C
CX020 THIS CARD IS PEPLACED BY CONTENTS OF FEXEC X-020 CONTROL CARD.
C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02 = 6
C (UNIT NUMBER FOR PRINTER).
CX021 THIS CARD IS PEPLACED BY CONTENTS OF FEXEC X-021 CONTROL CARD.
C THE CX021 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL
C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX020 ABOVE.
C
IVPASS = 0
IVFAIL = 0
IVDELE = 0
ICZERO = 0
C
C WRITE OUT PAGE HEADERS
C
WRITE (I02,90002)
WRITE (I02,90006)
WRITE (I02,90008)
WRITE (I02,90004)
WRITE (I02,90010)
WRITE (I02,90004)
WRITE (I02,90016)
WRITE (I02,90001)
WRITE (I02,90004)
WRITE (I02,90012)
WRITE (I02,90014)
WRITE (I02,90004)
C
C
C **** FCVS PROGRAM 256 - TEST 001 ****
C
C TEST 001 CHECKS THE SIMPLE DO STATEMENT WITH THE OPTIONAL
C COMMAS AND ALL DO PARAMETERS SPECIFIED. THE LOOP IS ACTIVE FOR
C TEN COUNTS. THE FINAL VALUE OF THE INTEGER COUNTER SHOULD BE
C EQUAL TO TEN (10). THE FORM OF THE DO STATEMENT USED IN THIS TEST
C IS SHOWN BELOW -
C
C DO S, I = E1, E2, E3
C
C
IVTNUM = 1
IF (ICZERO) 30010, 0010, 30010
0010 CONTINUE
IVCOMP = 0
DO 0012, IVON01 = 1, 10, 1
IVCOMP = IVCOMP + 1
0012 CONTINUE
IVCORR = 10
40010 IF ( IVCOMP - 10 ) 20010, 10010, 20010
30010 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10010, 0021, 20010
10010 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0021
20010 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0021 CONTINUE
C
C **** FCVS PROGRAM 256 - TEST 002 ****
C
C TEST 002 IS SIMILAR TO THE PREVIOUS TEST EXCEPT THAT THE COMMAS
C THAT ARE OPTIONAL HAVE BEEN DELETED AS A SYNTAX CHECK.
C
C THE INCREMENTATION PARAMETER IS OPTIONAL AND NOT PRESENT IN
C THIS TEST. ACCORDING TO SECTION 11.10.3, IF E3 DOES NOT APPEAR
C THEN M3 HAS A VALUE OF ONE. THE DO STATEMENT FOR THIS TEST IS OF
C THE FORM SHOWN BELOW -
C
C DO S I = E1, E2
C
C
IVTNUM = 2
IF (ICZERO) 30020, 0020, 30020
0020 CONTINUE
IVCOMP = 0
DO 0022 IVON01 = 1, 10
IVCOMP = IVCOMP + 1
0022 CONTINUE
IVCORR = 10
40020 IF ( IVCOMP - 10 ) 20020, 10020, 20020
30020 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10020, 0031, 20020
10020 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0031
20020 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0031 CONTINUE
C
C **** FCVS PROGRAM 256 - TEST 003 ****
C
C TEST 003 HAS A DO STATEMENT INSIDE A BLOCKED IF STRUCTURE.
C THE LOGICAL EXPRESSION IS TRUE SO THE DO-LOOP SHOULD BE EXECUTED
C A TOTAL OF TEN TIMES.
C
C
IVTNUM = 3
IF (ICZERO) 30030, 0030, 30030
0030 CONTINUE
IVCOMP = 0
LVON01 = .TRUE.
IF ( LVON01 ) THEN
DO 0032 IVON01 = 1, 10, 1
IVCOMP = IVCOMP + 1
0032 CONTINUE
END IF
IVCORR = 10
40030 IF ( IVCOMP - 10 ) 20030, 10030, 20030
30030 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10030, 0041, 20030
10030 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0041
20030 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0041 CONTINUE
C
C **** FCVS PROGRAM 256 - TEST 004 ****
C
C TEST 004 IS SIMILAR TO THE PREVIOUS TEST EXCEPT THAT THE DO
C STATEMENT IS LOCATED IN AN ELSE IF-BLOCK. THE DO-LOOP SHOULD BE
C EXECUTED FIVE (5) TIMES.
C
C
IVTNUM = 4
IF (ICZERO) 30040, 0040, 30040
0040 CONTINUE
IVCOMP = 0
LVON01 = .FALSE.
LVON02 = .TRUE.
IF ( LVON01 ) THEN
IVCOMP = 32000
ELSE IF ( LVON02 ) THEN
DO 0042 IVON01 = 1, 5
IVCOMP = IVCOMP + 1
0042 CONTINUE
END IF
IVCORR = 5
40040 IF ( IVCOMP - 5 ) 20040, 10040, 20040
30040 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10040, 0051, 20040
10040 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0051
20040 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0051 CONTINUE
C
C **** FCVS PROGRAM 256 - TEST 005 ****
C
C TEST 005 IS SIMILAR TO THE PREVIOUS TWO TESTS EXCEPT THAT THE
C DO STATEMENT IS CONTAINED IN AN ELSE-BLOCK. THE DO-LOOP SHOULD BE
C EXECUTED A TOTAL OF 3 TIMES.
C
C
IVTNUM = 5
IF (ICZERO) 30050, 0050, 30050
0050 CONTINUE
IVCOMP = 0
LVON01 = .FALSE.
LVON02 = .FALSE.
IF ( LVON01 ) THEN
IVCOMP = 100
ELSE IF ( LVON02 ) THEN
IVCOMP = 1000
ELSE
DO 0052 IVON01 = 1, 3
IVCOMP = IVCOMP + 1
0052 CONTINUE
END IF
IVCORR = 3
40050 IF ( IVCOMP - 3 ) 20050, 10050, 20050
30050 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10050, 0061, 20050
10050 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0061
20050 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0061 CONTINUE
C
C **** FCVS PROGRAM 256 - TEST 006 ****
C
C TEST 006 HAS A BLOCKED IF STRUCTURE INSIDE A DO-LOOP.
C THE LOOP IS EXECUTED THREE (3) TIMES. ALL THREE PARTS OF THE
C BLOCK-IF STRUCTURE SHOULD BE EXECUTED.
C
C
IVTNUM = 6
IF (ICZERO) 30060, 0060, 30060
0060 CONTINUE
IVCOMP = 1
DO 0062 IVON01 = 3, 5, 1
IF ( IVON01 .LE. 3 ) THEN
IVCOMP = IVCOMP * 2
ELSE IF ( IVON01 .GT. 3 .AND. IVON01 .LT. 5 ) THEN
IVCOMP = IVCOMP * 3
ELSE
IVCOMP = IVCOMP * 5
END IF
0062 CONTINUE
C
C **** IVCOMP IS DETERMINED BY IVCOMP = 30 = 1 * 2 * 3 * 5 ****
C
IVCORR = 30
40060 IF ( IVCOMP - 30 ) 20060, 10060, 20060
30060 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10060, 0071, 20060
10060 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0071
20060 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0071 CONTINUE
C
C
C THE FOLLOWING SERIES OF TESTS CHECK THE DO-VARIABLE WHEN THE
C DO-LOOP BECOMES INACTIVE. ACCORDING TO SECTION 11.10.2, WHEN A
C DO-LOOP BECOMES INACTIVE, THE DO-VARIABLE OF THE DO-LOOP RETAINS
C ITS LAST DEFINED VALUE.
C
C
C
C **** FCVS PROGRAM 256 - TEST 007 ****
C
C TEST 007 CHECKS THAT THE DO-VARIABLE CONTAINS ITS LAST DEFINED
C VALUE WHEN THE ITERATION COUNT IS ZERO.
C
C
IVTNUM = 7
IF (ICZERO) 30070, 0070, 30070
0070 CONTINUE
IVCOMP = 0
IVON02 = 0
DO 0072 IVON01 = 100, 105, 2
IVON02 = IVON02 + 1
0072 CONTINUE
IVCOMP = IVON01
IVCORR = 106
40070 IF ( IVCOMP - 106 ) 20070, 10070, 20070
30070 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10070, 0081, 20070
10070 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0081
20070 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0081 CONTINUE
C
C **** FCVS PROGRAM 256 - TEST 008 ****
C
C TEST 008 CHECKS THAT THE LOOP COUNTER IN THE PREVIOUS TEST HAD
C A VALUE OF THREE TO SHOW THAT THE DO-LOOP WAS EXECUTED THREE TIMES
C BEFORE TERMINATING ( BECOMMING INACTIVE ).
C
C
IVTNUM = 8
IF (ICZERO) 30080, 0080, 30080
0080 CONTINUE
IVCOMP = 0
IVCOMP = IVON02
IVCORR = 3
40080 IF ( IVCOMP - 3 ) 20080, 10080, 20080
30080 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10080, 0091, 20080
10080 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0091
20080 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0091 CONTINUE
C
C **** FCVS PROGRAM 256 - TEST 009 ****
C
C TEST 009 CHECKS THAT A DO-LOOP BECOMES INACTIVE IF THERE IS A
C TRANSFER OF CONTROL OUTSIDE THE RANGE OF THE DO-LOOP. THE TRANS-
C FER MUST BE INSIDE OF THE SAME PROGRAM UNIT - NOT A CALL OR
C FUNCTION REFERENCE TO A SUBPROGRAM.
C
C THIS IS A SIGNIFICANT DIFFERENCE BETWEEN FORTRAN 66 AND FORTRAN
C 77. FORTRAN 66 HAD AN EXTENDED RANGE OF THE DO FEATURE WHICH
C ALLOWED FOR A TRANSFER OUTSIDE THE RANGE OF A DO-LOOP WITHOUT
C MAKING THE DO-LOOP INACTIVE.
C
C
IVTNUM = 9
IF (ICZERO) 30090, 0090, 30090
0090 CONTINUE
IVCOMP = 0
DO 0092 IVON01 = 1, 7
IF ( IVON01 .GE. 3 ) GO TO 0093
0092 CONTINUE
0093 IVCOMP = IVON01
IVCORR = 3
40090 IF ( IVCOMP - 3 ) 20090, 10090, 20090
30090 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10090, 0101, 20090
10090 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0101
20090 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0101 CONTINUE
C
C **** FCVS PROGRAM 256 - TEST 010 ****
C
C TEST 010 CHECKS FOR AN INITIAL COUNT EQUAL TO ZERO BECAUSE
C M1 IS GREATER THAN M2 AND M3 IS GREATER THAN ZERO - SEE SECTION
C 11.10.3 FOR CONDITIONS WHICH MAKE THE ITERATION COUNT ZERO.
C THE LOOP SHOULD NOT BE EXECUTED AT ALL.
C
C
IVTNUM = 10
IF (ICZERO) 30100, 0100, 30100
0100 CONTINUE
IVCOMP = 0
DO 0102 IVON01 = 100, 10, 3
IVCOMP = IVCOMP + 1
0102 CONTINUE
IVCORR = 0
40100 IF ( IVCOMP ) 20100, 10100, 20100
30100 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10100, 0111, 20100
10100 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0111
20100 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0111 CONTINUE
C
C **** FCVS PROGRAM 256 - TEST 011 ****
C
C TEST 011 CHECKS FOR THE PROPER EXECUTION OF THE STEPS AS SHOWN
C IN SECTION 11.10.3 - EXECUTING A DO STATEMENT. THE VARIABLE IVON0
C SHOULD HAVE BEEN SET TO 100. THE ITERATION COUNT IS ZERO BY THE
C FORMULA IN 11.10.3(3). AS DESCRIBED IN SECTION 11.10.4 - THE
C ITERATION COUNT IS TESTED. IF IT IS NOT ZERO, EXECUTION OF THE
C FIRST STATEMENT IN THE RANGE OF THE DO-LOOP BEGINS. IF THE
C ITERATION COUNT IS ZERO, THE DO-LOOP BECOMES INACTIVE.
C
C
IVTNUM = 11
IF (ICZERO) 30110, 0110, 30110
0110 CONTINUE
IVCOMP = 0
IVCOMP = IVON01
IVCORR = 100
40110 IF ( IVCOMP - 100 ) 20110, 10110, 20110
30110 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10110, 0121, 20110
10110 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0121
20110 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0121 CONTINUE
C
C
C THE FOLLOWING TWO TESTS ARE SIMILAR TO THE PREVIOUS TWO TESTS
C IN THAT THE PARAMETERS OF THE DO STATEMENT MAKE THE ITERATION
C COUNT ZERO WHEN THE DO STATEMENT IS EXECUTED.
C
C
C
C **** FCVS PROGRAM 256 - TEST 012 ****
C
C TEST 012 HAS M1 LESS THAN M2, BUT M3 IS NEGATIVE. THE LOOP
C SHOULD NOT BE EXECUTED AT ALL.
C
C
IVTNUM = 12
IF (ICZERO) 30120, 0120, 30120
0120 CONTINUE
IVCOMP = 0
DO 0122 IVON01 = 10, 100, -3
IVCOMP = IVCOMP + 1
0122 CONTINUE
IVCORR = 0
40120 IF ( IVCOMP ) 20120, 10120, 20120
30120 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10120, 0131, 20120
10120 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0131
20120 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0131 CONTINUE
C
C **** FCVS PROGRAM 256 - TEST 013 ****
C
C TEST 013 CHECKS THAT THE VALUE RETAINED FOR THE DO-VARIABLE
C IN THE PREVIOUS TEST IS EQUAL TO THE INITIAL PARAMETER VALUE - M3.
C
C
IVTNUM = 13
IF (ICZERO) 30130, 0130, 30130
0130 CONTINUE
IVCOMP = 0
IVCOMP = IVON01
IVCORR = 10
40130 IF ( IVCOMP - 10 ) 20130, 10130, 20130
30130 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10130, 0141, 20130
10130 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0141
20130 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0141 CONTINUE
C
C **** FCVS PROGRAM 256 - TEST 014 ****
C
C TEST 014 CHECKS FOR ONE EXECUTION OF THE RANGE OF A DO-LOOP
C ACCORDING TO THE FORMULA SHOWN IN 11.10.3(3) WITH M1 = M2.
C
C THE DO-LOOPS IN THIS TEST ARE A NEST OF THREE EACH WITH ITS
C OWN TERMINAL STATEMENT.
C
C
IVTNUM = 14
IF (ICZERO) 30140, 0140, 30140
0140 CONTINUE
IVCOMP = 1
DO 0144 IVON01 = 1, 1, 1
IVCOMP = IVCOMP * 2
DO 0143 IVON02 = 10,10,10
IVCOMP = IVCOMP * 3
DO 0142 IVON03 = 100, 100, -2
IVCOMP = IVCOMP * 5
0142 CONTINUE
0143 CONTINUE
0144 CONTINUE
C
C **** IVCOMP IS DETERMINED BY IVCOMP = 30 = 1 * 2 * 3 * 5 ***
C
IVCORR = 30
40140 IF ( IVCOMP - 30 ) 20140, 10140, 20140
30140 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10140, 0151, 20140
10140 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0151
20140 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0151 CONTINUE
C
C **** FCVS PROGRAM 256 - TEST 015 ****
C
C TEST 015 IS A CHECK ON THE FIRST EXAMPLE SHOWN IN SECTION
C 11.10.7. THIS IS A TEST OF INCREMENTATION PROCESSING OF TWO NEST
C DO-LOOPS HAVING THE SAME TERMINAL STATEMENT.
C
C THIS IS A TEST OF A DO-LOOP THAT BECOMES ACTIVE INSIDE AN
C ALREADY ACTIVE DO-LOOP.
C
C
IVTNUM = 15
IF (ICZERO) 30150, 0150, 30150
0150 CONTINUE
IVCOMP = 0
IVON01 = 0
DO 0152 IVON02 = 1, 10
IVON03 = IVON02
DO 0152 IVON04 = 1, 5
IVON05 = IVON04
0152 IVON01 = IVON01 + 1
0153 CONTINUE
IVCOMP = IVON02
C THIS IS THE VALUE FOR I IN THE EXAMPLE.
IVCORR = 11
40150 IF ( IVCOMP - 11 ) 20150, 10150, 20150
30150 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10150, 0161, 20150
10150 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0161
20150 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0161 CONTINUE
C
C **** FCVS PROGRAM 256 - TEST 016 ****
C
C TEST 016 CHECKS THE VALUE OF J (IVON03) IN THE FIRST EXAMPLE.
C
C
IVTNUM = 16
IF (ICZERO) 30160, 0160, 30160
0160 CONTINUE
IVCOMP = 0
IVCOMP = IVON03
IVCORR = 10
40160 IF ( IVCOMP - 10 ) 20160, 10160, 20160
30160 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10160, 0171, 20160
10160 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0171
20160 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0171 CONTINUE
C
C **** FCVS PROGRAM 256 - TEST 017 ****
C
C TEST 017 CHECKS THE VALUE OF K (IVON04) IN THE FIRST EXAMPLE.
C
C
IVTNUM = 17
IF (ICZERO) 30170, 0170, 30170
0170 CONTINUE
IVCOMP = 0
IVCOMP = IVON04
IVCORR = 6
40170 IF ( IVCOMP - 6 ) 20170, 10170, 20170
30170 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10170, 0181, 20170
10170 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0181
20170 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0181 CONTINUE
C
C **** FCVS PROGRAM 256 - TEST 018 ****
C
C TEST 018 CHECKS THE VALUE OF L (IVON05) IN THE FIRST EXAMPLE.
C
C
IVTNUM = 18
IF (ICZERO) 30180, 0180, 30180
0180 CONTINUE
IVCOMP = 0
IVCOMP = IVON05
IVCORR = 5
40180 IF ( IVCOMP - 5 ) 20180, 10180, 20180
30180 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10180, 0191, 20180
10180 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0191
20180 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0191 CONTINUE
C
C **** FCVS PROGRAM 256 - TEST 019 ****
C
C TEST 019 CHECKS THE VALUE OF N (IVON01) IN THE FIRST EXAMPLE.
C
C
IVTNUM = 19
IF (ICZERO) 30190, 0190, 30190
0190 CONTINUE
IVCOMP = 0
IVCOMP = IVON01
IVCORR = 50
40190 IF ( IVCOMP - 50 ) 20190, 10190, 20190
30190 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10190, 0201, 20190
10190 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0201
20190 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0201 CONTINUE
C
C **** FCVS PROGRAM 256 - TEST 020 ****
C
C TEST 020 IS A CHECK ON THE SECOND EXAMPLE IN SECTION 11.10.7.
C IN THIS EXAMPLE, THE INNER DO-LOOP BECOMES ACTIVE AND THEN
C IMMEDIATELY INACTIVE INSIDE AN ALREADY ACTIVE OUTER DO-LOOP.
C
C ALTHOUGH IN SOME WAYS SIMILAR TO THE FIRST EXAMPLE, THE SECOND
C EXAMPLE SHOULD HAVE DIFFERENT FINAL VALUES ON THE INTEGER COUNTERS
C AND THE VALUE OF L (IVON10) WILL NOT BE TESTED BECAUSE IT IS NOT
C DEFINED DURING THE RANGE OF THE DO-LOOP INVOLVED.
C
C
IVTNUM = 20
IF (ICZERO) 30200, 0200, 30200
0200 CONTINUE
IVCOMP = 0
IVON06 = 0
DO 0202 IVON07 = 1, 10
IVON08 = IVON07
DO 0202 IVON09 = 5, 1
IVON10 = IVON09
0202 IVON06 = IVON06 + 1
0203 CONTINUE
IVCOMP = IVON07
C THIS IS THE VALUE FOR I IN THE SECOND EXAMPLE.
IVCORR = 11
40200 IF ( IVCOMP - 11 ) 20200, 10200, 20200
30200 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10200, 0211, 20200
10200 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0211
20200 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0211 CONTINUE
C
C **** FCVS PROGRAM 256 - TEST 021 ****
C
C TEST 021 CHECKS THE VALUE OF J (IVON08) IN THE SECOND EXAMPLE.
C
C
IVTNUM = 21
IF (ICZERO) 30210, 0210, 30210
0210 CONTINUE
IVCOMP = 0
IVCOMP = IVON08
IVCORR = 10
40210 IF ( IVCOMP - 10 ) 20210, 10210, 20210
30210 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10210, 0221, 20210
10210 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0221
20210 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0221 CONTINUE
C
C **** FCVS PROGRAM 256 - TEST 022 ****
C
C TEST 022 CHECKS THE VALUE OF K (IVON09) IN THE SECOND EXAMPLE.
C
C
IVTNUM = 22
IF (ICZERO) 30220, 0220, 30220
0220 CONTINUE
IVCOMP = 0
IVCOMP = IVON09
IVCORR = 5
40220 IF ( IVCOMP - 5 ) 20220, 10220, 20220
30220 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10220, 0231, 20220
10220 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0231
20220 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0231 CONTINUE
C
C **** FCVS PROGRAM 256 - TEST 023 ****
C
C TEST 023 CHECKS THE VALUE OF N (IVON06) IN THE SECOND EXAMPLE.
C
C
IVTNUM = 23
IF (ICZERO) 30230, 0230, 30230
0230 CONTINUE
IVCOMP = 0
IVCOMP = IVON06
IVCORR = 0
40230 IF ( IVCOMP - 0 ) 20230, 10230, 20230
30230 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10230, 0241, 20230
10230 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0241
20230 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0241 CONTINUE
C
C **** FCVS PROGRAM 256 - TEST 024 ****
C
C TEST 024 IS A CHECK ON USING A LOGICAL IF STATEMENT AS THE
C TERMINAL STATEMENT IN THE RANGE OF A DO-LOOP. THE LOGICAL IF
C STATEMENT HAS AN UNCONDITIONAL GO TO STATEMENT AS ITS EXECUTABLE
C STATEMENT AS ALLOWED IN SECTION 11.10.
C
C
IVTNUM = 24
IF (ICZERO) 30240, 0240, 30240
0240 CONTINUE
IVCOMP = 0
DO 0242 IVON01 = 1, 10
IVCOMP = IVCOMP + 1
0242 IF ( IVON01 .GE. 5 ) GO TO 0243
C
C
C IF THE LOGIC DOES NOT BRANCH OUT OF THE RANGE OF THE DO-LOOP WHEN
C THE DO-VARIABLE (IVON01) IS EQUAL TO FIVE (5), THEN IVCOMP WILL BE
C SET BACK TO THE VALUE OF ZERO.
C
IVCOMP = 0
C
C
0243 IVCORR = 5
40240 IF ( IVCOMP - 5 ) 20240, 10240, 20240
30240 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10240, 0251, 20240
10240 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0251
20240 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0251 CONTINUE
C
C
C WRITE OUT TEST SUMMARY
C
WRITE (I02,90004)
WRITE (I02,90014)
WRITE (I02,90004)
WRITE (I02,90000)
WRITE (I02,90004)
WRITE (I02,90020) IVFAIL
WRITE (I02,90022) IVPASS
WRITE (I02,90024) IVDELE
STOP
90001 FORMAT (1H ,24X,5HFM256)
90000 FORMAT (1H ,20X,20HEND OF PROGRAM FM256)
C
C FORMATS FOR TEST DETAIL LINES
C
80000 FORMAT (1H ,4X,I5,6X,7HDELETED)
80002 FORMAT (1H ,4X,I5,7X,4HPASS)
80010 FORMAT (1H ,4X,I5,7X,4HFAIL,10X,I6,9X,I6)
80012 FORMAT (1H ,4X,I5,7X,4HFAIL,4X,E12.5,3X,E12.5)
80018 FORMAT (1H ,4X,I5,7X,4HFAIL,2X,A14,1X,A14)
C
C FORMAT STATEMENTS FOR PAGE HEADERS
C
90002 FORMAT (1H1)
90004 FORMAT (1H )
90006 FORMAT (1H ,10X,34HFORTRAN COMPILER VALIDATION SYSTEM)
90008 FORMAT (1H ,21X,11HVERSION 1.0)
90010 FORMAT (1H ,8X,38HFOR OFFICIAL USE ONLY - COPYRIGHT 1978)
90012 FORMAT (1H ,5X,4HTEST,5X,9HPASS/FAIL,5X,8HCOMPUTED,8X,7HCORRECT)
90014 FORMAT (1H ,5X,46H----------------------------------------------)
90016 FORMAT (1H ,18X,17HSUBSET LEVEL TEST)
C
C FORMAT STATEMENTS FOR RUN SUMMARY
C
90020 FORMAT (1H ,19X,I5,13H TESTS FAILED)
90022 FORMAT (1H ,19X,I5,13H TESTS PASSED)
90024 FORMAT (1H ,19X,I5,14H TESTS DELETED)
END
*END-OF,FM256
FM257.f 480976139 170 2 100666 9070 `
*HEADER,FORTR,FM257
*FILES1,FORTR,FM257,X
PROGRAM FM257
C
C
C
C THIS ROUTINE IS A TEST OF THE PAUSE AND STOP STATEMENTS. THESE
C STATEMENTS CAN NOW BE FOLLOWED BY A STRING OF NOT MORE THAN FIVE
C DIGITS, OR A CHARACTER CONSTANT.
C
C REFERENCES
C REFERENCES
C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN,
C X3.9-1978
C SECTION 11.12, STOP STATEMENT
C SECTION 11.13, PAUSE STATEMENT
C
C FM015 - TESTS THE STOP AND PAUSE STATEMENTS USING AN OCTAL
C DIGIT STRING OF LENGTH FROM ONE TO FIVE.
C
C
C
C ******************************************************************
C A COMPILER VALIDATION SYSTEM FOR THE FORTRAN LANGUAGE
C BASED ON SPECIFICATIONS AS DEFINED IN AMERICAN STANDARD FORTRAN
C X3.9-1978, HAS BEEN DEVELOPED BY THE DEPARTMENT OF THE NAVY. THE
C FORTRAN COMPILER VALIDATION SYSTEM (FCVS) CONSISTS OF AUDIT
C ROUTINES, THEIR RELATED DATA, AND AN EXECUTIVE SYSTEM. EACH AUDIT
C ROUTINE IS A FORTRAN PROGRAM OR SUBPROGRAM WHICH INCLUDES TESTS
C OF SPECIFIC LANGUAGE ELEMENTS AND SUPPORTING PROCEDURES INDICATING
C THE RESULT OF EXECUTING THESE TESTS.
C
C THIS PARTICULAR PROGRAM OR SUBPROGRAM CONTAINS ONLY FEATURES
C FOUND IN THE SUBSET LEVEL OF THE STANDARD.
C
C SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO
C DEPARTMENT OF THE NAVY
C FEDERAL COBOL COMPILER TESTING SERVICE
C WASHINGTON, D.C. 20376
C
C ******************************************************************
C
C
IMPLICIT LOGICAL (L)
IMPLICIT CHARACTER*14 (C)
C
C
C
C INITIALIZATION SECTION.
C
C INITIALIZE CONSTANTS
C ********************
C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER
I01 = 5
C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER
I02 = 6
C SYSTEM ENVIRONMENT SECTION
C
CX010 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-010 CONTROL CARD.
C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5
C (UNIT NUMBER FOR CARD READER).
CX011 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-011 CONTROL CARD
C THE CX011 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL
C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX010 ABOVE.
C
CX020 THIS CARD IS PEPLACED BY CONTENTS OF FEXEC X-020 CONTROL CARD.
C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02 = 6
C (UNIT NUMBER FOR PRINTER).
CX021 THIS CARD IS PEPLACED BY CONTENTS OF FEXEC X-021 CONTROL CARD.
C THE CX021 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL
C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX020 ABOVE.
C
IVPASS = 0
IVFAIL = 0
IVDELE = 0
ICZERO = 0
C
C WRITE OUT PAGE HEADERS
C
WRITE (I02,90002)
WRITE (I02,90006)
WRITE (I02,90008)
WRITE (I02,90004)
WRITE (I02,90010)
WRITE (I02,90004)
WRITE (I02,90016)
WRITE (I02,90001)
WRITE (I02,90004)
WRITE (I02,90012)
WRITE (I02,90014)
WRITE (I02,90004)
C
C
C
C THE FOLLOWING SERIES OF TESTS CHECK THE VARIOUS FORMS OF THE
C PAUSE STATEMENT. IN EACH CASE THE WORD PAUSE (FOLLOWED BY A
C STRING OF CHARACTERS AS NOTED IN EACH TEST DESCRIPTION), SHOULD BE
C DISPLAYED ON THE OPERATORS CONSOLE. FOR EACH TEST THE OPERATOR
C NEED ONLY DO WHATEVER IS NESSARY TO TELL THE SYSTEM TO CONTINUE
C THE EXECUTION OF THE ROUTINE. THE STRING FORMS ARE AS DESCRIBED
C IN SECTION 11.13.
C
C
C
C **** FCVS PROGRAM 257 - TEST 001 ****
C
C TEST 001 CHECKS THE PAUSE STATEMENT THAT IS NOT FOLLOWED BY
C A STRING OF ANYTHING EXCEPT BLANKS. ONLY THE WORD PAUSE SHOULD
C BE DISPLAYED.
C
C
IVTNUM = 1
IF (ICZERO) 30010, 0010, 30010
0010 CONTINUE
PAUSE
C
C ***** THESE CARDS INITIALIZE IVCOMP AND IVCORR FOR THE NEXT
C FIVE TESTS EVEN THOUGH THEY ONLY APPEAR IN THE FAIL CODE
C OF THE BOILERPLATE.*****
IVCOMP = 1
IVCORR = 1
C
C
40010 IF ( ICZERO ) 20010, 10010, 20010
30010 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10010, 0021, 20010
10010 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0021
20010 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0021 CONTINUE
C
C **** FCVS PROGRAM 257 - TEST 002 ****
C
C TEST 002 SHOULD DISPLAY THE WORD PAUSE FOLLOWED BY A SINGLE
C CHARACTER ZERO (0).
C
C
IVTNUM = 2
IF (ICZERO) 30020, 0020, 30020
0020 CONTINUE
PAUSE 0
40020 IF ( ICZERO ) 20020, 10020, 20020
30020 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10020, 0031, 20020
10020 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0031
20020 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0031 CONTINUE
C
C **** FCVS PROGRAM 257 - TEST 003 ****
C
C TEST 003 SHOULD DISPLAY THE WORD PAUSE FOLLOWED BY A STRING OF
C FIVE ZEROS (00000).
C
C
IVTNUM = 3
IF (ICZERO) 30030, 0030, 30030
0030 CONTINUE
PAUSE 00000
40030 IF ( ICZERO ) 20030, 10030, 20030
30030 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10030, 0041, 20030
10030 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0041
20030 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0041 CONTINUE
C
C **** FCVS PROGRAM 257 - TEST 004 ****
C
C TEST 004 SHOULD DISPLAY THE WORD PAUSE FOLLOWED BY THE STRING
C OF FIVE CHARACTERS 19283.
C
C
IVTNUM = 4
IF (ICZERO) 30040, 0040, 30040
0040 CONTINUE
PAUSE 19283
40040 IF ( ICZERO ) 20040, 10040, 20040
30040 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10040, 0051, 20040
10040 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0051
20040 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0051 CONTINUE
C
C **** FCVS PROGRAM 257 - TEST 005 ****
C
C TEST 005 SHOULD DISPLAY THE WORD PAUSE FOLLOWED BY THE STRING
C OF FOUR NINES (9999).
C
C
IVTNUM = 5
IF (ICZERO) 30050, 0050, 30050
0050 CONTINUE
PAUSE 9999
40050 IF ( ICZERO ) 20050, 10050, 20050
30050 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10050, 0061, 20050
10050 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0061
20050 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0061 CONTINUE
C
C **** FCVS PROGRAM 257 - TEST 006 ****
C
C TEST 006 IS FOR THE STOP STATEMENT - SECTION 11.12.
C SINCE THE STOP STATEMENT CAN ONLY BE EXECUTED ONCE IN A PROGRAM
C UNIT, VARIOUS FORMATS OF THE STOP STATEMENT WILL BE CHECKED FOR
C SYNTAX ONLY BY THE USE OF A COMPUTED GO TO STATEMENT.
C
C ONCE THE STOP STATEMENT HAS BEEN EXECUTED, THEN THE ROUTINE
C FM257 SHOULD NO LONGER EXECUTE. ANY CONTINUATION IS CONSIDERED AS
C A FAILURE OF THIS TEST.
C
C
IVTNUM = 6
IF (ICZERO) 30060, 0060, 30060
0060 CONTINUE
IVON01 = 6
GO TO ( 0062, 0063, 0064, 0065, 0066, 0067, 40060 ), IVON01
C
0062 STOP 0
0063 STOP 00000
0064 STOP 12345
0065 STOP 9999
0066 STOP 'IMA 1'
0067 STOP 'P ASS'
C
C **** THE TEST FAILS IF IT GOES BEYOND THE STOP STATEMENTS ****
C
40060 IF ( ICZERO ) 10060, 20060, 10060
C ***** NOTE THAT THE NORMAL PASS-10060 AND FAIL-20060 LABELS
C ARE REVERSED BECAUSE IF THE LOGIC EXECUTES THIS STATEMENT
C THEN THE STOP STATEMENT FAILS TO EXECUTE CORRECTLY. *****
30060 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10060, 0071, 20060
10060 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0071
20060 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0071 CONTINUE
C
C
C WRITE OUT TEST SUMMARY
C
WRITE (I02,90004)
WRITE (I02,90014)
WRITE (I02,90004)
WRITE (I02,90000)
WRITE (I02,90004)
WRITE (I02,90020) IVFAIL
WRITE (I02,90022) IVPASS
WRITE (I02,90024) IVDELE
STOP
90001 FORMAT (1H ,24X,5HFM257)
90000 FORMAT (1H ,20X,20HEND OF PROGRAM FM257)
C
C FORMATS FOR TEST DETAIL LINES
C
80000 FORMAT (1H ,4X,I5,6X,7HDELETED)
80002 FORMAT (1H ,4X,I5,7X,4HPASS)
80010 FORMAT (1H ,4X,I5,7X,4HFAIL,10X,I6,9X,I6)
80012 FORMAT (1H ,4X,I5,7X,4HFAIL,4X,E12.5,3X,E12.5)
80018 FORMAT (1H ,4X,I5,7X,4HFAIL,2X,A14,1X,A14)
C
C FORMAT STATEMENTS FOR PAGE HEADERS
C
90002 FORMAT (1H1)
90004 FORMAT (1H )
90006 FORMAT (1H ,10X,34HFORTRAN COMPILER VALIDATION SYSTEM)
90008 FORMAT (1H ,21X,11HVERSION 1.0)
90010 FORMAT (1H ,8X,38HFOR OFFICIAL USE ONLY - COPYRIGHT 1978)
90012 FORMAT (1H ,5X,4HTEST,5X,9HPASS/FAIL,5X,8HCOMPUTED,8X,7HCORRECT)
90014 FORMAT (1H ,5X,46H----------------------------------------------)
90016 FORMAT (1H ,18X,17HSUBSET LEVEL TEST)
C
C FORMAT STATEMENTS FOR RUN SUMMARY
C
90020 FORMAT (1H ,19X,I5,13H TESTS FAILED)
90022 FORMAT (1H ,19X,I5,13H TESTS PASSED)
90024 FORMAT (1H ,19X,I5,14H TESTS DELETED)
END
*END-OF,FM257
FM258.f 480976141 170 2 100666 11274 `
*HEADER,FORTR,FM258
*FILES1,FORTR,FM258,X
C***********************************************************************
C***** FORTRAN 77
C***** FM258
C***** BLKIF1 - (300)
C*****
C***********************************************************************
C***** GENERAL PURPOSE SUBSET REF
C***** TEST BLOCK IF STATEMENTS 11.6 - 11.9
C***** SIMPLE TESTS OF IF (E) THEN,ELSE,ELSEIF,ENDIF
C*****
CBB** ********************** BBCCOMNT **********************************
C****
C**** 1978 FORTRAN COMPILER VALIDATION SYSTEM
C**** VERSION 2.0
C****
C****
C**** SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO
C**** GENERAL SERVICES ADMINISTRATION
C**** FEDERAL SOFTWARE TESTING CENTER
C**** 5203 LEESBURG PIKE, SUITE 1100
C**** FALLS CHURCH, VA. 22041
C****
C**** (703) 756-6153
C****
CBE** ********************** BBCCOMNT **********************************
CBB** ********************** BBCINITA **********************************
C**** SPECIFICATION STATEMENTS
C****
CHARACTER ZVERS*13, ZVERSD*17, ZDATE*17, ZPROG*5, ZCOMPL*20,
1 ZNAME*20, ZTAPE*10, ZPROJ*13, REMRKS*31, ZTAPED*13
CBE** ********************** BBCINITA **********************************
CBB** ********************** BBCINITB **********************************
C**** INITIALIZE SECTION
DATA ZVERS, ZVERSD, ZDATE
1 /'VERSION 2.0 ', '82/08/02*18.33.46', '*NO DATE*TIME'/
DATA ZCOMPL, ZNAME, ZTAPE
1 /'*NONE SPECIFIED*', '*NO COMPANY NAME*', '*NO TAPE*'/
DATA ZPROJ, ZTAPED, ZPROG
1 /'*NO PROJECT*', '*NO TAPE DATE', 'XXXXX'/
DATA REMRKS /' '/
C**** THE FOLLOWING 9 COMMENT LINES (CZ01, CZ02, ...) CAN BE REPLACED
C**** FOR IDENTIFYING THE TEST ENVIRONMENT
C****
CZ01 ZVERS = 'VERSION OF THE COMPILER VALIDATION SYSTEM'
CZ02 ZVERSD = 'CREATION DATE/TIME OF THE COMPILER VALIDATION SYSTEM'
CZ03 ZPROG = 'PROGRAM NAME'
CZ04 ZDATE = 'DATE OF TEST'
CZ05 ZCOMPL = 'COMPILER IDENTIFICATION'
CZ06 ZPROJ = 'PROJECT NUMBER/IDENTIFICATION'
CZ07 ZNAME = 'NAME OF USER'
CZ08 ZTAPE = 'TAPE OWNER/ID'
CZ09 ZTAPED = 'DATE TAPE COPIED'
C
IVPASS = 0
IVFAIL = 0
IVDELE = 0
IVINSP = 0
IVTOTL = 0
IVTOTN = 0
ICZERO = 0
C
C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER.
I01 = 05
C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER.
I02 = 06
C
CX010 REPLACED BY FEXEC X-010 CONTROL CARD (CARD-READER UNIT NUMBER).
C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5
CX011 REPLACED BY FEXEC X-011 CONTROL CARD. CX011 IS FOR SYSTEMS
C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX010.
C
CX020 REPLACED BY FEXEC X-020 CONTROL CARD (PRINTER UNIT NUMBER).
C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02= 6
CX021 REPLACED BY FEXEC X-021 CONTROL CARD. CX021 IS FOR SYSTEMS
C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX020.
C
CBE** ********************** BBCINITB **********************************
NUVI = I02
ZPROG='FM258'
CBB** ********************** BBCHED0A **********************************
C****
C**** WRITE REPORT TITLE
C****
WRITE (I02, 90002)
WRITE (I02, 90006)
WRITE (I02, 90007)
WRITE (I02, 90008) ZVERS, ZVERSD
WRITE (I02, 90009) ZPROG, ZPROG
WRITE (I02, 90010) ZDATE, ZCOMPL
CBE** ********************** BBCHED0A **********************************
C***** TOTAL NUMBER OF EXPECTED TEST
IVTOTL=8
C***** HEADER FOR SEGMENT 300
WRITE(NUVI,30000)
30000 FORMAT(/1X,38H BLKIF1 - (300) BLOCK IF - SIMPLE TEST//
1 26H SUBSET REF. 11.6 - 11.9)
CBB** ********************** BBCHED0B **********************************
C**** WRITE DETAIL REPORT HEADERS
C****
WRITE (I02,90004)
WRITE (I02,90004)
WRITE (I02,90013)
WRITE (I02,90014)
WRITE (I02,90015) IVTOTL
CBE** ********************** BBCHED0B **********************************
C*****
WRITE (NUVI,30025)
CT001* TEST 1 IF (E) THEN .*. ELSE .*. ENDIF
IVTNUM = 1
IVINSP=IVINSP+1
WRITE(NUVI,80004) IVTNUM
JVI = 0
30001 JVI = JVI + 1
IF (JVI .EQ. 2) THEN
KVI = 2
ELSE
KVI = 1
ENDIF
LVI = JVI - KVI
WRITE(NUVI,30018) LVI
GOTO(30001,30002), JVI
30002 CONTINUE
CT002* TEST 2 IF (E) THEN .*. ENDIF
IVTNUM = 2
IVINSP=IVINSP+1
WRITE(NUVI,80004) IVTNUM
JVI = 0
KVI = 1
30003 JVI = JVI + 1
IF (JVI .EQ. 2) THEN
KVI = 2
ENDIF
LVI = JVI - KVI
WRITE(NUVI,30018) LVI
GOTO(30003,30004), JVI
30004 CONTINUE
CT003* TEST 3 IF (E) THEN ... ELSE .*. ENDIF
IVTNUM = 3
IVINSP=IVINSP+1
WRITE(NUVI,80004) IVTNUM
JVI = 0
KVI = 1
30005 JVI = JVI + 1
IF (JVI .EQ. 1) THEN
ELSE
KVI = 2
ENDIF
LVI = JVI - KVI
WRITE(NUVI,30018) LVI
GOTO(30005,30006), JVI
30006 CONTINUE
CT004* TEST 4 IF (E) THEN .*. ELSEIF .*. ELSE .*. ENDIF
IVTNUM = 4
IVINSP=IVINSP+1
WRITE(NUVI,80004) IVTNUM
JVI = 0
30007 JVI = JVI + 1
IF (JVI .EQ. 1) THEN
KVI = 1
ELSEIF (JVI .EQ. 2) THEN
KVI = 2
ELSE
KVI = 3
ENDIF
LVI = JVI - KVI
WRITE(NUVI,30018) LVI
GOTO(30007,30007,30008), JVI
30008 CONTINUE
CT005* TEST 5 IF (E) THEN .*. ELSEIF .*. ENDIF
IVTNUM = 5
IVINSP=IVINSP+1
WRITE(NUVI,80004) IVTNUM
JVI = 0
KVI = 1
30009 JVI = JVI + 1
IF (JVI .GT. 2) THEN
KVI = 3
ELSEIF (JVI .EQ. 2) THEN
KVI = 2
ENDIF
LVI = JVI - KVI
WRITE(NUVI,30018) LVI
GOTO(30009,30009,30010), JVI
30010 CONTINUE
CT006* TEST 6 IF (E) THEN .*. ELSEIF ... ELSE .*. ENDIF
IVTNUM = 6
IVINSP=IVINSP+1
WRITE(NUVI,80004) IVTNUM
JVI = 0
KVI = 1
30011 JVI = JVI + 1
IF ( JVI .GT. 2) THEN
KVI = 3
ELSEIF (JVI .EQ. 1) THEN
ELSE
KVI = 2
ENDIF
LVI = JVI - KVI
WRITE(NUVI,30018) LVI
GOTO(30011,30011,30012), JVI
30012 CONTINUE
CT007* TEST 7 IF (E) THEN ... ELSEIF .*. ELSE .*. ENDIF
IVTNUM = 7
IVINSP=IVINSP+1
WRITE(NUVI,80004) IVTNUM
JVI = 0
KVI = 1
30013 JVI = JVI + 1
IF (JVI .EQ. 1) THEN
ELSEIF (JVI .LT. 3) THEN
KVI = 2
ELSE
KVI = 3
ENDIF
LVI = JVI - KVI
WRITE(NUVI,30018) LVI
GOTO(30013,30013,30014), JVI
30014 CONTINUE
CT008* TEST 8 IF (E) THEN .*. ELSEIF .*. ELSEIF .*. ENDIF
IVTNUM = 8
IVINSP=IVINSP+1
WRITE(NUVI,80004) IVTNUM
JVI = 0
30015 JVI = JVI + 1
KVI = 4
IF ( JVI .EQ. 1) THEN
KVI = 1
ELSEIF (JVI .EQ. 2) THEN
KVI = 2
ELSEIF (JVI .LT. 4) THEN
KVI = 3
ENDIF
LVI = JVI - KVI
WRITE(NUVI,30018) LVI
GOTO(30015,30015,30015,30016), JVI
C*****
30016 CONTINUE
C*****
CBB** ********************** BBCSUM0 **********************************
C**** WRITE OUT TEST SUMMARY
C****
IVTOTN = IVPASS + IVFAIL + IVDELE + IVINSP
WRITE (I02, 90004)
WRITE (I02, 90014)
WRITE (I02, 90004)
WRITE (I02, 90020) IVPASS
WRITE (I02, 90022) IVFAIL
WRITE (I02, 90024) IVDELE
WRITE (I02, 90026) IVINSP
WRITE (I02, 90028) IVTOTN, IVTOTL
CBE** ********************** BBCSUM0 **********************************
CBB** ********************** BBCFOOT0 **********************************
C**** WRITE OUT REPORT FOOTINGS
C****
WRITE (I02,90016) ZPROG, ZPROG
WRITE (I02,90018) ZPROJ, ZNAME, ZTAPE, ZTAPED
WRITE (I02,90019)
CBE** ********************** BBCFOOT0 **********************************
CBB** ********************** BBCFMT0A **********************************
C**** FORMATS FOR TEST DETAIL LINES
C****
80000 FORMAT (1H ,2X,I3,4X,7HDELETED,32X,A31)
80002 FORMAT (1H ,2X,I3,4X,7H PASS ,32X,A31)
80004 FORMAT (1H ,2X,I3,4X,7HINSPECT,32X,A31)
80008 FORMAT (1H ,2X,I3,4X,7H FAIL ,32X,A31)
80010 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,15X,10HCOMPUTED= ,
1I6,/,1H ,15X,10HCORRECT= ,I6)
80012 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
1E12.5,/,1H ,16X,10HCORRECT= ,E12.5)
80018 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
1A21,/,1H ,16X,10HCORRECT= ,A21)
80020 FORMAT (1H ,16X,10HCOMPUTED= ,A21,1X,A31)
80022 FORMAT (1H ,16X,10HCORRECT= ,A21,1X,A31)
80024 FORMAT (1H ,16X,10HCOMPUTED= ,I6,16X,A31)
80026 FORMAT (1H ,16X,10HCORRECT= ,I6,16X,A31)
80028 FORMAT (1H ,16X,10HCOMPUTED= ,E12.5,10X,A31)
80030 FORMAT (1H ,16X,10HCORRECT= ,E12.5,10X,A31)
80050 FORMAT (1H ,48X,A31)
CBE** ********************** BBCFMT0A **********************************
CBB** ********************** BBCFMT0B **********************************
C**** FORMAT STATEMENTS FOR PAGE HEADERS
C****
90002 FORMAT (1H1)
90004 FORMAT (1H )
90006 FORMAT (1H ,20X,31HFEDERAL SOFTWARE TESTING CENTER)
90007 FORMAT (1H ,19X,34HFORTRAN COMPILER VALIDATION SYSTEM)
90008 FORMAT (1H ,21X,A13,A17)
90009 FORMAT (1H ,/,2H *,A5,6HBEGIN*,12X,15HTEST RESULTS - ,A5,/)
90010 FORMAT (1H ,8X,16HTEST DATE*TIME= ,A17,15H - COMPILER= ,A20)
90013 FORMAT (1H ,8H TEST ,10HPASS/FAIL ,6X,17HDISPLAYED RESULTS,
1 7X,7HREMARKS,24X)
90014 FORMAT (1H ,46H----------------------------------------------,
1 33H---------------------------------)
90015 FORMAT (1H ,48X,17HTHIS PROGRAM HAS ,I3,6H TESTS,/)
C****
C**** FORMAT STATEMENTS FOR REPORT FOOTINGS
C****
90016 FORMAT (1H ,/,2H *,A5,4HEND*,14X,14HEND OF TEST - ,A5,/)
90018 FORMAT (1H ,A13,13X,A20,7H * ,A10,1H/,
1 A13)
90019 FORMAT (1H ,26HFOR OFFICIAL USE ONLY ,35X,15HCOPYRIGHT 1982)
C****
C**** FORMAT STATEMENTS FOR RUN SUMMARY
C****
90020 FORMAT (1H ,21X,I5,13H TESTS PASSED)
90022 FORMAT (1H ,21X,I5,13H TESTS FAILED)
90024 FORMAT (1H ,21X,I5,14H TESTS DELETED)
90026 FORMAT (1H ,21X,I5,25H TESTS REQUIRE INSPECTION)
90028 FORMAT (1H ,21X,I5,4H OF ,I3,15H TESTS EXECUTED)
CBE** ********************** BBCFMT0B **********************************
30026 FORMAT (1H1, 26X,I1)
30018 FORMAT(1H ,26X,I10)
30025 FORMAT(/49X,30HTESTS 1-3 (2 COMPUTED RESULTS),
1 /49X,30HTESTS 4-7 (3 COMPUTED RESULTS),
2 /49X,30HTEST 8 (4 COMPUTED RESULTS),
3 /49X,26HALL ANSWERS SHOULD BE ZERO)
C***** END OF TEST SEGMENT 300
STOP
END
*END-OF,FM258
FM259.f 481036179 170 2 100666 9699 `
*HEADER,FORTR,FM259
*FILES1,FORTR,FM259,X
C***********************************************************************
C***** FORTRAN 77
C***** FM259
C***** BLKIF2 - (301)
C*****
C***********************************************************************
C***** GENERAL PURPOSE SUBSET REF
C***** TEST BLOCK IF STATEMENTS 11.1 - 11.3
C***** WITH GOTO, COMPUTED GOTO, ASSIGN GOTO, DO 11.6 - 11.10
C****
CBB** ********************** BBCCOMNT **********************************
C****
C**** 1978 FORTRAN COMPILER VALIDATION SYSTEM
C**** VERSION 2.0
C****
C****
C**** SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO
C**** GENERAL SERVICES ADMINISTRATION
C**** FEDERAL SOFTWARE TESTING CENTER
C**** 5203 LEESBURG PIKE, SUITE 1100
C**** FALLS CHURCH, VA. 22041
C****
C**** (703) 756-6153
C****
CBE** ********************** BBCCOMNT **********************************
CBB** ********************** BBCINITA **********************************
C**** SPECIFICATION STATEMENTS
C****
CHARACTER ZVERS*13, ZVERSD*17, ZDATE*17, ZPROG*5, ZCOMPL*20,
1 ZNAME*20, ZTAPE*10, ZPROJ*13, REMRKS*31, ZTAPED*13
CBE** ********************** BBCINITA **********************************
CBB** ********************** BBCINITB **********************************
C**** INITIALIZE SECTION
DATA ZVERS, ZVERSD, ZDATE
1 /'VERSION 2.0 ', '82/08/02*18.33.46', '*NO DATE*TIME'/
DATA ZCOMPL, ZNAME, ZTAPE
1 /'*NONE SPECIFIED*', '*NO COMPANY NAME*', '*NO TAPE*'/
DATA ZPROJ, ZTAPED, ZPROG
1 /'*NO PROJECT*', '*NO TAPE DATE', 'XXXXX'/
DATA REMRKS /' '/
C**** THE FOLLOWING 9 COMMENT LINES (CZ01, CZ02, ...) CAN BE REPLACED
C**** FOR IDENTIFYING THE TEST ENVIRONMENT
C****
CZ01 ZVERS = 'VERSION OF THE COMPILER VALIDATION SYSTEM'
CZ02 ZVERSD = 'CREATION DATE/TIME OF THE COMPILER VALIDATION SYSTEM'
CZ03 ZPROG = 'PROGRAM NAME'
CZ04 ZDATE = 'DATE OF TEST'
CZ05 ZCOMPL = 'COMPILER IDENTIFICATION'
CZ06 ZPROJ = 'PROJECT NUMBER/IDENTIFICATION'
CZ07 ZNAME = 'NAME OF USER'
CZ08 ZTAPE = 'TAPE OWNER/ID'
CZ09 ZTAPED = 'DATE TAPE COPIED'
C
IVPASS = 0
IVFAIL = 0
IVDELE = 0
IVINSP = 0
IVTOTL = 0
IVTOTN = 0
ICZERO = 0
C
C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER.
I01 = 05
C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER.
I02 = 06
C
CX010 REPLACED BY FEXEC X-010 CONTROL CARD (CARD-READER UNIT NUMBER).
C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5
CX011 REPLACED BY FEXEC X-011 CONTROL CARD. CX011 IS FOR SYSTEMS
C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX010.
C
CX020 REPLACED BY FEXEC X-020 CONTROL CARD (PRINTER UNIT NUMBER).
C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02= 6
CX021 REPLACED BY FEXEC X-021 CONTROL CARD. CX021 IS FOR SYSTEMS
C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX020.
C
CBE** ********************** BBCINITB **********************************
NUVI = I02
IVTOTL = 3
ZPROG = 'FM259'
CBB** ********************** BBCHED0A **********************************
C****
C**** WRITE REPORT TITLE
C****
WRITE (I02, 90002)
WRITE (I02, 90006)
WRITE (I02, 90007)
WRITE (I02, 90008) ZVERS, ZVERSD
WRITE (I02, 90009) ZPROG, ZPROG
WRITE (I02, 90010) ZDATE, ZCOMPL
CBE** ********************** BBCHED0A **********************************
C*****
C***** HEADER FOR SEGMENT 301
WRITE(NUVI,30100)
30100 FORMAT(1H , / 24H BLKIF2 - (301) BLOCK IF//
1 35H WITH OTHER CONTROL CONSTRUCTS (I)//
2 36H SUBSET REF. 11.1-11.3, 11.6-11.10)
CBB** ********************** BBCHED0B **********************************
C**** WRITE DETAIL REPORT HEADERS
C****
WRITE (I02,90004)
WRITE (I02,90004)
WRITE (I02,90013)
WRITE (I02,90014)
WRITE (I02,90015) IVTOTL
CBE** ********************** BBCHED0B **********************************
C*****
WRITE (NUVI,70000)
CT001* TEST 1 IF (E) THEN .*. ENDIF
IVTNUM = 1
IVINSP = IVINSP + 1
WRITE (NUVI, 80004) IVTNUM
KVI = 7
IF (KVI .EQ. 7) THEN
KVI = 8
IF (KVI .GE. 8) GOTO 0012
KVI = 9
ENDIF
0012 LVI = 8 - KVI
WRITE(NUVI,70010) LVI
CT002* TEST 2 IF (E) THEN .*. ELSE .*. ENDIF
IVTNUM = 2
IVINSP = IVINSP + 1
WRITE (NUVI, 80004) IVTNUM
KVI = 0
LVI = 1
IF (LVI .EQ. 7) THEN
KVI = 8
IF (LVI .EQ. 1) GOTO 0026
KVI = 9
ELSE
GOTO (0023, 0024, 0022), LVI
0022 KVI = 1
GOTO 0025
0023 KVI = 2
GOTO 0025
0024 KVI = 3
0025 CONTINUE
ENDIF
0026 LVI = 2 - KVI
WRITE(NUVI,70010) LVI
CT003* TEST 3 DO ..........
IVTNUM = 3
IVINSP = IVINSP + 1
WRITE (NUVI, 80004) IVTNUM
MVI = 0
ASSIGN 0034 TO NVI
LVI = 0
JVI = 1
DO 0037 IVI = 1,4
IF (IVI .EQ. 1) THEN
DO 0032 KVI = 1,IVI
LVI = LVI + 1
0032 CONTINUE
ELSEIF (IVI .EQ. 2) THEN
LVI = 6
IF (.FALSE.) GOTO 0036
LVI = 2
ELSEIF (IVI .EQ. 3) THEN
IF (MVI .NE. 0) THEN
LVI = 7
ELSE
LVI = 3
ENDIF
ELSE
GOTO NVI, (0033, 0034)
0033 LVI = 5
GOTO 0035
0034 LVI = 4
ASSIGN 0033 TO NVI
0035 CONTINUE
ENDIF
LVI = LVI - JVI
0036 WRITE(NUVI,70010) LVI
JVI = JVI + 1
0037 CONTINUE
C*****
CBB** ********************** BBCSUM0 **********************************
C**** WRITE OUT TEST SUMMARY
C****
IVTOTN = IVPASS + IVFAIL + IVDELE + IVINSP
WRITE (I02, 90004)
WRITE (I02, 90014)
WRITE (I02, 90004)
WRITE (I02, 90020) IVPASS
WRITE (I02, 90022) IVFAIL
WRITE (I02, 90024) IVDELE
WRITE (I02, 90026) IVINSP
WRITE (I02, 90028) IVTOTN, IVTOTL
CBE** ********************** BBCSUM0 **********************************
CBB** ********************** BBCFOOT0 **********************************
C**** WRITE OUT REPORT FOOTINGS
C****
WRITE (I02,90016) ZPROG, ZPROG
WRITE (I02,90018) ZPROJ, ZNAME, ZTAPE, ZTAPED
WRITE (I02,90019)
CBE** ********************** BBCFOOT0 **********************************
CBB** ********************** BBCFMT0A **********************************
C**** FORMATS FOR TEST DETAIL LINES
C****
80000 FORMAT (1H ,2X,I3,4X,7HDELETED,32X,A31)
80002 FORMAT (1H ,2X,I3,4X,7H PASS ,32X,A31)
80004 FORMAT (1H ,2X,I3,4X,7HINSPECT,32X,A31)
80008 FORMAT (1H ,2X,I3,4X,7H FAIL ,32X,A31)
80010 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,15X,10HCOMPUTED= ,
1I6,/,1H ,15X,10HCORRECT= ,I6)
80012 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
1E12.5,/,1H ,16X,10HCORRECT= ,E12.5)
80018 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
1A21,/,1H ,16X,10HCORRECT= ,A21)
80020 FORMAT (1H ,16X,10HCOMPUTED= ,A21,1X,A31)
80022 FORMAT (1H ,16X,10HCORRECT= ,A21,1X,A31)
80024 FORMAT (1H ,16X,10HCOMPUTED= ,I6,16X,A31)
80026 FORMAT (1H ,16X,10HCORRECT= ,I6,16X,A31)
80028 FORMAT (1H ,16X,10HCOMPUTED= ,E12.5,10X,A31)
80030 FORMAT (1H ,16X,10HCORRECT= ,E12.5,10X,A31)
80050 FORMAT (1H ,48X,A31)
CBE** ********************** BBCFMT0A **********************************
CBB** ********************** BBCFMT0B **********************************
C**** FORMAT STATEMENTS FOR PAGE HEADERS
C****
90002 FORMAT (1H1)
90004 FORMAT (1H )
90006 FORMAT (1H ,20X,31HFEDERAL SOFTWARE TESTING CENTER)
90007 FORMAT (1H ,19X,34HFORTRAN COMPILER VALIDATION SYSTEM)
90008 FORMAT (1H ,21X,A13,A17)
90009 FORMAT (1H ,/,2H *,A5,6HBEGIN*,12X,15HTEST RESULTS - ,A5,/)
90010 FORMAT (1H ,8X,16HTEST DATE*TIME= ,A17,15H - COMPILER= ,A20)
90013 FORMAT (1H ,8H TEST ,10HPASS/FAIL ,6X,17HDISPLAYED RESULTS,
1 7X,7HREMARKS,24X)
90014 FORMAT (1H ,46H----------------------------------------------,
1 33H---------------------------------)
90015 FORMAT (1H ,48X,17HTHIS PROGRAM HAS ,I3,6H TESTS,/)
C****
C**** FORMAT STATEMENTS FOR REPORT FOOTINGS
C****
90016 FORMAT (1H ,/,2H *,A5,4HEND*,14X,14HEND OF TEST - ,A5,/)
90018 FORMAT (1H ,A13,13X,A20,7H * ,A10,1H/,
1 A13)
90019 FORMAT (1H ,26HFOR OFFICIAL USE ONLY ,35X,15HCOPYRIGHT 1982)
C****
C**** FORMAT STATEMENTS FOR RUN SUMMARY
C****
90020 FORMAT (1H ,21X,I5,13H TESTS PASSED)
90022 FORMAT (1H ,21X,I5,13H TESTS FAILED)
90024 FORMAT (1H ,21X,I5,14H TESTS DELETED)
90026 FORMAT (1H ,21X,I5,25H TESTS REQUIRE INSPECTION)
90028 FORMAT (1H ,21X,I5,4H OF ,I3,15H TESTS EXECUTED)
CBE** ********************** BBCFMT0B **********************************
C*****
70000 FORMAT (/49X,'TEST 1 (1 COMPUTED RESULT)'/
1 49X,'TEST 2 (1 COMPUTED RESULT)'/
2 49X,'TEST 3 (4 COMPUTED RESULTS)'/
3 49X,'ALL ANSWERS SHOULD BE ZERO')
70010 FORMAT (1H ,26X,I10)
C***** END OF TEST SEGMENT 301
STOP
END
*END-OF,FM259
FM260.f 481036182 170 2 100666 11432 `
*HEADER,FORTR,FM260
*FILES1,FORTR,FM260,X
C***********************************************************************
C***** FORTRAN 77
C***** FM260
C***** BLKIF3 - (302)
C*****
C***********************************************************************
C***** GENERAL PURPOSE SUBSET REF
C***** TEST BLOCK IF STATEMENTS 11.1 - 11.3
C***** WITH DO, ARITHMETIC IF, LOGICAL IF, 11.6 - 11.10
C***** COMPUTED GOTO, ASSIGN GOTO
C*****
CBB** ********************** BBCCOMNT **********************************
C****
C**** 1978 FORTRAN COMPILER VALIDATION SYSTEM
C**** VERSION 2.0
C****
C****
C**** SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO
C**** GENERAL SERVICES ADMINISTRATION
C**** FEDERAL SOFTWARE TESTING CENTER
C**** 5203 LEESBURG PIKE, SUITE 1100
C**** FALLS CHURCH, VA. 22041
C****
C**** (703) 756-6153
C****
CBE** ********************** BBCCOMNT **********************************
CBB** ********************** BBCINITA **********************************
C**** SPECIFICATION STATEMENTS
C****
CHARACTER ZVERS*13, ZVERSD*17, ZDATE*17, ZPROG*5, ZCOMPL*20,
1 ZNAME*20, ZTAPE*10, ZPROJ*13, REMRKS*31, ZTAPED*13
CBE** ********************** BBCINITA **********************************
CBB** ********************** BBCINITB **********************************
C**** INITIALIZE SECTION
DATA ZVERS, ZVERSD, ZDATE
1 /'VERSION 2.0 ', '82/08/02*18.33.46', '*NO DATE*TIME'/
DATA ZCOMPL, ZNAME, ZTAPE
1 /'*NONE SPECIFIED*', '*NO COMPANY NAME*', '*NO TAPE*'/
DATA ZPROJ, ZTAPED, ZPROG
1 /'*NO PROJECT*', '*NO TAPE DATE', 'XXXXX'/
DATA REMRKS /' '/
C**** THE FOLLOWING 9 COMMENT LINES (CZ01, CZ02, ...) CAN BE REPLACED
C**** FOR IDENTIFYING THE TEST ENVIRONMENT
C****
CZ01 ZVERS = 'VERSION OF THE COMPILER VALIDATION SYSTEM'
CZ02 ZVERSD = 'CREATION DATE/TIME OF THE COMPILER VALIDATION SYSTEM'
CZ03 ZPROG = 'PROGRAM NAME'
CZ04 ZDATE = 'DATE OF TEST'
CZ05 ZCOMPL = 'COMPILER IDENTIFICATION'
CZ06 ZPROJ = 'PROJECT NUMBER/IDENTIFICATION'
CZ07 ZNAME = 'NAME OF USER'
CZ08 ZTAPE = 'TAPE OWNER/ID'
CZ09 ZTAPED = 'DATE TAPE COPIED'
C
IVPASS = 0
IVFAIL = 0
IVDELE = 0
IVINSP = 0
IVTOTL = 0
IVTOTN = 0
ICZERO = 0
C
C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER.
I01 = 05
C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER.
I02 = 06
C
CX010 REPLACED BY FEXEC X-010 CONTROL CARD (CARD-READER UNIT NUMBER).
C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5
CX011 REPLACED BY FEXEC X-011 CONTROL CARD. CX011 IS FOR SYSTEMS
C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX010.
C
CX020 REPLACED BY FEXEC X-020 CONTROL CARD (PRINTER UNIT NUMBER).
C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02= 6
CX021 REPLACED BY FEXEC X-021 CONTROL CARD. CX021 IS FOR SYSTEMS
C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX020.
C
CBE** ********************** BBCINITB **********************************
NUVI = I02
ZPROG = 'FM260'
IVTOTL = 2
CBB** ********************** BBCHED0A **********************************
C****
C**** WRITE REPORT TITLE
C****
WRITE (I02, 90002)
WRITE (I02, 90006)
WRITE (I02, 90007)
WRITE (I02, 90008) ZVERS, ZVERSD
WRITE (I02, 90009) ZPROG, ZPROG
WRITE (I02, 90010) ZDATE, ZCOMPL
CBE** ********************** BBCHED0A **********************************
C***** TOTAL NUMBER OF EXPECTED TESTS
C*****
C***** HEADER FOR SEGMENT 302
WRITE(NUVI,30200)
30200 FORMAT(1H ,24H BLKIF3 - (302) BLOCK IF//
1 36H WITH OTHER CONTROL CONSTRUCTS (II)//
2 40H SUBSET REF. 11.1 - 11.3, 11.6 - 11.10)
CBB** ********************** BBCHED0B **********************************
C**** WRITE DETAIL REPORT HEADERS
C****
WRITE (I02,90004)
WRITE (I02,90004)
WRITE (I02,90013)
WRITE (I02,90014)
WRITE (I02,90015) IVTOTL
CBE** ********************** BBCHED0B **********************************
C*****
WRITE (NUVI, 30225)
CT001* TEST 1 BLOCK IF WITH DO, ARITHMETIC IF, COMPUTED GOTO,
C***** ASSIGNED GOTO
IVTNUM = 1
IVINSP = IVINSP + 1
WRITE (NUVI, 80004) IVTNUM
JVI = 1
KVI = 1
ASSIGN 0017 TO MVI
DO 0011 IVI = 1, 9
IF (IVI - 6) 0010, 0013, 0016
0010 IF (IVI .LE. 3) THEN
GOTO (0019, 0012, 0012) IVI
0012 KVI = KVI + 1
ELSE
KVI = 5
IF (IVI .NE. 5) KVI = 4
ENDIF
GOTO 0019
0013 DO 0015 NVI = 1,3
KVI = 8
IF ((IVI + NVI) .EQ. 7) THEN
KVI = 6
GOTO 0014
ELSEIF (NVI .EQ. 2) THEN
KVI = 7
C***** LABEL ON A ENDIF IS PERMITTED
0014 ENDIF
LVI = KVI - JVI
WRITE(NUVI,30215) LVI
JVI = JVI + 1
0015 CONTINUE
GOTO 0011
0016 LVI = 10
GOTO MVI, (0017, 0018)
0017 ASSIGN 0018 TO MVI
LVI = 9
0018 IF (IVI .LE. 8) THEN
KVI = LVI
ELSE
KVI = 11
ENDIF
0019 LVI = KVI - JVI
WRITE (NUVI, 30215) LVI
JVI = JVI + 1
0011 CONTINUE
CT002* TEST 2 DO WITH NESTED BLOCK IFS
IVTNUM = 2
IVINSP = IVINSP + 1
WRITE (NUVI, 80004) IVTNUM
JVI = 1
DO 0021 IVI = 1, 8
KVI = 0
IF (IVI .LT. 5) THEN
IF (IVI .LE. 2) THEN
IF (IVI - 1 .EQ. 0) THEN
KVI = KVI + 1
ELSE
KVI = KVI + 2
ENDIF
KVI = KVI * 2
ELSE
IF (IVI .EQ. 3) THEN
DO 0020 NVI = 1,IVI
0020 KVI = KVI + 10
ELSE
DO 0022 NVI = 1, IVI
0022 KVI = KVI + 10
ENDIF
KVI = KVI / 10 * 2
ENDIF
KVI = KVI * 3
ELSE
IF (IVI .LE. 6) THEN
IF (IVI - 5 .EQ. 0) THEN
KVI = KVI + 105
ELSE
KVI = KVI + 106
ENDIF
KVI = (KVI - 100) * 3
ELSE
IF (IVI .LE. 7) THEN
KVI = KVI - 7
ELSE
KVI = KVI - 8
ENDIF
KVI = KVI + IVI * 4
ENDIF
KVI = KVI * 2
ENDIF
LVI = KVI / 6 - JVI
WRITE (NUVI,30215) LVI
JVI = JVI + 1
0021 CONTINUE
C*****
30215 FORMAT(1H ,26X,I10)
30225 FORMAT (/49X,'TEST 1 (11 COMPUTED RESULTS)'/
1 49X,'TEST 2 (8 COMPUTED RESULTS)'/
2 49X,'ALL ANSWERS SHOULD BE ZERO')
C*****
CBB** ********************** BBCSUM0 **********************************
C**** WRITE OUT TEST SUMMARY
C****
IVTOTN = IVPASS + IVFAIL + IVDELE + IVINSP
WRITE (I02, 90004)
WRITE (I02, 90014)
WRITE (I02, 90004)
WRITE (I02, 90020) IVPASS
WRITE (I02, 90022) IVFAIL
WRITE (I02, 90024) IVDELE
WRITE (I02, 90026) IVINSP
WRITE (I02, 90028) IVTOTN, IVTOTL
CBE** ********************** BBCSUM0 **********************************
CBB** ********************** BBCFOOT0 **********************************
C**** WRITE OUT REPORT FOOTINGS
C****
WRITE (I02,90016) ZPROG, ZPROG
WRITE (I02,90018) ZPROJ, ZNAME, ZTAPE, ZTAPED
WRITE (I02,90019)
CBE** ********************** BBCFOOT0 **********************************
CBB** ********************** BBCFMT0A **********************************
C**** FORMATS FOR TEST DETAIL LINES
C****
80000 FORMAT (1H ,2X,I3,4X,7HDELETED,32X,A31)
80002 FORMAT (1H ,2X,I3,4X,7H PASS ,32X,A31)
80004 FORMAT (1H ,2X,I3,4X,7HINSPECT,32X,A31)
80008 FORMAT (1H ,2X,I3,4X,7H FAIL ,32X,A31)
80010 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,15X,10HCOMPUTED= ,
1I6,/,1H ,15X,10HCORRECT= ,I6)
80012 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
1E12.5,/,1H ,16X,10HCORRECT= ,E12.5)
80018 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
1A21,/,1H ,16X,10HCORRECT= ,A21)
80020 FORMAT (1H ,16X,10HCOMPUTED= ,A21,1X,A31)
80022 FORMAT (1H ,16X,10HCORRECT= ,A21,1X,A31)
80024 FORMAT (1H ,16X,10HCOMPUTED= ,I6,16X,A31)
80026 FORMAT (1H ,16X,10HCORRECT= ,I6,16X,A31)
80028 FORMAT (1H ,16X,10HCOMPUTED= ,E12.5,10X,A31)
80030 FORMAT (1H ,16X,10HCORRECT= ,E12.5,10X,A31)
80050 FORMAT (1H ,48X,A31)
CBE** ********************** BBCFMT0A **********************************
CBB** ********************** BBCFMT0B **********************************
C**** FORMAT STATEMENTS FOR PAGE HEADERS
C****
90002 FORMAT (1H1)
90004 FORMAT (1H )
90006 FORMAT (1H ,20X,31HFEDERAL SOFTWARE TESTING CENTER)
90007 FORMAT (1H ,19X,34HFORTRAN COMPILER VALIDATION SYSTEM)
90008 FORMAT (1H ,21X,A13,A17)
90009 FORMAT (1H ,/,2H *,A5,6HBEGIN*,12X,15HTEST RESULTS - ,A5,/)
90010 FORMAT (1H ,8X,16HTEST DATE*TIME= ,A17,15H - COMPILER= ,A20)
90013 FORMAT (1H ,8H TEST ,10HPASS/FAIL ,6X,17HDISPLAYED RESULTS,
1 7X,7HREMARKS,24X)
90014 FORMAT (1H ,46H----------------------------------------------,
1 33H---------------------------------)
90015 FORMAT (1H ,48X,17HTHIS PROGRAM HAS ,I3,6H TESTS,/)
C****
C**** FORMAT STATEMENTS FOR REPORT FOOTINGS
C****
90016 FORMAT (1H ,/,2H *,A5,4HEND*,14X,14HEND OF TEST - ,A5,/)
90018 FORMAT (1H ,A13,13X,A20,7H * ,A10,1H/,
1 A13)
90019 FORMAT (1H ,26HFOR OFFICIAL USE ONLY ,35X,15HCOPYRIGHT 1982)
C****
C**** FORMAT STATEMENTS FOR RUN SUMMARY
C****
90020 FORMAT (1H ,21X,I5,13H TESTS PASSED)
90022 FORMAT (1H ,21X,I5,13H TESTS FAILED)
90024 FORMAT (1H ,21X,I5,14H TESTS DELETED)
90026 FORMAT (1H ,21X,I5,25H TESTS REQUIRE INSPECTION)
90028 FORMAT (1H ,21X,I5,4H OF ,I3,15H TESTS EXECUTED)
CBE** ********************** BBCFMT0B **********************************
C***** END OF TEST SEGMENT 302
STOP
END
*END-OF,FM260
FM261.f 481036185 170 2 100666 10040 `
*HEADER,FORTR,FM261
*FILES1,FORTR,FM261
C***********************************************************************
C***** FORTRAN 77
C***** FM261
C***** BLKIF4 - (303)
C***** THIS PROGRAM CALLS SUBROUTINES SN262, SN263 AND INTEGER
C FUNCTION IF264
C***********************************************************************
C***** GENERAL PURPOSE SUBSET REF
C***** TEST BLOCK IF STATEMENTS 11.6 - 11.9
C***** WITH SUBROUTINE CALLS 15.6
C***** USES SUBROUTINES SN262 (750), SN263 (751)
C***** AND FUNCTION IF264 (752)
CBB** ********************** BBCCOMNT **********************************
C****
C**** 1978 FORTRAN COMPILER VALIDATION SYSTEM
C**** VERSION 2.0
C****
C****
C**** SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO
C**** GENERAL SERVICES ADMINISTRATION
C**** FEDERAL SOFTWARE TESTING CENTER
C**** 5203 LEESBURG PIKE, SUITE 1100
C**** FALLS CHURCH, VA. 22041
C****
C**** (703) 756-6153
C****
CBE** ********************** BBCCOMNT **********************************
CBB** ********************** BBCINITA **********************************
C**** SPECIFICATION STATEMENTS
C****
CHARACTER ZVERS*13, ZVERSD*17, ZDATE*17, ZPROG*5, ZCOMPL*20,
1 ZNAME*20, ZTAPE*10, ZPROJ*13, REMRKS*31, ZTAPED*13
CBE** ********************** BBCINITA **********************************
CBB** ********************** BBCINITB **********************************
C**** INITIALIZE SECTION
DATA ZVERS, ZVERSD, ZDATE
1 /'VERSION 2.0 ', '82/08/02*18.33.46', '*NO DATE*TIME'/
DATA ZCOMPL, ZNAME, ZTAPE
1 /'*NONE SPECIFIED*', '*NO COMPANY NAME*', '*NO TAPE*'/
DATA ZPROJ, ZTAPED, ZPROG
1 /'*NO PROJECT*', '*NO TAPE DATE', 'XXXXX'/
DATA REMRKS /' '/
C**** THE FOLLOWING 9 COMMENT LINES (CZ01, CZ02, ...) CAN BE REPLACED
C**** FOR IDENTIFYING THE TEST ENVIRONMENT
C****
CZ01 ZVERS = 'VERSION OF THE COMPILER VALIDATION SYSTEM'
CZ02 ZVERSD = 'CREATION DATE/TIME OF THE COMPILER VALIDATION SYSTEM'
CZ03 ZPROG = 'PROGRAM NAME'
CZ04 ZDATE = 'DATE OF TEST'
CZ05 ZCOMPL = 'COMPILER IDENTIFICATION'
CZ06 ZPROJ = 'PROJECT NUMBER/IDENTIFICATION'
CZ07 ZNAME = 'NAME OF USER'
CZ08 ZTAPE = 'TAPE OWNER/ID'
CZ09 ZTAPED = 'DATE TAPE COPIED'
C
IVPASS = 0
IVFAIL = 0
IVDELE = 0
IVINSP = 0
IVTOTL = 0
IVTOTN = 0
ICZERO = 0
C
C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER.
I01 = 05
C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER.
I02 = 06
C
CX010 REPLACED BY FEXEC X-010 CONTROL CARD (CARD-READER UNIT NUMBER).
C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5
CX011 REPLACED BY FEXEC X-011 CONTROL CARD. CX011 IS FOR SYSTEMS
C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX010.
C
CX020 REPLACED BY FEXEC X-020 CONTROL CARD (PRINTER UNIT NUMBER).
C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02= 6
CX021 REPLACED BY FEXEC X-021 CONTROL CARD. CX021 IS FOR SYSTEMS
C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX020.
C
CBE** ********************** BBCINITB **********************************
NUVI = I02
ZPROG = 'FM261'
CBB** ********************** BBCHED0A **********************************
C****
C**** WRITE REPORT TITLE
C****
WRITE (I02, 90002)
WRITE (I02, 90006)
WRITE (I02, 90007)
WRITE (I02, 90008) ZVERS, ZVERSD
WRITE (I02, 90009) ZPROG, ZPROG
WRITE (I02, 90010) ZDATE, ZCOMPL
CBE** ********************** BBCHED0A **********************************
C***** TOTAL NUMBER OF EXPECTED TESTS
IVTOTL = 2
C***** HEADER FOR SEGMENT 303
WRITE(NUVI,30300)
30300 FORMAT(1H ,/24H BLKIF4 - (303) BLOCK IF//
1 31H BLOCK IF WITH SUBPROGRAM CALL//
2 31H SUBSET REF. 11.6 - 11.9, 15.6)
CBB** ********************** BBCHED0B **********************************
C**** WRITE DETAIL REPORT HEADERS
C****
WRITE (I02,90004)
WRITE (I02,90004)
WRITE (I02,90013)
WRITE (I02,90014)
WRITE (I02,90015) IVTOTL
CBE** ********************** BBCHED0B **********************************
C*****
WRITE (NUVI, 30325)
CT001* TEST 1 BLOCK IF WITH SUBROUTINE CALLS
IVTNUM = 1
IVINSP = IVINSP + 1
WRITE (NUVI, 80004) IVTNUM
IVI = 3
CALL SN262 (IVI)
IF (IVI .GT. 0) THEN
CALL SN262 (IVI)
ELSE
CALL SN263 (IVI)
ENDIF
LVI = 7 - IVI
WRITE (NUVI, 30301) LVI
C***** CONTINUE
CT002* TEST 2 CALL OF FUNCTION CONTAINING BLOCK IF
IVTNUM = 2
IVINSP = IVINSP + 1
WRITE (NUVI, 80004) IVTNUM
IVI = 7
IVI = IF264 (IVI .GT. 0)
LVI = 8 - IVI
WRITE (NUVI, 30301) LVI
IVI = IF264 (LVI .NE. 0)
LVI = 6 - IVI
WRITE (NUVI, 30301) LVI
C*****
30325 FORMAT (/49X,'TEST 1 (1 COMPUTED RESULT)'/
1 49X,'TEST 2 (2 COMPUTED RESULTS)'/
2 49X,'ALL ANSWERS SHOULD BE ZERO')
30301 FORMAT (1H ,26X,I10)
C*****
CBB** ********************** BBCSUM0 **********************************
C**** WRITE OUT TEST SUMMARY
C****
IVTOTN = IVPASS + IVFAIL + IVDELE + IVINSP
WRITE (I02, 90004)
WRITE (I02, 90014)
WRITE (I02, 90004)
WRITE (I02, 90020) IVPASS
WRITE (I02, 90022) IVFAIL
WRITE (I02, 90024) IVDELE
WRITE (I02, 90026) IVINSP
WRITE (I02, 90028) IVTOTN, IVTOTL
CBE** ********************** BBCSUM0 **********************************
CBB** ********************** BBCFOOT0 **********************************
C**** WRITE OUT REPORT FOOTINGS
C****
WRITE (I02,90016) ZPROG, ZPROG
WRITE (I02,90018) ZPROJ, ZNAME, ZTAPE, ZTAPED
WRITE (I02,90019)
CBE** ********************** BBCFOOT0 **********************************
CBB** ********************** BBCFMT0A **********************************
C**** FORMATS FOR TEST DETAIL LINES
C****
80000 FORMAT (1H ,2X,I3,4X,7HDELETED,32X,A31)
80002 FORMAT (1H ,2X,I3,4X,7H PASS ,32X,A31)
80004 FORMAT (1H ,2X,I3,4X,7HINSPECT,32X,A31)
80008 FORMAT (1H ,2X,I3,4X,7H FAIL ,32X,A31)
80010 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,15X,10HCOMPUTED= ,
1I6,/,1H ,15X,10HCORRECT= ,I6)
80012 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
1E12.5,/,1H ,16X,10HCORRECT= ,E12.5)
80018 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
1A21,/,1H ,16X,10HCORRECT= ,A21)
80020 FORMAT (1H ,16X,10HCOMPUTED= ,A21,1X,A31)
80022 FORMAT (1H ,16X,10HCORRECT= ,A21,1X,A31)
80024 FORMAT (1H ,16X,10HCOMPUTED= ,I6,16X,A31)
80026 FORMAT (1H ,16X,10HCORRECT= ,I6,16X,A31)
80028 FORMAT (1H ,16X,10HCOMPUTED= ,E12.5,10X,A31)
80030 FORMAT (1H ,16X,10HCORRECT= ,E12.5,10X,A31)
80050 FORMAT (1H ,48X,A31)
CBE** ********************** BBCFMT0A **********************************
CBB** ********************** BBCFMT0B **********************************
C**** FORMAT STATEMENTS FOR PAGE HEADERS
C****
90002 FORMAT (1H1)
90004 FORMAT (1H )
90006 FORMAT (1H ,20X,31HFEDERAL SOFTWARE TESTING CENTER)
90007 FORMAT (1H ,19X,34HFORTRAN COMPILER VALIDATION SYSTEM)
90008 FORMAT (1H ,21X,A13,A17)
90009 FORMAT (1H ,/,2H *,A5,6HBEGIN*,12X,15HTEST RESULTS - ,A5,/)
90010 FORMAT (1H ,8X,16HTEST DATE*TIME= ,A17,15H - COMPILER= ,A20)
90013 FORMAT (1H ,8H TEST ,10HPASS/FAIL ,6X,17HDISPLAYED RESULTS,
1 7X,7HREMARKS,24X)
90014 FORMAT (1H ,46H----------------------------------------------,
1 33H---------------------------------)
90015 FORMAT (1H ,48X,17HTHIS PROGRAM HAS ,I3,6H TESTS,/)
C****
C**** FORMAT STATEMENTS FOR REPORT FOOTINGS
C****
90016 FORMAT (1H ,/,2H *,A5,4HEND*,14X,14HEND OF TEST - ,A5,/)
90018 FORMAT (1H ,A13,13X,A20,7H * ,A10,1H/,
1 A13)
90019 FORMAT (1H ,26HFOR OFFICIAL USE ONLY ,35X,15HCOPYRIGHT 1982)
C****
C**** FORMAT STATEMENTS FOR RUN SUMMARY
C****
90020 FORMAT (1H ,21X,I5,13H TESTS PASSED)
90022 FORMAT (1H ,21X,I5,13H TESTS FAILED)
90024 FORMAT (1H ,21X,I5,14H TESTS DELETED)
90026 FORMAT (1H ,21X,I5,25H TESTS REQUIRE INSPECTION)
90028 FORMAT (1H ,21X,I5,4H OF ,I3,15H TESTS EXECUTED)
CBE** ********************** BBCFMT0B **********************************
C***** END OF TEST SEGMENT 303
STOP
END
*HEADER,FORTR,FM261,SUBRTN,FM262
C***********************************************************************
C***** FORTRAN 77
C***** FM262
C***** SN262 SN262 - (750)
C***** SUBROUTINE CALLED BY FM261
C***********************************************************************
C*****
SUBROUTINE SN262 (IWVI)
C*****
IWVI = IWVI + 2
C*****
RETURN
END
*HEADER,FORTR,FM261,SUBRTN,FM263
C***********************************************************************
C***** FORTRAN 77
C***** FM263
C***** SN263 SN263 - (751)
C***** SUBROUTINE CALLED BY FM261
C***********************************************************************
C*****
SUBROUTINE SN263 (IWVI)
C*****
IWVI = IWVI * (-10)
C*****
RETURN
END
*HEADER,FORTR,FM261,SUBRTN,FM264
C***********************************************************************
C***** FORTRAN 77
C***** FM264
C***** IF264 IF264 - (752)
C***** INTEGER FUNCTION CALLED BY FM261
C***********************************************************************
C*****
INTEGER FUNCTION IF264 (AWVB)
LOGICAL AWVB
C*****
IF (AWVB) THEN
IF264 = 8
RETURN
ELSE
IF264 = 6
ENDIF
C*****
RETURN
END
*END-OF,FM261
FM300.f 481036189 170 2 100666 19206 `
*HEADER,FORTR,FM300
*FILES1,FORTR,FM300,X
PROGRAM FM300
C
C
C THIS ROUTINE TESTS THE USE OF THE EQUIVALENCE STATEMENT TO
C EQUATE STORAGE UNITS OF VARIABLES, ARRAYS AND ARRAY ELEMENTS.
C ONLY INTEGER, REAL, LOGICAL AND CHARACTER DATA TYPES ARE TESTED.
C NO ATTEMPT IS MADE TO TEST DATA OF DIFFERENT TYPES THAT ARE
C EQUATED WITH THE EQUIVALENCE STATEMENT.
C
C REFERENCES.
C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN,
C X3.9-1978
C
C SECTION 8.1, DIMENSION STATEMENT
C SECTION 8.2, EQUIVALENCE STATEMENT
C SECTION 9, DATA STATEMENT
C
C
C ******************************************************************
C A COMPILER VALIDATION SYSTEM FOR THE FORTRAN LANGUAGE
C BASED ON SPECIFICATIONS AS DEFINED IN AMERICAN STANDARD FORTRAN
C X3.9-1978, HAS BEEN DEVELOPED BY THE DEPARTMENT OF THE NAVY. THE
C FORTRAN COMPILER VALIDATION SYSTEM (FCVS) CONSISTS OF AUDIT
C ROUTINES, THEIR RELATED DATA, AND AN EXECUTIVE SYSTEM. EACH AUDIT
C ROUTINE IS A FORTRAN PROGRAM OR SUBPROGRAM WHICH INCLUDES TESTS
C OF SPECIFIC LANGUAGE ELEMENTS AND SUPPORTING PROCEDURES INDICATING
C THE RESULT OF EXECUTING THESE TESTS.
C
C THIS PARTICULAR PROGRAM OR SUBPROGRAM CONTAINS ONLY FEATURES
C FOUND IN THE SUBSET LEVEL OF THE STANDARD.
C
C SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO
C DEPARTMENT OF THE NAVY
C FEDERAL COBOL COMPILER TESTING SERVICE
C WASHINGTON, D.C. 20376
C
C ******************************************************************
C
C
IMPLICIT LOGICAL (L)
IMPLICIT CHARACTER*14 (C)
C
C *** SPECIFICATION STATEMENTS FOR TEST 001 ***
C
EQUIVALENCE (IVOE01, IVOE02)
C
C *** SPECIFICATION STATEMENTS FOR TEST 002 ***
C
EQUIVALENCE (RVOE01, RVOE02)
C
C *** SPECIFICATION STATEMENTS FOR TEST 003 ***
C
EQUIVALENCE (LVOE01, LVOE02)
C
C *** SPECIFICATION STATEMENTS FOR TEST 004 ***
C
CHARACTER CVTE01*3, CVTE02*3, CVCOMP*3
EQUIVALENCE (CVTE01, CVTE02)
C
C *** SPECIFICATION STATEMENTS FOR TEST 005 ***
C
EQUIVALENCE (IVOE03, IVOE04, IVOE05)
C
C *** SPECIFICATION STATEMENTS FOR TEST 006 ***
C
EQUIVALENCE (IVOE06, IVOE07, RVOE03)
C
C *** SPECIFICATION STATEMENTS FOR TESTS 007 AND 008 ***
C
EQUIVALENCE (IVOE08, IVOE09), (IVOE10, IVOE11)
C
C *** SPECIFICATION STATEMENTS FOR TEST 009 ***
C
EQUIVALENCE (IVOE12, IVOE13), (IVOE13, IVOE14)
C
C *** SPECIFICATION STATEMENTS FOR TEST 010 ***
C
EQUIVALENCE (IVOE15, IVOE16)
EQUIVALENCE (IVOE16, IVOE17)
C
C *** SPECIFICATION STATEMENTS FOR TESTS 011 AND 012 ***
C
DIMENSION IADE11(2), IADE12(3)
EQUIVALENCE (IADE11, IADE12)
C
C *** SPECIFICATION STATEMENTS FOR TESTS 013 AND 014 ***
C
DIMENSION RADE11(5), RADE12(5)
EQUIVALENCE (RADE11(4), RADE12(2))
C
C *** SPECIFICATION STATEMENTS FOR TEST 015 ***
C
DIMENSION IADE13(4), IADE14(4)
EQUIVALENCE (IADE13, IADE14(3))
C
C *** SPECIFICATION STATEMENTS FOR TEST 016 ***
C
DIMENSION IADE15(3)
EQUIVALENCE (IADE15(2), IVOE18)
C
C *** SPECIFICATION STATEMENTS FOR TESTS 017 AND 018 ***
C
DIMENSION IADE21(2,2), IADE16(4)
EQUIVALENCE (IADE21, IADE16)
C
C *** SPECIFICATION STATEMENTS FOR TEST 019 ***
C
EQUIVALENCE (IVOE19, IVOE20)
DATA IVOE19/19/
C
C
C
C INITIALIZATION SECTION.
C
C INITIALIZE CONSTANTS
C ********************
C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER
I01 = 5
C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER
I02 = 6
C SYSTEM ENVIRONMENT SECTION
C
CX010 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-010 CONTROL CARD.
C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5
C (UNIT NUMBER FOR CARD READER).
CX011 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-011 CONTROL CARD
C THE CX011 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL
C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX010 ABOVE.
C
CX020 THIS CARD IS PEPLACED BY CONTENTS OF FEXEC X-020 CONTROL CARD.
C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02 = 6
C (UNIT NUMBER FOR PRINTER).
CX021 THIS CARD IS PEPLACED BY CONTENTS OF FEXEC X-021 CONTROL CARD.
C THE CX021 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL
C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX020 ABOVE.
C
IVPASS = 0
IVFAIL = 0
IVDELE = 0
ICZERO = 0
C
C WRITE OUT PAGE HEADERS
C
WRITE (I02,90002)
WRITE (I02,90006)
WRITE (I02,90008)
WRITE (I02,90004)
WRITE (I02,90010)
WRITE (I02,90004)
WRITE (I02,90016)
WRITE (I02,90001)
WRITE (I02,90004)
WRITE (I02,90012)
WRITE (I02,90014)
WRITE (I02,90004)
C
C
C **** FCVS PROGRAM 300 - TEST 001 ****
C
C THIS IS A TEST FOR EQUATING TWO INTEGER VARIABLES.
C
C
IVTNUM = 1
IF (ICZERO) 30010, 0010, 30010
0010 CONTINUE
IVCOMP = 0
IVOE01 = 5
IVOE02 = 7
IVCORR = 7
IVCOMP = IVOE01
40010 IF (IVCOMP - 7) 20010,10010,20010
30010 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10010, 0021, 20010
10010 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0021
20010 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0021 CONTINUE
C
C **** FCVS PROGRAM 300 - TEST 002 ****
C
C THIS IS A TEST FOR EQUATING TWO REAL VARIABLES.
C
C
IVTNUM = 2
IF (ICZERO) 30020, 0020, 30020
0020 CONTINUE
RVCOMP = 0.0
RVOE01 = 4.5
RVOE02 = 1.2
RVCORR = 1.2
RVCOMP = RVOE01
40020 IF (RVCOMP - 1.1995) 20020,10020,40021
40021 IF (RVCOMP - 1.2005) 10020,10020,20020
30020 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10020, 0031, 20020
10020 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0031
20020 IVFAIL = IVFAIL + 1
WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR
0031 CONTINUE
C
C **** FCVS PROGRAM 300 - TEST 003 ****
C
C THIS IS A TEST FOR EQUATING TWO LOGICAL VARIABLES.
C
C
IVTNUM = 3
IF (ICZERO) 30030, 0030, 30030
0030 CONTINUE
LVOE01 = .TRUE.
LVOE02 = .FALSE.
IVCORR = 0
IVCOMP = 0
IF (LVOE01) IVCOMP = 1
40030 IF (IVCOMP) 20030,10030,20030
30030 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10030, 0041, 20030
10030 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0041
20030 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0041 CONTINUE
C
C **** FCVS PROGRAM 300 - TEST 004 ****
C
C THIS IS A TEST FOR EQUATING TWO CHARACTER VARIABLES.
C
C
IVTNUM = 4
IF (ICZERO) 30040, 0040, 30040
0040 CONTINUE
CVCOMP = ' '
CVTE01 = 'ABC'
CVTE02 = 'DEF'
CVCORR = 'DEF'
CVCOMP = CVTE01
40040 IF (CVCOMP .EQ. 'DEF') GO TO 10040
40041 GO TO 20040
30040 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10040, 0051, 20040
10040 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0051
20040 IVFAIL = IVFAIL + 1
WRITE (I02,80018) IVTNUM, CVCOMP, CVCORR
0051 CONTINUE
C
C **** FCVS PROGRAM 300 - TEST 005 ****
C
C THIS IS A TEST FOR EQUATING THREE INTEGER VARIABLES.
C
C
IVTNUM = 5
IF (ICZERO) 30050, 0050, 30050
0050 CONTINUE
IVCOMP = 0
IVOE03 = 3
IVOE04 = 4
IVOE05 = 5
IVCORR = 5
IVCOMP = IVOE03
40050 IF (IVCOMP - 5) 20050,40051,20050
40051 IVCOMP = IVOE04
40052 IF (IVCOMP - 5) 20050,10050,20050
30050 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10050, 0061, 20050
10050 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0061
20050 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0061 CONTINUE
C
C **** FCVS PROGRAM 300 - TEST 006 ****
C
C THIS IS A TEST FOR EQUATING TWO INTEGER VARIABLES AND ONE
C REAL VARIABLE WITHIN ONE EQUIVALENCE STATEMENT LIST OF NAMES. THE
C VALUE OF THE REAL VARIABLE IS NOT TESTED.
C
C
IVTNUM = 6
IF (ICZERO) 30060, 0060, 30060
0060 CONTINUE
IVCOMP = 0
RVOE03 = 3.445
IVOE06 = 6
IVOE07 = 7
IVCORR = 7
IVCOMP = IVOE06
40060 IF (IVCOMP - 7) 20060,10060,20060
30060 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10060, 0071, 20060
10060 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0071
20060 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0071 CONTINUE
C
C **** FCVS PROGRAM 300 - TEST 007 ****
C
C THIS IS A TEST FOR EQUATING INTEGER VARIABLES USING TWO LISTS
C OF NAMES IN ONE EQUIVALENCE STATEMENT. NAMES SPECIFIED IN THE
C FIRST LIST ARE NOT EQUATED TO NAMES IN THE SECOND LIST. THIS
C TEST CHECKS THE EQUIVALINCE OF THE VARIABLES IN THE FIRST LIST.
C
C
IVTNUM = 7
IF (ICZERO) 30070, 0070, 30070
0070 CONTINUE
IVCOMP = 0
IVOE08 = 8
IVOE09 = 9
IVOE10 = 10
IVOE11 = 11
IVCORR = 9
IVCOMP = IVOE08
40070 IF (IVCOMP - 9) 20070,10070,20070
30070 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10070, 0081, 20070
10070 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0081
20070 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0081 CONTINUE
C
C **** FCVS PROGRAM 300 - TEST 008 ****
C
C THIS TEST CHECKS THE EQUIVALENCE OF THE VARIABLES IN THE
C SECOND LIST.
C
C
IVTNUM = 8
IF (ICZERO) 30080, 0080, 30080
0080 CONTINUE
IVCOMP = 0
IVCORR = 11
IVCOMP = IVOE10
40080 IF (IVCOMP - 11) 20080,10080,20080
30080 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10080, 0091, 20080
10080 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0091
20080 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0091 CONTINUE
C
C **** FCVS PROGRAM 300 - TEST 009 ****
C
C THIS IS A TEST FOR EQUATING INTEGER VARIABLES IN ONE LIST
C WITH INTEGER VARIABLES IN A SECOND LIST OF THE SAME EQUIVALENCE
C STATEMENT. ALL VARIABLES SHOULD BE EQUATED AND SHARE THE SAME
C STORAGE UNIT.
C
C
IVTNUM = 9
IF (ICZERO) 30090, 0090, 30090
0090 CONTINUE
IVCOMP = 0
IVOE12 = 12
IVOE13 = 13
IVOE14 = 14
IVCORR = 14
IVCOMP = IVOE13
40090 IF (IVCOMP - 14) 20090,40091,20090
40091 IVCOMP = IVOE12
40092 IF (IVCOMP - 14) 20090,10090,20090
30090 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10090, 0101, 20090
10090 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0101
20090 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0101 CONTINUE
C
C **** FCVS PROGRAM 300 - TEST 010 ****
C
C THIS IS A TEST FOR EQUATING INTEGER VARIABLES SPECIFIED IN ONE
C EQUIVALENCE STATEMENT WITH INTEGER VARIABLES SPECIFIED IN A
C SECOND EQUIVALENCE STATEMENT. ONE VARIABLE IS SPECIFIED IN BOTH
C STATEMENTS, THEREFORE ALL VARIABLES SHOULD BE EQUATED AND SHARE
C THE SAME STORAGE UNIT.
C
C
IVTNUM = 10
IF (ICZERO) 30100, 0100, 30100
0100 CONTINUE
IVCOMP = 0
IVOE15 = 15
IVOE16 = 16
IVOE17 = 17
IVCORR = 17
IVCOMP = IVOE16
40100 IF (IVCOMP - 17) 20100,40101,20100
40101 IVCOMP = IVOE15
40102 IF (IVCOMP - 17) 20100,10100,20100
30100 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10100, 0111, 20100
10100 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0111
20100 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0111 CONTINUE
C
C **** FCVS PROGRAM 300 - TEST 011 ****
C
C THIS IS A TEST FOR EQUATING TWO INTEGER ARRAYS UNQUALIFIED
C BY A SUBSCRIPT IN THE EQUIVALENCE STATEMENT. ALL ARRAY ELEMENTS
C SPECIFIED BY THE SAME SUBSCRIPT VALUE, BEGINNING WITH THE FIRST
C ARRAY ELEMENT, SHOULD BE EQUATED AND SHARE THE SAME STORAGE UNIT.
C THIS TEST CHECKS THE EQUIVALENCE OF THE FIRST ARRAY ELEMENTS.
C
C
IVTNUM = 11
IF (ICZERO) 30110, 0110, 30110
0110 CONTINUE
IVCOMP = 0
IADE11(1) = 111
IADE11(2) = 112
IADE12(1) = 121
IADE12(2) = 122
IADE12(3) = 123
IVCORR = 121
IVCOMP = IADE11(1)
40110 IF (IVCOMP - 121) 20110,10110,20110
30110 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10110, 0121, 20110
10110 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0121
20110 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0121 CONTINUE
C
C **** FCVS PROGRAM 300 - TEST 012 ****
C
C THIS TEST CHECKS THE EQUIVALENCE OF THE SECOND ARRAY ELEMENTS.
C
C
IVTNUM = 12
IF (ICZERO) 30120, 0120, 30120
0120 CONTINUE
IVCOMP = 0
IVCORR = 122
IVCOMP = IADE11(2)
40120 IF (IVCOMP - 122) 20120,10120,20120
30120 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10120, 0131, 20120
10120 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0131
20120 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0131 CONTINUE
C
C **** FCVS PROGRAM 300 - TEST 013 ****
C
C THIS IS A TEST FOR EQUATING TWO REAL ARRAY ELEMENTS. THIS
C TEST CHECKS THE EQUIVALENCE OF THE TWO ARRAY ELEMENTS SPECIFIED
C IN THE EQUIVALENCE STATEMENT.
C
C
IVTNUM = 13
IF (ICZERO) 30130, 0130, 30130
0130 CONTINUE
RVCOMP = 0.0
RADE11(4) = 11.4
RADE12(2) = 1.22
RVCORR = 1.22
RVCOMP = RADE11(4)
40130 IF (RVCOMP - 1.2195) 20130,10130,40131
40131 IF (RVCOMP - 1.2205) 10130,10130,20130
30130 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10130, 0141, 20130
10130 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0141
20130 IVFAIL = IVFAIL + 1
WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR
0141 CONTINUE
C
C **** FCVS PROGRAM 300 - TEST 014 ****
C
C THIS TEST CHECKS THE EQUIVALENCE OF THE ARRAY ELEMENTS
C WITH A SUBSCRIPT VALUE ONE LESS THAN THOSE TESTED IN THE
C PREVIOUS TEST. THESE ELEMENTS SHOULD BE EQUATED AND SHARE THE
C SAME STORAGE UNIT DUE TO THE WAY ARRAY ELEMENTS OCCUPY
C CONSECUTIVE STORAGE UNITS.
C
C
IVTNUM = 14
IF (ICZERO) 30140, 0140, 30140
0140 CONTINUE
RVCOMP = 0.0
RADE11(3) = .113
RADE12(1) = 122.
RVCORR = 122.
RVCOMP = RADE11(3)
40140 IF (RVCOMP - 121.95) 20140,10140,40141
40141 IF (RVCOMP - 122.05) 10140,10140,20140
30140 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10140, 0151, 20140
10140 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0151
20140 IVFAIL = IVFAIL + 1
WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR
0151 CONTINUE
C
C **** FCVS PROGRAM 300 - TEST 015 ****
C
C THIS IS A TEST TO EQUATE AN ARRAY NAME TO AN ARRAY ELEMENT
C NAME.
C
C
IVTNUM = 15
IF (ICZERO) 30150, 0150, 30150
0150 CONTINUE
IVCOMP = 0
IADE13(1) = 131
IADE14(3) = 143
IVCORR = 143
IVCOMP = IADE13(1)
40150 IF (IVCOMP - 143) 20150,10150,20150
30150 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10150, 0161, 20150
10150 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0161
20150 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0161 CONTINUE
C
C **** FCVS PROGRAM 300 - TEST 016 ****
C
C THIS IS A TEST TO EQUATE AN ARRAY ELEMENT TO AN INTEGER
C VARIABLE.
C
C
IVTNUM = 16
IF (ICZERO) 30160, 0160, 30160
0160 CONTINUE
IVCOMP = 0
IADE15(2) = 152
IVOE18 = 18
IVCORR = 18
IVCOMP = IADE15(2)
40160 IF (IVCOMP - 18) 20160,10160,20160
30160 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10160, 0171, 20160
10160 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0171
20160 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0171 CONTINUE
C
C **** FCVS PROGRAM 300 - TEST 017 ****
C
C THIS IS A TEST TO EQUATE A ONE DIMENSIONAL ARRAY TO A TWO
C DIMENSIONAL ARRAY. THIS TEST CHECKS THE SECOND ARRAY ELEMENTS.
C
C
IVTNUM = 17
IF (ICZERO) 30170, 0170, 30170
0170 CONTINUE
IVCOMP = 0
IADE21(2,1) = 212
IADE16(2) = 162
IVCORR = 162
IVCOMP = IADE21(2,1)
40170 IF (IVCOMP - 162) 20170,10170,20170
30170 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10170, 0181, 20170
10170 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0181
20170 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0181 CONTINUE
C
C **** FCVS PROGRAM 300 - TEST 018 ****
C
C THIS TEST CHECKS THE THIRD ARRAY ELEMENTS FROM THE PREVIOUS
C TEST.
C
C
IVTNUM = 18
IF (ICZERO) 30180, 0180, 30180
0180 CONTINUE
IVCOMP = 0
IADE21(1,2) = 2112
IADE16(3) = 163
IVCORR = 163
IVCOMP = IADE21(1,2)
40180 IF (IVCOMP - 163) 20180,10180,20180
30180 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10180, 0191, 20180
10180 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0191
20180 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0191 CONTINUE
C
C **** FCVS PROGRAM 300 - TEST 019 ****
C
C THIS IS A TEST TO EQUATE TWO INTEGER VARIABLES ONE OF WHICH
C IS INITIALIZED IN A DATA STATEMENT.
C
C
IVTNUM = 19
IF (ICZERO) 30190, 0190, 30190
0190 CONTINUE
IVCOMP = 0
IVCORR = 19
IVCOMP = IVOE20
40190 IF (IVCOMP - 19) 20190,10190,20190
30190 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10190, 0201, 20190
10190 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0201
20190 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0201 CONTINUE
C
C
C WRITE OUT TEST SUMMARY
C
WRITE (I02,90004)
WRITE (I02,90014)
WRITE (I02,90004)
WRITE (I02,90000)
WRITE (I02,90004)
WRITE (I02,90020) IVFAIL
WRITE (I02,90022) IVPASS
WRITE (I02,90024) IVDELE
STOP
90001 FORMAT (1H ,24X,5HFM300)
90000 FORMAT (1H ,20X,20HEND OF PROGRAM FM300)
C
C FORMATS FOR TEST DETAIL LINES
C
80000 FORMAT (1H ,4X,I5,6X,7HDELETED)
80002 FORMAT (1H ,4X,I5,7X,4HPASS)
80010 FORMAT (1H ,4X,I5,7X,4HFAIL,10X,I6,9X,I6)
80012 FORMAT (1H ,4X,I5,7X,4HFAIL,4X,E12.5,3X,E12.5)
80018 FORMAT (1H ,4X,I5,7X,4HFAIL,2X,A14,1X,A14)
C
C FORMAT STATEMENTS FOR PAGE HEADERS
C
90002 FORMAT (1H1)
90004 FORMAT (1H )
90006 FORMAT (1H ,10X,34HFORTRAN COMPILER VALIDATION SYSTEM)
90008 FORMAT (1H ,21X,11HVERSION 1.0)
90010 FORMAT (1H ,8X,38HFOR OFFICIAL USE ONLY - COPYRIGHT 1978)
90012 FORMAT (1H ,5X,4HTEST,5X,9HPASS/FAIL,5X,8HCOMPUTED,8X,7HCORRECT)
90014 FORMAT (1H ,5X,46H----------------------------------------------)
90016 FORMAT (1H ,18X,17HSUBSET LEVEL TEST)
C
C FORMAT STATEMENTS FOR RUN SUMMARY
C
90020 FORMAT (1H ,19X,I5,13H TESTS FAILED)
90022 FORMAT (1H ,19X,I5,13H TESTS PASSED)
90024 FORMAT (1H ,19X,I5,14H TESTS DELETED)
END
*END-OF,FM300
FM301.f 481036193 170 2 100666 19576 `
*HEADER,FORTR,FM301
*FILES1,FORTR,FM301,X
PROGRAM FM301
C
C
C FM301 TESTS THE USE OF THE TYPE-STATEMENT TO EXPLICITLY
C DEFINE THE DATA TYPE FOR VARIABLES, ARRAYS, AND STATEMENT
C FUNCTIONS. ONLY INTEGER, REAL, LOGICAL AND CHARACTER DATA
C TYPES ARE TESTED IN THIS ROUTINE. INTEGER AND REAL VARIABLES
C AND ARRAYS ARE TESTED IN A MANNER WHICH BOTH CONFIRMS AND
C OVERRIDES THE IMPLICIT TYPING OF THE DATA ENTITIES.
C
C FM301 DOES NOT ATTEMPT TO TEST ALL OF THE ELEMENTARY SYNTAX
C FORMS OF THE TYPE-STATEMENT. THESE FORMS ARE TESTED ADEQUATELY
C WITHIN THE BOILER PLATE AND OTHER AUDIT PROGRAMS.
C
C REFERENCES.
C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN,
C X3.9-1978
C
C SECTION 4.1, DATA TYPES
C SECTION 8.4, TYPE-STATEMENT
C SECTION 8.5, IMPLICIT STATEMENT
C SECTION 15.4, STATEMENT FUNCTION
C
C
C ******************************************************************
C A COMPILER VALIDATION SYSTEM FOR THE FORTRAN LANGUAGE
C BASED ON SPECIFICATIONS AS DEFINED IN AMERICAN STANDARD FORTRAN
C X3.9-1978, HAS BEEN DEVELOPED BY THE DEPARTMENT OF THE NAVY. THE
C FORTRAN COMPILER VALIDATION SYSTEM (FCVS) CONSISTS OF AUDIT
C ROUTINES, THEIR RELATED DATA, AND AN EXECUTIVE SYSTEM. EACH AUDIT
C ROUTINE IS A FORTRAN PROGRAM OR SUBPROGRAM WHICH INCLUDES TESTS
C OF SPECIFIC LANGUAGE ELEMENTS AND SUPPORTING PROCEDURES INDICATING
C THE RESULT OF EXECUTING THESE TESTS.
C
C THIS PARTICULAR PROGRAM OR SUBPROGRAM CONTAINS ONLY FEATURES
C FOUND IN THE SUBSET LEVEL OF THE STANDARD.
C
C SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO
C DEPARTMENT OF THE NAVY
C FEDERAL COBOL COMPILER TESTING SERVICE
C WASHINGTON, D.C. 20376
C
C ******************************************************************
C
C
IMPLICIT LOGICAL (L)
IMPLICIT CHARACTER*14 (C)
C
C
C *** IMPLICIT STATEMENT FOR TEST 006 ***
C
IMPLICIT LOGICAL (M)
C
C *** IMPLICIT STATEMENT FOR TEST 017 ***
C
IMPLICIT INTEGER (G)
C
C *** IMPLICIT STATEMENT FOR TEST 018 ***
C
IMPLICIT CHARACTER*2 (F)
C
C *** SPECIFICATION STATEMENTS FOR TEST 001 ***
C
INTEGER AVTN01
C
C *** SPECIFICATION STATEMENTS FOR TEST 002 ***
C
REAL KVTN01
C
C *** SPECIFICATION STATEMENTS FOR TEST 003 ***
C
INTEGER KVTN02, AVTN02, KVTN03
C
C *** SPECIFICATION STATEMENTS FOR TEST 004 ***
C
REAL AVTN03, AVTN04, KVTN04
C
C *** SPECIFICATION STATEMENTS FOR TEST 005 ***
C
LOGICAL HVTN01
C
C *** SPECIFICATION STATEMENTS FOR TEST 006 ***
C (ALSO SEE THE IMPLICIT STATEMENTS FOR TEST 006)
C
REAL MVTN01
C
C *** SPECIFICATION STATEMENTS FOR TEST 007 ***
C
INTEGER NVTN11(4)
C
C *** SPECIFICATION STATEMENTS FOR TEST 008 ***
C
REAL NVTN22(2,2)
C
C *** SPECIFICATION STATEMENTS FOR TESTS 009 AND 010 ***
C
INTEGER NVTN33(3,3,3), AVTN15(5)
C
C *** SPECIFICATION STATEMENTS FOR TEST 011 ***
C
DIMENSION NVTN14(5)
INTEGER NVTN14
C
C *** SPECIFICATION STATEMENTS FOR TEST 012 ***
C
DIMENSION AVTN16(4)
INTEGER AVTN16
C
C *** SPECIFICATION STATEMENTS FOR TESTS 013 AND 014 ***
C
CHARACTER CVTN01*14, CATN12(4)*14
C
C *** SPECIFICATION STATEMENTS FOR TEST 015 ***
C
DIMENSION CADN13(6)
CHARACTER CADN13*14
C
C *** SPECIFICATION STATEMENTS FOR TEST 016 ***
C
CHARACTER KVTN05
C
C *** SPECIFICATION STATEMENTS FOR TEST 017 ***
C (ALSO SEE THE IMPLICIT STATEMENT FOR TEST 017)
C
CHARACTER GVTN01*3
C
C *** SPECIFICATION STATEMENTS FOR TEST 018 ***
C (ALSO SEE THE IMPLICIT STATEMENT FOR TEST 018)
C
CHARACTER FVTN01*3
C
C *** SPECIFICATION STATEMENTS FOR TEST 019 ***
C
INTEGER IFTN01
IFTN01(IDON01) = IDON01 + 1
C
C
C
C INITIALIZATION SECTION.
C
C INITIALIZE CONSTANTS
C ********************
C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER
I01 = 5
C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER
I02 = 6
C SYSTEM ENVIRONMENT SECTION
C
CX010 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-010 CONTROL CARD.
C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5
C (UNIT NUMBER FOR CARD READER).
CX011 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-011 CONTROL CARD
C THE CX011 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL
C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX010 ABOVE.
C
CX020 THIS CARD IS PEPLACED BY CONTENTS OF FEXEC X-020 CONTROL CARD.
C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02 = 6
C (UNIT NUMBER FOR PRINTER).
CX021 THIS CARD IS PEPLACED BY CONTENTS OF FEXEC X-021 CONTROL CARD.
C THE CX021 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL
C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX020 ABOVE.
C
IVPASS = 0
IVFAIL = 0
IVDELE = 0
ICZERO = 0
C
C WRITE OUT PAGE HEADERS
C
WRITE (I02,90002)
WRITE (I02,90006)
WRITE (I02,90008)
WRITE (I02,90004)
WRITE (I02,90010)
WRITE (I02,90004)
WRITE (I02,90016)
WRITE (I02,90001)
WRITE (I02,90004)
WRITE (I02,90012)
WRITE (I02,90014)
WRITE (I02,90004)
C
C
C **** FCVS PROGRAM 301 - TEST 001 ****
C
C TEST 001 DEFINES AN INTEGER VARIABLE OVERRIDING THE IMPLICIT
C COMPILER DEFAULT TYPE SPECIFYING REAL.
C
C
IVTNUM = 1
IF (ICZERO) 30010, 0010, 30010
0010 CONTINUE
IVCOMP = 0
AVTN01 = 100
IVCORR = 100
IVCOMP = AVTN01
40010 IF (IVCOMP - 100) 20010, 10010, 20010
30010 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10010, 0021, 20010
10010 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0021
20010 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0021 CONTINUE
C
C **** FCVS PROGRAM 301 - TEST 002 ****
C
C TEST 002 DEFINES A REAL VARIABLE OVERRIDING THE IMPLICIT
C COMPILER DEFAULT TYPE SPECIFYING INTEGER.
C
C
IVTNUM = 2
IF (ICZERO) 30020, 0020, 30020
0020 CONTINUE
RVCOMP = 0.0
KVTN01 = 1.004
RVCORR = 1.004
RVCOMP = KVTN01
40020 IF (RVCOMP - 1.0035) 20020, 10020, 40021
40021 IF (RVCOMP - 1.0045) 10020, 10020, 20020
30020 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10020, 0031, 20020
10020 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0031
20020 IVFAIL = IVFAIL + 1
WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR
0031 CONTINUE
C
C **** FCVS PROGRAM 301 - TEST 003 ****
C
C TEST 003 DEFINES A SERIES OF INTEGER VARIABLES IN ONE TYPE-
C STATEMENT. TWO VARIABLES CONFIRM THE IMPLICIT INTEGER TYPING.
C THE OTHER VARIABLE OVERRIDES THE IMPLICIT TYPING.
C
C
IVTNUM = 3
IF (ICZERO) 30030, 0030, 30030
0030 CONTINUE
IVCOMP = 0
KVTN02 = 20
KVTN03 = 30
AVTN02 = 200
IVCORR = 20
IVCOMP = KVTN02
40030 IF (IVCOMP - 20) 20030, 40031, 20030
40031 IVCORR = 30
IVCOMP = KVTN03
40033 IF (IVCOMP - 30) 20030, 40034, 20030
40034 IVCORR = 200
IVCOMP = AVTN02
40035 IF (IVCOMP - 200) 20030, 10030, 20030
30030 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10030, 0041, 20030
10030 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0041
20030 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0041 CONTINUE
C
C **** FCVS PROGRAM 301 - TEST 004 ****
C
C TEST 004 DEFINES A SERIES OF REAL VARIABLES IN ONE TYPE-
C STATEMENT. TWO VARIABLES CONFIRM THE IMPLICIT REAL TYPING. THE
C THIRD VARIABLE OVERRIDES THE IMPLICIT TYPING.
C
C
IVTNUM = 4
IF (ICZERO) 30040, 0040, 30040
0040 CONTINUE
RVCOMP = 0.0
AVTN03 = 3.0
AVTN04 = 4.
KVTN04 = .4
RVCORR = 3.0
RVCOMP = AVTN03
40040 IF (RVCOMP - 2.9995) 20040, 40042, 40041
40041 IF (RVCOMP - 3.0005) 40042, 40042, 20040
40042 RVCORR = 4.
RVCOMP = AVTN04
40043 IF (RVCOMP - 3.9995) 20040, 40045, 40044
40044 IF (RVCOMP - 4.0005) 40045, 40045, 20040
40045 RVCORR = .4
RVCOMP = KVTN04
40046 IF (RVCOMP - .39995) 20040, 10040, 40047
40047 IF (RVCOMP - .40005) 10040, 10040, 20040
30040 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10040, 0051, 20040
10040 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0051
20040 IVFAIL = IVFAIL + 1
WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR
0051 CONTINUE
C
C **** FCVS PROGRAM 301 - TEST 005 ****
C
C TEST 005 DEFINES A LOGICAL VARIABLE.
C
C
IVTNUM = 5
IF (ICZERO) 30050, 0050, 30050
0050 CONTINUE
HVTN01 = .TRUE.
IVCORR = 1
IVCOMP = 0
IF (HVTN01) IVCOMP = 1
40050 IF (IVCOMP - 1) 20050, 10050, 20050
30050 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10050, 0061, 20050
10050 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0061
20050 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0061 CONTINUE
C
C **** FCVS PROGRAM 301 - TEST 006 ****
C
C TEST 006 DEFINES A REAL VARIABLE WITH A TYPE-STATEMENT THAT
C OVERRIDES THE IMPLICIT STATEMENT TYPING OF THE INTEGER LETTER 'M'
C AS LOGICAL.
C
C
IVTNUM = 6
IF (ICZERO) 30060, 0060, 30060
0060 CONTINUE
RVCOMP = 0.0
MVTN01 = 12.345
RVCORR = 12.345
RVCOMP = MVTN01
40060 IF (RVCOMP - 12.340) 20060, 10060, 40061
40061 IF (RVCOMP - 12.350) 10060, 10060, 20060
30060 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10060, 0071, 20060
10060 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0071
20060 IVFAIL = IVFAIL + 1
WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR
0071 CONTINUE
C
C **** FCVS PROGRAM 301 - TEST 007 ****
C
C TEST 007 DEFINES A ONE DIMENSIONAL INTEGER ARRAY.
C
C
IVTNUM = 7
IF (ICZERO) 30070, 0070, 30070
0070 CONTINUE
IVCOMP = 0
NVTN11(3) = 3
IVCORR = 3
IVCOMP = NVTN11(3)
40070 IF (IVCOMP - 3) 20070, 10070, 20070
30070 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10070, 0081, 20070
10070 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0081
20070 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0081 CONTINUE
C
C **** FCVS PROGRAM 301 - TEST 008 ****
C
C TEST 008 DEFINES A TWO DIMENSIONAL REAL ARRAY THAT OVERRIDES
C THE IMPLICIT TYPING OF INTEGER.
C
C
IVTNUM = 8
IF (ICZERO) 30080, 0080, 30080
0080 CONTINUE
RVCOMP = 0.0
NVTN22(1,2) = 2.12
RVCORR = 2.12
RVCOMP = NVTN22(1,2)
40080 IF (RVCOMP - 2.1195) 20080, 10080, 40081
40081 IF (RVCOMP - 2.1205) 10080, 10080, 20080
30080 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10080, 0091, 20080
10080 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0091
20080 IVFAIL = IVFAIL + 1
WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR
0091 CONTINUE
C
C **** FCVS PROGRAM 301 - TEST 009 ****
C
C TEST 009 DEFINES TWO INTEGER ARRAYS WITH ONE TYPE-STATEMENT.
C ONE ARRAY IS THREE DIMENSIONAL WHILE THE OTHER ARRAY OVERRIDES
C THE IMPLICIT TYPING OF REAL. ONLY THE THREE DIMENSIONAL ARRAY
C IS CHECKED IN THIS TEST.
C
C
IVTNUM = 9
IF (ICZERO) 30090, 0090, 30090
0090 CONTINUE
IVCOMP = 0
NVTN33(1,2,3) = 123
IVCORR = 123
IVCOMP = NVTN33(1,2,3)
40090 IF (IVCOMP - 123) 20090, 10090, 20090
30090 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10090, 0101, 20090
10090 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0101
20090 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0101 CONTINUE
C
C **** FCVS PROGRAM 301 - TEST 010 ****
C
C TEST 010 CHECKS THE SECOND ARRAY DESCRIBED IN THE PREVIOUS
C TEST.
C
C
IVTNUM = 10
IF (ICZERO) 30100, 0100, 30100
0100 CONTINUE
IVCOMP = 0
AVTN15(2) = 5
IVCORR = 5
IVCOMP = AVTN15(2)
40100 IF (IVCOMP - 5) 20100, 10100, 20100
30100 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10100, 0111, 20100
10100 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0111
20100 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0111 CONTINUE
C
C **** FCVS PROGRAM 301 - TEST 011 ****
C
C TEST 011 USES THE TYPE-STATEMENT TO EXPLICITLY TYPE AN ARRAY
C THAT WAS DEFINED WITH A DIMENSION STATEMENT.
C
C
IVTNUM = 11
IF (ICZERO) 30110, 0110, 30110
0110 CONTINUE
IVCOMP = 0
NVTN14(5) = 5
IVCORR = 5
IVCOMP = NVTN14(5)
40110 IF (IVCOMP - 5) 20110, 10110, 20110
30110 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10110, 0121, 20110
10110 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0121
20110 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0121 CONTINUE
C
C **** FCVS PROGRAM 301 - TEST 012 ****
C
C TEST 012 USES THE TYPE-STATEMENT TO OVERRIDE THE TYPING OF
C AN ARRAY THAT WAS DEFINED WITH A DIMENSION STATEMENT.
C
IVTNUM = 12
IF (ICZERO) 30120, 0120, 30120
0120 CONTINUE
IVCOMP = 0
AVTN16(3) = 163
IVCORR = 163
IVCOMP = AVTN16(3)
40120 IF (IVCOMP - 163) 20120, 10120, 20120
30120 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10120, 0131, 20120
10120 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0131
20120 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0131 CONTINUE
C
C **** FCVS PROGRAM 301 - TEST 013 ****
C
C TEST 013 USES ONE CHARACTER TYPE-STATEMENT TO SPECIFY BOTH A
C VARIABLE AND AN ARRAY DECLARATOR. ONLY THE VARIABLE IS CHECKED
C IN THIS TEST.
C
IVTNUM = 13
IF (ICZERO) 30130, 0130, 30130
0130 CONTINUE
CVTN01 = '12345678901234'
CVCOMP = ' '
CVCORR = '12345678901234'
CVCOMP = CVTN01
40130 IF (CVCOMP .EQ. '12345678901234') GO TO 10130
40131 GO TO 20130
30130 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10130, 0141, 20130
10130 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0141
20130 IVFAIL = IVFAIL + 1
WRITE (I02,80018) IVTNUM, CVCOMP, CVCORR
0141 CONTINUE
C
C **** FCVS PROGRAM 301 - TEST 014 ****
C
C TEST 014 CHECKS THE ARRAY DECLARATOR FROM THE PREVIOUS TEST.
C
IVTNUM = 14
IF (ICZERO) 30140, 0140, 30140
0140 CONTINUE
CVCOMP = ' '
CATN12(2) = 'ABCDEFGHIJKLMN'
CVCORR = 'ABCDEFGHIJKLMN'
CVCOMP = CATN12(2)
40140 IF (CVCOMP .EQ. 'ABCDEFGHIJKLMN') GO TO 10140
40141 GO TO 20140
30140 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10140, 0151, 20140
10140 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0151
20140 IVFAIL = IVFAIL + 1
WRITE (I02,80018) IVTNUM, CVCOMP, CVCORR
0151 CONTINUE
C
C **** FCVS PROGRAM 301 - TEST 015 ****
C
C TEST 015 USES THE CHARACTER TYPE-STATEMENT TO SPECIFY AN
C ARRAY-NAME. THE ARRAY IS DECLARED IN A DIMENSION STATEMENT.
C
IVTNUM = 15
IF (ICZERO) 30150, 0150, 30150
0150 CONTINUE
CVCOMP = ' '
CADN13(3) = '12345678901234'
CVCORR = '12345678901234'
CVCOMP = CADN13(3)
40150 IF (CVCOMP .EQ. '12345678901234') GO TO 10150
40151 GO TO 20150
30150 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10150, 0161, 20150
10150 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0161
20150 IVFAIL = IVFAIL + 1
WRITE (I02,80018) IVTNUM, CVCOMP, CVCORR
0161 CONTINUE
C
C **** FCVS PROGRAM 301 - TEST 016 ****
C
C TEST 016 USES THE CHARACTER TYPE-STATEMENT TO OVERRIDE THE
C IMPLICIT (DEFAULT) TYPING OF INTEGER.
C
IVTNUM = 16
IF (ICZERO) 30160, 0160, 30160
0160 CONTINUE
CVCOMP = ' '
KVTN05 = 'A'
CVCORR = 'A'
CVCOMP = KVTN05
40160 IF (CVCOMP .EQ. 'A') GO TO 10160
40161 GO TO 20160
30160 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10160, 0171, 20160
10160 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0171
20160 IVFAIL = IVFAIL + 1
WRITE (I02,80018) IVTNUM, CVCOMP, CVCORR
0171 CONTINUE
C
C **** FCVS PROGRAM 301 - TEST 017 ****
C
C TEST 017 USES THE CHARACTER TYPE-STATEMENT TO OVERRIDE THE
C IMPLICIT TYPING OF THE LETTER 'G' AS INTEGER.
C
IVTNUM = 17
IF (ICZERO) 30170, 0170, 30170
0170 CONTINUE
CVCOMP = ' '
GVTN01 = 'ABC'
CVCORR = 'ABC'
CVCOMP = GVTN01
40170 IF (CVCOMP .EQ. 'ABC') GO TO 10170
40171 GO TO 20170
30170 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10170, 0181, 20170
10170 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0181
20170 IVFAIL = IVFAIL + 1
WRITE (I02,80018) IVTNUM, CVCOMP, CVCORR
0181 CONTINUE
C
C **** FCVS PROGRAM 301 - TEST 018 ****
C
C TEST 018 USES THE CHARAACTER TYPE-STATEMENT TO OVERRIDE THE
C LENGTH OF A CHARACTER FIELD DEFINED BY AN IMPLICIT STATEMENT.
C
IVTNUM = 18
IF (ICZERO) 30180, 0180, 30180
0180 CONTINUE
CVCOMP = ' '
FVTN01 = 'ABC'
CVCORR = 'ABC'
CVCOMP = FVTN01
40180 IF (CVCOMP .EQ. 'ABC') GO TO 10180
40181 GO TO 20180
30180 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10180, 0191, 20180
10180 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0191
20180 IVFAIL = IVFAIL + 1
WRITE (I02,80018) IVTNUM, CVCOMP, CVCORR
0191 CONTINUE
C
C **** FCVS PROGRAM 301 - TEST 019 ****
C
C TEST 019 USES THE TYPE-STATEMENT TO SPECIFY AN INTEGER
C STATEMENT FUNCTION.
C
IVTNUM = 19
IF (ICZERO) 30190, 0190, 30190
0190 CONTINUE
IVCOMP = 0
IVON01 = 5
IVON02 = IFTN01(IVON01)
IVCORR = 6
IVCOMP = IVON02
40190 IF (IVCOMP - 6) 20190, 10190, 20190
30190 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10190, 0201, 20190
10190 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0201
20190 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0201 CONTINUE
C
C
C WRITE OUT TEST SUMMARY
C
WRITE (I02,90004)
WRITE (I02,90014)
WRITE (I02,90004)
WRITE (I02,90000)
WRITE (I02,90004)
WRITE (I02,90020) IVFAIL
WRITE (I02,90022) IVPASS
WRITE (I02,90024) IVDELE
STOP
90001 FORMAT (1H ,24X,5HFM301)
90000 FORMAT (1H ,20X,20HEND OF PROGRAM FM301)
C
C FORMATS FOR TEST DETAIL LINES
C
80000 FORMAT (1H ,4X,I5,6X,7HDELETED)
80002 FORMAT (1H ,4X,I5,7X,4HPASS)
80010 FORMAT (1H ,4X,I5,7X,4HFAIL,10X,I6,9X,I6)
80012 FORMAT (1H ,4X,I5,7X,4HFAIL,4X,E12.5,3X,E12.5)
80018 FORMAT (1H ,4X,I5,7X,4HFAIL,2X,A14,1X,A14)
C
C FORMAT STATEMENTS FOR PAGE HEADERS
C
90002 FORMAT (1H1)
90004 FORMAT (1H )
90006 FORMAT (1H ,10X,34HFORTRAN COMPILER VALIDATION SYSTEM)
90008 FORMAT (1H ,21X,11HVERSION 1.0)
90010 FORMAT (1H ,8X,38HFOR OFFICIAL USE ONLY - COPYRIGHT 1978)
90012 FORMAT (1H ,5X,4HTEST,5X,9HPASS/FAIL,5X,8HCOMPUTED,8X,7HCORRECT)
90014 FORMAT (1H ,5X,46H----------------------------------------------)
90016 FORMAT (1H ,18X,17HSUBSET LEVEL TEST)
C
C FORMAT STATEMENTS FOR RUN SUMMARY
C
90020 FORMAT (1H ,19X,I5,13H TESTS FAILED)
90022 FORMAT (1H ,19X,I5,13H TESTS PASSED)
90024 FORMAT (1H ,19X,I5,14H TESTS DELETED)
END
*END-OF,FM301
FM302.f 481036197 170 2 100666 24094 `
*HEADER,FORTR,FM302
*FILES1,FORTR,FM302
PROGRAM FM302
C
C
C THIS ROUTINE TESTS THE SUBSET LEVEL FEATURES OF THE COMMON
C SPECIFICATION STATEMENT. INTEGER, REAL AND LOGICAL VARIABLES AND
C ARRAYS ARE PASSED BACK-AND-FORTH BETWEEN THE MAIN PROGRAM,EXTERNAL
C FUNCTIONS AND SUBROUTINES. BOTH NAMED AND UNNAMED (BLANK) COMMON
C ARE TESTED. SPECIFIC TESTS ARE INCLUDED FOR RENAMING ENTITIES IN
C COMMON BETWEEN PROGRAM UNITS, THE PASSING OF DATA THROUGH COMMON
C BY EQUIVALENCE ASSOCIATION, AND THE SPECIFYING OF BLANK COMMON OF
C DIFFERENT LENGTHS IN DIFFERENT PROGRAM UNITS. THE SUBSET LEVEL
C FEATURES OF THE COMMON STATEMENT ARE ALSO TESTED IN FM022 THROUGH
C FM025, FM050 AND FM056.
C
C REFERENCES.
C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN,
C X3.9-1978
C
C SECTION 8.2, EQUIVALENCE STATEMENT
C SECTION 8.3, COMMON STATEMENT
C SECTION 15.5, EXTERNAL FUNCTIONS
C SECTION 15.6, SUBROUTINES
C SECTION 15.9.4, COMMON BLOCKS
C
C
C ******************************************************************
C A COMPILER VALIDATION SYSTEM FOR THE FORTRAN LANGUAGE
C BASED ON SPECIFICATIONS AS DEFINED IN AMERICAN STANDARD FORTRAN
C X3.9-1978, HAS BEEN DEVELOPED BY THE DEPARTMENT OF THE NAVY. THE
C FORTRAN COMPILER VALIDATION SYSTEM (FCVS) CONSISTS OF AUDIT
C ROUTINES, THEIR RELATED DATA, AND AN EXECUTIVE SYSTEM. EACH AUDIT
C ROUTINE IS A FORTRAN PROGRAM OR SUBPROGRAM WHICH INCLUDES TESTS
C OF SPECIFIC LANGUAGE ELEMENTS AND SUPPORTING PROCEDURES INDICATING
C THE RESULT OF EXECUTING THESE TESTS.
C
C THIS PARTICULAR PROGRAM OR SUBPROGRAM CONTAINS ONLY FEATURES
C FOUND IN THE SUBSET LEVEL OF THE STANDARD.
C
C SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO
C DEPARTMENT OF THE NAVY
C FEDERAL COBOL COMPILER TESTING SERVICE
C WASHINGTON, D.C. 20376
C
C ******************************************************************
C
C
IMPLICIT LOGICAL (L)
IMPLICIT CHARACTER*14 (C)
C
C
C *** SPECIFICATION STATEMENT FOR TEST 001 ***
C
COMMON IVCN01
C
C *** SPECIFICATION STATEMENT FOR TEST 002 ***
C
COMMON //IVCN02,LVCN01
C
C *** SPECIFICATION STATEMENT FOR TEST 003 ***
C
COMMON RVCN01//IVCN03
C
C *** SPECIFICATION STATEMENT FOR TEST 004 ***
C
COMMON IVCN04, IVCN05, // IACN11(4)
C
C *** SPECIFICATION STATEMENT FOR TEST 005 ***
C
COMMON /BLK1/ IVCNA1
C
C *** SPECIFICATION STATEMENT FOR TEST 006 ***
C
COMMON /BLK2/IVCNB1,RVCNB1, /BLK2/IVCNB2
C
C *** SPECIFICATION STATEMENT FOR TEST 007 ***
C
DIMENSION RACN11(10)
COMMON /BLK3/LVCNC1,IVCNC1/BLK4/RACN11,IACN21(2,3)
C
C *** SPECIFICATION STATEMENT FOR TEST 008 ***
C
COMMON /BLK5/IVCND1, IVCND2
C
C *** SPECIFICATION STATEMENT FOR TEST 009 ***
C
COMMON IVCN06/BLK5/RVCND1,LVCND1//IVCN07,IVCN08/BLK6/RVCNE1
C
C *** SPECIFICATION STATEMENT FOR TEST 010 ***
C
DIMENSION IACN1F(3)
COMMON /BLK7/IVCNF1,IVCNF2,IVCNF3,IACN1F
C
C *** SPECIFICATION STATEMENT FOR TEST 011 ***
C
EQUIVALENCE (IVCEH1,IVCEH2)
COMMON /BLK8/IVCEH1
C
C *** SPECIFICATION STATEMENT FOR TEST 012
EQUIVALENCE (IVCE09,IVCE10)
COMMON IVCE09
C
C *** SPECIFICATION STATEMENT FOR TEST 013
C
EQUIVALENCE (IVCEI1,IACE1I)
DIMENSION IACE1I(3)
COMMON /BLK9/IVCEI1
C
C *** SPECIFICATION STATEMENT FOR TEST 014 ***
C
COMMON IVCN12
C
C *** SPECIFICATION STATEMENT FOR TEST 015 ***
C
COMMON /BLK10/IVCNJ1
C
C *** SPECIFICATION STATEMENT FOR TEST 016 ***
C
COMMON /BLKCHR/CVTN01,CVTN02,CATN11
CHARACTER CVTN01*2, CVTN02*3, CATN11(3)*5
INTEGER FF304
C
C
C
C INITIALIZATION SECTION.
C
C INITIALIZE CONSTANTS
C ********************
C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER
I01 = 5
C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER
I02 = 6
C SYSTEM ENVIRONMENT SECTION
C
CX010 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-010 CONTROL CARD.
C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5
C (UNIT NUMBER FOR CARD READER).
CX011 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-011 CONTROL CARD
C THE CX011 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL
C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX010 ABOVE.
C
CX020 THIS CARD IS PEPLACED BY CONTENTS OF FEXEC X-020 CONTROL CARD.
C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02 = 6
C (UNIT NUMBER FOR PRINTER).
CX021 THIS CARD IS PEPLACED BY CONTENTS OF FEXEC X-021 CONTROL CARD.
C THE CX021 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL
C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX020 ABOVE.
C
IVPASS = 0
IVFAIL = 0
IVDELE = 0
ICZERO = 0
C
C WRITE OUT PAGE HEADERS
C
WRITE (I02,90002)
WRITE (I02,90006)
WRITE (I02,90008)
WRITE (I02,90004)
WRITE (I02,90010)
WRITE (I02,90004)
WRITE (I02,90016)
WRITE (I02,90001)
WRITE (I02,90004)
WRITE (I02,90012)
WRITE (I02,90014)
WRITE (I02,90004)
C
C
C THE FOLLOWING ASSIGNMENT STATEMENTS INITIALIZE THE DATA
C ENTITIES BEING PASSED THROUGH COMMON TO SUBROUTINE FS303. ONLY
C ONE REFERENCE TO THIS SUBPROGRAM IS MADE FROM THIS PROGRAM. THE
C CONTENTS OF THE DATA ENTITIES BEING RETURNED THROUGH COMMON ARE
C THEN CHECKED IN THIS PROGRAM.
C
C
IVCN01 = 3
IVCN02 = 2
LVCN01 = .FALSE.
IVCNA1 = 25
IVCNB1 = 3
RVCNB1 = 4.0
IVCNB2 = 5
LVCNC1 = .TRUE.
IVCNC1 = 13
RACN11(1) = 1.
RACN11(10) = 10.0
IACN21(1,1) = 11
IACN21(2,3) = 23
IVCNF1 = 41
IVCNF3 = 43
IACN1F(1) = 141
IACN1F(2) = 142
IVCEH1 = 1
IVCEH2 = 5
CVTN01 = 'AB'
CVTN02 = 'CDE'
CATN11(1) = 'FGHIJ'
CATN11(2) = 'KLMNO'
CATN11(3) = 'PQRST'
CALL FS303
C
C THE FOLLOWING ASSIGNMENT STATEMENTS INITIALIZE THE DATA
C ENTITIES BEING PASSED THROUGH COMMON TO EXTERNAL FUNCTION FF304.
C ONLY ONE REFERENCE TO THIS SUBPROGRAM IS MADE FROM THIS PROGRAM.
C THE CONTENTS OF THE DATA ENTITIES BEING RETURNED THROUGH COMMON
C ARE THEN CHECKED IN THIS PROGRAM.
C
RVCN01 = 6.4
IVCN03 = 11
IVCN03 = IVCN03*2
IVCN04 = 16
IVCN05 = 16
IACN11(1) = 1
IACN11(2) = 2
IACN11(3) = 3
IACN11(4) = 4
IVCND1 = +33
IVCND2 = 10
IVCN06 = 6
IVCN07 = 7
IVCN08 = 8
RVCND1 = 1.3
LVCND1 = .FALSE.
RVCNE1 = +3.5
IVCE09 = 9
IVCE10 = 10
IVCEI1 = 5
IACE1I(1) = 10
IACE1I(2) = 15
IACE1I(3) = 20
IVCNJ1 = 1
IVON99 = FF304 ( )
C
C TESTS 001 THROUGH 009 ARE DESIGNED TO TEST VARIOUS
C SYNTACTICAL CONSTRUCTS OF THE COMMON STATEMENT USING NAMED AND
C UNNAMED (BLANK) COMMON IN THE MAIN PROGRAM, A SUBROUTINE AND AN
C EXTERNAL FUNCTION. DATA ENTITIES CONSIST OF INTEGER, REAL AND
C LOGICAL VARIABLES AND INTEGER AND REAL ARRAYS.
C
C **** FCVS PROGRAM 302 - TEST 001 ****
C
C TESTS 001 AND 002 TEST THE USE OF UNNAMED COMMON IN A MAIN
C PROGRAM AND A SUBROUTINE.
C
IVTNUM = 1
IF (ICZERO) 30010, 0010, 30010
0010 CONTINUE
IVCOMP = 0
IVCOMP = IVCN01
IVCORR = 4
40010 IF (IVCOMP - 4) 20010, 10010, 20010
30010 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10010, 0021, 20010
10010 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0021
20010 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0021 CONTINUE
C
C **** FCVS PROGRAM 302 - TEST 002 ****
C
C
IVTNUM = 2
IF (ICZERO) 30020, 0020, 30020
0020 CONTINUE
IVCOMP = 1
IF (IVCN02 .EQ. 7) IVCOMP = IVCOMP * 2
IF (LVCN01) IVCOMP = IVCOMP * 3
IVCORR = 6
C 6 = 2 * 3
40020 IF (IVCOMP - 6) 20020, 10020, 20020
30020 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10020, 0031, 20020
10020 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0031
20020 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0031 CONTINUE
C
C **** FCVS PROGRAM 302 - TEST 003 ****
C
C TESTS 003 AND 004 TEST THE USE OF UNNAMED COMMON IN A MAIN
C PROGRAM AND AN EXTERNAL FUNCTION.
C
IVTNUM = 3
IF (ICZERO) 30030, 0030, 30030
0030 CONTINUE
IVCOMP = 1
IF (RVCN01 .GE. 4.1995 .AND. RVCN01 .LE. 4.2005) IVCOMP=IVCOMP*2
IF (IVCN03 .EQ. 23) IVCOMP = IVCOMP * 3
IVCORR = 6
C 6 = 2 * 3
40030 IF (IVCOMP - 6) 20030, 10030, 20030
30030 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10030, 0041, 20030
10030 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0041
20030 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0041 CONTINUE
C
C **** FCVS PROGRAM 302 - TEST 004 ****
C
C
IVTNUM = 4
IF (ICZERO) 30040, 0040, 30040
0040 CONTINUE
IVCOMP = 1
IF (IVCN04 .EQ. 8) IVCOMP = IVCOMP * 2
IF (IVCN05 .EQ. 16) IVCOMP = IVCOMP * 3
IF (IACN11(1) .EQ. 5) IVCOMP = IVCOMP * 5
IF (IACN11(2) .EQ. 5) IVCOMP = IVCOMP * 7
IF (IACN11(3) .EQ. 5) IVCOMP = IVCOMP * 11
IF (IACN11(4) .EQ. 5) IVCOMP = IVCOMP * 13
IVCORR = 30030
C 30030 = 2 * 3 * 5 * 7 * 11 * 13
40040 IF (IVCOMP - 30030) 20040, 10040, 20040
30040 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10040, 0051, 20040
10040 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0051
20040 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0051 CONTINUE
C
C **** FCVS PROGRAM 302 - TEST 005 ****
C
C TESTS 005 THROUGH 007 TEST THE USE OF NAMED COMMON BLOCKS
C IN A MAIN PROGRAM AND A SUBROUTINE.
C
IVTNUM = 5
IF (ICZERO) 30050, 0050, 30050
0050 CONTINUE
IVCOMP = 0
IVCOMP = IVCNA1
IVCORR = 5
40050 IF (IVCOMP - 5) 20050, 10050, 20050
30050 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10050, 0061, 20050
10050 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0061
20050 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0061 CONTINUE
C
C **** FCVS PROGRAM 302 - TEST 006 ****
C
C
IVTNUM = 6
IF (ICZERO) 30060, 0060, 30060
0060 CONTINUE
IVCOMP = 1
IF (IVCNB1 .EQ. 8) IVCOMP = IVCOMP * 2
IF (RVCNB1 .GE. 3.4995 .AND. RVCNB1 .LE. 3.5005) IVCOMP=IVCOMP*3
IF (IVCNB2 .EQ. 5) IVCOMP = IVCOMP * 5
IVCORR = 30
C 30 = 2 * 3 * 5
40060 IF (IVCOMP - 30) 20060, 10060, 20060
30060 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10060, 0071, 20060
10060 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0071
20060 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0071 CONTINUE
C
C **** FCVS PROGRAM 302 - TEST 007 ****
C
C
IVTNUM = 7
IF (ICZERO) 30070, 0070, 30070
0070 CONTINUE
IVCOMP = 1
IF (.NOT. LVCNC1) IVCOMP = IVCOMP * 2
IF (IVCNC1 .EQ. 12) IVCOMP = IVCOMP * 3
IF (RACN11(1).GE.110.95 .AND. RACN11(1).LE.111.05) IVCOMP=IVCOMP*5
IF (RACN11(10).GE.109.95.AND.RACN11(10).LE.110.05)IVCOMP=IVCOMP*7
IF (IACN21(1,1) .EQ. 12) IVCOMP = IVCOMP * 11
IF (IACN21 (2,3) .EQ. 24) IVCOMP = IVCOMP * 13
IVCORR = 30030
C 30030 = 2* 3 * 5 * 7 * 11 * 13
40070 IF (IVCOMP - 30030) 20070, 10070, 20070
30070 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10070, 0081, 20070
10070 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0081
20070 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0081 CONTINUE
C
C **** FCVS PROGRAM 302 - TEST 008 ****
C
C TESTS 008 AND 009 TEST THE USE OF NAMED COMMON BLOCKS IN A
C MAIN PROGRAM AND AN EXTERNAL FUNCTION.
C
IVTNUM = 8
IF (ICZERO) 30080, 0080, 30080
0080 CONTINUE
IVCOMP = 1
IF (IVCND1 .EQ. 34) IVCOMP = IVCOMP * 2
IF (IVCND2 .EQ. 11) IVCOMP = IVCOMP * 3
IVCORR = 6
C 6 = 2 * 3
40080 IF (IVCOMP - 6) 20080, 10080, 20080
30080 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10080, 0091, 20080
10080 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0091
20080 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0091 CONTINUE
C
C **** FCVS PROGRAM 302 - TEST 009 ****
C
C
IVTNUM = 9
IF (ICZERO) 30090, 0090, 30090
0090 CONTINUE
IVCOMP = 1
IF (IVCN06 .EQ. 7) IVCOMP = IVCOMP * 2
IF (RVCND1 .GE. 4.4995 .AND. RVCND1 .LE. 4.5005) IVCOMP = IVCOMP*3
IF (LVCND1) IVCOMP = IVCOMP * 5
IF (IVCN07 .EQ. -7) IVCOMP = IVCOMP * 7
IF (IVCN08 .EQ. -3) IVCOMP = IVCOMP * 11
IF (RVCNE1.GE.-6.7005.AND.RVCNE1.LE.-6.6995) IVCOMP=IVCOMP*13
IVCORR = 30030
C 30030 = 2 * 3 * 5 * 7 * 11 * 13
40090 IF (IVCOMP - 30030) 20090, 10090, 20090
30090 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10090, 0101, 20090
10090 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0101
20090 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0101 CONTINUE
C
C **** FCVS PROGRAM 302 - TEST 010 ****
C
C TEST 010 IS DESIGNED TO TEST THE ABILITY TO RENAME ENTITIES
C IN NAMED COMMON BETWEEN A MAIN PROGRAM AND A SUBROUTINE.
C
IVTNUM = 10
IF (ICZERO) 30100, 0100, 30100
0100 CONTINUE
IVCOMP = 1
IF (IVCNF1 .EQ. 42) IVCOMP = IVCOMP * 2
IF (IVCNF2 .EQ. 43) IVCOMP = IVCOMP * 3
IF (IVCNF3 .EQ. 44) IVCOMP = IVCOMP * 5
IF (IACN1F(1) .EQ. 142) IVCOMP = IVCOMP * 7
IF (IACN1F(2) .EQ. 143) IVCOMP = IVCOMP * 11
IF (IACN1F(3) .EQ. 144) IVCOMP = IVCOMP * 13
IVCORR = 30030
C 30030 = 2 * 3 * 5 * 7 * 11 * 13
40100 IF (IVCOMP - 30030) 20100, 10100, 20100
30100 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10100, 0111, 20100
10100 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0111
20100 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0111 CONTINUE
C
C **** FCVS PROGRAM 302 - TEST 011 ****
C
C TEST 011 IS DESIGNED TO TEST THE STORAGE OF A VARIABLE IN
C NAMED COMMON BY EQUIVALENCE ASSOCIATION.
C
IVTNUM = 11
IF (ICZERO) 30110, 0110, 30110
0110 CONTINUE
IVCOMP = 0
IVCOMP = IVCEH2
IVCORR = 6
40110 IF (IVCOMP - 6) 20110, 10110, 20110
30110 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10110, 0121, 20110
10110 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0121
20110 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0121 CONTINUE
C
C **** FCVS PROGRAM 302 - TEST 012 ****
C
C TEST 012 IS DESIGNED TO TEST THE STORAGE OF A VARIABLE IN
C UNNAMED COMMON BY EQUIVALENCE ASSOCIATION.
C
IVTNUM = 12
IF (ICZERO) 30120, 0120, 30120
0120 CONTINUE
IVCOMP = 1
IF (IVCE09 .EQ. 100) IVCOMP = IVCOMP * 2
IF (IVCE10 .EQ. 100) IVCOMP = IVCOMP * 3
IVCORR = 6
C 6 = 2 * 3
40120 IF (IVCOMP - 6) 20120, 10120, 20120
30120 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10120, 0131, 20120
10120 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0131
20120 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0131 CONTINUE
C
C **** FCVS PROGRAM 302 - TEST 013 ****
C
C TEST 013 IS DESIGNED TO TEST THE EXTENSION OF NAMED COMMON
C BLOCK STORAGE BY EQUIVALENCE ASSOCIATION OF A VARIABLE AND AN
C ARRAY.
C
IVTNUM = 13
IF (ICZERO) 30130, 0130, 30130
0130 CONTINUE
IVCOMP = 1
IF (IVCEI1 .EQ. 11) IVCOMP = IVCOMP * 2
IF (IACE1I(1) .EQ. 11) IVCOMP = IVCOMP * 3
IF (IACE1I(2) .EQ. 16) IVCOMP = IVCOMP * 5
IF (IACE1I(3) .EQ. 21) IVCOMP = IVCOMP * 7
IVCORR = 210
C 210 = 2 * 3 * 5 * 7
40130 IF (IVCOMP - 210) 20130, 10130, 20130
30130 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10130, 0141, 20130
10130 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0141
20130 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0141 CONTINUE
C
C **** FCVS PROGRAM 302 - TEST 014 ****
C
C TEST 014 IS DESIGNED TO TEST THE ABILITY OF PASSING DATA
C THROUGH UNNAMED COMMON FROM EXTERNAL FUNCTIONS WHICH HAVE MORE
C ENTITIES IN UNNAMED COMMON THAN THE MAIN PROGRAM.
C
IVTNUM = 14
IF (ICZERO) 30140, 0140, 30140
0140 CONTINUE
IVCOMP = 0
IVCOMP = IVCN12
IVCORR = 11
40140 IF (IVCOMP - 11) 20140, 10140, 20140
30140 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10140, 0151, 20140
10140 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0151
20140 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0151 CONTINUE
C
C **** FCVS PROGRAM 302 - TEST 015 ****
C
C TEST 015 IS DESIGNED TO TEST THE ABILITY OF PASSING DATA
C THROUGH NAMED COMMON BETWEEN EXTERNAL FUNCTIONS WHERE THE NAMED
C COMMON BLOCK IS NOT SPECIFIED IN THE MAIN PROGRAM.
C
IVTNUM = 15
IF (ICZERO) 30150, 0150, 30150
0150 CONTINUE
IVCOMP = 0
IVCOMP = IVCNJ1
IVCORR = 5
40150 IF (IVCOMP - 5) 20150, 10150, 20150
30150 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10150, 0161, 20150
10150 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0161
20150 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0161 CONTINUE
C
C **** FCVS PROGRAM 302 - TEST 016 ****
C
C TEST 016 IS DESIGNED TO TEST THE PASSING OF CHARACTER DATA
C IN NAMED COMMON BETWEEN THE MAIN PROGRAM AND A SUBROUTINE.
C
IVTNUM = 16
IF (ICZERO) 30160, 0160, 30160
0160 CONTINUE
IVCOMP = 1
IF (CVTN01 .EQ. 'YZ') IVCOMP = IVCOMP * 2
IF (CVTN02 .EQ. 'UVW') IVCOMP = IVCOMP * 3
IF (CATN11(1) .EQ. 'VWXYZ') IVCOMP = IVCOMP * 5
IF (CATN11(2) .EQ. 'KLMNO') IVCOMP = IVCOMP * 7
IF (CATN11(3) .EQ. 'ABCDE') IVCOMP = IVCOMP * 11
IVCORR = 2310
C 2310 = 2 * 3 * 5 * 7 * 11
40160 IF (IVCOMP - 2310) 20160, 10160, 20160
30160 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10160, 0171, 20160
10160 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0171
20160 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0171 CONTINUE
C
C
C WRITE OUT TEST SUMMARY
C
WRITE (I02,90004)
WRITE (I02,90014)
WRITE (I02,90004)
WRITE (I02,90000)
WRITE (I02,90004)
WRITE (I02,90020) IVFAIL
WRITE (I02,90022) IVPASS
WRITE (I02,90024) IVDELE
STOP
90001 FORMAT (1H ,24X,5HFM302)
90000 FORMAT (1H ,20X,20HEND OF PROGRAM FM302)
C
C FORMATS FOR TEST DETAIL LINES
C
80000 FORMAT (1H ,4X,I5,6X,7HDELETED)
80002 FORMAT (1H ,4X,I5,7X,4HPASS)
80010 FORMAT (1H ,4X,I5,7X,4HFAIL,10X,I6,9X,I6)
80012 FORMAT (1H ,4X,I5,7X,4HFAIL,4X,E12.5,3X,E12.5)
80018 FORMAT (1H ,4X,I5,7X,4HFAIL,2X,A14,1X,A14)
C
C FORMAT STATEMENTS FOR PAGE HEADERS
C
90002 FORMAT (1H1)
90004 FORMAT (1H )
90006 FORMAT (1H ,10X,34HFORTRAN COMPILER VALIDATION SYSTEM)
90008 FORMAT (1H ,21X,11HVERSION 1.0)
90010 FORMAT (1H ,8X,38HFOR OFFICIAL USE ONLY - COPYRIGHT 1978)
90012 FORMAT (1H ,5X,4HTEST,5X,9HPASS/FAIL,5X,8HCOMPUTED,8X,7HCORRECT)
90014 FORMAT (1H ,5X,46H----------------------------------------------)
90016 FORMAT (1H ,18X,17HSUBSET LEVEL TEST)
C
C FORMAT STATEMENTS FOR RUN SUMMARY
C
90020 FORMAT (1H ,19X,I5,13H TESTS FAILED)
90022 FORMAT (1H ,19X,I5,13H TESTS PASSED)
90024 FORMAT (1H ,19X,I5,14H TESTS DELETED)
END
*HEADER,FORTR,FM302,SUBRTN,FM303
SUBROUTINE FS303
C
C FS303 IS A SUBROUTINE WHICH IS CALLED ONCE FROM PROGRAM FM302.
C IT IS USED TO MODIFY VARIABLES AND ARRAY PASSED THROUGH NAMED AND
C UNNAMED COMMON FROM FM302. AFTER THE DATA ENTITIES ARE MODIFIED
C CONTROL IS RETURNED TO FM302 WHERE EACH ENTITY IS TESTED.
C
IMPLICIT LOGICAL (L)
DIMENSION RACN11(10)
COMMON IVCN01
COMMON //IVCN02, LVCN01
COMMON RVCN01//IVCN03
COMMON IVCN04,IVCN05, //IACN11(4)
COMMON /BLK1/IVCNA1
COMMON /BLK2/IVCNB1,RVCNB1,/BLK2/IVCNB2
COMMON /BLK3/LVCNC1,IVCNC1/BLK4/RACN11,IACN21(2,3)
COMMON /BLK7/IACN1G(5),IVCNG1
COMMON /BLK8/IVCNH1
COMMON /BLKCHR/CVTN01,CVTN02,CATN11
CHARACTER CVTN01*2, CVTN02*3, CATN11(3)*5
C TEST 001
IVCN01 = IVCN01 + 1
C TEST 002
IVCN02 = IVCN02 + 5
LVCN01 = .NOT. LVCN01
C TEST 005
IVCNA1 = IVCNA1 / 5
C TEST 006
IVCNB1 = IVCNB1 + IVCNB2
RVCNB1 = 3.5
C TEST 007
LVCNC1 = .FALSE.
IVCNC1 = IVCNC1 - 1
RACN11(1) = 111.
RACN11(10) = 110.
IACN21(1,1) = IACN21(1,1) + 1
IACN21(2,3) = IACN21(2,3) + 1
C TEST 010
IACN1G(1) = IACN1G(1) + 1
IACN1G(2) = 43
IACN1G(3) = IACN1G(3) + 1
IACN1G(4) = IACN1G(4) + 1
IACN1G(5) = IACN1G(5) + 1
IVCNG1 = 144
C TEST 011
IVCNH1 = IVCNH1 + 1
C TEST 017
CVTN01 = 'YZ'
CVTN02 = 'UVW'
CATN11(1) = 'VWXYZ'
CATN11(3) = 'ABCDE'
RETURN
END
*HEADER,FORTR,FM302,SUBRTN,FM304
INTEGER FUNCTION FF304 ()
C
C FF304 IS AN EXTERNAL FUNCTION WHICH IS REFERENCED ONCE FROM
C PROGRAM FM302. IT IS USED TO MODIFY VARIABLES AND ARRAYS PASSED
C THROUGH NAMED AND UNNAMED COMMON FROM FM302. AFTER THE DATA
C ENTITIES ARE MODIFIED CONTROL IS RETURNED TO FM302 WHERE EACH
C ENTITY IS TESTED. A FUNCTION VALUE OF 999 IS RETURNED BUT IT IS
C NOT SIGNIFICANT NOR IS IT TESTED BY FM302.
C
IMPLICIT LOGICAL (L)
DIMENSION IACN11(4)
COMMON IVCN01
COMMON IVCN02, LVCN01
COMMON RVCN01, IVCN03
COMMON IVCN04,IVCN05,IACN11
COMMON /BLK5/IVCND1,IVCND2
COMMON IVCN06
COMMON /BLK5/RVCND1,LVCND1
COMMON IVCN07, IVCN08
COMMON /BLK6/RVCNE1
COMMON IVCN10
COMMON /BLK9/IVCNI1, IVCNI2, IVCNI3
COMMON IVCN12, IVCN13
COMMON /BLK10/IVCNJ1
COMMON /BLK11/IVCNK1
INTEGER FF305
C TEST 003
RVCN01 = 4.2
IVCN03 = IVCN03 + 1
C TEST 004
IVCN04 = 32
IVCN04 = IVCN04 / 4
IVCN05 = IVCN05
IACN11(1) = IACN11(1) + 4
IACN11(2) = IACN11(2) + 3
IACN11(3) = IACN11(3) + 2
IACN11(4) = IACN11(4) + 1
C TEST 008
IVCND1 = IVCND1 + 1
IVCND2 = IVCND2 + 1
C TEST 009
IVCN06 = IVCN06 + 1
RVCND1 = 4.5
LVCND1 = .TRUE.
IVCN07 = -IVCN07
IVCN08 = -3
RVCNE1 = -6.7
C TEST 012
IVCN10 = IVCN10 * IVCN10
C TEST 013
IVCNI1 = IVCNI1 + 1
IVCNI2 = IVCNI2 + 1
IVCNI3 = IVCNI3 + 1
C TEST 014
IVCN13 = 5
C TEST 015
IVCNK1 = 3
C
C FOR TESTS 014 AND 015 EXTERNAL FUNCTION FF305 IS REFERENCED
C
IVON99 = FF305 ()
C TEST 014
IVCN12 = IVCN13
C TEST 015
IVCNJ1 = IVCNK1
FF304 = 999
RETURN
END
*HEADER,FORTR,FM302,SUBRTN,FM305
INTEGER FUNCTION FF305 ()
C
C FF305 IS AN EXTERNAL FUNCTION WHICH IS USED IN TEST 014 AND
C 015 OF PROGRAM FM302. THIS SUBPROGRAM IS REFERENCED FROM EXTERNAL
C FUNCTION FF304.
C
COMMON IACN11(15)
COMMON IVCN12, IVCN13, IVCN14
COMMON /BLK10/IVCNJ1, /BLK11/IVCNK1
C TEST 014
IVCN14 = 11
IVCN13 = IVCN14
C TEST 015
IVCNK1 = 5
FF305 = 999
RETURN
END
*END-OF,FM302
FM306.f 481036203 170 2 100666 14152 `
*HEADER,FORTR,FM306
*FILES1,FORTR,FM306,X
PROGRAM FM306
C
C
C THIS ROUTINE TESTS THE USE OF THE SUBSET LEVEL FEATURES OF
C THE IMPLICIT SPECIFICATION STATEMENT. THE DEFAULT IMPLIED INTEGER
C AND REAL TYPING IS EITHER CONFIRMED OR OVERRIDDEN TO SPECIFY
C INTEGER, REAL AND LOGICAL TYPING. ALL 26 ALPHABETIC LETTERS ARE
C USED TO INDICATE THE IMPLICIT TYPING. VARIABLE AND ARRAY
C ENTITIES ARE USED TO TEST THE ACTUAL TYPING. THE SUBSET LEVEL
C FEATURES OF THE IMPLICIT STATEMENT ARE ALSO TESTED IN ROUTINES
C FM201 AND FM251.
C
C REFERENCES.
C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN,
C X3.9-1978
C
C SECTION 4.1.2, TYPE RULES FOR DATA AND PROCEDURE IDENTIFIERS.
C SECTION 8.5, IMPLICIT STATEMENT
C
C
C ******************************************************************
C A COMPILER VALIDATION SYSTEM FOR THE FORTRAN LANGUAGE
C BASED ON SPECIFICATIONS AS DEFINED IN AMERICAN STANDARD FORTRAN
C X3.9-1978, HAS BEEN DEVELOPED BY THE DEPARTMENT OF THE NAVY. THE
C FORTRAN COMPILER VALIDATION SYSTEM (FCVS) CONSISTS OF AUDIT
C ROUTINES, THEIR RELATED DATA, AND AN EXECUTIVE SYSTEM. EACH AUDIT
C ROUTINE IS A FORTRAN PROGRAM OR SUBPROGRAM WHICH INCLUDES TESTS
C OF SPECIFIC LANGUAGE ELEMENTS AND SUPPORTING PROCEDURES INDICATING
C THE RESULT OF EXECUTING THESE TESTS.
C
C THIS PARTICULAR PROGRAM OR SUBPROGRAM CONTAINS ONLY FEATURES
C FOUND IN THE SUBSET LEVEL OF THE STANDARD.
C
C SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO
C DEPARTMENT OF THE NAVY
C FEDERAL COBOL COMPILER TESTING SERVICE
C WASHINGTON, D.C. 20376
C
C ******************************************************************
C
C
IMPLICIT LOGICAL (L)
IMPLICIT CHARACTER*14 (C)
C
IMPLICIT INTEGER (A)
IMPLICIT LOGICAL (B)
IMPLICIT INTEGER (D,E,F)
IMPLICIT REAL (G-H)
IMPLICIT INTEGER (I)
IMPLICIT REAL (J)
IMPLICIT INTEGER (K,O-Q)
IMPLICIT REAL (M), REAL (N)
IMPLICIT REAL (R)
IMPLICIT REAL (S), INTEGER (T-V)
IMPLICIT INTEGER (W), REAL (X), LOGICAL (Y), INTEGER (Z)
DIMENSION AAIN11(5)
DIMENSION HAIN11(5)
C
C
C
C INITIALIZATION SECTION.
C
C INITIALIZE CONSTANTS
C ********************
C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER
I01 = 5
C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER
I02 = 6
C SYSTEM ENVIRONMENT SECTION
C
CX010 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-010 CONTROL CARD.
C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5
C (UNIT NUMBER FOR CARD READER).
CX011 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-011 CONTROL CARD
C THE CX011 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL
C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX010 ABOVE.
C
CX020 THIS CARD IS PEPLACED BY CONTENTS OF FEXEC X-020 CONTROL CARD.
C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02 = 6
C (UNIT NUMBER FOR PRINTER).
CX021 THIS CARD IS PEPLACED BY CONTENTS OF FEXEC X-021 CONTROL CARD.
C THE CX021 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL
C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX020 ABOVE.
C
IVPASS = 0
IVFAIL = 0
IVDELE = 0
ICZERO = 0
C
C WRITE OUT PAGE HEADERS
C
WRITE (I02,90002)
WRITE (I02,90006)
WRITE (I02,90008)
WRITE (I02,90004)
WRITE (I02,90010)
WRITE (I02,90004)
WRITE (I02,90016)
WRITE (I02,90001)
WRITE (I02,90004)
WRITE (I02,90012)
WRITE (I02,90014)
WRITE (I02,90004)
C
C
C **** FCVS PROGRAM 306 - TEST 001 ****
C
C TEST 001 IS DESIGNED TO CONFIRM IMPLICIT INTEGER TYPING.
C
IVTNUM = 1
IF (ICZERO) 30010, 0010, 30010
0010 CONTINUE
RVCOMP = 10.0
IVIN01 = 4
RVCOMP = IVIN01 / 5
RVCORR = 0.0
40010 IF (RVCOMP) 20010, 10010, 20010
30010 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10010, 0021, 20010
10010 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0021
20010 IVFAIL = IVFAIL + 1
WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR
0021 CONTINUE
C
C **** FCVS PROGRAM 306 - TEST 002 ****
C
C TEST 002 IS DESIGNED TO CONFIRM IMPLICIT REAL TYPING.
C
IVTNUM = 2
IF (ICZERO) 30020, 0020, 30020
0020 CONTINUE
RVCOMP = 10.0
RVIN01 = 4
RVCOMP = RVIN01/5
RVCORR = .8
40020 IF (RVCOMP - .79995) 20020, 10020, 40021
40021 IF (RVCOMP - .80005) 10020, 10020, 20020
30020 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10020, 0031, 20020
10020 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0031
20020 IVFAIL = IVFAIL + 1
WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR
0031 CONTINUE
C
C **** FCVS PROGRAM 306 - TEST 003 ****
C
C TEST 003 IS DESIGNED TO OVERRIDE IMPLICIT DEFAULT TYPING OF
C INTEGER WITH IMPLICIT TYPING OF REAL.
C
IVTNUM = 3
IF (ICZERO) 30030, 0030, 30030
0030 CONTINUE
RVCOMP = 10.0
JVIN01 = 4
RVCOMP = JVIN01/5
RVCORR = .8
40030 IF (RVCOMP - .79995) 20030, 10030, 40031
40031 IF (RVCOMP - .80005) 10030, 10030, 20030
30030 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10030, 0041, 20030
10030 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0041
20030 IVFAIL = IVFAIL + 1
WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR
0041 CONTINUE
C
C **** FCVS PROGRAM 306 - TEST 004 ****
C
C TEST 004 IS DESIGNED TO OVERRIDE IMPLICIT DEFAULT TYPING OF
C INTEGER WITH IMPLICIT TYPING OF LOGICAL.
C
IVTNUM = 4
IF (ICZERO) 30040, 0040, 30040
0040 CONTINUE
LVIN01 = .TRUE.
IVCORR = 1
IVCOMP = 0
IF (LVIN01) IVCOMP = 1
40040 IF (IVCOMP - 1) 20040, 10040, 20040
30040 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10040, 0051, 20040
10040 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0051
20040 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0051 CONTINUE
C
C **** FCVS PROGRAM 306 - TEST 005 ****
C
C TEST 005 IS DESIGNED TO OVERRIDE IMPLICIT DEFAULT TYPING OF
C REAL WITH IMPLICIT TYPING OF INTEGER.
C
IVTNUM = 5
IF (ICZERO) 30050, 0050, 30050
0050 CONTINUE
RVCOMP = 10.0
AAIN11(2) = 4
RVCOMP = AAIN11(2)/5
RVCORR = 0.0
40050 IF (RVCOMP) 20050, 10050, 20050
30050 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10050, 0061, 20050
10050 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0061
20050 IVFAIL = IVFAIL + 1
WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR
0061 CONTINUE
C
C **** FCVS PROGRAM 306 - TEST 006 ****
C
C TEST 006 IS DESIGNED TO OVERRIDE IMPLICIT DEFAULT TYPING OF REAL
C WITH IMPLICIT TYPING OF LOGICAL.
C
IVTNUM = 6
IF (ICZERO) 30060, 0060, 30060
0060 CONTINUE
BVIN01 = .TRUE.
IVCORR = 1
IVCOMP = 0
IF (BVIN01) IVCOMP = 1
40060 IF (IVCOMP - 1) 20060, 10060, 20060
30060 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10060, 0071, 20060
10060 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0071
20060 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0071 CONTINUE
C
C TESTS 007 THROUGH 012 ARE DESIGNED TO TEST VARIOUS SYNTACTICAL
C CONSTRUCTS OF THE IMPLICIT STATEMENT.
C
C
C **** FCVS PROGRAM 306 - TEST 007 ****
C
C TEST 007 TESTS THE SPECIFYING OF MORE THAN ONE ALPHABETIC
C CHARACTER IN AN IMPLICIT STATEMENT.
C
IVTNUM = 7
IF (ICZERO) 30070, 0070, 30070
0070 CONTINUE
DVIN01 = 4
EVIN01 = 4
FVIN01 = 4
RVCMP1 = DVIN01/5
RVCMP2 = EVIN01/5
RVCMP3 = FVIN01/5
IVCOMP = 1
IF (RVCMP1 .EQ. 0.0) IVCOMP = IVCOMP * 2
IF (RVCMP2 .EQ. 0.0) IVCOMP = IVCOMP * 3
IF (RVCMP3 .EQ. 0.0) IVCOMP = IVCOMP * 5
IVCORR = 30
C 30 = 2 * 3 * 5
40070 IF (IVCOMP - 30) 20070, 10070, 20070
30070 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10070, 0081, 20070
10070 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0081
20070 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0081 CONTINUE
C
C **** FCVS PROGRAM 306 - TEST 008 ****
C
C TEST 008 TESTS THE SPECIFYING A RANGE OF SINGLE LETTERS IN
C ALPHABETIC ORDER IN AN IMPLICIT STATEMENT.
C
IVTNUM = 8
IF (ICZERO) 30080, 0080, 30080
0080 CONTINUE
GVIN01 = 4
HAIN11(4) = 4
RVCMP1 = GVIN01/5
RVCMP2 = HAIN11(4)/5
IVCOMP = 1
IF (RVCMP1 .GE. .79995 .AND. RVCMP1 .LE. .80005) IVCOMP=IVCOMP*2
IF (RVCMP2 .GE. .79995 .AND. RVCMP2 .LE. .80005) IVCOMP=IVCOMP*3
IVCORR = 6
C 6 = 2 * 3
40080 IF (IVCOMP - 6) 20080, 10080, 20080
30080 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10080, 0091, 20080
10080 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0091
20080 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0091 CONTINUE
C
C **** FCVS PROGRAM 306 - TEST 009 ****
C
C TEST 009 TESTS THE SPECIFYING A SINGLE LETTER AND A RANGE OF
C SINGLE LETTERS IN ALPHABETIC ORDER IN AN IMPLICIT STATEMENT.
C
IVTNUM = 9
IF (ICZERO) 30090, 0090, 30090
0090 CONTINUE
KVIN01 = 4
OVIN01 = 4
PVIN01 = 4
QVIN01 = 4
RVCMP1 = KVIN01/5
RVCMP2 = OVIN01/5
RVCMP3 = PVIN01/5
RVCMP4 = QVIN01/5
IVCOMP = 1
IF (RVCMP1 .EQ. 0.0) IVCOMP = IVCOMP * 2
IF (RVCMP2 .EQ. 0.0) IVCOMP = IVCOMP * 3
IF (RVCMP3 .EQ. 0.0) IVCOMP = IVCOMP * 5
IF (RVCMP4 .EQ. 0.0) IVCOMP = IVCOMP * 7
IVCORR = 210
C 210 = 2 * 3 * 5 * 7
40090 IF (IVCOMP - 210) 20090, 10090, 20090
30090 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10090, 0101, 20090
10090 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0101
20090 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0101 CONTINUE
C
C **** FCVS PROGRAM 306 - TEST 010 ****
C
C TEST 010 TESTS THE SPECIFYING OF MORE THAN ONE TYPING IN ONE
C IMPLICIT STATEMENT.
C
IVTNUM = 10
IF (ICZERO) 30100, 0100, 30100
0100 CONTINUE
SVIN01 = 4
TVIN01 = 4
UVIN01 = 4
VVIN01 = 4
RVCMP1 = SVIN01/5
RVCMP2 = TVIN01/5
RVCMP3 = UVIN01/5
RVCMP4 = VVIN01/5
IVCOMP = 1
IF (RVCMP1 .GE. .79995 .AND. RVCMP1 .LE. .80005) IVCOMP=IVCOMP*2
IF (RVCMP2 .EQ. 0.0) IVCOMP = IVCOMP * 3
IF (RVCMP3 .EQ. 0.0) IVCOMP = IVCOMP * 5
IF (RVCMP4 .EQ. 0.0) IVCOMP = IVCOMP * 7
IVCORR = 210
C 210 = 2 * 3 * 5 * 7
IF (IVCOMP - 210) 20100, 10100, 20100
30100 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10100, 0111, 20100
10100 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0111
20100 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0111 CONTINUE
C
C **** FCVS PROGRAM 306 - TEST 011 ****
C
C TEST 011 TESTS THE SPECIFYING OF INTEGER, REAL, AND LOGICAL
C TYPING IN ONE IMPLICIT STATEMENT. IN THIS TEST INTEGER TYPING
C IS REPEATED A SECOND TIME.
C
IVTNUM = 11
IF (ICZERO) 30110, 0110, 30110
0110 CONTINUE
WVIN01 = 4
XVIN01 = 4
YVIN01 = .TRUE.
ZVIN01 = 4
RVCMP1 = WVIN01/5
RVCMP2 = XVIN01/5
LVCOMP = YVIN01
RVCMP3 = ZVIN01/5
IVCOMP = 1
IF (RVCMP1 .EQ. 0.0) IVCOMP = IVCOMP * 2
IF (RVCMP2 .GE. .79995 .AND. RVCMP2 .LE. .80005) IVCOMP=IVCOMP*3
IF (LVCOMP) IVCOMP = IVCOMP * 5
IF (RVCMP3 .EQ. 0.0) IVCOMP = IVCOMP * 7
IVCORR = 210
C 210 = 2 * 3 * 5 * 7
40110 IF (IVCOMP - 210) 20110, 10110, 20110
30110 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10110, 0121, 20110
10110 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0121
20110 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0121 CONTINUE
C
C **** FCVS PROGRAM 306 - TEST 012 ****
C
C TEST 012 TESTS THE SPECIFYING OF REAL TYPING TWICE IN ONE
C IMPLICIT STATEMENT.
C
IVTNUM = 12
IF (ICZERO) 30120, 0120, 30120
0120 CONTINUE
MVIN01 = 4
NVIN01 = 4
RVCMP1 = MVIN01/5
RVCMP2 = NVIN01/5
IVCOMP = 1
IF (RVCMP1 .GE. .79995 .AND. RVCMP1 .LE. .80005) IVCOMP=IVCOMP*2
IF (RVCMP2 .GE. .79995 .AND. RVCMP2 .LE. .80005) IVCOMP=IVCOMP*3
IVCORR = 6
C 6 = 2 * 3
IF (IVCOMP - 6) 20120, 10120, 20120
30120 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10120, 0131, 20120
10120 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0131
20120 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0131 CONTINUE
C
C
C WRITE OUT TEST SUMMARY
C
WRITE (I02,90004)
WRITE (I02,90014)
WRITE (I02,90004)
WRITE (I02,90000)
WRITE (I02,90004)
WRITE (I02,90020) IVFAIL
WRITE (I02,90022) IVPASS
WRITE (I02,90024) IVDELE
STOP
90001 FORMAT (1H ,24X,5HFM306)
90000 FORMAT (1H ,20X,20HEND OF PROGRAM FM306)
C
C FORMATS FOR TEST DETAIL LINES
C
80000 FORMAT (1H ,4X,I5,6X,7HDELETED)
80002 FORMAT (1H ,4X,I5,7X,4HPASS)
80010 FORMAT (1H ,4X,I5,7X,4HFAIL,10X,I6,9X,I6)
80012 FORMAT (1H ,4X,I5,7X,4HFAIL,4X,E12.5,3X,E12.5)
80018 FORMAT (1H ,4X,I5,7X,4HFAIL,2X,A14,1X,A14)
C
C FORMAT STATEMENTS FOR PAGE HEADERS
C
90002 FORMAT (1H1)
90004 FORMAT (1H )
90006 FORMAT (1H ,10X,34HFORTRAN COMPILER VALIDATION SYSTEM)
90008 FORMAT (1H ,21X,11HVERSION 1.0)
90010 FORMAT (1H ,8X,38HFOR OFFICIAL USE ONLY - COPYRIGHT 1978)
90012 FORMAT (1H ,5X,4HTEST,5X,9HPASS/FAIL,5X,8HCOMPUTED,8X,7HCORRECT)
90014 FORMAT (1H ,5X,46H----------------------------------------------)
90016 FORMAT (1H ,18X,17HSUBSET LEVEL TEST)
C
C FORMAT STATEMENTS FOR RUN SUMMARY
C
90020 FORMAT (1H ,19X,I5,13H TESTS FAILED)
90022 FORMAT (1H ,19X,I5,13H TESTS PASSED)
90024 FORMAT (1H ,19X,I5,14H TESTS DELETED)
END
*END-OF,FM306
FM307.f 481036209 170 2 100666 25921 `
*HEADER,FORTR,FM307
*FILES1,FORTR,FM307,X
PROGRAM FM307
C
C
C THIS ROUTINE TESTS INTRINSIC FUNCTIONS WHERE THE FUNCTION
C TYPE IS REAL AND THE ARGUMENTS ARE EITHER INTEGER OR REAL. THE
C FUNCTION NINT IS AN EXCEPTION AND HAS AN INTEGER FUNCTION TYPE.
C THE REAL OR INTEGER ARGUMENTS CONSIST OF POSITIVE, NEGATIVE AND
C UNSIGNED CONSTANTS, VARIABLES AND ARRAY ELEMENT VALUES. EACH
C INTRINSIC FUNCTION IS TESTED WITH THREE OR FOUR DIFFERENT
C COMBINATIONS OF ACTUAL ARGUMENTS DESIGNED TO TEST NOT ONLY THE
C VARIOUS COMBINATIONS OF DATA USAGES BUT ALSO TO TEST THE RANGE OF
C ARGUMENT AND FUNCTION VALUES, WHERE THAT IS APPROPRIATE. THE
C INTRINSIC FUNCTIONS TESTED IN THIS ROUTINE INCLUDE.
C
C SPECIFIC TYPE OF
C INTRINSIC FUNCTION NAME ARGUMENT FUNCTION
C ------------------ ------ -------- --------
C CONVERSION TO REAL REAL INTEGER REAL
C NEAREST WHOLE NUMBER ANINT REAL REAL
C NEAREST INTEGER NINT REAL INTEGER
C TANGENT TAN REAL REAL
C ARCSINE ASIN REAL REAL
C ARCCOSINE ACOS REAL REAL
C HYPERBOLIC SINE SINH REAL REAL
C HYPERBOLIC COSINE COSH REAL REAL
C
C SUBSET LEVEL ROUTINES FM097 THROUGH FM099 AND FM308 ALSO
C TEST THE USE OF INTEGER AND REAL INTRINSIC FUNCTIONS.
C
C REFERENCES.
C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN,
C X3.9-1978
C
C SECTION 15.3, INTRINSIC FUNCTIONS
C SECTION 15.9.2, ACTUAL ARGUMENTS
C SECTION 15.9.3, ASSOCIATION OF DUMMY AND ACTUAL ARGUMENTS
C TABLE 5, INTRINSIC FUNCTIONS (INCLUDING NOTES)
C SECTION 15.10.1, RESTRICTION ON RANGE OF ARGUMENTS AND RESULTS
C
C
C ******************************************************************
C A COMPILER VALIDATION SYSTEM FOR THE FORTRAN LANGUAGE
C BASED ON SPECIFICATIONS AS DEFINED IN AMERICAN STANDARD FORTRAN
C X3.9-1978, HAS BEEN DEVELOPED BY THE DEPARTMENT OF THE NAVY. THE
C FORTRAN COMPILER VALIDATION SYSTEM (FCVS) CONSISTS OF AUDIT
C ROUTINES, THEIR RELATED DATA, AND AN EXECUTIVE SYSTEM. EACH AUDIT
C ROUTINE IS A FORTRAN PROGRAM OR SUBPROGRAM WHICH INCLUDES TESTS
C OF SPECIFIC LANGUAGE ELEMENTS AND SUPPORTING PROCEDURES INDICATING
C THE RESULT OF EXECUTING THESE TESTS.
C
C THIS PARTICULAR PROGRAM OR SUBPROGRAM CONTAINS ONLY FEATURES
C FOUND IN THE SUBSET LEVEL OF THE STANDARD.
C
C SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO
C DEPARTMENT OF THE NAVY
C FEDERAL COBOL COMPILER TESTING SERVICE
C WASHINGTON, D.C. 20376
C
C ******************************************************************
C
C
IMPLICIT LOGICAL (L)
IMPLICIT CHARACTER*14 (C)
C
DIMENSION IAON11(4)
DIMENSION RAON11(4)
DATA PI/3.141592654/
C
C
C
C INITIALIZATION SECTION.
C
C INITIALIZE CONSTANTS
C ********************
C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER
I01 = 5
C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER
I02 = 6
C SYSTEM ENVIRONMENT SECTION
C
CX010 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-010 CONTROL CARD.
C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5
C (UNIT NUMBER FOR CARD READER).
CX011 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-011 CONTROL CARD
C THE CX011 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL
C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX010 ABOVE.
C
CX020 THIS CARD IS PEPLACED BY CONTENTS OF FEXEC X-020 CONTROL CARD.
C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02 = 6
C (UNIT NUMBER FOR PRINTER).
CX021 THIS CARD IS PEPLACED BY CONTENTS OF FEXEC X-021 CONTROL CARD.
C THE CX021 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL
C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX020 ABOVE.
C
IVPASS = 0
IVFAIL = 0
IVDELE = 0
ICZERO = 0
C
C WRITE OUT PAGE HEADERS
C
WRITE (I02,90002)
WRITE (I02,90006)
WRITE (I02,90008)
WRITE (I02,90004)
WRITE (I02,90010)
WRITE (I02,90004)
WRITE (I02,90016)
WRITE (I02,90001)
WRITE (I02,90004)
WRITE (I02,90012)
WRITE (I02,90014)
WRITE (I02,90004)
C
C
C TEST 001 THROUGH TEST 004 CONTAIN INTRINSIC FUNCTION TESTS FOR
C TYPE CONVERSION TO REAL (REAL) WHERE THE FUNCTION IS REAL AND THE
C ARGUMENT IS INTEGER.
C
C
C **** FCVS PROGRAM 307 - TEST 001 ****
C
C CONSTANT ARGUMENT
C
IVTNUM = 1
IF (ICZERO) 30010, 0010, 30010
0010 CONTINUE
RVCOMP = 10.0
RVCOMP = REAL (6)
RVCORR = 6.0
40010 IF (RVCOMP - 5.9995) 20010,10010,40011
40011 IF (RVCOMP - 6.0005) 10010,10010,20010
30010 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10010, 0021, 20010
10010 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0021
20010 IVFAIL = IVFAIL + 1
WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR
0021 CONTINUE
C
C **** FCVS PROGRAM 307 - TEST 002 ****
C
C VARIABLE ARGUMENT
C
IVTNUM = 2
IF (ICZERO) 30020, 0020, 30020
0020 CONTINUE
RVCOMP = 10.0
IVON01 = 6
RVCOMP = REAL (IVON01)
RVCORR = 6.0
40020 IF (RVCOMP - 5.9995) 20020,10020,40021
40021 IF (RVCOMP - 6.0005) 10020, 10020, 20020
30020 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10020, 0031, 20020
10020 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0031
20020 IVFAIL = IVFAIL + 1
WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR
0031 CONTINUE
C
C **** FCVS PROGRAM 307 - TEST 003 ****
C
C ARRAY ELEMENT NAME ARGUMENT
C
IVTNUM = 3
IF (ICZERO) 30030, 0030, 30030
0030 CONTINUE
RVCOMP = 10.0
IAON11(3) = 6
RVCOMP = REAL (IAON11(3))
RVCORR = 6.0
40030 IF (RVCOMP - 5.9995) 20030, 10030, 40031
40031 IF (RVCOMP - 6.0005) 10030, 10030, 20030
30030 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10030, 0041, 20030
10030 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0041
20030 IVFAIL = IVFAIL + 1
WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR
0041 CONTINUE
C
C **** FCVS PROGRAM 307 - TEST 004 ****
C
C EXPRESSION AS ARGUMENT
C
IVTNUM = 4
IF (ICZERO) 30040, 0040, 30040
0040 CONTINUE
RVCOMP = 10.0
IVON01 = 6
RVCOMP = REAL (IVON01 - 6)
RVCORR = 0.0
40040 IF(RVCOMP + .00005) 20040, 10040, 40041
40041 IF(RVCOMP - .00005) 10040, 10040, 20040
30040 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10040, 0051, 20040
10040 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0051
20040 IVFAIL = IVFAIL + 1
WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR
0051 CONTINUE
C
C TEST 005 THROUGH TEST 008 CONTAIN INTRINSIC FUNCTION TESTS FOR
C FINDING THE NEAREST WHOLE NUMBER (ANINT) WHERE THE FUNCTION AND
C ARGUMENT TYPES ARE BOTH REAL.
C
C
C **** FCVS PROGRAM 307 - TEST 005 ****
C
C CONSTANT ARGUMENT
C
IVTNUM = 5
IF (ICZERO) 30050, 0050, 30050
0050 CONTINUE
RVCOMP = 10.0
RVCOMP = ANINT (3.4994)
RVCORR = 3.0
40050 IF (RVCOMP - 2.9995) 20050, 10050, 40051
40051 IF (RVCOMP - 3.0005) 10050, 10050, 20050
30050 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10050, 0061, 20050
10050 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0061
20050 IVFAIL = IVFAIL + 1
WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR
0061 CONTINUE
C
C **** FCVS PROGRAM 307 - TEST 006 ****
C
C VARIABLE ARGUMENT
C
IVTNUM = 6
IF (ICZERO) 30060, 0060, 30060
0060 CONTINUE
RVCOMP = 10.0
RVON01 = -3.4994
RVCOMP = ANINT (RVON01)
RVCORR = -3.0
40060 IF (RVCOMP + 3.0005) 20060, 10060, 40061
40061 IF (RVCOMP + 2.9995) 10060, 10060, 20060
30060 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10060, 0071, 20060
10060 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0071
20060 IVFAIL = IVFAIL + 1
WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR
0071 CONTINUE
C
C **** FCVS PROGRAM 307 - TEST 007 ****
C
C ARRAY ELEMENT NAME ARGUMENT
C
IVTNUM = 7
IF (ICZERO) 30070, 0070, 30070
0070 CONTINUE
RVCOMP = 10.0
RAON11(3) = 3.0000
RVCOMP = ANINT (RAON11(3))
RVCORR = 3.0
40070 IF (RVCOMP - 2.9995) 20070, 10070, 40071
40071 IF (RVCOMP - 3.0005) 10070, 10070, 20070
30070 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10070, 0081, 20070
10070 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0081
20070 IVFAIL = IVFAIL + 1
WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR
0081 CONTINUE
C
C **** FCVS PROGRAM 307 - TEST 008 ****
C
C ZERO ARGUMENT
C
IVTNUM = 8
IF (ICZERO) 30080, 0080, 30080
0080 CONTINUE
RVCOMP = 10.0
RVCOMP = ANINT (0.0)
RVCORR = 0.0
40080 IF (RVCOMP) 20080, 10080, 20080
30080 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10080, 0091, 20080
10080 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0091
20080 IVFAIL = IVFAIL + 1
WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR
0091 CONTINUE
C
C TEST 009 THROUGH TEST 012 CONTAIN INTRINSIC FUNCTION TESTS FOR
C FINDING THE NEAREST INTEGER (NINT) WHERE THE ARGUMENT IS REAL
C AND THE FUNCTION TYPE IS INTEGER.
C
C
C **** FCVS PROGRAM 307 - TEST 009 ****
C
C CONSTANT ARGUMENT
C
IVTNUM = 9
IF (ICZERO) 30090, 0090, 30090
0090 CONTINUE
IVCOMP = 10
IVCOMP = NINT (3.4994)
IVCORR = 3
40090 IF (IVCOMP - 3) 20090, 10090, 20090
30090 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10090, 0101, 20090
10090 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0101
20090 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0101 CONTINUE
C
C **** FCVS PROGRAM 307 - TEST 010 ****
C
C VARIABLE ARGUMENT
C
IVTNUM = 10
IF (ICZERO) 30100, 0100, 30100
0100 CONTINUE
IVCOMP = 10
RVON01 = -3.4994
IVCOMP = NINT (RVON01)
IVCORR = -3
40100 IF (IVCOMP +3) 20100, 10100, 20100
30100 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10100, 0111, 20100
10100 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0111
20100 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0111 CONTINUE
C
C **** FCVS PROGRAM 307 - TEST 011 ****
C
C ARRAY ELEMENT NAME ARGUMENT
C
IVTNUM = 11
IF (ICZERO) 30110, 0110, 30110
0110 CONTINUE
IVCOMP = 10
RAON11(1) = 3.0000
IVCOMP = NINT (RAON11(1))
IVCORR = 3
40110 IF (IVCOMP -3) 20110, 10110, 20110
30110 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10110, 0121, 20110
10110 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0121
20110 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0121 CONTINUE
C
C **** FCVS PROGRAM 307 - TEST 012 ****
C
C ZERO ARGUMENT
C
IVTNUM = 12
IF (ICZERO) 30120, 0120, 30120
0120 CONTINUE
IVCOMP = 10
IVCOMP = NINT (0.0)
IVCORR = 0
40120 IF (IVCOMP) 20120, 10120, 20120
30120 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10120, 0131, 20120
10120 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0131
20120 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0131 CONTINUE
C
C TEST 013 THROUGH TEST 017 CONTAIN INTRINSIC FUNCTION TESTS FOR
C FINDING THE TRIGONOMETRIC TANGENT (TAN) WHERE THE FUNCTION AND
C ARGUMENT TYPES ARE BOTH REAL. ALL ARGUMENTS ARE GIVEN IN RADIANS
C WHERE ONE RADIAN EQUALS 57.296 DEGREES.
C
C
C **** FCVS PROGRAM 307 - TEST 013 ****
C
C FIND THE TANGENT OF 0 DEGREES (0.0 RADIANS)
C
IVTNUM = 13
IF (ICZERO) 30130, 0130, 30130
0130 CONTINUE
RVCOMP = 10.0
RVCOMP = TAN (0.0)
RVCORR = 0.0
40130 IF (RVCOMP) 20130, 10130, 20130
30130 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10130, 0141, 20130
10130 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0141
20130 IVFAIL = IVFAIL + 1
WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR
0141 CONTINUE
C
C **** FCVS PROGRAM 307 - TEST 014 ****
C
C FIND THE TANGENT OF 135 DEGREES (2.3562 RADIANS)
C
IVTNUM = 14
IF (ICZERO) 30140, 0140, 30140
0140 CONTINUE
RVCOMP = 10.0
RVON01 = 3 * PI / 4
RVCOMP = TAN (RVON01)
RVCORR = -1.0
40140 IF (RVCOMP + 1.0005) 20140, 10140, 40141
40141 IF (RVCOMP + .9995) 10140, 10140, 20140
30140 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10140, 0151, 20140
10140 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0151
20140 IVFAIL = IVFAIL + 1
WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR
0151 CONTINUE
C
C **** FCVS PROGRAM 307 - TEST 015 ****
C
C FIND THE TANGENT OF 540 DEGREES (9.4248 RADIANS)
C
IVTNUM = 15
IF (ICZERO) 30150, 0150, 30150
0150 CONTINUE
RVCOMP = 10.0
RAON11(2) = 3 * PI
RVCOMP = TAN (RAON11(2))
RVCORR = 0.0
40150 IF (RVCOMP + .00005) 20150, 10150, 40151
40151 IF (RVCOMP - .00005) 10150, 10150, 20150
30150 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10150, 0161, 20150
10150 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0161
20150 IVFAIL = IVFAIL + 1
WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR
0161 CONTINUE
C
C **** FCVS PROGRAM 307 - TEST 016 ****
C
C FIND THE TANGENT OF 30 DEGREES (.52360 RADIANS)
C
IVTNUM = 16
IF (ICZERO) 30160, 0160, 30160
0160 CONTINUE
RVCOMP = 10.0
RVON01 = PI/6
RVCOMP = TAN (RVON01)
RVCORR = .57735
40160 IF (RVCOMP - .57730) 20160, 10160, 40161
40161 IF (RVCOMP - .57740) 10160, 10160, 20160
30160 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10160, 0171, 20160
10160 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0171
20160 IVFAIL = IVFAIL + 1
WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR
0171 CONTINUE
C
C **** FCVS PROGRAM 307 - TEST 017 ****
C
C FIND THE TANGENT OF 30 DEGREES BY DIVIDING THE SINE OF 30 DEGREES
C BY THE COSINE OF 30 DEGREES.
C
IVTNUM = 17
IF (ICZERO) 30170, 0170, 30170
0170 CONTINUE
RVCOMP = 10.0
RVON01 = PI/6
RVCOMP = SIN(RVON01)/COS(RVON01)
RVCORR = .57735
40170 IF (RVCOMP - .57730) 20170, 10170, 40171
40171 IF (RVCOMP - .57740) 10170, 10170, 20170
30170 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10170, 0181, 20170
10170 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0181
20170 IVFAIL = IVFAIL + 1
WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR
0181 CONTINUE
C
C TEST 018 THROUGH TEST 021 CONTAIN INTRINSIC FUNCTION TESTS FOR
C FINDING THE TRIGONOMETRIC ARCSINE (ASIN) WHERE THE FUNCTION AND
C ARGUMENT TYPES ARE BOTH REAL. THE ABSOLUTE VALUES OF ALL
C ARGUMENTS ARE LESS THAN OR EQUAL TO ONE. THE FUNCTION VALUES
C ARE EXPRESSED IN RADIANS WHERE ONE RADIAN EQUALS 57.296 DEGREES.
C
C
C **** FCVS PROGRAM 307 - TEST 018 ****
C
C THE ARCSINE OF +1. IS 90 DEGREES (1.5708 RADIANS)
C
IVTNUM = 18
IF (ICZERO) 30180, 0180, 30180
0180 CONTINUE
RVCOMP = 10.0
RVCOMP = ASIN (+1.0)
RVCORR = 1.5708
40180 IF (RVCOMP - 1.5703) 20180, 10180, 40181
40181 IF (RVCOMP - 1.5713) 10180, 10180, 20180
30180 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10180, 0191, 20180
10180 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0191
20180 IVFAIL = IVFAIL + 1
WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR
0191 CONTINUE
C
C **** FCVS PROGRAM 307 - TEST 019 ****
C
C THE ARCSINE OF -1. IS -90 DEGREES (-1.5708 RADIANS)
C
IVTNUM = 19
IF (ICZERO) 30190, 0190, 30190
0190 CONTINUE
RVCOMP = 10.0
RVON01 = -1.0
RVCOMP = ASIN(RVON01)
RVCORR = -1.5708
40190 IF (RVCOMP + 1.5713) 20190, 10190, 40191
40191 IF (RVCOMP + 1.5703) 10190, 10190, 20190
30190 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10190, 0201, 20190
10190 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0201
20190 IVFAIL = IVFAIL + 1
WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR
0201 CONTINUE
C
C **** FCVS PROGRAM 307 - TEST 020 ****
C
C THE ARCSINE OF -.5 TS -30 DEGREES (-.52360 RADIANS)
C
IVTNUM = 20
IF (ICZERO) 30200, 0200, 30200
0200 CONTINUE
RVCOMP = 10.0
RAON11(1) = -.5
RVCOMP = ASIN (RAON11(1))
RVCORR = -.52360
40200 IF (RVCOMP + .52365) 20200, 10200, 40201
40201 IF (RVCOMP + .52355) 10200, 10200, 20200
30200 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10200, 0211, 20200
10200 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0211
20200 IVFAIL = IVFAIL + 1
WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR
0211 CONTINUE
C
C **** FCVS PROGRAM 307 - TEST 021 ****
C
C THE ARCSINE OF 0.0 IS 0 DEGREES (0.0 RADIANS)
C
IVTNUM = 21
IF (ICZERO) 30210, 0210, 30210
0210 CONTINUE
RVCOMP = 10.0
RVON01 = 0.0
RVCOMP = ASIN (RVON01)
RVCORR = 0.0
40210 IF (RVCOMP) 20210, 10210, 20210
30210 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10210, 0221, 20210
10210 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0221
20210 IVFAIL = IVFAIL + 1
WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR
0221 CONTINUE
C
C TEST 022 THROUGH TEST 025 CONTAIN INTRINSIC FUNCTION TESTS FOR
C FINDING THE TRIGONOMETRIC ARCCOSINE (ACOS) WHERE THE FUNCTION
C AND ARGUMENT TYPES ARE BOTH REAL. THE ABSOLUTE VALUES ALL
C ARGUMENTS ARE LESS THAN OR EQUAL TO ONE. THE FUNCTION VALUES
C ARE EXPRESSED IN RADIANS WHERE ONE RADIAN EQUALS 57.296 DEGREES.
C
C
C **** FCVS PROGRAM 307 - TEST 022 ****
C
C THE ARCCOSINE OF +1. IS 0 DEGREES ( 0.0 RADIANS)
C
IVTNUM = 22
IF (ICZERO) 30220, 0220, 30220
0220 CONTINUE
RVCOMP = 10.0
RVCOMP = ACOS(+1.)
RVCORR = 0.0
40220 IF (RVCOMP + .00005) 20220, 10220, 40221
40221 IF (RVCOMP - .00005) 10220, 10220, 20220
30220 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10220, 0231, 20220
10220 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0231
20220 IVFAIL = IVFAIL + 1
WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR
0231 CONTINUE
C
C **** FCVS PROGRAM 307 - TEST 023 ****
C
C THE ARCCOSINE OF -1. IS 180 DEGREES (3.1416 RADIANS)
C
IVTNUM = 23
IF (ICZERO) 30230, 0230, 30230
0230 CONTINUE
RVCOMP = 10.0
RVON01 = -1.0
RVCOMP = ACOS (RVON01)
RVCORR = 3.1416
40230 IF (RVCOMP - 3.1411) 20230, 10230, 40231
40231 IF (RVCOMP - 3.1421) 10230, 10230, 20230
30230 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10230, 0241, 20230
10230 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0241
20230 IVFAIL = IVFAIL + 1
WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR
0241 CONTINUE
C
C **** FCVS PROGRAM 307 - TEST 024 ****
C
C THE ARCCOSINE OF -.5 IS 120 DEGREES (2.0944 RADIANS)
C
IVTNUM = 24
IF (ICZERO) 30240, 0240, 30240
0240 CONTINUE
RVCOMP = 10.0
RAON11(1) = -.5
RVCOMP = ACOS (RAON11(1))
RVCORR = 2.0944
40240 IF (RVCOMP - 2.0939) 20240, 10240, 40241
40241 IF (RVCOMP - 2.0949) 10240, 10240, 20240
30240 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10240, 0251, 20240
10240 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0251
20240 IVFAIL = IVFAIL + 1
WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR
0251 CONTINUE
C
C **** FCVS PROGRAM 307 - TEST 025 ****
C
C THE ARCCOSINE OF 0.0 IS 90 DEGREES (1.5708 RADIANS)
C
IVTNUM = 25
IF (ICZERO) 30250, 0250, 30250
0250 CONTINUE
RVCOMP = 10.0
RVCOMP = ACOS (0.)
RVCORR = 1.5708
40250 IF (RVCOMP - 1.5703) 20250, 10250, 40251
40251 IF (RVCOMP - 1.5713) 10250, 10250, 20250
30250 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10250, 0261, 20250
10250 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0261
20250 IVFAIL = IVFAIL + 1
WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR
0261 CONTINUE
C
C TEST 026 THROUGH TEST 028 CONTAIN INTRINSIC FUNCTION TESTS FOR
C FINDING THE HYPERBOLIC SINE (SINH) WHERE THE FUNCTION AND
C ARGUMENT TYPES ARE BOTH REAL. ONLY POSITIVE ARGUMENTS ARE
C TESTED.
C
C
C **** FCVS PROGRAM 307 - TEST 026 ****
C
C CONSTANT ARGUMENT
C
IVTNUM = 26
IF (ICZERO) 30260, 0260, 30260
0260 CONTINUE
RVCOMP = 10.0
RVCOMP = SINH (0.0)
RVCORR = 0.0
40260 IF (RVCOMP + .00005) 20260, 10260, 40261
40261 IF (RVCOMP - .00005) 10260, 10260, 20260
30260 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10260, 0271, 20260
10260 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0271
20260 IVFAIL = IVFAIL + 1
WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR
0271 CONTINUE
C
C **** FCVS PROGRAM 307 - TEST 027 ****
C
C VARIABLE ARGUMENT
C
IVTNUM = 27
IF (ICZERO) 30270, 0270, 30270
0270 CONTINUE
RVCOMP =10.0
RVON01 = 2.0
RVCOMP = SINH (RVON01)
RVCORR = 3.6269
40270 IF (RVCOMP - 3.6264) 20270, 10270, 40271
40271 IF (RVCOMP - 3.6274) 10270, 10270, 20270
30270 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10270, 0281, 20270
10270 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0281
20270 IVFAIL = IVFAIL + 1
WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR
0281 CONTINUE
C
C **** FCVS PROGRAM 307 - TEST 028 ****
C
C ARRAY ELEMENT NAME ARGUMENT
C
IVTNUM = 28
IF (ICZERO) 30280, 0280, 30280
0280 CONTINUE
RVCOMP = 10.0
RAON11(1) = 6.0
RVCOMP = SINH (RAON11(1))
RVCORR = 201.71
40280 IF (RVCOMP - 201.66) 20280, 10280, 40281
40281 IF (RVCOMP - 201.76) 10280, 10280, 20280
30280 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10280, 0291, 20280
10280 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0291
20280 IVFAIL = IVFAIL + 1
WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR
0291 CONTINUE
C
C TEST 029 THROUGH TEST 031 CONTAIN INTRINSIC FUNCTION TESTS FOR
C FINDING THE HYPERBOLIC COSINE (COSH) WHERE THE FUNCTION AND
C ARGUMENT TYPES ARE BOTH REAL. ONLY POSITIVE ARGUMENTS ARE TESTED.
C
C
C **** FCVS PROGRAM 307 - TEST 029 ****
C
C CONSTANT ARGUMENT
C
IVTNUM = 29
IF (ICZERO) 30290, 0290, 30290
0290 CONTINUE
RVCOMP = 10.0
RVCOMP = COSH (0.0)
RVCORR = 1.0
40290 IF (RVCOMP - .9995) 20290, 10290, 40291
40291 IF (RVCOMP - 1.0005) 10290, 10290, 20290
30290 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10290, 0301, 20290
10290 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0301
20290 IVFAIL = IVFAIL + 1
WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR
0301 CONTINUE
C
C **** FCVS PROGRAM 307 - TEST 030 ****
C
C VARIABLE ARGUMENT
C
IVTNUM = 30
IF (ICZERO) 30300, 0300, 30300
0300 CONTINUE
RVCOMP = 10.0
RVON01 = 2.0
RVCOMP = COSH (RVON01)
RVCORR = 3.7622
40300 IF (RVCOMP - 3.7617) 20300, 10300, 40301
40301 IF (RVCOMP - 3.7627) 10300, 10300, 20300
30300 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10300, 0311, 20300
10300 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0311
20300 IVFAIL = IVFAIL + 1
WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR
0311 CONTINUE
C
C **** FCVS PROGRAM 307 - TEST 031 ****
C
C ARRAY ELEMENT NAME ARGUMENT
C
IVTNUM = 31
IF (ICZERO) 30310, 0310, 30310
0310 CONTINUE
RVCOMP = 10.0
RAON11(2) = 6.0
RVCOMP = COSH (RAON11(2))
RVCORR = 201.72
40310 IF (RVCOMP - 201.67) 20310, 10310, 40311
40311 IF (RVCOMP - 201.77) 10310, 10310, 20310
30310 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10310, 0321, 20310
10310 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0321
20310 IVFAIL = IVFAIL + 1
WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR
0321 CONTINUE
C
C
C WRITE OUT TEST SUMMARY
C
WRITE (I02,90004)
WRITE (I02,90014)
WRITE (I02,90004)
WRITE (I02,90000)
WRITE (I02,90004)
WRITE (I02,90020) IVFAIL
WRITE (I02,90022) IVPASS
WRITE (I02,90024) IVDELE
STOP
90001 FORMAT (1H ,24X,5HFM307)
90000 FORMAT (1H ,20X,20HEND OF PROGRAM FM307)
C
C FORMATS FOR TEST DETAIL LINES
C
80000 FORMAT (1H ,4X,I5,6X,7HDELETED)
80002 FORMAT (1H ,4X,I5,7X,4HPASS)
80010 FORMAT (1H ,4X,I5,7X,4HFAIL,10X,I6,9X,I6)
80012 FORMAT (1H ,4X,I5,7X,4HFAIL,4X,E12.5,3X,E12.5)
80018 FORMAT (1H ,4X,I5,7X,4HFAIL,2X,A14,1X,A14)
C
C FORMAT STATEMENTS FOR PAGE HEADERS
C
90002 FORMAT (1H1)
90004 FORMAT (1H )
90006 FORMAT (1H ,10X,34HFORTRAN COMPILER VALIDATION SYSTEM)
90008 FORMAT (1H ,21X,11HVERSION 1.0)
90010 FORMAT (1H ,8X,38HFOR OFFICIAL USE ONLY - COPYRIGHT 1978)
90012 FORMAT (1H ,5X,4HTEST,5X,9HPASS/FAIL,5X,8HCOMPUTED,8X,7HCORRECT)
90014 FORMAT (1H ,5X,46H----------------------------------------------)
90016 FORMAT (1H ,18X,17HSUBSET LEVEL TEST)
C
C FORMAT STATEMENTS FOR RUN SUMMARY
C
90020 FORMAT (1H ,19X,I5,13H TESTS FAILED)
90022 FORMAT (1H ,19X,I5,13H TESTS PASSED)
90024 FORMAT (1H ,19X,I5,14H TESTS DELETED)
END
*END-OF,FM307
FM308.f 481036215 170 2 100666 28454 `
*HEADER,FORTR,FM308
*FILES1,FORTR,FM308
PROGRAM FM308
C
C
C THIS ROUTINE TESTS INTRINSIC FUNCTIONS WHERE THE ACTUAL
C ARGUMENTS CONSIST OF INTRINSIC FUNCTION REFERENCES, EXTERNAL
C FUNCTION REFERENCES, STATEMENT FUNCTION REFERENCES, AND
C EXPRESSIONS INVOLVING OPERATORS. THE ARGUMENT AND FUNCTION
C TYPES OF ALL INTRINSIC FUNCTIONS TESTED ARE EITHER INTEGER OR
C REAL. THE INTRINSIC AND EXTERNAL SPECIFICATION STATEMENTS ARE
C SPECIFIED IN ORDER TO ALLOW INTRINSIC AND EXTERNAL FUNCTIONS TO
C BE USED AS ACTUAL ARGUMENTS. THE IMPLICIT STATEMENT AND THE
C TYPE-STATEMENT ARE TESTED TO ENSURE THAT THEY DO NOT CHANGE THE
C TYPE OF AN INTRINSIC FUNCTION. THE COMMON STATEMENT IS USED TO
C PASS DATA ENTITIES TO AN EXTERNAL FUNCTION. THE DATA STATEMENT
C IS USED TO ENSURE THAT INITIALLY DEFINED ENTITIES CAN BE USED AS
C ACTUAL ARGUMENTS. THE EQUIVALENCE STATEMENT IS USED TO EQUATE A
C VARIABLE USED AS AN ACTUAL ARGUMENT. THE INTRINSIC FUNCTIONS
C TESTED IN THIS ROUTINE INCLUDE.
C
C SPECIFIC TYPE OF
C INTRINSIC FUNCTION NAME ARGUMENT FUNCTION
C ------------------ -------- -------- --------
C TYPE CONVERSION INT REAL INTEGER
C TYPE CONVERSION IFIX REAL INTEGER
C TYPE CONVERSION FLOAT INTEGER REAL
C TYPE CONVERSION REAL INTEGER REAL
C TRUNCATION AINT REAL REAL
C NEAREST WHOLE NUMBER ANINT REAL REAL
C NEAREST INTEGER NINT REAL INTEGER
C ABSOLUTE VALUE IABS INTEGER INTEGER
C ABSOLUTE VALUE ABS REAL REAL
C REMAINDERING MOD INTEGER INTEGER
C REMAINDERING AMOD REAL REAL
C TRANSFER OF SIGN ISIGN INTEGER INTEGER
C TRANSFER OF SIGN SIGN REAL REAL
C POSITIVE DIFFERENCE IDIM INTEGER INTEGER
C POSITIVE DIFFERENCE DIM REAL REAL
C CHOOSING LARGEST VALUE MAX0 INTEGER INTEGER
C CHOOSING LARGEST VALUE AMAX0 INTEGER REAL
C CHOOSING LARGEST VALUE MAX1 REAL INTEGER
C CHOOSING SMALLEST VALUE AMIN1 REAL REAL
C CHOOSING SMALLEST VALUE MIN1 REAL INTEGER
C SQUARE ROOT SQRT REAL REAL
C EXPONENTIAL EXP REAL REAL
C NATURAL LOGARITHM ALOG REAL REAL
C SINE SIN REAL REAL
C COSINE COS REAL REAL
C TANGENT TAN REAL REAL
C ARCSINE ASIN REAL REAL
C ARCCOSINE ACOS REAL REAL
C ARCTANGENT ATAN REAL REAL
C HYPERBOLIC SINE SINH REAL REAL
C HYPERBOLIC COSINE COSH REAL REAL
C HYPERBOLIC TANGENT TANH REAL REAL
C
C SUBSET LEVEL ROUTINES FM097, FM098, FM099 AND FM307 TEST THE
C USE OF INTEGER AND REAL INTRINSIC FUNCTIONS USING INTEGER AND REAL
C CONSTANTS, VARIABLES AND ARRAY ELEMENT ENTITIES AS ACTUAL
C ARGUMENTS.
C
C REFERENCES.
C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN,
C X3.9-1978
C
C SECTION 8.2, EQUIVALENCE STATEMENT
C SECTION 8.3, COMMON STATEMENT
C SECTION 8.4, TYPE-STATEMENTS
C SECTION 8.5, IMPLICIT STATEMENT
C SECTION 8.7, EXTERNAL STATEMENT
C SECTION 8.8, INTRINSIC STATEMENT
C SECTION 9, DATA STATEMENT
C SECTION 15.3, INTRINSIC FUNCTION
C SECTION 15.4, STATEMENT FUNCTION
C SECTION 15.5, EXTERNAL FUNCTION
C SECTION 15.5.2, .REFERENCING AN EXTERNAL FUNCTION
C SECTION 15.9.2, ACTUAL ARGUMENTS
C SECTION 15.9.3, ASSOCIATION OF DUMMY AND ACTUAL ARGUMENTS
C TABLE 5, INTRINSIC FUNCTIONS (INCLUDING NOTES)
C SECTION 15.10.1, RESTRICTIONS ON RANGE OF ARGUMENTS AND RESULTS
C
C
C ******************************************************************
C A COMPILER VALIDATION SYSTEM FOR THE FORTRAN LANGUAGE
C BASED ON SPECIFICATIONS AS DEFINED IN AMERICAN STANDARD FORTRAN
C X3.9-1978, HAS BEEN DEVELOPED BY THE DEPARTMENT OF THE NAVY. THE
C FORTRAN COMPILER VALIDATION SYSTEM (FCVS) CONSISTS OF AUDIT
C ROUTINES, THEIR RELATED DATA, AND AN EXECUTIVE SYSTEM. EACH AUDIT
C ROUTINE IS A FORTRAN PROGRAM OR SUBPROGRAM WHICH INCLUDES TESTS
C OF SPECIFIC LANGUAGE ELEMENTS AND SUPPORTING PROCEDURES INDICATING
C THE RESULT OF EXECUTING THESE TESTS.
C
C THIS PARTICULAR PROGRAM OR SUBPROGRAM CONTAINS ONLY FEATURES
C FOUND IN THE SUBSET LEVEL OF THE STANDARD.
C
C SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO
C DEPARTMENT OF THE NAVY
C FEDERAL COBOL COMPILER TESTING SERVICE
C WASHINGTON, D.C. 20376
C
C ******************************************************************
C
C
IMPLICIT LOGICAL (L)
IMPLICIT CHARACTER*14 (C)
C
IMPLICIT INTEGER (E)
IMPLICIT REAL (N)
INTEGER MAX1
REAL SINH
DIMENSION RADN11(5)
DIMENSION IADN11(5)
COMMON RVCN01
EQUIVALENCE (IVOE01,IVOE02)
EXTERNAL FF309,FF310
INTRINSIC ABS, AINT, IABS, ISIGN, SQRT
DATA RVON04/2.23/
RFOS01(RDON01) = RDON01 + 1.0
C
C
C
C INITIALIZATION SECTION.
C
C INITIALIZE CONSTANTS
C ********************
C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER
I01 = 5
C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER
I02 = 6
C SYSTEM ENVIRONMENT SECTION
C
CX010 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-010 CONTROL CARD.
C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5
C (UNIT NUMBER FOR CARD READER).
CX011 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-011 CONTROL CARD
C THE CX011 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL
C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX010 ABOVE.
C
CX020 THIS CARD IS PEPLACED BY CONTENTS OF FEXEC X-020 CONTROL CARD.
C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02 = 6
C (UNIT NUMBER FOR PRINTER).
CX021 THIS CARD IS PEPLACED BY CONTENTS OF FEXEC X-021 CONTROL CARD.
C THE CX021 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL
C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX020 ABOVE.
C
IVPASS = 0
IVFAIL = 0
IVDELE = 0
ICZERO = 0
C
C WRITE OUT PAGE HEADERS
C
WRITE (I02,90002)
WRITE (I02,90006)
WRITE (I02,90008)
WRITE (I02,90004)
WRITE (I02,90010)
WRITE (I02,90004)
WRITE (I02,90016)
WRITE (I02,90001)
WRITE (I02,90004)
WRITE (I02,90012)
WRITE (I02,90014)
WRITE (I02,90004)
C
C
C TEST 032 THROUGH TEST 040 TEST INTRINSIC FUNCTIONS USING
C INTRINSIC FUNCTION REFERENCES AS ACTUAL ARGUMENTS.
C
C
C **** FCVS PROGRAM 308 - TEST 032 ****
C
C
IVTNUM = 32
IF (ICZERO) 30320, 0320, 30320
0320 CONTINUE
RVCOMP = 10.0
RVCOMP = ANINT (ABS (-2.78) )
RVCORR = 3.0
40320 IF (RVCOMP - 2.9995) 20320, 10320, 40321
40321 IF (RVCOMP - 3.0005) 10320, 10320, 20320
30320 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10320, 0331, 20320
10320 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0331
20320 IVFAIL = IVFAIL + 1
WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR
0331 CONTINUE
C
C **** FCVS PROGRAM 308 - TEST 033 ****
C
C
IVTNUM = 33
IF (ICZERO) 30330, 0330, 30330
0330 CONTINUE
RVCOMP = 10.0
RVCOMP = ATAN (AINT (1.2) )
RVCORR = .78540
40330 IF (RVCOMP - .78535) 20330, 10330, 40331
40331 IF (RVCOMP - .78545) 10330, 10330, 20330
30330 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10330, 0341, 20330
10330 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0341
20330 IVFAIL = IVFAIL + 1
WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR
0341 CONTINUE
C
C **** FCVS PROGRAM 308 - TEST 034 ****
C
C
IVTNUM = 34
IF (ICZERO) 30340, 0340, 30340
0340 CONTINUE
RVCOMP = 10.0
RVCOMP = COS (ABS (-.78540) )
RVCORR = .70711
40340 IF (RVCOMP - .70706) 20340, 10340, 40341
40341 IF (RVCOMP - .70716) 10340, 10340, 20340
30340 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10340, 0351, 20340
10340 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0351
20340 IVFAIL = IVFAIL + 1
WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR
0351 CONTINUE
C
C **** FCVS PROGRAM 308 - TEST 035 ****
C
C
IVTNUM = 35
IF (ICZERO) 30350, 0350, 30350
0350 CONTINUE
RVCOMP = 10.0
IVON01 = 6
RVCOMP = AMAX0 (1, IVON01, IABS(-7) )
RVCORR = 7.0
40350 IF (RVCOMP - 6.9995) 20350, 10350, 40351
40351 IF (RVCOMP - 7.0005) 10350, 10350, 20350
30350 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10350, 0361, 20350
10350 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0361
20350 IVFAIL = IVFAIL + 1
WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR
0361 CONTINUE
C
C **** FCVS PROGRAM 308 - TEST 036 ****
C
C
IVTNUM = 36
IF (ICZERO) 30360, 0360, 30360
0360 CONTINUE
IVCOMP = 10
IVCOMP = IABS (ISIGN (7, -2))
IVCORR = 7
40360 IF (IVCOMP - 7) 20360, 10360, 20360
30360 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10360, 0371, 20360
10360 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0371
20360 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0371 CONTINUE
C
C **** FCVS PROGRAM 308 - TEST 037 ****
C
C
IVTNUM = 37
IF (ICZERO) 30370, 0370, 30370
0370 CONTINUE
IVCOMP = 10
IVCOMP = MOD (5, IABS (-3) )
IVCORR = 2
40370 IF (IVCOMP - 2) 20370, 10370, 20370
30370 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10370, 0381, 20370
10370 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0381
20370 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0381 CONTINUE
C
C **** FCVS PROGRAM 308 - TEST 038 ****
C
C
IVTNUM = 38
IF (ICZERO) 30380, 0380, 30380
0380 CONTINUE
IVCOMP = 10
IVCOMP = ISIGN (-3, IABS (-5) )
IVCORR = 3
40380 IF (IVCOMP - 3) 20380, 10380, 20380
30380 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10380, 0391, 20380
10380 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0391
20380 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0391 CONTINUE
C
C **** FCVS PROGRAM 308 - TEST 039 ****
C
C REPEAT FUNCTION REFERENCE TWICE IN ONE INTRINSIC FUNCTION
C REFERENCE.
C
IVTNUM = 39
IF (ICZERO) 30390, 0390, 30390
0390 CONTINUE
IVCOMP = 10
IVCOMP = MAX0 (IABS (-5), IABS (-6) )
IVCORR = 6
40390 IF (IVCOMP -6) 20390, 10390, 20390
30390 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10390, 0401, 20390
10390 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0401
20390 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0401 CONTINUE
C
C **** FCVS PROGRAM 308 - TEST 040 ****
C
C USE INTRINSIC FUNCTION REFERENCE AS ACTUAL ARGUMENT TO ITSELF.
C
IVTNUM = 40
IF (ICZERO) 30400, 0400, 30400
0400 CONTINUE
RVCOMP = 10.0
RVCOMP = SQRT (SQRT (25.) )
RVCORR = 2.2361
40400 IF (RVCOMP - 2.2356) 20400, 10400, 40401
40401 IF (RVCOMP - 2.2366) 10400, 10400, 20400
30400 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10400, 0411, 20400
10400 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0411
20400 IVFAIL = IVFAIL + 1
WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR
0411 CONTINUE
C
C TEST 041 THROUGH TEST 045 TEST INTRINSIC FUNCTIONS USING EXTERNAL
C FUNCTION REFERENCES AS ACTUAL ARGUMENTS.
C
C
C **** FCVS PROGRAM 308 - TEST 041 ****
C
C
IVTNUM = 41
IF (ICZERO) 30410, 0410, 30410
0410 CONTINUE
RVCOMP = 10.0
RVCOMP = ALOG (FF309 (29.0) )
RVCORR = 3.4012
40410 IF (RVCOMP - 3.4007) 20410, 10410, 40411
40411 IF (RVCOMP - 3.4017) 10410, 10410, 20410
30410 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10410, 0421, 20410
10410 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0421
20410 IVFAIL = IVFAIL + 1
WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR
0421 CONTINUE
C
C **** FCVS PROGRAM 308 - TEST 042 ****
C
C
IVTNUM = 42
IF (ICZERO) 30420, 0420, 30420
0420 CONTINUE
RVCOMP = 10.0
RVCOMP = ASIN (FF309 (0.) )
RVCORR = 1.5708
40420 IF (RVCOMP - 1.5703) 20420, 10420, 40421
40421 IF (RVCOMP - 1.5713) 10420, 10420, 20420
30420 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10420, 0431, 20420
10420 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0431
20420 IVFAIL = IVFAIL + 1
WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR
0431 CONTINUE
C
C **** FCVS PROGRAM 308 - TEST 043 ****
C
C
IVTNUM = 43
IF (ICZERO) 30430, 0430, 30430
0430 CONTINUE
RVCOMP = 10.0
RVON01 = 1.5
RVCOMP = COSH (FF309 (RVON01) )
RVCORR = 6.1323
40430 IF (RVCOMP - 6.1318) 20430, 10430, 40431
40431 IF (RVCOMP - 6.1328) 10430, 10430, 20430
30430 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10430, 0441, 20430
10430 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0441
20430 IVFAIL = IVFAIL + 1
WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR
0441 CONTINUE
C
C **** FCVS PROGRAM 308 - TEST 044 ****
C
C
IVTNUM = 44
IF (ICZERO) 30440, 0440, 30440
0440 CONTINUE
IVCOMP = 10
IVCOMP = IFIX (FF309 (33.3) )
IVCORR = 34
40440 IF (IVCOMP - 34) 20440, 10440, 20440
30440 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10440, 0451, 20440
10440 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0451
20440 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0451 CONTINUE
C
C **** FCVS PROGRAM 308 - TEST 045 ****
C
C
IVTNUM = 45
IF (ICZERO) 30450, 0450, 30450
0450 CONTINUE
RVCOMP = 10.0
RADN11(2) = 2.1416
RVCOMP = TAN (FF309 (RADN11(2)))
RVCORR = 0.0
40450 IF (RVCOMP + .00005) 20450, 10450, 40451
40451 IF (RVCOMP - .00005) 10450, 10450, 20450
30450 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10450, 0461, 20450
10450 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0461
20450 IVFAIL = IVFAIL + 1
WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR
0461 CONTINUE
C
C TEST 046 THROUGH TEST 052 TEST INTRINSIC FUNCTIONS USING
C EXPRESSIONS INVOLVING OPERATORS AS ACTUAL ARGUMENTS.
C
C
C **** FCVS PROGRAM 308 - TEST 046 ****
C
C
IVTNUM = 46
IF (ICZERO) 30460, 0460, 30460
0460 CONTINUE
RVCOMP = 10.0
RVCOMP = ABS (3.4 - 8.2)
RVCORR = 4.8
40460 IF (RVCOMP - 4.7995) 20460, 10460, 40461
40461 IF (RVCOMP - 4.8005) 10460, 10460, 20460
30460 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10460, 0471, 20460
10460 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0471
20460 IVFAIL = IVFAIL + 1
WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR
0471 CONTINUE
C
C **** FCVS PROGRAM 308 - TEST 047 ****
C
C
IVTNUM = 47
IF (ICZERO) 30470, 0470, 30470
0470 CONTINUE
RVCOMP = 10.0
IVON01 = 2
RVON01 = 3.0
RVCOMP = ACOS (IVON01 - RVON01 * .5)
RVCORR = 1.0472
40470 IF (RVCOMP - 1.0467) 20470, 10470, 40471
40471 IF (RVCOMP - 1.0477) 10470, 10470, 20470
30470 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10470, 0481, 20470
10470 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0481
20470 IVFAIL = IVFAIL + 1
WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR
0481 CONTINUE
C
C **** FCVS PROGRAM 308 - TEST 048 ****
C
C
IVTNUM = 48
IF (ICZERO) 30480, 0480, 30480
0480 CONTINUE
RVCOMP = 10.0
IVON01 = 2
RVON01 = -4.8
RVON02 = 4.5
RVCOMP = AMIN1 (RVON01, (IVON01 - 3.2) * RVON02)
RVCORR = -5.4
40480 IF (RVCOMP + 5.4005 ) 20480, 10480, 40481
40481 IF (RVCOMP + 5.3995 ) 10480, 10480, 20480
30480 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10480, 0491, 20480
10480 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0491
20480 IVFAIL = IVFAIL + 1
WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR
0491 CONTINUE
C
C **** FCVS PROGRAM 308 - TEST 049 ****
C
C
IVTNUM = 49
IF (ICZERO) 30490, 0490, 30490
0490 CONTINUE
RVCOMP = 10.0
RVON01 = 12.0
IADN11(1) = 3
RADN11(2) = 2.5
RVCOMP = AMOD (RVON01 / IADN11(1), 12 / RADN11(2))
RVCORR = 4.0
40490 IF (RVCOMP - 3.9995) 20490, 10490, 40491
40491 IF (RVCOMP - 4.0005) 10490, 10490, 20490
30490 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10490, 0501, 20490
10490 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0501
20490 IVFAIL = IVFAIL + 1
WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR
0501 CONTINUE
C
C **** FCVS PROGRAM 308 - TEST 050 ****
C
C
IVTNUM = 50
IF (ICZERO) 30500, 0500, 30500
0500 CONTINUE
IVCOMP = 10
IVON01 = 2
IVON02 = 9
IVCOMP = IDIM (IVON01 ** 3, IVON02)
IVCORR = 0
40500 IF (IVCOMP) 20500, 10500, 20500
30500 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10500, 0511, 20500
10500 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0511
20500 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0511 CONTINUE
C
C **** FCVS PROGRAM 308 - TEST 051 ****
C
C
IVTNUM = 51
IF (ICZERO) 30510, 0510, 30510
0510 CONTINUE
RVCOMP = 10.0
IVON01 = 6
RVCOMP = REAL (IABS (-3) + IVON01)
RVCORR = 9.0
40510 IF (RVCOMP - 8.9995) 20510, 10510, 40511
40511 IF (RVCOMP - 9.0005) 10510, 10510, 20510
30510 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10510, 0521, 20510
10510 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0521
20510 IVFAIL = IVFAIL + 1
WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR
0521 CONTINUE
C
C **** FCVS PROGRAM 308 - TEST 052 ****
C
C
IVTNUM = 52
IF (ICZERO) 30520, 0520, 30520
0520 CONTINUE
RVCOMP = 10.0
RVON01 = 2.3
IVON01 = 150
IADN11(1) = 3
RVCOMP = SIGN(13+RVON01*IABS(-4)-IVON01/FF309(1.)**IADN11(1),-1.)
RVCORR = -3.45
40520 IF (RVCOMP + 3.4505) 20520, 10520, 40521
40521 IF (RVCOMP + 3.4495) 10520, 10520, 20520
30520 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10520, 0531, 20520
10520 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0531
20520 IVFAIL = IVFAIL + 1
WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR
0531 CONTINUE
C
C TEST 053 THROUGH TEST 056 TEST INTRINSIC FUNCTIONS USING
C STATEMENT FUNCTION REFERENCES AS ACTUAL ARGUMENTS.
C
C
C **** FCVS PROGRAM 308 - TEST 053 ****
C
C
IVTNUM = 53
IF (ICZERO) 30530, 0530, 30530
0530 CONTINUE
RVCOMP = 10.0
RVCOMP = DIM (RFOS01(5.4), 6.0)
RVCORR = .4
40530 IF (RVCOMP - .39995) 20530, 10530, 40531
40531 IF (RVCOMP - .40005) 10530, 10530, 20530
30530 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10530, 0541, 20530
10530 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0541
20530 IVFAIL = IVFAIL + 1
WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR
0541 CONTINUE
C
C **** FCVS PROGRAM 308 - TEST 054 ****
C
C
IVTNUM = 54
IF (ICZERO) 30540, 0540, 30540
0540 CONTINUE
IVCOMP = 10
IVCOMP = INT(RFOS01(2.01))
IVCORR = 3
40540 IF (IVCOMP - 3) 20540, 10540, 20540
30540 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10540, 0551, 20540
10540 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0551
20540 IVFAIL = IVFAIL + 1
WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR
0551 CONTINUE
C
C **** FCVS PROGRAM 308 - TEST 055 ****
C
C
IVTNUM = 55
IF (ICZERO) 30550, 0550, 30550
0550 CONTINUE
RVCOMP = 10.0
RVON01 = 0.5708
RVCOMP = SIN (RFOS01 (RVON01) / 2)
RVCORR = .70711
40550 IF (RVCOMP - .70706) 20550, 10550, 40551
40551 IF (RVCOMP - .70716) 10550, 10550, 20550
30550 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10550, 0561, 20550
10550 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0561
20550 IVFAIL = IVFAIL + 1
WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR
0561 CONTINUE
C
C **** FCVS PROGRAM 308 - TEST 056 ****
C
C
IVTNUM = 56
IF (ICZERO) 30560, 0560, 30560
0560 CONTINUE
RVCOMP = 10.0
RADN11(2) = 1.5
RVCOMP = TANH(RFOS01(RADN11(2)))
RVCORR = .98661
40560 IF (RVCOMP - .98656) 20560, 10560, 40561
40561 IF (RVCOMP - .98666) 10560, 10560, 20560
30560 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10560, 0571, 20560
10560 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0571
20560 IVFAIL = IVFAIL + 1
WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR
0571 CONTINUE
C
C **** FCVS PROGRAM 308 - TEST 057 ****
C
C TEST 057 TESTS THE INTRINSIC FUNCTION AINT USING AN EXTERNAL
C FUNCTION REFERENCE AS AN ACTUAL ARGUMENT AND THE COMMON
C STATEMENT AS A MEANS OF PASSING DATA TO THE EXTERNAL FUNCTION.
C
IVTNUM = 57
IF (ICZERO) 30570, 0570, 30570
0570 CONTINUE
RVCOMP = 10.0
RVCN01 = 25.3
RVCOMP = AINT(FF310( ))
RVCORR = 26.0
40570 IF (RVCOMP - 25.995) 20570, 10570, 40571
40571 IF (RVCOMP - 26.005) 10570, 10570, 20570
30570 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10570, 0581, 20570
10570 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0581
20570 IVFAIL = IVFAIL + 1
WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR
0581 CONTINUE
C
C **** FCVS PROGRAM 308 - TEST 058 ****
C
C TEST 058 TESTS THE INTRINSIC FUNCTION FLOAT BY USING A VARIABLE
C EQUATED BY EQUIVALENCE ASSOCIATION AS AN ACTUAL ARGUMENT.
C
IVTNUM = 58
IF (ICZERO) 30580, 0580, 30580
0580 CONTINUE
RVCOMP = 10.0
IVOE01 = 5
RVCOMP = FLOAT(IVOE01)
RVCORR = 5.0
40580 IF (RVCOMP - 4.9995) 20580, 10580, 40581
40581 IF (RVCOMP - 5.0005) 10580, 10580, 20580
30580 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10580, 0591, 20580
10580 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0591
20580 IVFAIL = IVFAIL + 1
WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR
0591 CONTINUE
C
C **** FCVS PROGRAM 308 - TEST 059 ****
C
C TEST 059 TESTS THE INTRINSIC FUNCTION MIN1 BY USING A VARIABLE
C INITIALIZED BY THE DATA STATEMENT AS AN ACTUAL ARGUMENT.
C
IVTNUM = 59
IF (ICZERO) 30590, 0590, 30590
0590 CONTINUE
IVCOMP = 10
IVCOMP = MIN1(6., RVON04, 7.3)
IVCORR = 2
40590 IF (IVCOMP - 2) 20590, 10590, 20590
30590 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10590, 0601, 20590
10590 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0601
20590 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0601 CONTINUE
C
C **** FCVS PROGRAM 308 - TEST 060 ****
C
C TEST 060 ATTEMPTS TO OVERRIDE THE TYPING OF REAL FOR THE
C INTRINSIC FUNCTION EXP WITH IMPLICIT INTEGER TYPING.
C
IVTNUM = 60
IF (ICZERO) 30600, 0600, 30600
0600 CONTINUE
RVCOMP = 10.0
RVON01 = 2.05
RVCOMP = EXP(RVON01)
RVCORR = 7.7679
40600 IF (RVCOMP - 7.7674) 20600, 10600, 40601
40601 IF (RVCOMP - 7.7684) 10600, 10600, 20600
30600 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10600, 0611, 20600
10600 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0611
20600 IVFAIL = IVFAIL + 1
WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR
0611 CONTINUE
C
C **** FCVS PROGRAM 308 - TEST 061 ****
C
C TEST 061 ATTEMPTS TO OVERRIDE THE TYPING OF INTEGER FOR THE
C INTRINSIC FUNCTION NINT WITH IMPLICIT REAL TYPING.
C
IVTNUM = 61
IF (ICZERO) 30610, 0610, 30610
0610 CONTINUE
RVCOMP = 10.0
RVON01 = 3.78
RVCOMP = NINT(RVON01) / 5
RVCORR = 0.0
40610 IF (RVCOMP + .00005) 20610, 10610, 40611
40611 IF (RVCOMP - .00005) 10610, 10610, 20610
30610 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10610, 0621, 20610
10610 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0621
20610 IVFAIL = IVFAIL + 1
WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR
0621 CONTINUE
C
C **** FCVS PROGRAM 308 - TEST 062 ****
C
C TEST 062 ATTEMPTS TO OVERRIDE THE TYPING OF REAL FOR THE
C INTRINSIC FUNCTION SINH WITH TYPE-STATEMENT TYPING OF INTEGER.
C
IVTNUM = 62
IF (ICZERO) 30620, 0620, 30620
0620 CONTINUE
RVCOMP = 10.0
RVCOMP = SINH(2.0)
RVCORR = 3.6269
40620 IF (RVCOMP - 3.6264) 20620, 10620, 40621
40621 IF (RVCOMP - 3.6274) 10620, 10620, 20620
30620 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10620, 0631, 20620
10620 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0631
20620 IVFAIL = IVFAIL + 1
WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR
0631 CONTINUE
C
C **** FCVS PROGRAM 308 - TEST 063 ****
C
C TEST 063 ATTEMPTS TO OVERRIDE THE TYPING OF INTEGER FOR THE
C INTRINSIC FUNCTION MAX1 WITH TYPE-STATEMENT TYPING OF REAL.
C
IVTNUM = 63
IF (ICZERO) 30630, 0630, 30630
0630 CONTINUE
RVCOMP = 10.0
RVCOMP = MAX1(2.3, 3.1, 4.4) / 5
RVCORR = 0.0
40630 IF (RVCOMP + .00005) 20630, 10630, 40631
40631 IF (RVCOMP - .00005) 10630, 10630, 20630
30630 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10630, 0641, 20630
10630 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0641
20630 IVFAIL = IVFAIL + 1
WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR
0641 CONTINUE
C
C
C WRITE OUT TEST SUMMARY
C
WRITE (I02,90004)
WRITE (I02,90014)
WRITE (I02,90004)
WRITE (I02,90000)
WRITE (I02,90004)
WRITE (I02,90020) IVFAIL
WRITE (I02,90022) IVPASS
WRITE (I02,90024) IVDELE
STOP
90001 FORMAT (1H ,24X,5HFM308)
90000 FORMAT (1H ,20X,20HEND OF PROGRAM FM308)
C
C FORMATS FOR TEST DETAIL LINES
C
80000 FORMAT (1H ,4X,I5,6X,7HDELETED)
80002 FORMAT (1H ,4X,I5,7X,4HPASS)
80010 FORMAT (1H ,4X,I5,7X,4HFAIL,10X,I6,9X,I6)
80012 FORMAT (1H ,4X,I5,7X,4HFAIL,4X,E12.5,3X,E12.5)
80018 FORMAT (1H ,4X,I5,7X,4HFAIL,2X,A14,1X,A14)
C
C FORMAT STATEMENTS FOR PAGE HEADERS
C
90002 FORMAT (1H1)
90004 FORMAT (1H )
90006 FORMAT (1H ,10X,34HFORTRAN COMPILER VALIDATION SYSTEM)
90008 FORMAT (1H ,21X,11HVERSION 1.0)
90010 FORMAT (1H ,8X,38HFOR OFFICIAL USE ONLY - COPYRIGHT 1978)
90012 FORMAT (1H ,5X,4HTEST,5X,9HPASS/FAIL,5X,8HCOMPUTED,8X,7HCORRECT)
90014 FORMAT (1H ,5X,46H----------------------------------------------)
90016 FORMAT (1H ,18X,17HSUBSET LEVEL TEST)
C
C FORMAT STATEMENTS FOR RUN SUMMARY
C
90020 FORMAT (1H ,19X,I5,13H TESTS FAILED)
90022 FORMAT (1H ,19X,I5,13H TESTS PASSED)
90024 FORMAT (1H ,19X,I5,14H TESTS DELETED)
END
*HEADER,FORTR,FM308,SUBRTN,FM309
REAL FUNCTION FF309(RDON01)
C THIS FUNCTION IS USED TO INCREMENT THE ARGUMENT VALUE BY
C ONE AND RETURN THE RESULT AS THE FUNCTION VALUE.
FF309 = RDON01 + 1.0
RETURN
END
*HEADER,FORTR,FM308,SUBRTN,FM310
REAL FUNCTION FF310 ( )
C THIS FUNCTION IS USED TO INCREMENT BY ONE A VALUE PASSED
C TO THE FUNCTION THROUGH COMMON.
COMMON RVCN01
FF310 = RVCN01 + 1.0
RETURN
END
*END-OF,FM308
FM311.f 481036220 170 2 100666 33476 `
*HEADER,FORTR,FM311
*FILES1,FORTR,FM311
PROGRAM FM311
C
C
C THIS ROUTINE TESTS THE USE OF THE FORTRAN IN-LINE STATEMENT
C FUNCTION OF TYPES INTEGER, REAL AND LOGICAL. SPECIFIC FEATURES
C TESTED INCLUDE,
C
C A) REAL STATEMENT FUNCTIONS USING REAL CONSTANTS AND VARIABLES
C IN THE EXPRESSION AND AS ACTUAL ARGUMENTS.
C
C B) STATEMENT FUNCTIONS WHICH REQUIRE CONVERSION OF THE
C EXPRESSION TO REAL AND INTEGER TYPING.
C
C C) THE USE OF VARIABLES, ARRAY ELEMENTS, EXTERNAL REFERENCES,
C AND INITIALLY DEFINED ENITIIES IN THE EXPRESSION.
C
C D) VARIOUS DEFINITIONS AND USES OF DUMMY ARGUMENTS.
C
C E) ACTUAL ARGUMENTS CONSISTING OF EXPRESSIONS, INTRINSIC
C FUNCTION REFERENCES, AND EXTERNAL FUNCTION REFERENCES.
C
C F) CONFIRMING AND OVERRIDING THE TYPING OF STATEMENT FUNCTIONS
C AND DUMMY ARGUMENTS.
C
C G) USE OF STATEMENT FUNCTIONS AND DUMMY ARGUMENTS IN THE MAIN
C PROGRAM AND IN EXTERNAL FUNCTION AND SUBROUTINE SUBPROGRAMS.
C
C THE SUBSET LEVEL FEATURES OF STATEMENT FUNCTIONS ARE ALSO TESTED
C IN ROUTINE FM020.
C
C REFERENCES.
C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN,
C X3.9-1978
C
C SECTION 8.3, COMMON STATEMENT
C SECTION 8.4, TYPE-STATEMENT
C SECTION 8.5, IMPLICIT STATEMENT
C SECTION 8.7, EXTERNAL STATEMENT
C SECTION 8.8, INTRINSIC STATEMENT
C SECTION 9, DATA STATEMENT
C SECTION 15.3, INTRINSIC FUNCTIONS
C SECTION 15.4, STATEMENT FUNCTION
C SECTION 15.5, EXTERNAL FUNCTIONS
C SECTION 15.6, SUBROUTINES
C SECTION 15.9.1, DUMMY ARGUMENTS
C SECTION 15.9.2, ACTUAL ARGUMENTS
C SECTION 15.9.3, ASSOCIATION OF DUMMY AND ACTUAL ARGUMENTS
C
C
C ******************************************************************
C A COMPILER VALIDATION SYSTEM FOR THE FORTRAN LANGUAGE
C BASED ON SPECIFICATIONS AS DEFINED IN AMERICAN STANDARD FORTRAN
C X3.9-1978, HAS BEEN DEVELOPED BY THE DEPARTMENT OF THE NAVY. THE
C FORTRAN COMPILER VALIDATION SYSTEM (FCVS) CONSISTS OF AUDIT
C ROUTINES, THEIR RELATED DATA, AND AN EXECUTIVE SYSTEM. EACH AUDIT
C ROUTINE IS A FORTRAN PROGRAM OR SUBPROGRAM WHICH INCLUDES TESTS
C OF SPECIFIC LANGUAGE ELEMENTS AND SUPPORTING PROCEDURES INDICATING
C THE RESULT OF EXECUTING THESE TESTS.
C
C THIS PARTICULAR PROGRAM OR SUBPROGRAM CONTAINS ONLY FEATURES
C FOUND IN THE SUBSET LEVEL OF THE STANDARD.
C
C SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO
C DEPARTMENT OF THE NAVY
C FEDERAL COBOL COMPILER TESTING SERVICE
C WASHINGTON, D.C. 20376
C
C ******************************************************************
C
C
IMPLICIT LOGICAL (L)
IMPLICIT CHARACTER*14 (C)
C
IMPLICIT INTEGER (A)
IMPLICIT INTEGER (B)
IMPLICIT REAL (K)
IMPLICIT REAL (M)
REAL NDON01
INTEGER EDON01
INTEGER FF312, FF314
EXTERNAL FF312
INTRINSIC NINT
DIMENSION RADN11(4), RADN12(4), RADN13(4)
DIMENSION IADN11(4), IADN12(4)
DIMENSION LADN11(4)
COMMON /IFOS19/IVCN01
DATA IVOND1/6/
C TEST 001
RFOS01(RDON01) = 3.5
C TEST 002
RFOS02(RDON02) = RDON02
C TEST 003
RFOS03(RDON03) = RDON03 + 1.0
C TEST 004
IFOS01(RDON04) = RDON04 + 1.0
C TEST 005
RFOS04(IDON01) = IDON01 + 1
C TEST 006
IFOS02(IDON02) = IDON02 + 1.95
C TEST 007
IFOS03(IDON03) = IDON03 + IVON01
C TEST 008
RFOS05(RDON05) = RDON05 + RVON02
C TEST 009
LFOS01(LDON01) = LDON01 .OR. LVON01
C TEST 010
IFOS04(IDON04) = IDON04 + IADN11(1)
C TEST 011
RFOS06(RDON06) = RDON06 + RADN12(3)
C TEST 012
LFOS02(LDON02) = .NOT. LDON02 .AND. LADN11(2)
C TEST 013
RFOS07(IDON05) = RADN13(IDON05)
C TEST 014
IFOS05(IDON06) = IDON06 + FF312(4)
C TEST 015
IFOS06(IDON07) = (IDON07 + 1)
C TEST 016
IFOS07(IDON08) = IDON08 + IVOND1
C TEST 017
IFOS08(IDON09) = IDON09 + 1
IFOS09(IDON10) = IFOS08(IDON10) + 1
C TEST 018
IFOS10() = IVON02
C TEST 019
IFOS11(IDON11,IDON12,IDON13) = IDON11 + IDON12 + IDON13
C TEST 020
IFOS12(IDON14) = IDON14 + 1
IFOS13(IDON14) = IDON14 + 2
C TEST 021,022,023
IFOS14(IDON15) = IDON15 + 1
C TEST 024
KFOS01(IDON16) = IDON16 + 1.0
C TEST 025
AFOS01(RDON07) = RDON07 + 1.0
C TEST 026
RFOS08(MDON01) = MDON01 / 5
C TEST 027
RFOS09(BDON01) = BDON01 / 5
C TEST 028
RFOS10(NDON01) = NDON01 / 5
C TEST 029
RFOS11(EDON01) = EDON01 / 5
C TEST 030
IFOS15(IVON04) = IVON04 + 1
C TEST 031
IFOS16(IDON17) = IDON17 + 1
C TEST 032
IFOS17(IDON18) = IDON18 + 1
C TEST 037
IFOS19(IDON21) = IDON21 + 1
C
C
C
C INITIALIZATION SECTION.
C
C INITIALIZE CONSTANTS
C ********************
C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER
I01 = 5
C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER
I02 = 6
C SYSTEM ENVIRONMENT SECTION
C
CX010 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-010 CONTROL CARD.
C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5
C (UNIT NUMBER FOR CARD READER).
CX011 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-011 CONTROL CARD
C THE CX011 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL
C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX010 ABOVE.
C
CX020 THIS CARD IS PEPLACED BY CONTENTS OF FEXEC X-020 CONTROL CARD.
C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02 = 6
C (UNIT NUMBER FOR PRINTER).
CX021 THIS CARD IS PEPLACED BY CONTENTS OF FEXEC X-021 CONTROL CARD.
C THE CX021 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL
C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX020 ABOVE.
C
IVPASS = 0
IVFAIL = 0
IVDELE = 0
ICZERO = 0
C
C WRITE OUT PAGE HEADERS
C
WRITE (I02,90002)
WRITE (I02,90006)
WRITE (I02,90008)
WRITE (I02,90004)
WRITE (I02,90010)
WRITE (I02,90004)
WRITE (I02,90016)
WRITE (I02,90001)
WRITE (I02,90004)
WRITE (I02,90012)
WRITE (I02,90014)
WRITE (I02,90004)
C
C
C TEST 001 THROUGH TEST 003 TEST REAL STATEMENT FUNCTIONS WHERE THE
C EXPRESSION CONSISTS OF REAL CONSTANTS AND VARIABLES AND THE ACTUAL
C ARGUMENTS ARE EITHER REAL CONSTANTS OR VARIABLES.
C
C
C **** FCVS PROGRAM 311 - TEST 001 ****
C
C EXPRESSION CONSISTS OF REAL CONSTANT (NO DUMMY ARGUMENT).
C
IVTNUM = 1
IF (ICZERO) 30010, 0010, 30010
0010 CONTINUE
RVCOMP = 0.0
RVCOMP = RFOS01(1.0)
RVCORR = 3.5
40010 IF (RVCOMP - 3.4995) 20010, 10010, 40011
40011 IF (RVCOMP - 3.5005) 10010, 10010, 20010
30010 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10010, 0021, 20010
10010 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0021
20010 IVFAIL = IVFAIL + 1
WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR
0021 CONTINUE
C
C **** FCVS PROGRAM 311 - TEST 002 ****
C
C DUMMY ARGUMENT USED IN EXPRESSION AND ACTUAL ARGUMENT IS REAL
C CONSTANT.
C
IVTNUM = 2
IF (ICZERO) 30020, 0020, 30020
0020 CONTINUE
RVCOMP = 0.0
RVCOMP = RFOS02(1.3333)
RVCORR = 1.3333
40020 IF (RVCOMP - 1.3328) 20020, 10020, 40021
40021 IF (RVCOMP - 1.3338) 10020, 10020, 20020
30020 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10020, 0031, 20020
10020 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0031
20020 IVFAIL = IVFAIL + 1
WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR
0031 CONTINUE
C
C **** FCVS PROGRAM 311 - TEST 003 ****
C
C DUMMY ARGUMENT USED IN EXPRESSION AND ACTUAL ARGUMENT IS REAL
C VARIABLE.
C
IVTNUM = 3
IF (ICZERO) 30030, 0030, 30030
0030 CONTINUE
RVCOMP = 0.0
RVON01 = 4.5
RVCOMP = RFOS03(RVON01)
RVCORR = 5.5
40030 IF (RVCOMP - 5.4995) 20030, 10030, 40031
40031 IF (RVCOMP - 5.5005) 10030, 10030, 20030
30030 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10030, 0041, 20030
10030 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0041
20030 IVFAIL = IVFAIL + 1
WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR
0041 CONTINUE
C
C TEST 004 THROUGH TEST 006 TEST STATEMENT FUNCTIONS WHICH REQUIRE
C TYPE CONVERSION OF THE EXPRESSION.
C
C
C **** FCVS PROGRAM 311 - TEST 004 ****
C
C INTEGER STATEMENT FUNCTION WITH REAL EXPRESSION.
C
IVTNUM = 4
IF (ICZERO) 30040, 0040, 30040
0040 CONTINUE
IVCOMP = 0
IVCOMP = IFOS01(2.3)
IVCORR = 3
40040 IF (IVCOMP - 3) 20040, 10040, 20040
30040 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10040, 0051, 20040
10040 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0051
20040 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0051 CONTINUE
C
C **** FCVS PROGRAM 311 - TEST 005 ****
C
C REAL STATEMENT FUNCTION WITH INTEGER EXPRESSION
C
IVTNUM = 5
IF (ICZERO) 30050, 0050, 30050
0050 CONTINUE
RVCOMP = 0.0
RVCOMP = RFOS04(3)
RVCORR = 4.0
40050 IF (RVCOMP - 3.9995) 20050, 10050, 40051
40051 IF (RVCOMP - 4.0005) 10050, 10050, 20050
30050 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10050, 0061, 20050
10050 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0061
20050 IVFAIL = IVFAIL + 1
WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR
0061 CONTINUE
C
C **** FCVS PROGRAM 311 - TEST 006 ****
C
C INTEGER STATEMENT FUNCTION WITH EXPRESSION CONSISTING OF INTEGER
C AND REAL PRIMARIES.
C
IVTNUM = 6
IF (ICZERO) 30060, 0060, 30060
0060 CONTINUE
IVCOMP = 0
IVCOMP = IFOS02(2)
IVCORR = 3
40060 IF (IVCOMP - 3) 20060, 10060, 20060
30060 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10060, 0071, 20060
10060 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0071
20060 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0071 CONTINUE
C
C TEST 007 THROUGH TEST 017 TEST THE USAGE OF VARIOUS PRIMARIES
C IN THE EXPRESSION OF A STATEMENT FUNCTION.
C
C
C **** FCVS PROGRAM 311 - TEST 007 ****
C
C USE INTEGER VARIABLE AS PRIMARY
C
IVTNUM = 7
IF (ICZERO) 30070, 0070, 30070
0070 CONTINUE
IVCOMP = 0
IVON01 = 3
IVCOMP = IFOS03(4)
IVCORR = 7
40070 IF (IVCOMP - 7) 20070, 10070, 20070
30070 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10070, 0081, 20070
10070 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0081
20070 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0081 CONTINUE
C
C **** FCVS PROGRAM 311 - TEST 008 ****
C
C USE REAL VARIABLE AS PRIMARY.
C
IVTNUM = 8
IF (ICZERO) 30080, 0080, 30080
0080 CONTINUE
RVCOMP = 0.0
RVON02 = 1.5
RADN11(2) = 1.3
RVCOMP = RFOS05(RADN11(2))
RVCORR = 2.8
40080 IF (RVCOMP - 2.7995) 20080, 10080, 40081
40081 IF (RVCOMP - 2.8005) 10080, 10080, 20080
30080 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10080, 0091, 20080
10080 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0091
20080 IVFAIL = IVFAIL + 1
WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR
0091 CONTINUE
C
C **** FCVS PROGRAM 311 - TEST 009 ****
C
C USE LOGICAL VARIABLE AS PRIMARY.
C
IVTNUM = 9
IF (ICZERO) 30090, 0090, 30090
0090 CONTINUE
LVON01 = .TRUE.
IVCOMP = 0
IF (LFOS01(.FALSE.)) IVCOMP = 1
IVCORR = 1
40090 IF (IVCOMP - 1) 20090, 10090, 20090
30090 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10090, 0101, 20090
10090 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0101
20090 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0101 CONTINUE
C
C **** FCVS PROGRAM 311 - TEST 010 ****
C
C USE INTEGER ARRAY ELEMENT NAME AS PRIMARY.
C
IVTNUM = 10
IF (ICZERO) 30100, 0100, 30100
0100 CONTINUE
IVCOMP = 0
IADN11(1) = 7
IVCOMP = IFOS04(-4)
IVCORR = 3
40100 IF (IVCOMP - 3) 20100, 10100, 20100
30100 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10100, 0111, 20100
10100 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0111
20100 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0111 CONTINUE
C
C **** FCVS PROGRAM 311 - TEST 011 ****
C
C USE REAL ARRAY ELEMENT NAME AS PRIMARY.
C
IVTNUM = 11
IF (ICZERO) 30110, 0110, 30110
0110 CONTINUE
RVCOMP = 0.0
RADN12(3) = 1.23
RVCOMP = RFOS06(3.0)
RVCORR = 4.23
40110 IF (RVCOMP - 4.2295) 20110, 10110, 40111
40111 IF (RVCOMP - 4.2305) 10110, 10110, 20110
30110 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10110, 0121, 20110
10110 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0121
20110 IVFAIL = IVFAIL + 1
WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR
0121 CONTINUE
C
C **** FCVS PROGRAM 311 - TEST 012 ****
C
C USE LOGICAL ARRAY ELEMENT NAME AS PRIMARY.
C
IVTNUM = 12
IF (ICZERO) 30120, 0120, 30120
0120 CONTINUE
LADN11(2) = .TRUE.
IVCOMP = 0
IF (LFOS02(.FALSE.)) IVCOMP = 1
IVCORR = 1
40120 IF (IVCOMP - 1) 20120, 10120, 20120
30120 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10120, 0131, 20120
10120 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0131
20120 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0131 CONTINUE
C
C **** FCVS PROGRAM 311 - TEST 013 ****
C
C USE A REAL ARRAY ELEMENT NAME AS PRIMARY WHERE THE SUBSCRIPT
C VALUE IS THE DUMMY ARGUMENT NAME.
C
IVTNUM = 13
IF (ICZERO) 30130, 0130, 30130
0130 CONTINUE
RVCOMP = 0.0
RADN13(4) = 13.4
RVCOMP = RFOS07(4)
RVCORR = 13.4
40130 IF (RVCOMP - 13.395) 20130, 10130, 40131
40131 IF (RVCOMP - 13.405) 10130, 10130, 20130
30130 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10130, 0141, 20130
10130 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0141
20130 IVFAIL = IVFAIL + 1
WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR
0141 CONTINUE
C
C **** FCVS PROGRAM 311 - TEST 014 ****
C
C USE EXTERNAL FUNCTION REFERENCE AS PRIMARY.
C
IVTNUM = 14
IF (ICZERO) 30140, 0140, 30140
0140 CONTINUE
IVCOMP = 0
IVCOMP = IFOS05(6)
IVCORR = 11
40140 IF (IVCOMP - 11) 20140, 10140, 20140
30140 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10140, 0151, 20140
10140 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0151
20140 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0151 CONTINUE
C
C **** FCVS PROGRAM 311 - TEST 015 ****
C
C USE EXPRESSION ENCLOSED IN PARENTHESES.
C
IVTNUM = 15
IF (ICZERO) 30150, 0150, 30150
0150 CONTINUE
IVCOMP = 0
IVCOMP = IFOS06(4)
IVCORR = 5
40150 IF (IVCOMP - 5) 20150, 10150, 20150
30150 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10150, 0161, 20150
10150 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0161
20150 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0161 CONTINUE
C
C **** FCVS PROGRAM 311 - TEST 016 ****
C
C USE VARIABLE INITIALLY DEFINED IN DATA STATEMENT AS PRIMARY.
C
IVTNUM = 16
IF (ICZERO) 30160, 0160, 30160
0160 CONTINUE
IVCOMP = 0
IVCOMP = IFOS07(3)
IVCORR = 9
40160 IF (IVCOMP - 9) 20160, 10160, 20160
30160 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10160, 0171, 20160
10160 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0171
20160 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0171 CONTINUE
C
C **** FCVS PROGRAM 311 - TEST 017 ****
C
C USE PREVIOUSLY DEFINED STATEMENT FUNCTION REFERENCE AS PRIMARY.
C
IVTNUM = 17
IF (ICZERO) 30170, 0170, 30170
0170 CONTINUE
IVCOMP = 0
IVCOMP = IFOS09(3)
IVCORR = 5
40170 IF (IVCOMP - 5) 20170, 10170, 20170
30170 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10170, 0181, 20170
10170 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0181
20170 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0181 CONTINUE
C
C TEST 018 THROUGH TEST 020 APPLY TO THE DEFINITION OF THE
C STATEMENT FUNCTION DUMMY ARGUMENTS.
C
C
C **** FCVS PROGRAM 311 - TEST 018 ****
C
C DEFINE STATEMENT FUNCTION WITH NO DUMMY ARGUMENTS.
C
IVTNUM = 18
IF (ICZERO) 30180, 0180, 30180
0180 CONTINUE
IVCOMP = 0
IVON02 = 4
IVCOMP = IFOS10()
IVCORR = 4
40180 IF (IVCOMP - 4) 20180, 10180, 20180
30180 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10180, 0191, 20180
10180 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0191
20180 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0191 CONTINUE
C
C **** FCVS PROGRAM 311 - TEST 019 ****
C
C DEFINE STATEMENT FUNCTION WITH THREE DUMMY ARGUMENTS.
C
IVTNUM = 19
IF (ICZERO) 30190, 0190, 30190
0190 CONTINUE
IVCOMP = 0
IVCOMP = IFOS11(1,2,3)
IVCORR = 6
40190 IF (IVCOMP - 6) 20190, 10190, 20190
30190 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10190, 0201, 20190
10190 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0201
20190 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0201 CONTINUE
C
C **** FCVS PROGRAM 311 - TEST 020 ****
C
C USE THE SAME DUMMY ARGUMENT NAME IN TWO DIFFERENT
C STATEMENT FUNCTIONS.
C
IVTNUM = 20
IF (ICZERO) 30200, 0200, 30200
0200 CONTINUE
IVCOMP = 1
IF (IFOS12(3) .EQ. 4) IVCOMP = IVCOMP * 2
IF (IFOS13(4) .EQ. 6) IVCOMP = IVCOMP * 3
IVCORR = 6
C 6 = 2 * 3
40200 IF (IVCOMP - 6) 20200, 10200, 20200
30200 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10200, 0211, 20200
10200 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0211
20200 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0211 CONTINUE
C
C TEST 021 THROUGH TEST 022 TEST THE USAGE OF DIFFERENT TYPES OF
C ACTUAL ARGUMENTS IN A STATEMENT FUNCTION REFERENCE.
C
C
C **** FCVS PROGRAM 311 - TEST 021 ****
C
C USE AN EXPRESSION WITH OPERATORS AS AN ACTUAL ARGUMENT.
C
IVTNUM = 21
IF (ICZERO) 30210, 0210, 30210
0210 CONTINUE
IVCOMP = 0
IVON03 = 4
IVCOMP = IFOS14(IVON03 * 4 + 1)
IVCORR = 18
40210 IF (IVCOMP - 18) 20210, 10210, 20210
30210 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10210, 0221, 20210
10210 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0221
20210 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0221 CONTINUE
C
C **** FCVS PROGRAM 311 - TEST 022 ****
C
C USE AN INTRINSIC FUNCTION REFERENCE AS AN ACTUAL ARGUMENT.
C
IVTNUM = 22
IF (ICZERO) 30220, 0220, 30220
0220 CONTINUE
IVCOMP = 0
RVON01 = 1.75
IVCOMP = IFOS14(NINT(RVON01))
IVCORR = 3
40220 IF (IVCOMP - 3) 20220, 10220, 20220
30220 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10220, 0231, 20220
10220 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0231
20220 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0231 CONTINUE
C
C **** FCVS PROGRAM 311 - TEST 023 ****
C
C USE AN EXTERNAL FUNCTION REFERENCE AS AN ACTUAL ARGUMENT.
C
IVTNUM = 23
IF (ICZERO) 30230, 0230, 30230
0230 CONTINUE
IVCOMP = 0
IVCOMP = IFOS14(FF312(5))
IVCORR = 7
40230 IF (IVCOMP - 7) 20230, 10230, 20230
30230 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10230, 0241, 20230
10230 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0241
20230 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0241 CONTINUE
C
C TEST 024 THROUGH TEST 029 APPLY TO THE TYPING OF STATEMENT
C FUNCTIONS AND THE ASSOCIATED DUMMY ARGUMENT NAMES.
C
C
C **** FCVS PROGRAM 311 - TEST 024 ****
C
C OVERRIDE THE INTEGER DEFAULT TYPING OF A STATEMENT FUNCTION WITH
C THE IMPLICIT STATEMENT TYPING OF REAL.
C
IVTNUM = 24
IF (ICZERO) 30240, 0240, 30240
0240 CONTINUE
RVCOMP = 10.0
RVCOMP = KFOS01(3) / 5
RVCORR = 0.8
40240 IF (RVCOMP - .79995) 20240, 10240, 40241
40241 IF (RVCOMP - .80005) 10240, 10240, 20240
30240 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10240, 0251, 20240
10240 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0251
20240 IVFAIL = IVFAIL + 1
WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR
0251 CONTINUE
C
C **** FCVS PROGRAM 311 - TEST 025 ****
C
C OVERRIDE THE REAL DEFAULT TYPING OF A STATEMENT FUNCTION WITH
C THE IMPLICIT STATEMENT TYPING OF INTEGER.
C
IVTNUM = 25
IF (ICZERO) 30250, 0250, 30250
0250 CONTINUE
RVCOMP = 10.0
RVCOMP = AFOS01(3.0) / 5
RVCORR = 0.0
40250 IF (RVCOMP + .00005) 20250, 10250, 40251
40251 IF (RVCOMP - .00005) 10250, 10250, 20250
30250 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10250, 0261, 20250
10250 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0261
20250 IVFAIL = IVFAIL + 1
WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR
0261 CONTINUE
C
C **** FCVS PROGRAM 311 - TEST 026 ****
C
C OVERRIDE THE INTEGER DEFAULT TYPING OF A STATEMENT FUNCTION
C DUMMY ARGUMENT WITH THE IMPLICIT STATEMENT TYPING OF REAL.
C
IVTNUM = 26
IF (ICZERO) 30260, 0260, 30260
0260 CONTINUE
RVCOMP = 10.0
RVCOMP = RFOS08(4.0)
RVCORR = 0.8
40260 IF (RVCOMP - .79995) 20260, 10260, 40261
40261 IF (RVCOMP - .80005) 10260, 10260, 20260
30260 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10260, 0271, 20260
10260 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0271
20260 IVFAIL = IVFAIL + 1
WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR
0271 CONTINUE
C
C **** FCVS PROGRAM 311 - TEST 027 ****
C
C OVERRIDE THE REAL DEFAULT TYPING OF A STATEMENT FUNCTION DUMMY
C ARGUMENT WITH THE IMPLICIT STATEMENT TYPING OF INTEGER.
C
IVTNUM = 27
IF (ICZERO) 30270, 0270, 30270
0270 CONTINUE
RVCOMP = 10.0
RVCOMP = RFOS09(4)
RVCORR = 0.0
40270 IF (RVCOMP + .00005) 20270, 10270, 40271
40271 IF (RVCOMP - .00005) 10270, 10270, 20270
30270 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10270, 0281, 20270
10270 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0281
20270 IVFAIL = IVFAIL + 1
WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR
0281 CONTINUE
C
C **** FCVS PROGRAM 311 - TEST 028 ****
C
C OVERRIDE INTEGER DEFAULT TYPING OF A STATEMENT FUNCTION DUMMY
C ARGUMENT WITH TYPE-STATEMENT TYPING OF REAL.
C
IVTNUM = 28
IF (ICZERO) 30280, 0280, 30280
0280 CONTINUE
RVCOMP = 10.0
RVCOMP = RFOS10(4.0)
RVCORR = 0.8
40280 IF (RVCOMP - .79995) 20280, 10280, 40281
40281 IF (RVCOMP - .80005) 10280, 10280, 20280
30280 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10280, 0291, 20280
10280 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0291
20280 IVFAIL = IVFAIL + 1
WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR
0291 CONTINUE
C
C **** FCVS PROGRAM 311 - TEST 029 ****
C
C OVERRIDE THE REAL DEFAULT TYPING OF A STATEMENT FUNCTION DUMMY
C ARGUMENT WITH TYPE-STATEMENT TYPING OF INTEGER.
C
IVTNUM = 29
IF (ICZERO) 30290, 0290, 30290
0290 CONTINUE
RVCOMP = 10.0
RVCOMP = RFOS11(4)
RVCORR = 0.0
40290 IF (RVCOMP + .00005) 20290, 10290, 40291
40291 IF (RVCOMP - .00005) 10290, 10290, 20290
30290 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10290, 0301, 20290
10290 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0301
20290 IVFAIL = IVFAIL + 1
WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR
0301 CONTINUE
C
C **** FCVS PROGRAM 311 - TEST 030 ****
C
C TEST 030 TESTS A STATEMENT FUNCTION WHERE THE DUMMY ARGUMENT
C NAME IS IDENTICAL TO A VARIABLE NAME WITHIN THE PROGRAM.
C
IVTNUM = 30
IF (ICZERO) 30300, 0300, 30300
0300 CONTINUE
IVON04 = 10
IVCOMP = 1
IF (IFOS15(3) .EQ. 4) IVCOMP = IVCOMP * 2
IF (IVON04 .EQ. 10) IVCOMP = IVCOMP * 3
IVCORR = 6
C 6 = 2 * 3
40300 IF (IVCOMP - 6) 20300, 10300, 20300
30300 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10300, 0311, 20300
10300 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0311
20300 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0311 CONTINUE
C
C **** FCVS PROGRAM 311 - TEST 031 ****
C
C TEST 031 TESTS THE ASSIGNMENT OF A STATEMENT FUNCTION TO AN
C ARRAY ELEMENT.
C
IVTNUM = 31
IF (ICZERO) 30310, 0310, 30310
0310 CONTINUE
IVCOMP = 0
IADN12(3) = IFOS16(4)
IVCOMP = IADN12(3)
IVCORR = 5
40310 IF (IVCOMP - 5) 20310, 10310, 20310
30310 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10310, 0321, 20310
10310 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0321
20310 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0321 CONTINUE
C
C **** FCVS PROGRAM 311 - TEST 032 ****
C
C TEST 032 TESTS THE USE OF A STATEMENT FUNCTION REFERENCE
C IN AN ARITHMETIC EXPRESSION.
C
IVTNUM = 32
IF (ICZERO) 30320, 0320, 30320
0320 CONTINUE
IVCOMP = 0
IVON05 = 12
IVCOMP = IVON05 + IFOS17(4) * 2 - 3
IVCORR = 19
40320 IF (IVCOMP - 19) 20320, 10320, 20320
30320 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10320, 0331, 20320
10320 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0331
20320 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0331 CONTINUE
C
C **** FCVS PROGRAM 311 - TEST 033 ****
C
C TEST 033 TESTS THE USE OF A STATEMENT FUNCTION DEFINITION AND
C REFERENCE WITHIN AN EXTERNAL FUNCTION.
C
IVTNUM = 33
IF (ICZERO) 30330, 0330, 30330
0330 CONTINUE
RVCOMP = 0.0
RVCOMP = FF313(1.3)
RVCORR = 5.8
40330 IF (RVCOMP - 5.7995) 20330, 10330, 40331
40331 IF (RVCOMP - 5.8005) 10330, 10330, 20330
30330 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10330, 0341, 20330
10330 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0341
20330 IVFAIL = IVFAIL + 1
WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR
0341 CONTINUE
C
C **** FCVS PROGRAM 311 - TEST 034 ****
C
C TEST 034 TESTS THE USE OF A STATEMENT FUNCTION DEFINITION AND
C REFERENCE WITHIN A SUBROUTINE.
C
IVTNUM = 34
IF (ICZERO) 30340, 0340, 30340
0340 CONTINUE
RVCOMP = 0.0
RVON05 = 10.0
CALL FS316(RVON05)
RVCOMP = RVON05
RVCORR = 5.5
40340 IF (RVCOMP - 5.4995) 20340, 10340, 40341
40341 IF (RVCOMP - 5.5005) 10340, 10340, 20340
30340 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10340, 0351, 20340
10340 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0351
20340 IVFAIL = IVFAIL + 1
WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR
0351 CONTINUE
C
C **** FCVS PROGRAM 311 - TEST 035 ****
C
C TEST 035 REFERENCES THE DUMMY ARGUMENT NAME OF AN EXTERNAL
C FUNCTION WITHIN THE EXPRESSION OF A STATEMENT FUNCTION DEFINED
C IN THAT EXTERNAL FUNCTION.
C
IVTNUM = 35
IF (ICZERO) 30350, 0350, 30350
0350 CONTINUE
IVCOMP = 0
IVCOMP = FF314(4)
IVCORR = 7
40350 IF (IVCOMP - 7) 20350, 10350, 20350
30350 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10350, 0361, 20350
10350 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0361
20350 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0361 CONTINUE
C
C **** FCVS PROGRAM 311 - TEST 036 ****
C
C TEST 036 TESTS A STATEMENT FUNCTION DEFINED WITHIN AN EXTERNAL
C FUNCTION IN WHICH THE STATEMENT FUNCTION DUMMY ARGUMENT NAME IS
C IDENTICAL TO THE EXTERNAL FUNCTION DUMMY ARGUMENT NAME.
C
IVTNUM = 36
IF (ICZERO) 30360, 0360, 30360
0360 CONTINUE
RVCOMP = 0.0
RVCOMP = FF315(5.5)
RVCORR = 16.7
40360 IF (RVCOMP - 16.695) 20360, 10360, 40361
40361 IF (RVCOMP - 16.705) 10360, 10360, 20360
30360 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10360, 0371, 20360
10360 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0371
20360 IVFAIL = IVFAIL + 1
WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR
0371 CONTINUE
C
C **** FCVS PROGRAM 311 - TEST 037 ****
C
C TEST 037 TESTS THE USAGE OF THE NAME OF A COMMON BLOCK AS THE
C SYMBOLIC NAME OF A STATEMENT FUNCTION.
C
IVTNUM = 37
IF (ICZERO) 30370, 0370, 30370
0370 CONTINUE
IVCOMP = 0
IVCOMP = IFOS19(4)
IVCORR = 5
40370 IF (IVCOMP - 5) 20370, 10370, 20370
30370 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10370, 0381, 20370
10370 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0381
20370 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0381 CONTINUE
C
C
C WRITE OUT TEST SUMMARY
C
WRITE (I02,90004)
WRITE (I02,90014)
WRITE (I02,90004)
WRITE (I02,90000)
WRITE (I02,90004)
WRITE (I02,90020) IVFAIL
WRITE (I02,90022) IVPASS
WRITE (I02,90024) IVDELE
STOP
90001 FORMAT (1H ,24X,5HFM311)
90000 FORMAT (1H ,20X,20HEND OF PROGRAM FM311)
C
C FORMATS FOR TEST DETAIL LINES
C
80000 FORMAT (1H ,4X,I5,6X,7HDELETED)
80002 FORMAT (1H ,4X,I5,7X,4HPASS)
80010 FORMAT (1H ,4X,I5,7X,4HFAIL,10X,I6,9X,I6)
80012 FORMAT (1H ,4X,I5,7X,4HFAIL,4X,E12.5,3X,E12.5)
80018 FORMAT (1H ,4X,I5,7X,4HFAIL,2X,A14,1X,A14)
C
C FORMAT STATEMENTS FOR PAGE HEADERS
C
90002 FORMAT (1H1)
90004 FORMAT (1H )
90006 FORMAT (1H ,10X,34HFORTRAN COMPILER VALIDATION SYSTEM)
90008 FORMAT (1H ,21X,11HVERSION 1.0)
90010 FORMAT (1H ,8X,38HFOR OFFICIAL USE ONLY - COPYRIGHT 1978)
90012 FORMAT (1H ,5X,4HTEST,5X,9HPASS/FAIL,5X,8HCOMPUTED,8X,7HCORRECT)
90014 FORMAT (1H ,5X,46H----------------------------------------------)
90016 FORMAT (1H ,18X,17HSUBSET LEVEL TEST)
C
C FORMAT STATEMENTS FOR RUN SUMMARY
C
90020 FORMAT (1H ,19X,I5,13H TESTS FAILED)
90022 FORMAT (1H ,19X,I5,13H TESTS PASSED)
90024 FORMAT (1H ,19X,I5,14H TESTS DELETED)
END
*HEADER,FORTR,FM311,SUBRTN,FM312
INTEGER FUNCTION FF312(IDONX1)
C THIS SUBPROGRAM IS USED BY TESTS 014 AND 023 OF THE MAIN PROGRAM
C FM311 TO TEST STATEMENT FUNCTION. IN TEST 014 REFERENCE TO FF312
C IS USED IN THE EXPRESSION OF A STATEMENT FUNCTION. IN TEST 023
C REFERENCE TO FF312 IS USED AS AN ACTUAL ARGUMENT IN A STATEMENT
C FUNCTION REFERENCE. THIS ROUTINE MERELY INCREMENTS THE VALUE OF
C ACTUAL/DUMMY ARGUMENT BY ONE AND RETURN THE RESULT AS THE
C FUNCTION VALUE.
IDONX2 = IDONX1 + 1
FF312 = IDONX2
RETURN
END
*HEADER,FORTR,FM311,SUBRTN,FM313
REAL FUNCTION FF313(RDON08)
C THIS SUBPROGRAM IS USED BY TEST 033 OF THE MAIN PROGRAM FM311 TO
C TEST THE DEFINITION AND REFERENCE OF A STATEMENT FUNCTION WITHIN
C AN EXTERNAL FUNCTION.
RFOS12(RDON09) = RDON09 + 1.0
RVON04 = RFOS12(3.5)
FF313 = RDON08 + RVON04
RETURN
END
*HEADER,FORTR,FM311,SUBRTN,FM314
INTEGER FUNCTION FF314(IDON19)
C THIS SUBPROGRAM IS USED BY TEST 035 OF THE MAIN PROGRAM FM311 TO
C TEST THE DEFINITION AND REFERENCE OF A STATEMENT FUNCTION WITHIN
C AN EXTERNAL FUNCTION. IN THIS TEST THE EXTERNAL FUNCTION DUMMY
C ARGUMENT IS REFERENCED WITHIN THE EXPRESSION OF THE STATEMENT
C FUNCTION.
IFOS18(IDON20) = IDON19 + IDON20
FF314 = IFOS18(3)
RETURN
END
*HEADER,FORTR,FM311,SUBRTN,FM315
REAL FUNCTION FF315(RDON12)
C THIS SUBPROGRAM IS USED BY TEST 036 OF THE MAIN PROGRAM FM311 TO
C TEST THE DEFINITION AND REFERENCE OF A STATEMENT FUNCTION WITHIN
C AN EXTERNAL FUNCTION. IN THIS TEST THE EXTERNAL FUNCTION AND
C STATEMENT FUNCTION DUMMY ARGUMENTS NAMES ARE IDENTICAL.
RFOS14(RDON12) = RDON12 + 1.0
RVON06 = 10.2
RVON07 = RFOS14(RVON06)
FF315 = RDON12 + RVON07
RETURN
END
*HEADER,FORTR,FM311,SUBRTN,FM316
SUBROUTINE FS316(RDON10)
C THIS SUBPROGRAM IS USED BY TEST 034 OF THE MAIN PROGRAM FM311 TO
C TEST THE DEFINITION AND REFERENCE OF A STATEMENT FUNCTION WITHIN
C A SUBROUTINE.
RFOS13(RDON11) = RDON11 + 1.0
RDON10 = RFOS13(3.5) + 1.0
RETURN
END
*END-OF,FM311
FM317.f 481036226 170 2 100666 32909 `
*HEADER,FORTR,FM317
*FILES1,FORTR,FM317
PROGRAM FM317
C
C
C THIS ROUTINE TESTS SUBSET LEVEL FEATURES OF EXTERNAL
C FUNCTION SUBPROGRAMS. TESTS ARE DESIGNED TO CHECK THE
C ASSOCIATION OF ALL PERMISSIBLE FORMS OF ACTUAL ARGUMENTS WITH
C VARIABLE, ARRAY AND PROCEDURE NAME DUMMY ARGUMENTS. THESE
C INCLUDE,
C
C 1) ACTUAL ARGUMENTS ASSOCIATED TO VARIABLE NAME DUMMY
C ARGUMENT INCLUDE,
C
C A) CONSTANT
C B) VARIABLE NAME
C C) ARRAY ELEMENT NAME
C D) EXPRESSION INVOLVING OPERATORS
C E) EXPRESSION ENCLOSED IN PARENTHESES
C F) INTRINSIC FUNCTION REFERENCE
C G) EXTERNAL FUNCTION REFERENCE
C H) STATEMENT FUNCTION REFERENCE
C I) ACTUAL ARGUMENT NAME SAME AS DUMMY ARGUMENT NAME
C
C 2) ACTUAL ARGUMENTS ASSOCIATED TO ARRAY NAME DUMMY
C ARGUMENT INCLUDE,
C
C A) ARRAY NAME
C B) ARRAY ELEMENT NAME
C
C 3) ACTUAL ARGUMENTS ASSOCIATED TO PROCEDURE NAME DUMMY
C ARGUMENT INCLUDE,
C
C A) EXTERNAL FUNCTION NAME
C B) INTRINSIC FUNCTION NAME
C C) SUBROUTINE NAME
C
C SUBSET LEVEL ROUTINES FM028,FM050 AND FM080 ALSO TEST THE USE OF
C EXTERNAL FUNCTIONS.
C
C REFERENCES.
C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN,
C X3.9-1978
C
C SECTION 2.8, DUMMY ARGUMENTS
C SECTION 5.1.2.2, DUMMY ARRAY DECLARATOR
C SECTION 5.5, DUMMY AND ACTUAL ARRAYS
C SECTION 8.1, DIMENSION STATEMENT
C SECTION 8.3, COMMON STATEMENT
C SECTION 8.4, TYPE-STATEMENT
C SECTION 8.7, EXTERNAL STATEMENT
C SECTION 8.8, INTRINSIC STATEMENT
C SECTION 15.2, REFERENCING A FUNCTION
C SECTION 15.3, INTRINSIC FUNCTIONS
C SECTION 15.5, EXTERNAL FUNCTIONS
C SECTION 15.6, SUBROUTINES
C SECTION 15.9, ARGUMENTS AND COMMON BLOCKS
C
C
C ******************************************************************
C A COMPILER VALIDATION SYSTEM FOR THE FORTRAN LANGUAGE
C BASED ON SPECIFICATIONS AS DEFINED IN AMERICAN STANDARD FORTRAN
C X3.9-1978, HAS BEEN DEVELOPED BY THE DEPARTMENT OF THE NAVY. THE
C FORTRAN COMPILER VALIDATION SYSTEM (FCVS) CONSISTS OF AUDIT
C ROUTINES, THEIR RELATED DATA, AND AN EXECUTIVE SYSTEM. EACH AUDIT
C ROUTINE IS A FORTRAN PROGRAM OR SUBPROGRAM WHICH INCLUDES TESTS
C OF SPECIFIC LANGUAGE ELEMENTS AND SUPPORTING PROCEDURES INDICATING
C THE RESULT OF EXECUTING THESE TESTS.
C
C THIS PARTICULAR PROGRAM OR SUBPROGRAM CONTAINS ONLY FEATURES
C FOUND IN THE SUBSET LEVEL OF THE STANDARD.
C
C SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO
C DEPARTMENT OF THE NAVY
C FEDERAL COBOL COMPILER TESTING SERVICE
C WASHINGTON, D.C. 20376
C
C ******************************************************************
C
C
IMPLICIT LOGICAL (L)
IMPLICIT CHARACTER*14 (C)
C
INTEGER FF318, FF321, FF322, FF324, FF325
LOGICAL FF320
INTRINSIC ABS, IABS, NINT
EXTERNAL FF318, FF321, FF325, FS327
DIMENSION IADN11(4), IADN12(4)
DIMENSION RADN11(4), RADN12(4)
DIMENSION LADN11(4)
COMMON IACN11(6), RACN11(10)
INTEGER IATN11(2,3)
REAL RATN11(3,4)
IFOS01(IDON04) = IDON04 + 1
C
C
C
C INITIALIZATION SECTION.
C
C INITIALIZE CONSTANTS
C ********************
C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER
I01 = 5
C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER
I02 = 6
C SYSTEM ENVIRONMENT SECTION
C
CX010 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-010 CONTROL CARD.
C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5
C (UNIT NUMBER FOR CARD READER).
CX011 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-011 CONTROL CARD
C THE CX011 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL
C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX010 ABOVE.
C
CX020 THIS CARD IS PEPLACED BY CONTENTS OF FEXEC X-020 CONTROL CARD.
C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02 = 6
C (UNIT NUMBER FOR PRINTER).
CX021 THIS CARD IS PEPLACED BY CONTENTS OF FEXEC X-021 CONTROL CARD.
C THE CX021 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL
C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX020 ABOVE.
C
IVPASS = 0
IVFAIL = 0
IVDELE = 0
ICZERO = 0
C
C WRITE OUT PAGE HEADERS
C
WRITE (I02,90002)
WRITE (I02,90006)
WRITE (I02,90008)
WRITE (I02,90004)
WRITE (I02,90010)
WRITE (I02,90004)
WRITE (I02,90016)
WRITE (I02,90001)
WRITE (I02,90004)
WRITE (I02,90012)
WRITE (I02,90014)
WRITE (I02,90004)
C
C
C TEST 001 THROUGH TEST 022 ARE DESIGNED TO ASSOCIATE VARIOUS FORMS
C OF ACTUAL ARGUMENTS TO VARIABLE NAMES USED AS EXTERNAL FUNCTION
C DUMMY ARGUMENTS. INTEGER, REAL AND LOGICAL DUMMY ARGUMENTS ARE
C TESTED.
C
C
C **** FCVS PROGRAM 317 - TEST 001 ****
C
C INTEGER CONSTANT AS ACTUAL ARGUMENT
C
IVTNUM = 1
IF (ICZERO) 30010, 0010, 30010
0010 CONTINUE
IVCOMP = 0
IVCOMP = FF318(3)
IVCORR = 4
40010 IF (IVCOMP - 4) 20010, 10010, 20010
30010 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10010, 0021, 20010
10010 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0021
20010 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0021 CONTINUE
C
C **** FCVS PROGRAM 317 - TEST 002 ****
C
C REAL CONSTANT AS ACTUAL ARGUMENT
C
IVTNUM = 2
IF (ICZERO) 30020, 0020, 30020
0020 CONTINUE
RVCOMP = 0.0
RVCOMP = FF319(3.0)
RVCORR = 4.0
40020 IF (RVCOMP - 3.9995) 20020, 10020, 40021
40021 IF (RVCOMP - 4.0005) 10020, 10020, 20020
30020 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10020, 0031, 20020
10020 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0031
20020 IVFAIL = IVFAIL + 1
WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR
0031 CONTINUE
C
C **** FCVS PROGRAM 317 - TEST 003 ****
C
C LOGICAL CONSTANT AS ACTUAL ARGUMENT
C
IVTNUM = 3
IF (ICZERO) 30030, 0030, 30030
0030 CONTINUE
IVCOMP = 0
IF (FF320(.FALSE.)) IVCOMP = 1
IVCORR = 1
40030 IF (IVCOMP - 1) 20030, 10030, 20030
30030 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10030, 0041, 20030
10030 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0041
20030 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0041 CONTINUE
C
C **** FCVS PROGRAM 317 - TEST 004 ****
C
C INTEGER VARIABLE AS ACTUAL ARGUMENT
C
IVTNUM = 4
IF (ICZERO) 30040, 0040, 30040
0040 CONTINUE
IVCOMP = 0
IVON01 = 7
IVCOMP = FF318(IVON01)
IVCORR = 8
40040 IF (IVCOMP - 8) 20040, 10040, 20040
30040 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10040, 0051, 20040
10040 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0051
20040 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0051 CONTINUE
C
C **** FCVS PROGRAM 317 - TEST 005 ****
C
C REAL VARIABLE AS ACTUAL ARGUMENT
C
IVTNUM = 5
IF (ICZERO) 30050, 0050, 30050
0050 CONTINUE
RVCOMP = 0.0
RVON01 = 7.0
RVCOMP = FF319(RVON01)
RVCORR = 8.0
40050 IF (RVCOMP - 7.9995) 20050, 10050, 40051
40051 IF (RVCOMP - 8.0005) 10050, 10050, 20050
30050 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10050, 0061, 20050
10050 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0061
20050 IVFAIL = IVFAIL + 1
WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR
0061 CONTINUE
C
C **** FCVS PROGRAM 317 - TEST 006 ****
C
C LOGICAL VARIABLE AS ACTUAL ARGUMENT
C
IVTNUM = 6
IF (ICZERO) 30060, 0060, 30060
0060 CONTINUE
LVON01 = .TRUE.
IVCOMP = 0
IF (.NOT. FF320(LVON01)) IVCOMP = 1
IVCORR = 1
40060 IF (IVCOMP - 1) 20060, 10060, 20060
30060 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10060, 0071, 20060
10060 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0071
20060 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0071 CONTINUE
C
C **** FCVS PROGRAM 317 - TEST 007 ****
C
C INTEGER ARRAY ELEMENT NAME AS ACTUAL ARGUMENT
C
IVTNUM = 7
IF (ICZERO) 30070, 0070, 30070
0070 CONTINUE
IVCOMP = 0
IADN11(2) = 2
IVCOMP = FF318(IADN11(2))
IVCORR = 3
40070 IF (IVCOMP - 3) 20070, 10070, 20070
30070 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10070, 0081, 20070
10070 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0081
20070 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0081 CONTINUE
C
C **** FCVS PROGRAM 317 - TEST 008 ****
C
C REAL ARRAY ELEMENT NAME AS ACTUAL ARGUMENT
C
IVTNUM = 8
IF (ICZERO) 30080, 0080, 30080
0080 CONTINUE
RVCOMP = 0.0
RADN11(4) = 4.0
RVCOMP = FF319(RADN11(4))
RVCORR = 5.0
40080 IF (RVCOMP - 4.9995) 20080, 10080, 40081
40081 IF (RVCOMP - 5.0005) 10080, 10080, 20080
30080 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10080, 0091, 20080
10080 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0091
20080 IVFAIL = IVFAIL + 1
WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR
0091 CONTINUE
C
C **** FCVS PROGRAM 317 - TEST 009 ****
C
C LOGICAL ARRAY ELEMENT NAME AS ACTUAL ARGUMENT
C
IVTNUM = 9
IF (ICZERO) 30090, 0090, 30090
0090 CONTINUE
LADN11(1) = .FALSE.
IVCOMP = 0
IF (FF320(LADN11(1))) IVCOMP = 1
IVCORR = 1
40090 IF (IVCOMP - 1) 20090, 10090, 20090
30090 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10090, 0101, 20090
10090 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0101
20090 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0101 CONTINUE
C
C **** FCVS PROGRAM 317 - TEST 010 ****
C
C INTEGER EXPRESSION INVOLVING OPERATORS AS ACTUAL ARGUMENT
C
IVTNUM = 10
IF (ICZERO) 30100, 0100, 30100
0100 CONTINUE
IVCOMP = 0
IVON02 = 2
IVON03 = 3
IVCOMP = FF318(IVON02 + 3 * IVON03 - 7)
IVCORR = 5
40100 IF (IVCOMP - 5) 20100, 10100, 20100
30100 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10100, 0111, 20100
10100 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0111
20100 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0111 CONTINUE
C
C **** FCVS PROGRAM 317 - TEST 011 ****
C
C REAL EXPRESSION INVOLVING OPERATORS AS ACTUAL ARGUMENT
C
IVTNUM = 11
IF (ICZERO) 30110, 0110, 30110
0110 CONTINUE
RVCOMP = 0.0
RVON02 = 2.
RVON03 = 1.2
RVCOMP = FF319(RVON02 * RVON03 /.6)
RVCORR = 5.0
40110 IF (RVCOMP - 4.9995) 20110, 10110, 40111
40111 IF (RVCOMP - 5.0005) 10110, 10110, 20110
30110 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10110, 0121, 20110
10110 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0121
20110 IVFAIL = IVFAIL + 1
WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR
0121 CONTINUE
C
C **** FCVS PROGRAM 317 - TEST 012 ****
C
C REAL EXPRESSION INVOLVING INTEGER AND REAL PRIMARIES AND OPERATORS
C AS ACTUAL ARGUMENT.
C
IVTNUM = 12
IF (ICZERO) 30120, 0120, 30120
0120 CONTINUE
RVCOMP = 0.0
IVON01 = 2
RADN11(2) = 2.5
RVCOMP = FF319(IVON01**3 * (RADN11(2) - 1) + 2.0)
RVCORR = 15.0
40120 IF (RVCOMP - 14.995) 20120, 10120, 40121
40121 IF (RVCOMP - 15.005) 10120, 10120, 20120
30120 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10120, 0131, 20120
10120 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0131
20120 IVFAIL = IVFAIL + 1
WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR
0131 CONTINUE
C
C **** FCVS PROGRAM 317 - TEST 013 ****
C
C LOGICAL EXPRESSION INVOLVING LOGICAL OPERATOR (.NOT.) AS ACTUAL
C ARGUMENT.
C
IVTNUM = 13
IF (ICZERO) 30130, 0130, 30130
0130 CONTINUE
LVON01 = .TRUE.
IVCOMP = 0
IF (FF320(.NOT. LVON01)) IVCOMP = 1
IVCORR = 1
40130 IF (IVCOMP - 1) 20130, 10130, 20130
30130 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10130, 0141, 20130
10130 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0141
20130 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0141 CONTINUE
C
C **** FCVS PROGRAM 317 - TEST 014 ****
C
C LOGICAL EXPRESSION INVOLVING LOGICAL OPERATOR (.OR.) AS ACTIVE
C ARGUMENT.
C
IVTNUM = 14
IF (ICZERO) 30140, 0140, 30140
0140 CONTINUE
LVON01 = .TRUE.
LVON02 = .FALSE.
IVCOMP = 0
IF (.NOT. FF320(LVON01 .OR. LVON02)) IVCOMP = 1
IVCORR = 1
40140 IF (IVCOMP - 1) 20140, 10140, 20140
30140 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10140, 0151, 20140
10140 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0151
20140 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0151 CONTINUE
C
C **** FCVS PROGRAM 317 - TEST 015 ****
C
C LOGICAL EXPRESSION INVOLVING LOGICAL OPERATOR (.AND.) AS ACTUAL
C ARGUMENT.
C
IVTNUM = 15
IF (ICZERO) 30150, 0150, 30150
0150 CONTINUE
LVON01 = .FALSE.
LVON02 = .TRUE.
IVCOMP = 0
IF (FF320(LVON01 .AND. LVON02)) IVCOMP = 1
IVCORR = 1
40150 IF (IVCOMP - 1) 20150, 10150, 20150
30150 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10150, 0161, 20150
10150 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0161
20150 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0161 CONTINUE
C
C **** FCVS PROGRAM 317 - TEST 016 ****
C
C EXPRESSION ENCLOSED IN PARENTHESES AS ACTUAL ARGUMENT
C
IVTNUM = 16
IF (ICZERO) 30160, 0160, 30160
0160 CONTINUE
IVCOMP = 0
IVON01 = 6
IVCOMP = FF318((IVON01 + 3))
IVCORR = 10
40160 IF (IVCOMP - 10) 20160, 10160, 20160
30160 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10160, 0171, 20160
10160 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0171
20160 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0171 CONTINUE
C
C **** FCVS PROGRAM 317 - TEST 017 ****
C
C REAL INTRINSIC FUNCTION REFERENCE AS ACTUAL ARGUMENT.
C
IVTNUM = 17
IF (ICZERO) 30170, 0170, 30170
0170 CONTINUE
RVCOMP = 0.0
RVON01 = -5.2
RVCOMP = FF319(ABS(RVON01))
RVCORR = 6.2
40170 IF (RVCOMP - 6.1995) 20170, 10170, 40171
40171 IF (RVCOMP - 6.2005) 10170, 10170, 20170
30170 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10170, 0181, 20170
10170 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0181
20170 IVFAIL = IVFAIL + 1
WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR
0181 CONTINUE
C
C **** FCVS PROGRAM 317 - TEST 018 ****
C
C INTEGER INTRINSIC FUNCTION REFERENCE AS ACTUAL ARGUMENT.
C
IVTNUM = 18
IF (ICZERO) 30180, 0180, 30180
0180 CONTINUE
IVCOMP = 0
RVON01 = 4.7
IVCOMP = FF318(NINT(RVON01))
IVCORR = 6
40180 IF (IVCOMP - 6) 20180, 10180, 20180
30180 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10180, 0191, 20180
10180 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0191
20180 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0191 CONTINUE
C
C **** FCVS PROGRAM 317 - TEST 019 ****
C
C EXTERNAL FUNCTION REFERENCE AS ACTUAL ARGUMENT.
C
IVTNUM = 19
IF (ICZERO) 30190, 0190, 30190
0190 CONTINUE
IVCOMP = 0
IVON01 = 4
IVCOMP = FF318(FF321(IVON01))
IVCORR = 6
40190 IF (IVCOMP - 6) 20190, 10190, 20190
30190 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10190, 0201, 20190
10190 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0201
20190 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0201 CONTINUE
C
C **** FCVS PROGRAM 317 - TEST 020 ****
C
C EXTERNAL FUNCTION REFERENCE WHICH USES A REFERENCE TO ITSELF
C AS AN ACTUAL ARGUMENT.
C
IVTNUM = 20
IF (ICZERO) 30200, 0200, 30200
0200 CONTINUE
IVCOMP = 0
IVCOMP = FF318(FF318(4))
IVCORR = 6
40200 IF (IVCOMP - 6) 20200, 10200, 20200
30200 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10200, 0211, 20200
10200 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0211
20200 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0211 CONTINUE
C
C **** FCVS PROGRAM 317 - TEST 021 ****
C
C USE AN ACTUAL ARGUMENT NAME WHICH IS IDENTICAL TO THE DUMMY
C ARGUMENT NAME.
C
IVTNUM = 21
IF (ICZERO) 30210, 0210, 30210
0210 CONTINUE
IVCOMP = 0
IDON01 = 10
IVCOMP = FF318(IDON01)
IVCORR = 11
40210 IF (IVCOMP - 11) 20210, 10210, 20210
30210 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10210, 0221, 20210
10210 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0221
20210 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0221 CONTINUE
C
C **** FCVS PROGRAM 317 - TEST 022 ****
C
C USE STATEMENT FUNCTION REFERENCE AS ACTUAL ARGUMENT.
C
IVTNUM = 22
IF (ICZERO) 30220, 0220, 30220
0220 CONTINUE
IVCOMP = 0
IVCOMP = FF318(IFOS01(4))
IVCORR = 6
40220 IF (IVCOMP - 6) 20220, 10220, 20220
30220 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10220, 0231, 20220
10220 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0231
20220 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0231 CONTINUE
C
C TEST 023 THROUGH TEST 028 ARE DESIGNED TO ASSOCIATE VARIOUS
C FORMS OF ACTUAL ARGUMENTS TO ARRAY NAMES USED AS EXTERNAL
C FUNCTION DUMMY ARGUMENTS.
C
C
C **** FCVS PROGRAM 317 - TEST 023 ****
C
C USE AN ARRAY NAME AS AN ACTUAL ARGUMENT IN WHICH THE ACTUAL
C ARGUMENT ARRAY DECLARATOR IS IDENTICAL TO THE ASSOCIATED DUMMY
C ARGUMENT ARRAY DECLARATOR.
C
IVTNUM = 23
IF (ICZERO) 30230, 0230, 30230
0230 CONTINUE
IVCOMP = 0
IADN12(1) = 1
IADN12(2) = 10
IADN12(3) = 100
IADN12(4) = 1000
IVCOMP = FF322(IADN12)
IVCORR = 1111
40230 IF (IVCOMP - 1111) 20230, 10230, 20230
30230 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10230, 0241, 20230
10230 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0241
20230 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0241 CONTINUE
C
C **** FCVS PROGRAM 317 - TEST 024 ****
C
C USE AN ARRAY NAME AS AN ACTUAL ARGUMENT IN WHICH THE SIZE OF THE
C ACTUAL ARGUMENT ARRAY IS LARGER THAN THE SIZE OF THE ASSOCIATED
C DUMMY ARGUMENT ARRAY.
C
IVTNUM = 24
IF (ICZERO) 30240, 0240, 30240
0240 CONTINUE
IVCOMP = 0
IACN11(1) = 1
IACN11(2) = 10
IACN11(3) = 100
IACN11(4) = 1000
IACN11(5) = 10000
IVCOMP = FF322(IACN11)
IVCORR = 1111
40240 IF (IVCOMP - 1111) 20240, 10240, 20240
30240 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10240, 0251, 20240
10240 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0251
20240 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0251 CONTINUE
C
C **** FCVS PROGRAM 317 - TEST 025 ****
C
C USE AN ARRAY NAME AS AN ACTUAL ARGUMENT IN WHICH THE ACTUAL
C ARGUMENT ARRAY DECLARATOR IS LARGER AND HAS MORE SUBSCRIPT
C EXPRESSIONS THAN THE ASSOCIATED DUMMY ARGUMENT ARRAY DECLARATOR.
C THE ASSOCIATED DUMMY ARGUMENT ARRAY DECLARATOR.
C
IVTNUM = 25
IF (ICZERO) 30250, 0250, 30250
0250 CONTINUE
IVCOMP = 0
IATN11(1,1) = 1
IATN11(2,1) = 10
IATN11(1,2) = 100
IATN11(2,2) = 1000
IATN11(1,3) = 10000
IVCOMP = FF322(IATN11)
IVCORR = 1111
40250 IF (IVCOMP - 1111) 20250, 10250, 20250
30250 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10250, 0261, 20250
10250 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0261
20250 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0261 CONTINUE
C
C **** FCVS PROGRAM 317 - TEST 026 ****
C
C USE AN ARRAY ELEMENT NAME AS AN ACTUAL ARGUMENT IN WHICH THE
C ASSOCIATED ACTUAL AND DUMMY ARRAY DECLARATORS ARE IDENTICAL. ALL
C ARRAY ELEMENTS OF THE ACTUAL ARRAY SHOULD BE PASSED TO THE
C DUMMY ARRAY OF THE EXTERNAL FUNCTION.
C
IVTNUM = 26
IF (ICZERO) 30260, 0260, 30260
0260 CONTINUE
RVCOMP = 0.0
RADN12(1) = 1.
RADN12(2) = 10.
RADN12(3) = 100.
RADN12(4) = 1000.
RVCOMP = FF323(RADN12(1))
RVCORR = 1111.
40260 IF (RVCOMP - 1110.5) 20260, 10260, 40261
40261 IF (RVCOMP - 1111.5) 10260, 10260, 20260
30260 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10260, 0271, 20260
10260 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0271
20260 IVFAIL = IVFAIL + 1
WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR
0271 CONTINUE
C
C **** FCVS PROGRAM 317 - TEST 027 ****
C
C USE AN ARRAY ELEMENT NAME AS AN ACTUAL ARGUMENT IN WHICH THE SIZE
C OF THE ACTUAL ARGUMENT ARRAY IS LARGER AND HAS FEWER SUBSCRIPT
C EXPRESSIONS THAN THE ASSOCIATED DUMMY ARGUMENT ARRAY. ONLY ACTUAL
C ARRAY ELEMENTS WITH SUBSCRIPT VALUES OF 5, 6, 7 AND 8 (OUT OF A
C POSSIBLE 10 ELEMENTS) SHOULD BE PASSED TO THE DUMMY ARRAY OF THE
C EXTERNAL FUNCTION.
C
IVTNUM = 27
IF (ICZERO) 30270, 0270, 30270
0270 CONTINUE
RVCOMP = 0.0
RACN11(4) = 1.
RACN11(5) = 10.
RACN11(6) = 100.
RACN11(7) = 1000.
RACN11(8) = 10000.
RACN11(9) = 100000.
RVCORR = 11110.
RVCOMP = FF323(RACN11(5))
40270 IF (RVCOMP - 11105.) 20270, 10270, 40271
40271 IF (RVCOMP - 11115.) 10270, 10270, 20270
30270 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10270, 0281, 20270
10270 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0281
20270 IVFAIL = IVFAIL + 1
WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR
0281 CONTINUE
C
C **** FCVS PROGRAM 317 - TEST 028 ****
C
C USE AN ARRAY ELEMENT NAME AS AN ACTUAL ARGUMENT IN WHICH THE SIZE
C OF THE ACTUAL ARGUMENT ARRAY IS LARGE THAN THE SIZE OF THE
C ASSOCIATED DUMMY ARGUMENT ARRAY. ONLY ACTUAL ARRAY ELEMENTS WITH
C SUBSCRIPT VALUES OF 9, 10, 11 AND 12 (OUT OF A POSSIBLE 12
C ELEMENTS) SHOULD BE PASSED TO THE DUMMY ARRAY OF THE EXTERNAL
C FUNCTION.
C
IVTNUM = 28
IF (ICZERO) 30280, 0280, 30280
0280 CONTINUE
RVCOMP = 0.0
RATN11(2,3) = 1.
RATN11(3,3) = 10.
RATN11(1,4) = 100.
RATN11(2,4) = 1000.
RATN11(3,4) = 10000.
RVCOMP = FF323(RATN11(3,3))
RVCORR = 11110.
40280 IF (RVCOMP - 11105.) 20280, 10280, 40281
40281 IF (RVCOMP - 11115.) 10280, 10280, 20280
30280 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10280, 0291, 20280
10280 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0291
20280 IVFAIL = IVFAIL + 1
WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR
0291 CONTINUE
C
C TEST 029 THROUGH TEST 032 ARE DESIGNED TO ASSOCIATE VARIOUS FORMS
C OF ACTUAL ARGUMENTS TO PROCEDURES USED AS DUMMY ARGUMENTS.
C ACTUAL ARGUMENTS TESTED INCLUDE THE NAMES OF AN EXTERNAL FUNCTION,
C AN INTRINSIC FUNCTION, AND A SUBROUTINE.
C
C
C **** FCVS PROGRAM 317 - TEST 029 ****
C
C USE AN EXTERNAL FUNCTION NAME AS AN ACTUAL ARGUMENT.
C
IVTNUM = 29
IF (ICZERO) 30290, 0290, 30290
0290 CONTINUE
IVCOMP = 0
IVCOMP = FF324(FF325,5)
IVCORR = 7
40290 IF (IVCOMP - 7) 20290, 10290, 20290
30290 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10290, 0301, 20290
10290 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0301
20290 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0301 CONTINUE
C
C **** FCVS PROGRAM 317 - TEST 030 ****
C
C USE AN INTRINSIC FUNCTION NAME AS AN ACTUAL ARGUMENT.
C
IVTNUM = 30
IF (ICZERO) 30300, 0300, 30300
0300 CONTINUE
IVCOMP = 0
IVCOMP = FF324(IABS,-7)
IVCORR = 8
40300 IF (IVCOMP - 8) 20300, 10300, 20300
30300 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10300, 0311, 20300
10300 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0311
20300 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0311 CONTINUE
C
C **** FCVS PROGRAM 317 - TEST 031 ****
C
C USE AN EXTERNAL FUNCTION NAME AS AN ACTUAL ARGUMENT. THE
C INTRINSIC FUNCTION NAME (NINT) IS USED AS THE DUMMY PROCEDURE
C NAME IN THE EXTERNAL FUNCTION AND THEREFORE CAN NOT BE USED AS
C AN INTRINSIC FUNCTION WITHIN THAT PROGRAM UNIT. HOWEVER IT CAN
C BE REFERENCED IN THE MAIN PROGRAM FM317 AND IN THE SUBPROGRAM
C FF325.
C
IVTNUM = 31
IF (ICZERO) 30310, 0310, 30310
0310 CONTINUE
IVCOMP = 0
IVCOMP = NINT(3.7) + FF324(FF325,2)
IVCORR = 8
40310 IF (IVCOMP - 8) 20310, 10310, 20310
30310 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10310, 0321, 20310
10310 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0321
20310 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0321 CONTINUE
C
C **** FCVS PROGRAM 317 - TEST 032 ****
C
C USE A SUBROUTINE NAME AS AN ACTUAL ARGUMENT.
C
IVTNUM = 32
IF (ICZERO) 30320, 0320, 30320
0320 CONTINUE
RVCOMP = 0.0
RVON01 = 3.5
RVCOMP = FF326(FS327,RVON01)
RVCORR = 5.5
40320 IF (RVCOMP - 5.4995) 20320, 10320, 40321
40321 IF (RVCOMP - 5.5005) 10320, 10320, 20320
30320 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10320, 0331, 20320
10320 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0331
20320 IVFAIL = IVFAIL + 1
WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR
0331 CONTINUE
C
C
C WRITE OUT TEST SUMMARY
C
WRITE (I02,90004)
WRITE (I02,90014)
WRITE (I02,90004)
WRITE (I02,90000)
WRITE (I02,90004)
WRITE (I02,90020) IVFAIL
WRITE (I02,90022) IVPASS
WRITE (I02,90024) IVDELE
STOP
90001 FORMAT (1H ,24X,5HFM317)
90000 FORMAT (1H ,20X,20HEND OF PROGRAM FM317)
C
C FORMATS FOR TEST DETAIL LINES
C
80000 FORMAT (1H ,4X,I5,6X,7HDELETED)
80002 FORMAT (1H ,4X,I5,7X,4HPASS)
80010 FORMAT (1H ,4X,I5,7X,4HFAIL,10X,I6,9X,I6)
80012 FORMAT (1H ,4X,I5,7X,4HFAIL,4X,E12.5,3X,E12.5)
80018 FORMAT (1H ,4X,I5,7X,4HFAIL,2X,A14,1X,A14)
C
C FORMAT STATEMENTS FOR PAGE HEADERS
C
90002 FORMAT (1H1)
90004 FORMAT (1H )
90006 FORMAT (1H ,10X,34HFORTRAN COMPILER VALIDATION SYSTEM)
90008 FORMAT (1H ,21X,11HVERSION 1.0)
90010 FORMAT (1H ,8X,38HFOR OFFICIAL USE ONLY - COPYRIGHT 1978)
90012 FORMAT (1H ,5X,4HTEST,5X,9HPASS/FAIL,5X,8HCOMPUTED,8X,7HCORRECT)
90014 FORMAT (1H ,5X,46H----------------------------------------------)
90016 FORMAT (1H ,18X,17HSUBSET LEVEL TEST)
C
C FORMAT STATEMENTS FOR RUN SUMMARY
C
90020 FORMAT (1H ,19X,I5,13H TESTS FAILED)
90022 FORMAT (1H ,19X,I5,13H TESTS PASSED)
90024 FORMAT (1H ,19X,I5,14H TESTS DELETED)
END
*HEADER,FORTR,FM317,SUBRTN,FM318
INTEGER FUNCTION FF318(IDON01)
C THIS FUNCTION IS USED BY VARIOUS TESTS IN MAIN PROGRAM FM317
C TO TEST THE ASSOCIATION OF VARIOUS FORMS OF INTEGER ACTUAL
C ARGUMENTS TO AN INTEGER VARIABLE NAME USED AS AN EXTERNAL
C FUNCTION DUMMY ARGUMENT. THIS ROUTINE INCREMENTS THE ARGUMENT
C VALUE BY ONE AND RETURNS THE RESULT AS THE FUNCTION VALUE.
FF318 = IDON01 + 1
RETURN
END
*HEADER,FORTR,FM317,SUBRTN,FM319
REAL FUNCTION FF319(RDON01)
C THIS FUNCTION IS USED BY VARIOUS TESTS IN MAIN PROGRAM FM317
C TO TEST THE ASSOCIATION OF VARIOUS FORMS OF REAL ACTUAL
C ARGUMENTS TO A REAL VARIABLE NAME USED AS AN EXTERNAL FUNCTION
C DUMMY ARGUMENT. THIS ROUTINE INCREMENTS THE ARGUMENT VALUE BY
C ONE AND RETURNS THE RESULT AS THE FUNCTION VALUE.
FF319 = RDON01 + 1.0
RETURN
END
*HEADER,FORTR,FM317,SUBRTN,FM320
LOGICAL FUNCTION FF320(LDON01)
C THIS FUNCTION IS USED BY VARIOUS TESTS IN MAIN PROGRAM FM317
C TO TEST THE ASSOCIATION OF VARIOUS FORMS OF LOGICAL ACTUAL
C ARGUMENTS TO A LOGICAL VARIABLE NAME USED AS AN EXTERNAL
C FUNCTION DUMMY ARGUMENT. THIS ROUTINE NEGATES THE ARGUMENT
C VALUE AND RETURNS THE RESULT AS THE FUNCTION VALUE.
LOGICAL LDON01
FF320 = .NOT. LDON01
RETURN
END
*HEADER,FORTR,FM317,SUBRTN,FM321
INTEGER FUNCTION FF321(IDON02)
C THIS FUNCTION IS USED IN TEST 019 OF MAIN PROGRAM FM317 AS
C THE TEST OF THE USE OF AN EXTERNAL FUNCTION REFERENCE AS AN
C ACTUAL ARGUMENT TO A VARIABLE NAME USED AS AN EXTERNAL FUNCTION
C DUMMY ARGUMENT. THIS ROUTINE INCREMENTS THE ARGUMENT VALUE BY
C ONE AND RETURNS THE RESULT AS THE FUNCTION VALUE.
FF321 = IDON02 + 1
RETURN
END
*HEADER,FORTR,FM317,SUBRTN,FM322
INTEGER FUNCTION FF322(IDDN11)
C THIS FUNCTION IS USED BY VARIOUS TESTS IN MAIN PROGRAM FM317
C TO TEST THE ASSOCIATION OF VARIOUS FORMS OF ARRAY NAMES USED AS
C ACTUAL ARGUMENTS TO AN ARRAY NAME USED AS AN EXTERNAL FUNCTION
C DUMMY ARGUMENT. THIS ROUTINE ADDS TOGETHER THE FOUR ELEMENTS IN
C THE DUMMY ARRAY AND RETURNS THE SUM AS THE FUNCTION VALUE.
DIMENSION IDDN11(4)
FF322 = IDDN11(1) + IDDN11(2) + IDDN11(3) + IDDN11(4)
RETURN
END
*HEADER,FORTR,FM317,SUBRTN,FM323
REAL FUNCTION FF323(RDTN21)
C THIS FUNCTION IS USED BY VARIOUS TESTS IN MAIN PROGRAM FM317
C TO TEST THE ASSOCIATION OF VARIOUS FORMS OF ARRAY ELEMENT NAMES
C USED AS ACTUAL ARGUMENTS TO AN ARRAY NAME USED AS AN EXTERNAL
C FUNCTION DUMMY ARGUMENT. THIS ROUTINE ADDS TOGETHER THE FOUR
C ELEMENTS IN THE DUMMY ARRAY AND RETURNS THE SUM AS THE FUNCTION
C VALUE.
REAL RDTN21(2,2)
FF323 = RDTN21(1,1) + RDTN21(2,1) + RDTN21(1,2) + RDTN21(2,2)
RETURN
END
*HEADER,FORTR,FM317,SUBRTN,FM324
INTEGER FUNCTION FF324(NINT, IDON03)
C THIS FUNCTION IS USED BY TESTS 029, 030 AND 031 OF MAIN
C PROGRAM FM317 TO TEST THE ASSOCIATION OF EXTERNAL FUNCTION AND
C INTRINSIC FUNCTION NAMES USED AS ACTUAL ARGUMENTS TO A PROCEDURE
C NAME USED AS A DUMMY ARGUMENT. THIS FUNCTION REFERENCES THE
C EXTERNAL FUNCTION OR INTRINSIC FUNCTION PASSED AS A PROCEDURE
C NAME ARGUMENT, INCREMENTING THE RESULT BY ONE BEFORE RETURNING
C THE RESULT AS THE FUNCTION VALUE.
FF324 = NINT(IDON03) + 1
C **** THE NAME NINT IS A DUMMY ARGUMENT
C AND NOT AN INTRINSIC FUNCTION REFERENCE *****
RETURN
END
*HEADER,FORTR,FM317,SUBRTN,FM325
INTEGER FUNCTION FF325(IDON05)
C THIS FUNCTION IS USED BY TESTS 029 AND 031 OF MAIN PROGRAM
C FM317 TO TEST THE ASSOCIATION OF AN EXTERNAL FUNCTION NAME USED AS
C AN ACTUAL ARGUMENT TO A PROCEDURE NAME USED AS A DUMMY ARGUMENT.
C FF325 IS REFERENCED FROM EXTERNAL FUNCTION FF324 VIA A DUMMY
C PROCEDURE NAME REFERENCE. THIS ROUTINE ADDS THE RESULT OF AN
C INTRINSIC FUNCTION REFERENCE (NINT) TO THE ARGUMENT VALUE AND
C RETURNS THE SUM AS THE FUNCTION VALUE.
FF325 = IDON05 + NINT(1.2)
RETURN
END
*HEADER,FORTR,FM317,SUBRTN,FM326
REAL FUNCTION FF326(RDON02,RDON03)
C THIS FUNCTION IS USED BY TEST 032 OF MAIN PROGRAM FM317 TO
C TEST THE ASSOCIATION OF A SUBROUTINE NAME USED AS AN ACTUAL
C ARGUMENT TO A PROCEDURE NAME USED AS A DUMMY ARGUMENT. THIS
C FUNCTION CALLS THE SUBROUTINE (FS327) PASSED AS A PROCEDURE NAME
C ARGUMENT. THE VALUE OF THE ARGUMENT RETURNED FROM THIS
C REFERENCE IS THEN INCREMENTED BY ONE BEFORE RETURNING THE SUM AS
C THE FUNCTION VALUE.
CALL RDON02(RDON03)
FF326 = RDON03 + 1.0
RETURN
END
*HEADER,FORTR,FM317,SUBRTN,FM327
SUBROUTINE FS327(RDON04)
C THIS SUBROUTINE IS USED BY TEST 032 OF MAIN PROGRAM FM317 TO
C TEST THE ASSOCIATION OF A SUBROUTINE NAME USED AS AN ACTUAL
C ARGUMENT TO A PROCEDURE NAME USED AS A DUMMY ARGUMENT. FS327 IS
C CALLED FROM EXTERNAL PROGRAM FF326 VIA A DUMMY PROCEDURE NAME
C REFERENCE. THIS ROUTINE INCREMENTS THE ARGUMENT VALUE BY ONE.
RDON04 = RDON04 + 1.0
RETURN
END
*END-OF,FM317
FM328.f 481036231 170 2 100666 27836 `
*HEADER,FORTR,FM328
*FILES1,FORTR,FM328
PROGRAM FM328
C
C
C THIS ROUTINE TEST SUBSET LEVEL FEATURES OF
C SUBROUTINE SUBPROGRAMS. TESTS ARE DESIGNED TO CHECK THE
C ASSOCIATION OF ALL PERMISSIBLE FORMS OF ACTUAL ARGUMENTS WITH
C VARIABLE, ARRAY AND PROCEDURE NAME DUMMY ARGUMENTS. THESE
C INCLUDE,
C
C 1) ACTUAL ARGUMENTS ASSOCIATED TO VARIABLE NAME DUMMY
C ARGUMENT INCLUDE,
C
C A) CONSTANT
C B) VARIABLE NAME
C C) ARRAY ELEMENT NAME
C D) EXPRESSION INVOLVING OPERATORS
C E) EXPRESSION ENCLOSED IN PARENTHESES
C F) INTRINSIC FUNCTION REFERENCE
C G) EXTERNAL FUNCTION REFERENCE
C H) STATEMENT FUNCTION REFERENCE
C I) ACTUAL ARGUMENT NAME SAME AS DUMMY ARGUMENT NAME
C
C 2) ACTUAL ARGUMENTS ASSOCIATED TO ARRAY NAME DUMMY
C ARGUMENT INCLUDE,
C
C A) ARRAY NAME
C B) ARRAY ELEMENT NAME
C
C 3) ACTUAL ARGUMENTS ASSOCIATED TO PROCEDURE NAME DUMMY
C ARGUMENT INCLUDE,
C
C A) EXTERNAL FUNCTION NAME
C B) INTRINSIC FUNCTION NAME
C C) SUBROUTINE NAME
C
C ALL DATA PASSED TO THE REFERENCED SUBPROGRAMS ARE PASSED VIA
C ARGUMENT VALUES, WHILE ALL RESULTS RETURNED TO FM328 ARE
C RETURNED VIA VARIABLES IN NAMED COMMON. SUBSET LEVEL ROUTINES
C FM026, FM050 AND FM056 ALSO TEST THE USE OF SUBROUTINES.
C
C REFERENCES.
C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN,
C X3.9-1978
C
C SECTION 2.8, DUMMY ARGUMENTS
C SECTION 5.1.2.2, DUMMY ARRAY DECLARATOR
C SECTION 5.5, DUMMY AND ACTUAL ARRAYS
C SECTION 8.1, DIMENSION STATEMENT
C SECTION 8.3, COMMON STATEMENT
C SECTION 8.4, TYPE-STATEMENT
C SECTION 8.7, EXTERNAL STATEMENT
C SECTION 8.8, INTRINSIC STATEMENT
C SECTION 15.2, REFERENCING A FUNCTION
C SECTION 15.3, INTRINSIC FUNCTIONS
C SECTION 15.5, EXTERNAL FUNCTIONS
C SECTION 15.6, SUBROUTINES
C SECTION 15.9, ARGUMENTS AND COMMON BLOCKS
C
C
C ******************************************************************
C A COMPILER VALIDATION SYSTEM FOR THE FORTRAN LANGUAGE
C BASED ON SPECIFICATIONS AS DEFINED IN AMERICAN STANDARD FORTRAN
C X3.9-1978, HAS BEEN DEVELOPED BY THE DEPARTMENT OF THE NAVY. THE
C FORTRAN COMPILER VALIDATION SYSTEM (FCVS) CONSISTS OF AUDIT
C ROUTINES, THEIR RELATED DATA, AND AN EXECUTIVE SYSTEM. EACH AUDIT
C ROUTINE IS A FORTRAN PROGRAM OR SUBPROGRAM WHICH INCLUDES TESTS
C OF SPECIFIC LANGUAGE ELEMENTS AND SUPPORTING PROCEDURES INDICATING
C THE RESULT OF EXECUTING THESE TESTS.
C
C THIS PARTICULAR PROGRAM OR SUBPROGRAM CONTAINS ONLY FEATURES
C FOUND IN THE SUBSET LEVEL OF THE STANDARD.
C
C SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO
C DEPARTMENT OF THE NAVY
C FEDERAL COBOL COMPILER TESTING SERVICE
C WASHINGTON, D.C. 20376
C
C ******************************************************************
C
C
IMPLICIT LOGICAL (L)
IMPLICIT CHARACTER*14 (C)
C
INTEGER IATN11(2,3)
REAL RATN11(3,4)
INTEGER FF330
DIMENSION IADN11(4), IADN12(4)
DIMENSION RADN11(4), RADN12(4)
DIMENSION LADN11(4)
COMMON /BLK1/IVCN01, RVCN01, LVCN01
COMMON IACN11(6), RACN11(10)
EXTERNAL FF330, FS335
INTRINSIC ABS, IABS, NINT
IFOS01(IDON04) = IDON04 + 1
RFOS01(RDON04) = RDON04 + 1.0
LFOS01(LDON04) = .NOT. LDON04
C
C
C
C INITIALIZATION SECTION.
C
C INITIALIZE CONSTANTS
C ********************
C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER
I01 = 5
C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER
I02 = 6
C SYSTEM ENVIRONMENT SECTION
C
CX010 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-010 CONTROL CARD.
C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5
C (UNIT NUMBER FOR CARD READER).
CX011 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-011 CONTROL CARD
C THE CX011 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL
C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX010 ABOVE.
C
CX020 THIS CARD IS PEPLACED BY CONTENTS OF FEXEC X-020 CONTROL CARD.
C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02 = 6
C (UNIT NUMBER FOR PRINTER).
CX021 THIS CARD IS PEPLACED BY CONTENTS OF FEXEC X-021 CONTROL CARD.
C THE CX021 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL
C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX020 ABOVE.
C
IVPASS = 0
IVFAIL = 0
IVDELE = 0
ICZERO = 0
C
C WRITE OUT PAGE HEADERS
C
WRITE (I02,90002)
WRITE (I02,90006)
WRITE (I02,90008)
WRITE (I02,90004)
WRITE (I02,90010)
WRITE (I02,90004)
WRITE (I02,90016)
WRITE (I02,90001)
WRITE (I02,90004)
WRITE (I02,90012)
WRITE (I02,90014)
WRITE (I02,90004)
C
C
C TEST 001 THROUGH TEST 013 ARE DESIGNED TO ASSOCIATE VARIOUS FORMS
C OF ACTUAL ARGUMENTS TO VARIABLE NAMES USED AS SUBROUTINE
C DUMMY ARGUMENTS. INTEGER, REAL AND LOGICAL DUMMY ARGUMENTS ARE
C TESTED.
C
C
C **** FCVS PROGRAM 328 - TEST 001 ****
C
C USE INTEGER, REAL AND LOGICAL CONSTANTS AS ACTUAL ARGUMENTS.
C
IVTNUM = 1
IF (ICZERO) 30010, 0010, 30010
0010 CONTINUE
CALL FS329(3, 3.0, .FALSE.)
IVCOMP = 1
IF (IVCN01 .EQ. 4) IVCOMP = IVCOMP * 2
IF (RVCN01 .GE. 3.9995 .AND. RVCN01 .LE. 4.0005) IVCOMP = IVCOMP*3
IF (LVCN01) IVCOMP = IVCOMP * 5
IVCORR = 30
40010 IF (IVCOMP - 30) 20010, 10010, 20010
30010 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10010, 0021, 20010
10010 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0021
20010 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0021 CONTINUE
C
C **** FCVS PROGRAM 328 - TEST 002 ****
C
C USE INTEGER, REAL AND LOGICAL VARIABLES AS ACTUAL ARGUMENTS.
C
IVTNUM = 2
IF (ICZERO) 30020, 0020, 30020
0020 CONTINUE
IVON01 = 7
RVON01 = 7.0
LVON01 = .TRUE.
CALL FS329(IVON01, RVON01, LVON01)
IVCOMP = 1
IF (IVCN01 .EQ. 8) IVCOMP =IVCOMP * 2
IF (RVCN01 .GE. 7.9995 .AND. RVCN01 .LE. 8.0005) IVCOMP = IVCOMP*3
IF (.NOT. LVCN01) IVCOMP = IVCOMP * 5
IVCORR = 30
40020 IF (IVCOMP - 30) 20020, 10020, 20020
30020 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10020, 0031, 20020
10020 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0031
20020 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0031 CONTINUE
C
C **** FCVS PROGRAM 328 - TEST 003 ****
C
C USE INTEGER, REAL AND LOGICAL ARRAY ELEMENT NAMES AS ACTUAL
C ARGUMENTS.
C
IVTNUM = 3
IF (ICZERO) 30030, 0030, 30030
0030 CONTINUE
IADN11(2) = 2
RADN11(4) = 4.0
LADN11(1) = .FALSE.
CALL FS329(IADN11(2), RADN11(4), LADN11(1))
IVCOMP = 1
IF (IVCN01 .EQ. 3) IVCOMP = IVCOMP * 2
IF (RVCN01 .GE. 4.9995 .AND. RVCN01 .LE. 5.0005) IVCOMP = IVCOMP*3
IF (LVCN01) IVCOMP = IVCOMP * 5
IVCORR = 30
40030 IF (IVCOMP - 30) 20030, 10030, 20030
30030 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10030, 0041, 20030
10030 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0041
20030 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0041 CONTINUE
C
C **** FCVS PROGRAM 328 - TEST 004 ****
C
C INTEGER AND REAL EXPRESSIONS INVOLVING OPERATORS AS ACTUAL
C ARGUMENTS.
C
IVTNUM = 4
IF (ICZERO) 30040, 0040, 30040
0040 CONTINUE
IVON02 = 2
IVON03 = 3
RVON02 = 2.
RVON03 = 1.2
CALL FS329(IVON02 + 3 * IVON03 - 7, RVON02 *RVON03 / .6, .TRUE.)
IVCOMP = 1
IF (IVCN01 .EQ. 5) IVCOMP = IVCOMP * 2
IF (RVCN01 .GE. 4.9995 .AND. RVCN01 .LE. 5.0005) IVCOMP = IVCOMP*3
IVCORR = 6
40040 IF (IVCOMP - 6) 20040, 10040, 20040
30040 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10040, 0051, 20040
10040 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0051
20040 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0051 CONTINUE
C
C **** FCVS PROGRAM 328 - TEST 005 ****
C
C REAL EXPRESSION INVOLVING INTEGER AND REAL PRIMARIES AND OPERATORS
C AS ACTUAL ARGUMENT.
C
IVTNUM = 5
IF (ICZERO) 30050, 0050, 30050
0050 CONTINUE
RVCOMP = 0.0
IVON01 = 2
RADN11(2) = 2.5
CALL FS329(1, IVON01**3 * (RADN11(2) - 1) + 2.0, .TRUE.)
RVCOMP = RVCN01
RVCORR = 15.0
40050 IF (RVCOMP - 14.995) 20050, 10050, 40051
40051 IF (RVCOMP - 15.005) 10050, 10050, 20050
30050 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10050, 0061, 20050
10050 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0061
20050 IVFAIL = IVFAIL + 1
WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR
0061 CONTINUE
C
C **** FCVS PROGRAM 328 - TEST 006 ****
C
C LOGICAL EXPRESSION INVOLVING LOGICAL OPERATOR (.NOT.) AS ACTUAL
C ARGUMENT.
C
IVTNUM = 6
IF (ICZERO) 30060, 0060, 30060
0060 CONTINUE
LVON01 = .TRUE.
CALL FS329(1, 1.0, .NOT. LVON01)
IVCOMP = 0
IF (LVCN01) IVCOMP = 1
IVCORR = 1
40060 IF (IVCOMP - 1) 20060, 10060, 20060
30060 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10060, 0071, 20060
10060 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0071
20060 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0071 CONTINUE
C
C **** FCVS PROGRAM 328 - TEST 007 ****
C
C LOGICAL EXPRESSION INVOLVING LOGICAL OPERATOR (.OR.) AS ACTIVE
C ARGUMENT.
C
IVTNUM = 7
IF (ICZERO) 30070, 0070, 30070
0070 CONTINUE
LVON01 = .TRUE.
LVON02 = .FALSE.
CALL FS329(1, 1.0, LVON01 .OR. LVON02)
IVCOMP = 0
IF (.NOT. LVCN01) IVCOMP = 1
IVCORR = 1
40070 IF (IVCOMP - 1) 20070, 10070, 20070
30070 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10070, 0081, 20070
10070 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0081
20070 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0081 CONTINUE
C
C **** FCVS PROGRAM 328 - TEST 008 ****
C
C LOGICAL EXPRESSION INVOLVING LOGICAL OPERATOR (.AND.) AS ACTUAL
C ARGUMENT.
C
IVTNUM = 8
IF (ICZERO) 30080, 0080, 30080
0080 CONTINUE
LVON01 = .FALSE.
LVON02 = .TRUE.
CALL FS329(1, 1.0, LVON01 .AND. LVON02)
IVCOMP = 0
IF (LVCN01) IVCOMP = 1
IVCORR = 1
40080 IF (IVCOMP - 1) 20080, 10080, 20080
30080 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10080, 0091, 20080
10080 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0091
20080 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0091 CONTINUE
C
C **** FCVS PROGRAM 328 - TEST 009 ****
C
C EXPRESSION ENCLOSED IN PARENTHESES AS ACTUAL ARGUMENT.
C
IVTNUM = 9
IF (ICZERO) 30090, 0090, 30090
0090 CONTINUE
IVCOMP = 0
IVON01 = 6
CALL FS329((IVON01 + 3), 1.0, .TRUE.)
IVCOMP = IVCN01
IVCORR = 10
40090 IF (IVCOMP - 10) 20090, 10090, 20090
30090 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10090, 0101, 20090
10090 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0101
20090 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0101 CONTINUE
C
C **** FCVS PROGRAM 328 - TEST 010 ****
C
C INTEGER AND REAL INTRINSIC FUNCTION REFERENCES AS ACTUAL ARGUMENTS
C
IVTNUM = 10
IF (ICZERO) 30100, 0100, 30100
0100 CONTINUE
RVON01 = 4.7
RVON02 = -5.2
CALL FS329(NINT(RVON01), ABS(RVON02), .TRUE.)
IVCOMP = 1
IF (IVCN01 .EQ. 6) IVCOMP = IVCOMP * 2
IF (RVCN01 .GE. 6.1995 .AND. RVCN01 .LE. 6.2005) IVCOMP = IVCOMP*3
IVCORR = 6
40100 IF (IVCOMP - 6) 20100, 10100, 20100
30100 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10100, 0111, 20100
10100 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0111
20100 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0111 CONTINUE
C
C **** FCVS PROGRAM 328 - TEST 011 ****
C
C EXTERNAL FUNCTION REFERENCE AS ACTUAL ARGUMENT.
C
IVTNUM = 11
IF (ICZERO) 30110, 0110, 30110
0110 CONTINUE
IVCOMP = 0
IVON01 = 4
CALL FS329(FF330(IVON01), 1.0, .TRUE.)
IVCOMP = IVCN01
IVCORR = 6
40110 IF (IVCOMP - 6) 20110, 10110, 20110
30110 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10110, 0121, 20110
10110 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0121
20110 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0121 CONTINUE
C
C **** FCVS PROGRAM 328 - TEST 012 ****
C
C USE ACTUAL ARGUMENT NAMES WHICH ARE IDENTICAL TO THE DUMMY
C ARGUMENT NAMES.
C
IVTNUM = 12
IF (ICZERO) 30120, 0120, 30120
0120 CONTINUE
IDON01 = 10
RDON01 = 10.0
LDON01 = .FALSE.
CALL FS329(IDON01, RDON01, LDON01)
IVCOMP = 1
IF (IVCN01 .EQ. 11) IVCOMP = IVCOMP * 2
IF (RVCN01 .GE. 10.995 .AND. RVCN01 .LE. 11.005) IVCOMP = IVCOMP*3
IF (LVCN01) IVCOMP = IVCOMP * 5
IVCORR = 30
40120 IF (IVCOMP - 30) 20120, 10120, 20120
30120 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10120, 0131, 20120
10120 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0131
20120 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0131 CONTINUE
C
C **** FCVS PROGRAM 328 - TEST 013 ****
C
C USE INTEGER, REAL AND LOGICAL STATEMENT FUNCTION REFERENCES AS
C ARGUMENT NAMES.
C
IVTNUM = 13
IF (ICZERO) 30130, 0130, 30130
0130 CONTINUE
RVON01 = 5.0
CALL FS329(IFOS01(4), RFOS01(RVON01), LFOS01(.TRUE.))
IVCOMP = 1
IF (IVCN01 .EQ. 6) IVCOMP = IVCOMP * 2
IF (RVCN01 .GE. 6.9995 .AND. RVCN01 .LE. 7.0005) IVCOMP = IVCOMP*3
IF (LVCN01) IVCOMP = IVCOMP * 5
IVCORR = 30
40130 IF (IVCOMP - 30) 20130, 10130, 20130
30130 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10130, 0141, 20130
10130 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0141
20130 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0141 CONTINUE
C
C TEST 014 THROUGH TEST 019 ARE DESIGNED TO ASSOCIATE VARIOUS FORMS
C OF ACTUAL ARGUMENTS TO ARRAY NAMES USED AS SUBROUTINE DUMMY
C ARGUMENTS.
C
C
C **** FCVS PROGRAM 328 - TEST 014 ****
C
C USE AN ARRAY NAME AS AN ACTUAL ARGUMENT IN WHICH THE ACTUAL
C ARGUMENT ARRAY DECLARATOR IS IDENTICAL TO THE ASSOCIATED DUMMY
C ARGUMENT ARRAY DECLARATOR.
C
IVTNUM = 14
IF (ICZERO) 30140, 0140, 30140
0140 CONTINUE
IVCOMP = 0
IADN12(1) = 1
IADN12(2) = 10
IADN12(3) = 100
IADN12(4) = 1000
CALL FS331(IADN12)
IVCOMP = IVCN01
IVCORR = 1111
40140 IF (IVCOMP - 1111) 20140, 10140, 20140
30140 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10140, 0151, 20140
10140 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0151
20140 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0151 CONTINUE
C
C **** FCVS PROGRAM 328 - TEST 015 ****
C
C USE AN ARRAY NAME AS AN ACTUAL ARGUMENT IN WHICH THE SIZE OF THE
C ACTUAL ARGUMENT ARRAY IS LARGER THAN THE SIZE OF THE ASSOCIATED
C DUMMY ARGUMENT ARRAY.
C
IVTNUM = 15
IF (ICZERO) 30150, 0150, 30150
0150 CONTINUE
IVCOMP = 0
IACN11(1) = 1
IACN11(2) = 10
IACN11(3) = 100
IACN11(4) = 1000
IACN11(5) = 10000
CALL FS331(IACN11)
IVCOMP = IVCN01
IVCORR = 1111
40150 IF (IVCOMP - 1111) 20150, 10150, 20150
30150 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10150, 0161, 20150
10150 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0161
20150 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0161 CONTINUE
C
C **** FCVS PROGRAM 328 - TEST 016 ****
C
C USE AN ARRAY NAME AS AN ACTUAL ARGUMENT IN WHICH THE ACTUAL
C ARGUMENT ARRAY DECLARATOR IS LARGER AND HAS MORE SUBSCRIPT
C EXPRESSIONS THAN THE ASSOCIATED DUMMY ARGUMENT ARRAY DECLARATOR.
C
IVTNUM = 16
IF (ICZERO) 30160, 0160, 30160
0160 CONTINUE
IVCOMP = 0
IATN11(1,1) = 1
IATN11(2,1) = 10
IATN11(1,2) = 100
IATN11(2,2) = 1000
IATN11(1,3) = 10000
CALL FS331(IATN11)
IVCOMP = IVCN01
IVCORR = 1111
40160 IF (IVCOMP - 1111) 20160, 10160, 20160
30160 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10160, 0171, 20160
10160 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0171
20160 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0171 CONTINUE
C
C **** FCVS PROGRAM 328 - TEST 017 ****
C
C USE AN ARRAY ELEMENT NAME AS AN ACTUAL ARGUMENT IN WHICH THE
C ASSOCIATED ACTUAL AND DUMMY ARRAY DECLARATORS ARE IDENTICAL. ALL
C ARRAY ELEMENTS OF THE ACTUAL ARRAY SHOULD BE PASSED TO THE
C DUMMY ARRAY OF THE SUBROUTINE.
C
IVTNUM = 17
IF (ICZERO) 30170, 0170, 30170
0170 CONTINUE
RVCOMP = 0.0
RADN12(1) = 1.
RADN12(2) = 10.
RADN12(3) = 100.
RADN12(4) = 1000.
CALL FS332(RADN12(1))
RVCOMP = RVCN01
RVCORR = 1111.
40170 IF (RVCOMP - 1110.5) 20170, 10170, 40171
40171 IF (RVCOMP - 1111.5) 10170, 10170, 20170
30170 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10170, 0181, 20170
10170 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0181
20170 IVFAIL = IVFAIL + 1
WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR
0181 CONTINUE
C
C **** FCVS PROGRAM 328 - TEST 018 ****
C
C USE AN ARRAY ELEMENT NAME AS AN ACTUAL ARGUMENT IN WHICH THE SIZE
C OF THE ACTUAL ARGUMENT ARRAY IS LARGER AND HAS FEWER SUBSCRIPT
C EXPRESSIONS THAN THE ASSOCIATED DUMMY ARRAY. ONLY ACTUAL ARRAY
C ELEMENTS WITH SUBSCRIPT VALUES OF 5, 6, 7 AND 8 ( OUT OF A
C POSSIBLE 10 ELEMENTS) SHOULD BE PASSED TO THE DUMMY ARRAY OF
C THE SUBROUTINE.
C
IVTNUM = 18
IF (ICZERO) 30180, 0180, 30180
0180 CONTINUE
RVCOMP = 0.0
RACN11(4) = 1.
RACN11(5) = 10.
RACN11(6) = 100.
RACN11(7) = 1000.
RACN11(8) = 10000.
RACN11(9) = 100000.
CALL FS332(RACN11(5))
RVCOMP = RVCN01
RVCORR = 11110.
40180 IF (RVCOMP - 11105.) 20180, 10180, 40181
40181 IF (RVCOMP - 11115.) 10180, 10180, 20180
30180 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10180, 0191, 20180
10180 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0191
20180 IVFAIL = IVFAIL + 1
WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR
0191 CONTINUE
C
C **** FCVS PROGRAM 328 - TEST 019 ****
C
C USE AN ARRAY ELEMENT NAME AS AN ACTUAL ARGUMENT IN WHICH THE SIZE
C OF THE ACTUAL ARGUMENT ARRAY IS LARGE THAN THE SIZE OF THE
C ASSOCIATED DUMMY ARGUMENT ARRAY. ONLY ACTUAL ARRAY ELEMENTS WITH
C SUBSCRIPT VALUES OF 9, 10, 11 AND 12 (OUT OF A POSSIBLE 12
C ELEMENTS) SHOULD BE PASSED TO THE DUMMY ARRAY OF THE SUBROUTINE.
C
IVTNUM = 19
IF (ICZERO) 30190, 0190, 30190
0190 CONTINUE
RVCOMP = 0.0
RATN11(2,3) = 1.
RATN11(3,3) = 10.
RATN11(1,4) = 100.
RATN11(2,4) = 1000.
RATN11(3,4) = 10000.
CALL FS332(RATN11(3,3))
RVCOMP = RVCN01
RVCORR = 11110.
40190 IF (RVCOMP - 11105.) 20190, 10190, 40191
40191 IF (RVCOMP - 11115.) 10190, 10190, 20190
30190 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10190, 0201, 20190
10190 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0201
20190 IVFAIL = IVFAIL + 1
WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR
0201 CONTINUE
C
C TEST 020 THROUGH TEST 022 ARE DESIGNED TO ASSOCIATE VARIOUS FORMS
C OF ACTUAL ARGUMENTS TO PROCEDURES USED AS SUBROUTINE DUMMY
C ARGUMENTS. ACTUAL ARGUMENTS TESTED INCLUDE THE NAMES OF AN
C EXTERNAL FUNCTION, AN INTRINSIC FUNCTION AND A SUBROUTINE.
C
C
C **** FCVS PROGRAM 328 - TEST 020 ****
C
C USE AN EXTERNAL FUNCTION NAME AS AN ACTUAL ARGUMENT.
C
IVTNUM = 20
IF (ICZERO) 30200, 0200, 30200
0200 CONTINUE
IVCOMP = 0
CALL FS333(FF330, 5)
IVCOMP = IVCN01
IVCORR = 7
40200 IF (IVCOMP - 7) 20200, 10200, 20200
30200 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10200, 0211, 20200
10200 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0211
20200 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0211 CONTINUE
C
C **** FCVS PROGRAM 328 - TEST 021 ****
C
C USE AN INTRINSIC FUNCTION NAME AS AN ACTUAL ARGUMENT.
C
IVTNUM = 21
IF (ICZERO) 30210, 0210, 30210
0210 CONTINUE
IVCOMP = 0
CALL FS333(IABS, -7)
IVCOMP = IVCN01
IVCORR = 8
40210 IF (IVCOMP - 8) 20210, 10210, 20210
30210 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10210, 0221, 20210
10210 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0221
20210 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0221 CONTINUE
C
C **** FCVS PROGRAM 328 - TEST 022 ****
C
C USE A SUBROUTINE NAME AS AN ACTUAL ARGUMENT.
C
IVTNUM = 22
IF (ICZERO) 30220, 0220, 30220
0220 CONTINUE
RVCOMP = 0.0
RVON01 = 3.5
CALL FS334(FS335, RVON01)
RVCOMP = RVCN01
RVCORR = 5.5
40220 IF (RVCOMP - 5.4995) 20220, 10220, 40221
40221 IF (RVCOMP - 5.5005) 10220, 10220, 20220
30220 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10220, 0231, 20220
10220 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0231
20220 IVFAIL = IVFAIL + 1
WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR
0231 CONTINUE
C
C
C WRITE OUT TEST SUMMARY
C
WRITE (I02,90004)
WRITE (I02,90014)
WRITE (I02,90004)
WRITE (I02,90000)
WRITE (I02,90004)
WRITE (I02,90020) IVFAIL
WRITE (I02,90022) IVPASS
WRITE (I02,90024) IVDELE
STOP
90001 FORMAT (1H ,24X,5HFM328)
90000 FORMAT (1H ,20X,20HEND OF PROGRAM FM328)
C
C FORMATS FOR TEST DETAIL LINES
C
80000 FORMAT (1H ,4X,I5,6X,7HDELETED)
80002 FORMAT (1H ,4X,I5,7X,4HPASS)
80010 FORMAT (1H ,4X,I5,7X,4HFAIL,10X,I6,9X,I6)
80012 FORMAT (1H ,4X,I5,7X,4HFAIL,4X,E12.5,3X,E12.5)
80018 FORMAT (1H ,4X,I5,7X,4HFAIL,2X,A14,1X,A14)
C
C FORMAT STATEMENTS FOR PAGE HEADERS
C
90002 FORMAT (1H1)
90004 FORMAT (1H )
90006 FORMAT (1H ,10X,34HFORTRAN COMPILER VALIDATION SYSTEM)
90008 FORMAT (1H ,21X,11HVERSION 1.0)
90010 FORMAT (1H ,8X,38HFOR OFFICIAL USE ONLY - COPYRIGHT 1978)
90012 FORMAT (1H ,5X,4HTEST,5X,9HPASS/FAIL,5X,8HCOMPUTED,8X,7HCORRECT)
90014 FORMAT (1H ,5X,46H----------------------------------------------)
90016 FORMAT (1H ,18X,17HSUBSET LEVEL TEST)
C
C FORMAT STATEMENTS FOR RUN SUMMARY
C
90020 FORMAT (1H ,19X,I5,13H TESTS FAILED)
90022 FORMAT (1H ,19X,I5,13H TESTS PASSED)
90024 FORMAT (1H ,19X,I5,14H TESTS DELETED)
END
*HEADER,FORTR,FM328,SUBRTN,FM329
SUBROUTINE FS329(IDON01, RDON01, LDON01)
C THIS SUBROUTINE IS USED BY VARIOUS TESTS IN THE MAIN PROGRAM
C FM328 TO TEST THE DIFFERENT FORMS OF INTEGER, REAL AND LOGICAL
C ACTUAL ARGUMENTS THAT CAN BE ASSOCIATED WITH INTEGER, REAL AND
C LOGICAL DUMMY ARGUMENTS. THIS ROUTINE INCREMENTS THE INTEGER
C AND REAL ARGUMENTS BY ONE AND NEGATES THE LOGICAL ARGUMENT. ALL
C RESULTS ARE THEN RETURNED TO FM328 VIA VARIABLES IN NAMED COMMON.
IMPLICIT LOGICAL (L)
COMMON /BLK1/ IVCN01, RVCN01, LVCN01
IVCN01 = IDON01 + 1
RVCN01 = RDON01 + 1.0
LVCN01 = .NOT. LDON01
RETURN
END
*HEADER,FORTR,FM328,SUBRTN,FM330
INTEGER FUNCTION FF330(IDON02)
C THIS FUNCTION IS USED BY TEST 011 OF THE MAIN PROGRAM FM328 TO
C TEST THE USE OF AN EXTERNAL FUNCTION REFERENCE AS AN ACTUAL
C ARGUMENT WHEN THE ASSOCIATED DUMMY ARGUMENT IS A VARIABLE NAME.
C THIS FUNCTION IS ALSO REFERENCED FROM SUBROUTINE FS333 VIA A
C DUMMY PROCEDURE NAME REFERENCE. THIS FUNCTION INCREMENTS THE
C ARGUMENT VALUE BY ONE AND RETURNS THE RESULT AS THE FUNCTION
C VALUE.
FF330 = IDON02 + 1
RETURN
END
*HEADER,FORTR,FM328,SUBRTN,FM331
SUBROUTINE FS331(IDDN11)
C THIS SUBROUTINE IS USED BY VARIOUS TESTS IN THE MAIN PROGRAM
C FM328 TO TEST THE USE OF AN ARRAY NAME AS AN ACTUAL ARGUMENT WHEN
C THE ASSOCIATED DUMMY ARGUMENT IS AN ARRAY NAME. THIS ROUTINE
C ADDS TOGETHER THE FOUR ELEMENTS IN THE DUMMY ARGUMENT ARRAY AND
C RETURNS THE RESULTS VIA A VARIABLE IN NAMED COMMON.
LOGICAL LVCN01
DIMENSION IDDN11(4)
COMMON /BLK1/IVCN01, RVCN01, LVCN01
IVCN01 = IDDN11(1) + IDDN11(2) + IDDN11(3) + IDDN11(4)
RETURN
END
*HEADER,FORTR,FM328,SUBRTN,FM332
SUBROUTINE FS332(RDTN21)
C THIS SUBROUTINE IS USED BY VARIOUS TESTS IN THE MAIN PROGRAM
C FM328 TO TEST THE USE OF AN ARRAY ELEMENT NAME AS AN ACTUAL
C ARGUMENT WHEN THE ASSOCIATED DUMMY ARGUMENT IS AN ARRAY NAME.
C THIS ROUTINE ADDS TOGETHER THE FOUR ELEMENTS IN THE DUMMY
C ARGUMENT ARRAY AND RETURNS THE RESULT VIA A VARIABLE IN NAMED
C COMMON.
IMPLICIT LOGICAL (L)
REAL RDTN21(2,2)
COMMON /BLK1/IVCN01, RVCN01, LVCN01
RVCN01 = RDTN21(1,1) + RDTN21(2,1) + RDTN21(1,2) + RDTN21(2,2)
RETURN
END
*HEADER,FORTR,FM328,SUBRTN,FM333
SUBROUTINE FS333(NINT, IDON03)
C THIS SUBROUTINE IS USED BY TESTS 020 AND 021 OF THE MAIN
C PROGRAM FM328 TO TEST THE USE OF EXTERNAL AND INTRINSIC FUNCTION
C NAMES AS ACTUAL ARGUMENTS WHEN THE ASSOCIATED DUMMY ARGUMENT IS A
C PROCEDURE NAME. THIS SUBROUTINE REFERENCES THE EXTERNAL FUNCTION
C FF330 OR THE INTRINSIC FUNCTION IABS DEPENDING ON THE ACTUAL
C ARGUMENT PASSED TO IT. THE RESULT OF THIS FUNCTION REFERENCE IS
C THEN INCREMENTED BY ONE AND THE RESULT IS RETURNED TO FS328 VIA
C A VARIABLE IN NAMED COMMON.
IMPLICIT LOGICAL (L)
COMMON /BLK1/IVCN01, RVCN01, LVCN01
IVCN01 = NINT(IDON03) + 1
C **** THE NAME NINT IS A DUMMY ARGUMENT NAME
C AND NOT AN INTRINSIC FUNCTION REFERENCE ****
RETURN
END
*HEADER,FORTR,FM328,SUBRTN,FM334
SUBROUTINE FS334(IDON06, RDON03)
C THIS SUBROUTINE IS USED BY TEST 022 OF THE MAIN PROGRAM
C FM328 TO TEST THE USE OF A SUBROUTINE NAME AS AN ACTUAL ARGUMENT
C WHEN THE ASSOCIATED DUMMY ARGUMENT IS A PROCEDURE NAME. THIS
C SUBROUTINE CALLS THE SUBROUTINE FS335 VIA A DUMMY PROCEDURE NAME
C REFERENCE. THE ARGUMENT VALUE WHICH IS RETURNED FROM THE FS335
C REFERENCE IS THEN INCREMENTED BY ONE AND RETURNED TO FM328 VIA
C A VARIABLE IN NAMED COMMON.
IMPLICIT LOGICAL (L)
COMMON /BLK1/IVCN01, RVCN01, LVCN01
CALL IDON06(RDON03)
RVCN01 = RDON03 + 1.0
RETURN
END
*HEADER,FORTR,FM328,SUBRTN,FM335
SUBROUTINE FS335(RDON04)
C THIS SUBROUITNE IS USED BY TEST 022 OF THE MAIN PROGRAM FM328
C TO TEST THE USE OF A SUBROUTINE NAME AS AN ACTUAL ARGUMENT WHEN
C THE ASSOCIATED DUMMY ARGUMENT IS A PROCEDURE NAME. FS335 IS
C CALLED FROM SUBROUTINE FS334 VIA A DUMMY PROCEDURE NAME REFERENCE.
C THIS ROUTINE INCREMENTS THE ARGUMENT VALUE BY ONE.
RDON04 = RDON04 + 1.0
RETURN
END
*END-OF,FM328
FM351.f 481036236 170 2 100666 27623 `
*HEADER,FORTR,FM351
*FILES1,FORTR,FM351,X
PROGRAM FM351
C
C
C THIS PROGRAM CONTAINS TESTS FOR COMPOUND ARITHMETIC
C EXPRESSIONS WHICH NECESSITATE THE APPLICATION OF THE RULES
C FOR ARITHMETIC OPERATOR PRECEDENCE. THESE TESTS INCLUDE ONES
C WHICH EXERCIZE THE
C
C (1) USE OF ALL ARITHMETIC OPERATOR TYPES IN THE SAME STATEMENT.
C (2) USE OF PARENTHESES TO OVERRIDE DEFAULT PRECEDENCES.
C (3) USE OF ALL CLASSES OF PRIMARY OPERANDS.
C (4) USE OF NESTED FUNCTION REFERENCES.
C (5) USE OF MIXED DATA TYPES.
C
C REFERENCES -
C
C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN, X3.9-1977
C
C SECTION 6.1 ARITHMETIC EXPRESSIONS
C SECTION 6.5 PRECEDENCE OF OPERATORS
C SECTION 6.6 EVALUATION OF EXPRESSIONS
C
C
C ******************************************************************
C A COMPILER VALIDATION SYSTEM FOR THE FORTRAN LANGUAGE
C BASED ON SPECIFICATIONS AS DEFINED IN AMERICAN STANDARD FORTRAN
C X3.9-1978, HAS BEEN DEVELOPED BY THE DEPARTMENT OF THE NAVY. THE
C FORTRAN COMPILER VALIDATION SYSTEM (FCVS) CONSISTS OF AUDIT
C ROUTINES, THEIR RELATED DATA, AND AN EXECUTIVE SYSTEM. EACH AUDIT
C ROUTINE IS A FORTRAN PROGRAM OR SUBPROGRAM WHICH INCLUDES TESTS
C OF SPECIFIC LANGUAGE ELEMENTS AND SUPPORTING PROCEDURES INDICATING
C THE RESULT OF EXECUTING THESE TESTS.
C
C THIS PARTICULAR PROGRAM OR SUBPROGRAM CONTAINS ONLY FEATURES
C FOUND IN THE SUBSET LEVEL OF THE STANDARD.
C
C SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO
C DEPARTMENT OF THE NAVY
C FEDERAL COBOL COMPILER TESTING SERVICE
C WASHINGTON, D.C. 20376
C
C ******************************************************************
C
C
IMPLICIT LOGICAL (L)
IMPLICIT CHARACTER*14 (C)
C
DIMENSION IADN11(5), RADN11(5)
IFOS01(IDON01,IDON02,IDON03) = IDON01 ** IDON02 ** IDON03
IFOS02(IDON04,IDON05) = IADN11(IDON04) / IADN11(IDON05)
IFOS04(IDON09,IDON10) = IADN11(IDON09) + IABS(IDON10)
IFOS03(IDON06,IDON07,IDON08) = IFOS04(IDON06,IDON07) * IDON08
RFOS01(RDON01,RDON02,RDON03) = RDON01 ** RDON02 ** RDON03
RFOS02(IDON11,IDON12) = RADN11(IDON11) / RADN11(IDON12)
RFOS04(IDON13,RDON10) = RADN11(IDON13) + ABS(RDON10)
RFOS03(RDON06,RDON07,RDON08) = RFOS04(INT(RDON06),RDON07) * RDON08
IFOS05(IDON14,IDON16) = RADN11(IDON14) + IABS(IDON16)
RFOS06(RDON17,IDON18,RDON19) = IFOS05(INT(RDON17),IDON18) * RDON19
C
C
C
C INITIALIZATION SECTION.
C
C INITIALIZE CONSTANTS
C ********************
C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER
I01 = 5
C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER
I02 = 6
C SYSTEM ENVIRONMENT SECTION
C
CX010 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-010 CONTROL CARD.
C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5
C (UNIT NUMBER FOR CARD READER).
CX011 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-011 CONTROL CARD
C THE CX011 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL
C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX010 ABOVE.
C
CX020 THIS CARD IS PEPLACED BY CONTENTS OF FEXEC X-020 CONTROL CARD.
C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02 = 6
C (UNIT NUMBER FOR PRINTER).
CX021 THIS CARD IS PEPLACED BY CONTENTS OF FEXEC X-021 CONTROL CARD.
C THE CX021 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL
C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX020 ABOVE.
C
IVPASS = 0
IVFAIL = 0
IVDELE = 0
ICZERO = 0
C
C WRITE OUT PAGE HEADERS
C
WRITE (I02,90002)
WRITE (I02,90006)
WRITE (I02,90008)
WRITE (I02,90004)
WRITE (I02,90010)
WRITE (I02,90004)
WRITE (I02,90016)
WRITE (I02,90001)
WRITE (I02,90004)
WRITE (I02,90012)
WRITE (I02,90014)
WRITE (I02,90004)
C
C
C TESTS 1 THROUGH 10 DEAL ENTIRELY WITH INTEGER EXPRESSIONS.
C
C
C **** FCVS PROGRAM 351 - TEST 001 ****
C
C TEST 1 CHECKS AN INTEGER EXPRESSION WHERE ALL FIVE ARITHMETIC
C OPERATORS ARE USED AND ALL OPERAND PRIMARIES ARE SIMPLE INTEGER
C VARIABLES. NO PARENTHESES ARE USED TO UPSET DEFAULT PRECEDENCES.
C
IVTNUM = 1
IF (ICZERO) 30010, 0010, 30010
0010 CONTINUE
IVON01 = 7
IVON02 = 3
IVON03 = 573
IVON04 = 23
IVON05 = 3
IVON06 = -7
IVCOMP = IVON01 ** IVON02 + IVON03 - IVON04 * IVON05 / IVON06
IVCORR = 925
40010 IF (IVCOMP - 925) 20010, 10010, 20010
30010 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10010, 0021, 20010
10010 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0021
20010 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0021 CONTINUE
C
C **** FCVS PROGRAM 351 - TEST 002 ****
C
C TEST 2, LIKE TEST 1, CHECKS AN INTEGER EXPRESSION WHERE ALL
C FIVE ARITHMETIC OPERATORS ARE USED AND ALL OPERANDS ARE SIMPLE
C INTEGER VARIABLES; BUT IN THIS TEST, PARENTHESES ARE USED, AS IS
C A UNARY OPERATOR.
C
IVTNUM = 2
IF (ICZERO) 30020, 0020, 30020
0020 CONTINUE
IVON01 = 7
IVON02 = 3
IVON03 = 5
IVON04 = -3
IVON05 = 3
IVCOMP = -(IVON01 / IVON02) + (IVON03 * IVON04 ** IVON05)
IVCORR = -137
40020 IF (IVCOMP + 137) 20020, 10020, 20020
30020 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10020, 0031, 20020
10020 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0031
20020 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0031 CONTINUE
C
C **** FCVS PROGRAM 351 - TEST 003 ****
C
C TEST 3 IS SIMILAR TO TEST 2 EXCEPT THAT IT EMPLOYS NESTED
C PARENTHESES.
C
IVTNUM = 3
IF (ICZERO) 30030, 0030, 30030
0030 CONTINUE
IVON01 = 5
IVON02 = 3
IVON03 = 5
IVON04 = 17
IVON05 = 14
IVON06 = 3
IVCOMP = IVON01 ** (-(IVON02 + (IVON03 - IVON04)) - (IVON05 /
1 IVON06))
IVCORR = 3125
40030 IF (IVCOMP - 3125) 20030, 10030, 20030
30030 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10030, 0041, 20030
10030 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0041
20030 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0041 CONTINUE
C
C **** FCVS PROGRAM 351 - TEST 004 ****
C
C TEST 4 IS SIMILAR TO TEST 2 AND 3 EXCEPT THAT THE
C PARENTHESES USED ARE EFFECTIVELY EXTRANEOUS.
C
IVTNUM = 4
IF (ICZERO) 30040, 0040, 30040
0040 CONTINUE
IVON01 = 3
IVON02 = 4
IVON03 = 5
IVON04 = 2
IVON05 = 3
IVON06 = 4
IVCOMP = ((IVON01) ** (IVON02) + (IVON03) - (IVON04) *
1 (IVON05) / (IVON06))
IVCORR = 85
40040 IF (IVCOMP - 85) 20040, 10040, 20040
30040 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10040, 0051, 20040
10040 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0051
20040 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0051 CONTINUE
C
C **** FCVS PROGRAM 351 - TEST 005 ****
C
C TEST 5 CONTINUES THE TESTING OF EXPRESSIONS USING ONLY
C INTEGER VARIABLE OPERANDS CONNECTED BY ARITHMETIC OPERATORS,
C AND USING PARENTHESES TO OVERRIDE PRECEDENCES.
C
IVTNUM = 5
IF (ICZERO) 30050, 0050, 30050
0050 CONTINUE
IVON01 = 57
IVON02 = -3
IVON03 = 4
IVON04 = -1
IVON05 = -5
IVON06 = -2
IVCOMP = -IVON01 ** (IVON02 + IVON03 - IVON04) *
1 (IVON05 / IVON06)
IVCORR = -6498
40050 IF (IVCOMP + 6498) 20050, 10050, 20050
30050 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10050, 0061, 20050
10050 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0061
20050 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0061 CONTINUE
C
C **** FCVS PROGRAM 351 - TEST 006 ****
C
C TEST 6 CONTINUES THE TESTING OF EXPRESSIONS USING ONLY
C INTEGER VARIABLE OPERANDS CONNECTED BY ARITHMETIC OPERATORS,
C AND USING PARENTHESES TO OVERRIDE PRECEDENCES.
C
IVTNUM = 6
IF (ICZERO) 30060, 0060, 30060
0060 CONTINUE
IVON01 = 5
IVON02 = 3
IVON03 = 4
IVON04 = 5496
IVON05 = 7
IVON06 = -3
IVCOMP = ((IVON01 * (IVON02 / IVON03)) + IVON04) / IVON05 -
1 (-IVON06)
IVCORR = 782
40060 IF (IVCOMP - 782) 20060, 10060, 20060
30060 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10060, 0071, 20060
10060 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0071
20060 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0071 CONTINUE
C
C **** FCVS PROGRAM 351 - TEST 007 ****
C
C IN TEST 7, AN INTEGER EXPRESSION INVOLVING ALL FIVE
C ARITHMETIC OPERATORS TOGETHER WITH PARENTHESES IS EVALUATED,
C BUT UNLIKE TESTS 1 THROUGH 6 WHERE ALL OPERANDS WERE INTEGER
C VARIABLES, THE OPERANDS IN TEST 7 ARE CLASSED AS INTEGER
C VARIABLES, INTEGER CONSTANTS, INTEGER ARRAY ELEMENTS, AND INTEGER
C FUNCTION REFERENCES.
C
IVTNUM = 7
IF (ICZERO) 30070, 0070, 30070
0070 CONTINUE
IVON01 = 573
IVON02 = 1
IVON03 = 3
IVON04 = 2
IVON05 = 3
IADN11(3) = 3071
IVCOMP = (IVON01 + 1) - (5 + IADN11(IVON03)) /
1 (IFOS01(IVON03,IVON04,IVON05) ** IVON02)
IVCORR = 574
40070 IF (IVCOMP - 574) 20070, 10070, 20070
30070 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10070, 0081, 20070
10070 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0081
20070 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0081 CONTINUE
C
C **** FCVS PROGRAM 351 - TEST 008 ****
C
C TEST 8 IS IDENTICAL TO TEST 7 EXCEPT THAT PARENTHESES ARE
C USED TO CHANGE THE ORDER OF SUB-EXPRESSION EVALUATION.
C
IVTNUM = 8
IF (ICZERO) 30080, 0080, 30080
0080 CONTINUE
IVON01 = 573
IVON02 = 1
IVON03 = 3
IVON04 = 2
IVON05 = 3
IADN11(3) = 3071
IVCOMP = ((IVON01 + 1) - (5 + IADN11(IVON03))) /
1 IFOS01(IVON03,IVON04,IVON05) ** IVON02
IVCORR = 0
40080 IF (IVCOMP) 20080, 10080, 20080
30080 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10080, 0091, 20080
10080 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0091
20080 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0091 CONTINUE
C
C **** FCVS PROGRAM 351 - TEST 009 ****
C
C TEST 9 IS SIMILAR TO TESTS 7 AND 8 EXCEPT THAT THE
C FUNCTION REFERENCE IN TURN EVALUATES ARRAY ELEMENTS.
C
IVTNUM = 9
IF (ICZERO) 30090, 0090, 30090
0090 CONTINUE
IVON01 = 7
IVON02 = 3
IVON03 = 2
IVON04 = 1
IVON05 = 4
IADN11(1) = 5
IADN11(2) = 2
IADN11(4) = 2
IVCOMP = (IVON01 - 8 * IFOS02(IVON04,IVON03)) / IADN11(IVON05) +
1 13 ** IVON02
IVCORR = 2193
40090 IF (IVCOMP - 2193) 20090, 10090, 20090
30090 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10090, 0101, 20090
10090 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0101
20090 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0101 CONTINUE
C
C **** FCVS PROGRAM 351 - TEST 010 ****
C
C TEST 10 EVALUATES AN INTEGER EXPRESSION WHICH CONTAINS
C FUNCTION REFERENCES NESTED TO THREE LEVELS. THE OUTER TWO
C LEVELS ARE STATEMENT FUNCTION REFERENCES AND THE INNERMOST LEVEL
C IS AN INTRINSIC FUNCTION REFERENCE.
C
IVTNUM = 10
IF (ICZERO) 30100, 0100, 30100
0100 CONTINUE
IVON01 = -51
IVON02 = 4
IVON03 = -101
IVON04 = 13
IVON05 = 3
IVON06 = 5
IVON07 = -37
IADN11(4) = 87
IADN11(5) = 409
IVCOMP = (IVON01 + IFOS03(IVON02,IVON03,IVON04)) * IVON05 -
1 IFOS04(IVON06,IVON07)
IVCORR = 6733
40100 IF (IVCOMP - 6733) 20100, 10100, 20100
30100 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10100, 0111, 20100
10100 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0111
20100 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0111 CONTINUE
C
C TESTS 11 THROUGH 20 REPEAT TESTS 1 THROUGH 10 EXCEPT THAT
C TESTS 11 THROUGH 20 DEAL ENTIRELY WITH REAL ARITHMETIC
C EXPRESSIONS.
C
C
C **** FCVS PROGRAM 351 - TEST 011 ****
C
C TEST 11 TESTS A REAL EXPRESSION WHERE ALL FIVE ARITHMETIC
C OPERATORS ARE USED AND ALL OPERAND PRIMARIES ARE SIMPLE REAL
C VARIABLES.
C
IVTNUM = 11
IF (ICZERO) 30110, 0110, 30110
0110 CONTINUE
RVON01 = 3.2
RVON02 = 23.051
RVON03 = 1545 E7
RVON04 = -23.457
RVON05 = .02 E3
RVON06 = 7.210745323 E-10
RVCOMP = RVON01 ** RVON02 + RVON03 - RVON04 * RVON05 / RVON06
RVCORR = 1.10683 E12
40110 IF (RVCOMP - 1.1063 E12) 20110, 10110, 40111
40111 IF (RVCOMP - 1.1073 E12) 10110, 10110, 20110
30110 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10110, 0121, 20110
10110 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0121
20110 IVFAIL = IVFAIL + 1
WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR
0121 CONTINUE
C
C **** FCVS PROGRAM 351 - TEST 012 ****
C
C TEST 12, LIKE TEST 11, CHECKS A REAL EXPRESSION WHERE ALL
C FIVE ARITHMETIC OPERATORS ARE USED AND ALL OPERANDS ARE REAL
C VARIABLES, BUT IN TEST 12, PARENTHESES ARE USED, AS IS ALSO A
C UNARY OPERATOR.
C
IVTNUM = 12
IF (ICZERO) 30120, 0120, 30120
0120 CONTINUE
RVON01 = 3.2
RVON02 = 23.051
RVON03 = 1545 E-3
RVON04 = 5.75 E-1
RVON05 = 2.22 E+1
RVCOMP = -(RVON01 / RVON02) + (RVON03 * RVON04 ** RVON05)
RVCORR = -.13882
40120 IF (RVCOMP + .13887) 20120, 10120, 40121
40121 IF (RVCOMP + .13877) 10120, 10120, 20120
30120 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10120, 0131, 20120
10120 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0131
20120 IVFAIL = IVFAIL + 1
WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR
0131 CONTINUE
C
C **** FCVS PROGRAM 351 - TEST 013 ****
C
C TEST 13 IS SIMILAR TO TEST 12 EXCEPT THAT TEST 13 EMPLOYS
C NESTED PARENTHESES.
C
IVTNUM = 13
IF (ICZERO) 30130, 0130, 30130
0130 CONTINUE
RVON01 = 3.2
RVON02 = -63.051
RVON03 = 1545 E-3
RVON04 = 5.75 E-1
RVON05 = 2.22 E1
RVON06 = 0.523
RVCOMP = RVON01 ** (-(RVON02 + (RVON03 - RVON04)) -
1 (RVON05 / RVON06))
RVCORR = 8.27757 E9
40130 IF (RVCOMP - 8.2770 E9) 20130, 10130, 40131
40131 IF (RVCOMP - 8.2780 E9) 10130, 10130, 20130
30130 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10130, 0141, 20130
10130 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0141
20130 IVFAIL = IVFAIL + 1
WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR
0141 CONTINUE
C
C **** FCVS PROGRAM 351 - TEST 014 ****
C
C TEST 14 IS SIMILAR TO TESTS 12 AND 13 EXCEPT THAT THE
C PARENTHESES USED ARE EFFECTIVELY EXTRANEOUS.
C
IVTNUM = 14
IF (ICZERO) 30140, 0140, 30140
0140 CONTINUE
RVON01 = 5.4515 E18
RVON02 = .076923
RVON03 = 23 E-2
RVON04 = 7 E7
RVON05 = 45.23 E5
RVON06 = 5.65375 E12
RVCOMP = ((RVON01) ** (RVON02) + (RVON03) - (RVON04) * (RVON05) /
1 (RVON06))
RVCORR = -28.147
40140 IF (RVCOMP + 28.152) 20140, 10140, 40141
40141 IF (RVCOMP + 28.142) 10140, 10140, 20140
30140 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10140, 0151, 20140
10140 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0151
20140 IVFAIL = IVFAIL + 1
WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR
0151 CONTINUE
C
C **** FCVS PROGRAM 351 - TEST 015 ****
C
C TEST 15 CONTINUES THE TESTING OF EXPRESSIONS USING ONLY
C REAL VARIABLE OPERANDS CONNECTED BY ARITHMETIC OPERATORS, AND
C USING PARENTHESES TO OVERRIDE PRECEDENCES.
C
IVTNUM = 15
IF (ICZERO) 30150, 0150, 30150
0150 CONTINUE
RVON01 = .11341 E1
RVON02 = 7.1417
RVON03 = 5.2113 E1
RVON04 = 10.001
RVON05 = 7.241 E5
RVON06 = 5.7777 E-3
RVCOMP = -RVON01 ** (RVON02 + RVON03 - RVON04) * (RVON05 / RVON06)
RVCORR = -6.1635 E10
40150 IF (RVCOMP + 6.1640 E10) 20150, 10150, 40151
40151 IF (RVCOMP + 6.1630 E10) 10150, 10150, 20150
30150 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10150, 0161, 20150
10150 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0161
20150 IVFAIL = IVFAIL + 1
WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR
0161 CONTINUE
C
C **** FCVS PROGRAM 351 - TEST 016 ****
C
C TEST 16 CONTINUES THE TESTING OF EXPRESSIONS USING ONLY
C REAL VARIABLE OPERANDS CONNECTED BY ARITHMETIC OPERATORS, AND
C USING PARENTHESES TO OVERRIDE PRECEDENCES.
C
IVTNUM = 16
IF (ICZERO) 30160, 0160, 30160
0160 CONTINUE
RVON01 = 6.4003 E18
RVON02 = -3.7717 E-2
RVON03 = -5.1195 E3
RVON04 = 1.7521 E14
RVON05 = 1.0533 E3
RVON06 = -9.4207 E11
RVCOMP = ((RVON01 * (RVON02 / RVON03)) + RVON04) / RVON05 -
1 (-RVON06)
RVCORR = -7.3096 E11
40160 IF (RVCOMP + 7.3101 E11) 20160, 10160, 40161
40161 IF (RVCOMP + 7.3091 E11) 10160, 10160, 20160
30160 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10160, 0171, 20160
10160 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0171
20160 IVFAIL = IVFAIL + 1
WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR
0171 CONTINUE
C
C **** FCVS PROGRAM 351 - TEST 017 ****
C
C IN TEST 17, A REAL EXPRESSION INVOLVING ALL FIVE ARITHMETIC
C OPERATORS IS EVALUATED, BUT UNLIKE TESTS 11 THROUGH 16 WHERE
C ALL OPERANDS WERE REAL VARIABLES, THE OPERANDS IN TEST 17 ARE
C CLASSED AS REAL VARIABLES, REAL CONSTANTS, REAL ARRAY ELEMENTS,
C AND REAL FUNCTION REFERENCES.
C
IVTNUM = 17
IF (ICZERO) 30170, 0170, 30170
0170 CONTINUE
RVON01 = 5.247 E10
IVON01 = 3
RVON02 = 1.07 E1
RVON03 = 5.23
RVON04 = 1.001
RVON05 = 1.573
RADN11(3) = 0.3947 E18
RVCOMP = (RVON01 + 3.491 E10) - (4 E17 + RADN11(IVON01)) /
1 (RFOS01(RVON03,RVON04,RVON05) ** RVON02)
RVCORR = 7.1526 E10
40170 IF (RVCOMP - 7.1521 E10) 20170, 10170, 40171
40171 IF (RVCOMP - 7.1531 E10) 10170, 10170, 20170
30170 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10170, 0181, 20170
10170 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0181
20170 IVFAIL = IVFAIL + 1
WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR
0181 CONTINUE
C
C **** FCVS PROGRAM 351 - TEST 018 ****
C
C TEST 18 IS IDENTICAL TO TEST 17 EXCEPT THAT PARENTHESES ARE
C USED TO CHANGE THE ORDER OF SUB-EXPRESSION EVALUATION.
C
IVTNUM = 18
IF (ICZERO) 30180, 0180, 30180
0180 CONTINUE
RVON01 = 5.247 E10
IVON01 = 3
RVON02 = 1.07 E1
RVON03 = 5.23
RVON04 = 1.001
RVON05 = 1.573
RADN11(3) = 0.3947 E18
RVCOMP = ((RVON01 + 3.491 E10) - (4 E17 + RADN11(IVON01))) /
1 RFOS01(RVON03,RVON04,RVON05) ** RVON02
RVCORR = -1.5854 E10
40180 IF (RVCOMP + 1.5859 E10) 20180, 10180, 40181
40181 IF (RVCOMP + 1.5849 E10) 10180, 10180, 20180
30180 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10180, 0191, 20180
10180 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0191
20180 IVFAIL = IVFAIL + 1
WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR
0191 CONTINUE
C
C **** FCVS PROGRAM 351 - TEST 019 ****
C
C TEST 19 IS SIMILAR TO TESTS 17 AND 18 EXCEPT THAT THE
C FUNCTION REFERENCES IN TURN EVALUATE ARRAY ELEMENTS.
C
IVTNUM = 19
IF (ICZERO) 30190, 0190, 30190
0190 CONTINUE
RVON01 = 5.026 E2
RVON02 = 1.386 E1
IVON03 = 2
RVON04 = 1.9999
RVON05 = 4.0127
RADN11(1) = 3.004 E18
RADN11(2) = 2.5705 E-1
RADN11(4) = 7.993 E16
RVCOMP = (RVON01 - 5.902 * RFOS02(INT(RVON04),INT(RVON05))) /
1 RADN11(IVON03) + 1.5372 ** RVON02
RVCORR = 1.4797 E3
40190 IF (RVCORR - 1.4792 E3) 20190, 10190, 40191
40191 IF (RVCORR - 1.4802 E3) 10190, 10190, 20190
30190 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10190, 0201, 20190
10190 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0201
20190 IVFAIL = IVFAIL + 1
WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR
0201 CONTINUE
C
C **** FCVS PROGRAM 351 - TEST 020 ****
C
C TEST 20 EVALUATES A REAL EXPRESSION WHICH CONTAINS FUNCTION
C REFERENCES NESTED TO THREE LEVELS. THE OUTER TWO LEVELS ARE
C STATEMENT FUNCTION REFERENCES AND THE INNERMOST LEVEL IS AN
C INTRINSIC FUNCTION REFERENCE.
C
IVTNUM = 20
IF (ICZERO) 30200, 0200, 30200
0200 CONTINUE
RVON01 = 4.7117 E05
RVON02 = 5.987
RVON03 = 2.00000 E5
RVON04 = 1.0 E2
RVON05 = 1.5222 E9
IVON06 = 4
RVON07 = -3.2107 E14
RADN11(4) = 7.425 E14
RADN11(5) = -2.4015 E5
RVCOMP = (RVON01 + RFOS03(RVON02,RVON03,RVON04)) * RVON05 -
1 RFOS04(IVON06,RVON07)
RVCORR = -6.4580 E15
40200 IF (RVCOMP + 6.4585 E15) 20200, 10200, 40201
40201 IF (RVCOMP + 6.4575 E15) 10200, 10200, 20200
30200 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10200, 0211, 20200
10200 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0211
20200 IVFAIL = IVFAIL + 1
WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR
0211 CONTINUE
C
C TESTS 21 THROUGH 25 DEAL WITH MIXTURES OF REAL AND INTEGER
C EXPRESSIONS; I.E., THESE ARE TESTS WHICH EVALUATE EXPRESSIONS
C CONTAINING BOTH REAL SUB-EXPRESSIONS AND INTEGER SUB-EXPRESSIONS
C AND THEN ASSIGN THE RESULTS TO EITHER AN INTEGER OR A REAL
C VARIABLE.
C
C
C **** FCVS PROGRAM 351 - TEST 021 ****
C
C TEST 21 USES ALL FIVE ARITHMETIC OPERATORS AND A COMBINATION
C OF INTEGER AND REAL VARIABLES. NO PARENTHESES ARE USED. FINAL
C ASSIGNMENT IS TO AN INTEGER VARIABLE.
C
IVTNUM = 21
IF (ICZERO) 30210, 0210, 30210
0210 CONTINUE
IVON01 = 17
IVON02 = 3
RVON03 = 5.4732 E+2
RVON04 = 1.523
IVON05 = 798
IVCOMP = IVON01 ** IVON02 + RVON03 - RVON04 * IVON05 / IVON01
IVCORR = 5388
40210 IF (IVCOMP - 5388) 20210, 10210, 20210
30210 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10210, 0221, 20210
10210 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0221
20210 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0221 CONTINUE
C
C **** FCVS PROGRAM 351 - TEST 022 ****
C
C TEST 22 IS LIKE TEST 21 EXCEPT THAT PARENTHESES ARE USED,
C AS IS A UNARY OPERATOR. FINAL ASSIGNMENT IS TO A REAL VARIABLE.
C
IVTNUM = 22
IF (ICZERO) 30220, 0220, 30220
0220 CONTINUE
IVON01 = 798
IVON02 = 17
RVON03 = 9.34578 E-2
IVON04 = 15985
RVON05 = 0.72357
RVCOMP = -(IVON01 / IVON02) + (RVON03 * IVON04 ** RVON05)
RVCORR = 5.68717 E1
40220 IF (RVCOMP - 5.6866 E1) 20220, 10220, 40221
40221 IF (RVCOMP - 5.6876 E1) 10220, 10220, 20220
30220 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10220, 0231, 20220
10220 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0231
20220 IVFAIL = IVFAIL + 1
WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR
0231 CONTINUE
C
C **** FCVS PROGRAM 351 - TEST 023 ****
C
C TEST 23 IS SIMILAR TO TEST 22 EXCEPT THAT IT EMPLOYS NESTED
C PARENTHESES.
C
IVTNUM = 23
IF (ICZERO) 30230, 0230, 30230
0230 CONTINUE
IVON01 = 2
IVON02 = 183
RVON03 = 58.7025
IVON04 = 197
IVON05 = 87
RVON06 = 2.4611 E15
RVCOMP = IVON01 ** (-(IVON02 + (RVON03 - IVON04)) -
1 (IVON05 / RVON06))
RVCORR = 3.4931 E-14
40230 IF (RVCOMP - 3.4926 E-14) 20230, 10230, 40231
40231 IF (RVCOMP - 3.4936 E-14) 10230, 10230, 20230
30230 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10230, 0241, 20230
10230 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0241
20230 IVFAIL = IVFAIL + 1
WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR
0241 CONTINUE
C
C **** FCVS PROGRAM 351 - TEST 024 ****
C
C TEST 24 IS IDENTICAL TO TEST 23 EXCEPT THAT THE FINAL
C ASSIGNMENT IS TO AN INTEGER VARIABLE INSTEAD OF A REAL VARIABLE.
C
IVTNUM = 24
IF (ICZERO) 30240, 0240, 30240
0240 CONTINUE
IVON01 = 2
IVON02 = 183
RVON03 = 58.7025
IVON04 = 197
IVON05 = 87
RVON06 = 2.4611 E15
IVCOMP = IVON01 ** (-(IVON02 + (RVON03 - IVON04)) -
1 (IVON05 / RVON06))
IVCORR = 0
40240 IF (IVCOMP) 20240, 10240, 20240
30240 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10240, 0251, 20240
10240 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0251
20240 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0251 CONTINUE
C
C **** FCVS PROGRAM 351 - TEST 025 ****
C
C TEST 25 IS SIMILAR TO TESTS 9 AND 19 EXCEPT THAT A MIXTURE
C OF REAL AND INTEGER OPERANDS ARE USED, AND FINAL ASSIGNMENT IS
C TO A REAL VARIABLE.
C
IVTNUM = 25
IF (ICZERO) 30250, 0250, 30250
0250 CONTINUE
RVON01 = 4.7117
RVON02 = 5.998
IVON03 = 2
RVON04 = 1E2
IVON05 = 20
IVON06 = 4
IVON07 = -3
RADN11(4) = 7.425
RADN11(5) = -2.4015
RVCOMP = (RVON01 + RFOS06(AINT(RVON02),IVON03,RVON04)) * IVON05 -
1 IFOS05(IVON06,IVON07)
RVCORR = 84.234
40250 IF (RVCOMP - 84.229) 20250, 10250, 40251
40251 IF (RVCOMP - 84.239) 10250, 10250, 20250
30250 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10250, 0261, 20250
10250 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0261
20250 IVFAIL = IVFAIL + 1
WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR
0261 CONTINUE
C
C
C WRITE OUT TEST SUMMARY
C
WRITE (I02,90004)
WRITE (I02,90014)
WRITE (I02,90004)
WRITE (I02,90000)
WRITE (I02,90004)
WRITE (I02,90020) IVFAIL
WRITE (I02,90022) IVPASS
WRITE (I02,90024) IVDELE
STOP
90001 FORMAT (1H ,24X,5HFM351)
90000 FORMAT (1H ,20X,20HEND OF PROGRAM FM351)
C
C FORMATS FOR TEST DETAIL LINES
C
80000 FORMAT (1H ,4X,I5,6X,7HDELETED)
80002 FORMAT (1H ,4X,I5,7X,4HPASS)
80010 FORMAT (1H ,4X,I5,7X,4HFAIL,10X,I6,9X,I6)
80012 FORMAT (1H ,4X,I5,7X,4HFAIL,4X,E12.5,3X,E12.5)
80018 FORMAT (1H ,4X,I5,7X,4HFAIL,2X,A14,1X,A14)
C
C FORMAT STATEMENTS FOR PAGE HEADERS
C
90002 FORMAT (1H1)
90004 FORMAT (1H )
90006 FORMAT (1H ,10X,34HFORTRAN COMPILER VALIDATION SYSTEM)
90008 FORMAT (1H ,21X,11HVERSION 1.0)
90010 FORMAT (1H ,8X,38HFOR OFFICIAL USE ONLY - COPYRIGHT 1978)
90012 FORMAT (1H ,5X,4HTEST,5X,9HPASS/FAIL,5X,8HCOMPUTED,8X,7HCORRECT)
90014 FORMAT (1H ,5X,46H----------------------------------------------)
90016 FORMAT (1H ,18X,17HSUBSET LEVEL TEST)
C
C FORMAT STATEMENTS FOR RUN SUMMARY
C
90020 FORMAT (1H ,19X,I5,13H TESTS FAILED)
90022 FORMAT (1H ,19X,I5,13H TESTS PASSED)
90024 FORMAT (1H ,19X,I5,14H TESTS DELETED)
END
*END-OF,FM351
FM352.f 481036241 170 2 100666 26448 `
*HEADER,FORTR,FM352
*FILES1,FORTR,FM352,X
PROGRAM FM352
C
C
C THIS PROGRAM CHECKS BASIC RELATIONAL EXPRESSIONS INVOLVING
C OPERANDS OF REAL DATA TYPE. IN EACH TEST, NOT ONLY THE RELATIONAL
C EXPRESSION IS TESTED, BUT THE TRICHOTOMY LAW OF MATHEMATICAL
C RELATIONSHIPS IS ALSO TESTED (E.G., IF A .LT. B, THEN A CAN NOT
C BE .GT. THAN B, AND A CAN NOT BE .EQ. B). A TEST VARIABLE
C (IVCOMP) IS USED TO REPORT THE RESULT OF THE TEST AS FOLLOWS,
C IVCOMP = 0 IF BOTH THE TESTED RELATIONAL OPERATOR AND THE
C TRICHOTOMY TEST PASS.
C IVCOMP = 1 IF THE RELATIONAL TEST FAILS AND THE TRICHOTOMY
C TEST PASSES (WHICH WOULD INDICATE THAT A TESTED
C NOT .LT., .GT., OR .EQ. B).
C IVCOMP = 2 IF THE RELATIONAL TEST PASSES AND THE TRICHOTOMY
C TEST FAILS (WHICH WOULD INDICATE THAT A TESTED
C .LT., .GT., AND .EQ. B).
C IVCOMP = 3 IF BOTH THE RELATIONAL TEST AND THE TRICHOTOMY
C TEST FAIL (WHICH WOULD INDICATE THE RELATIONAL
C EXPRESSION TESTED OPPOSITE TO THAT EXPECTED
C (E.G., WHERE A WAS SUPPOSED TO BE .LT. B, IN
C FACT A .LT. B WAS FOUND TO BE FALSE AND A .GE. B
C WAS FOUND TO BE TRUE).
C
C
C REFERENCES -
C
C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN, X3.9-1977
C SECTION 4.4, REAL TYPE
C SECTION 6.3, RELATIONAL EXPRESSIONS
C SECTION 6.5, PRECEDENCE OF OPERATORS
C SECTION 6.6, EVALUATION OF EXPRESSIONS
C
C
C ******************************************************************
C A COMPILER VALIDATION SYSTEM FOR THE FORTRAN LANGUAGE
C BASED ON SPECIFICATIONS AS DEFINED IN AMERICAN STANDARD FORTRAN
C X3.9-1978, HAS BEEN DEVELOPED BY THE DEPARTMENT OF THE NAVY. THE
C FORTRAN COMPILER VALIDATION SYSTEM (FCVS) CONSISTS OF AUDIT
C ROUTINES, THEIR RELATED DATA, AND AN EXECUTIVE SYSTEM. EACH AUDIT
C ROUTINE IS A FORTRAN PROGRAM OR SUBPROGRAM WHICH INCLUDES TESTS
C OF SPECIFIC LANGUAGE ELEMENTS AND SUPPORTING PROCEDURES INDICATING
C THE RESULT OF EXECUTING THESE TESTS.
C
C THIS PARTICULAR PROGRAM OR SUBPROGRAM CONTAINS ONLY FEATURES
C FOUND IN THE SUBSET LEVEL OF THE STANDARD.
C
C SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO
C DEPARTMENT OF THE NAVY
C FEDERAL COBOL COMPILER TESTING SERVICE
C WASHINGTON, D.C. 20376
C
C ******************************************************************
C
C
IMPLICIT LOGICAL (L)
IMPLICIT CHARACTER*14 (C)
C
DIMENSION RADN11(2)
RFOS01(RDON01,RDON02) = RDON01 + RDON02
C
C
C
C INITIALIZATION SECTION.
C
C INITIALIZE CONSTANTS
C ********************
C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER
I01 = 5
C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER
I02 = 6
C SYSTEM ENVIRONMENT SECTION
C
CX010 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-010 CONTROL CARD.
C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5
C (UNIT NUMBER FOR CARD READER).
CX011 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-011 CONTROL CARD
C THE CX011 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL
C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX010 ABOVE.
C
CX020 THIS CARD IS PEPLACED BY CONTENTS OF FEXEC X-020 CONTROL CARD.
C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02 = 6
C (UNIT NUMBER FOR PRINTER).
CX021 THIS CARD IS PEPLACED BY CONTENTS OF FEXEC X-021 CONTROL CARD.
C THE CX021 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL
C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX020 ABOVE.
C
IVPASS = 0
IVFAIL = 0
IVDELE = 0
ICZERO = 0
C
C WRITE OUT PAGE HEADERS
C
WRITE (I02,90002)
WRITE (I02,90006)
WRITE (I02,90008)
WRITE (I02,90004)
WRITE (I02,90010)
WRITE (I02,90004)
WRITE (I02,90016)
WRITE (I02,90001)
WRITE (I02,90004)
WRITE (I02,90012)
WRITE (I02,90014)
WRITE (I02,90004)
C
C
C TESTS 1 THROUGH 13 CHECK BASIC RELATIONAL EXPRESSIONS USING
C ONLY REAL VARIABLE OPERANDS. ALL THE VARIABLES ARE ASSIGNED REAL
C CONSTANTS WITH EXPONENTIAL FORMAT.
C
C
C **** FCVS PROGRAM 352 - TEST 001 ****
C
C TEST 1 CHECKS THE .LT. OPERATOR USING TWO REAL OPERANDS
C WHERE THE MANTISSAS ARE EQUAL BUT THE EXPONENTS ARE DIFFERENT.
C
IVTNUM = 1
IF (ICZERO) 30010, 0010, 30010
0010 CONTINUE
RVON01 = 1.0001 E17
RVON02 = 1.0001 E18
IVCOMP = 0
IVCORR = 0
40010 IF(RVON01 .LT. RVON02) GO TO 40011
IVCOMP = 1
40011 IF (RVON01 .GE. RVON02) IVCOMP = IVCOMP + 2
IF (IVCOMP) 20010, 10010, 20010
30010 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10010, 0021, 20010
10010 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0021
20010 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0021 CONTINUE
C
C **** FCVS PROGRAM 352 - TEST 002 ****
C
C TEST 2 CHECKS THE .LT. OPERATOR USING TWO REAL OPERANDS
C WHERE THE EXPONENTS ARE EQUAL BUT THE MANTISSAS ARE DIFFERENT.
C
IVTNUM = 2
IF (ICZERO) 30020, 0020, 30020
0020 CONTINUE
RVON01 = 1.0001 E17
RVON02 = 1.9999 E17
IVCOMP = 0
IVCORR = 0
40020 IF (RVON01 .LT. RVON02) GO TO 40021
IVCOMP = 1
40021 IF (RVON01 .GE. RVON02) IVCOMP = IVCOMP + 2
IF (IVCOMP) 20020, 10020, 20020
30020 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10020, 0031, 20020
10020 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0031
20020 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0031 CONTINUE
C
C **** FCVS PROGRAM 352 - TEST 003 ****
C
C TEST 3 CHECKS THE .LE. OPERATOR USING TWO REAL OPERANDS
C WHERE THE MANTISSAS ARE EQUAL BUT THE EXPONENTS ARE DIFFERENT.
C
IVTNUM = 3
IF (ICZERO) 30030, 0030, 30030
0030 CONTINUE
RVON01 = 1.0001 E17
RVON02 = 1.0001 E18
IVCOMP = 0
IVCORR = 0
40030 IF (RVON01 .LE. RVON02) GO TO 40031
IVCOMP = 1
40031 IF (RVON01 .GT. RVON02) IVCOMP = IVCOMP + 2
IF (IVCOMP) 20030, 10030, 20030
30030 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10030, 0041, 20030
10030 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0041
20030 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0041 CONTINUE
C
C **** FCVS PROGRAM 352 - TEST 004 ****
C
C TEST 4 CHECKS THE .LE. OPERATOR USING TWO REAL OPERANDS
C WHERE THE EXPONENTS ARE EQUAL BUT THE MANTISSAS ARE DIFFERENT.
C
IVTNUM = 4
IF (ICZERO) 30040, 0040, 30040
0040 CONTINUE
RVON01 = 1.0001 E17
RVON02 = 1.9999 E17
IVCOMP = 0
IVCORR = 0
40040 IF (RVON01 .LE. RVON02) GO TO 40041
IVCOMP = 1
40041 IF (RVON01 .GT. RVON02) IVCOMP = IVCOMP + 2
IF (IVCOMP) 20040, 10040, 20040
30040 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10040, 0051, 20040
10040 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0051
20040 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0051 CONTINUE
C
C **** FCVS PROGRAM 352 - TEST 005 ****
C
C TEST 5 CHECKS THE .LE. OPERATOR USING TWO REAL OPERANDS
C WHICH HAVE BEEN ASSIGNED THE SAME REAL CONSTANT.
C
IVTNUM = 5
IF (ICZERO) 30050, 0050, 30050
0050 CONTINUE
RVON01 = 1.0001 E17
RVON02 = 1.0001 E17
IVCOMP = 0
IVCORR = 0
40050 IF (RVON01 .LE. RVON02) GO TO 40051
IVCOMP = 1
40051 IF (RVON01 .GT. RVON02) IVCOMP = IVCOMP + 2
IF (IVCOMP) 20050, 10050, 20050
30050 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10050, 0061, 20050
10050 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0061
20050 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0061 CONTINUE
C
C **** FCVS PROGRAM 352 - TEST 006 ****
C
C TEST 6 CHECKS THE .NE. OPERATOR USING TWO REAL OPERANDS
C WHERE THE MANTISSAS ARE EQUAL BUT THE EXPONENTS ARE DIFFERENT.
C
IVTNUM = 6
IF (ICZERO) 30060, 0060, 30060
0060 CONTINUE
RVON01 = 1.0001 E17
RVON02 = 1.0001 E18
IVCOMP = 0
IVCORR = 0
40060 IF (RVON01 .NE. RVON02) GO TO 40061
IVCOMP = 1
40061 IF (RVON01 .EQ. RVON02) IVCOMP = IVCOMP + 2
IF (IVCOMP) 20060, 10060, 20060
30060 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10060, 0071, 20060
10060 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0071
20060 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0071 CONTINUE
C
C **** FCVS PROGRAM 352 - TEST 007 ****
C
C TEST 7 CHECKS THE .NE. OPERATOR USING TWO REAL OPERANDS
C WHERE THE EXPONENTS ARE EQUAL BUT THE MANTISSAS ARE DIFFERENT.
C
IVTNUM = 7
IF (ICZERO) 30070, 0070, 30070
0070 CONTINUE
RVON01 = 1.0001 E17
RVON02 = 1.9999 E17
IVCOMP = 0
IVCORR = 0
40070 IF (RVON01 .NE. RVON02) GO TO 40071
IVCOMP = 1
40071 IF (RVON01 .EQ. RVON02) IVCOMP = IVCOMP + 2
IF (IVCOMP) 20070, 10070, 20070
30070 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10070, 0081, 20070
10070 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0081
20070 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0081 CONTINUE
C
C **** FCVS PROGRAM 352 - TEST 008 ****
C
C TEST 8 CHECKS THE .EQ. OPERATOR USING TWO REAL OPERANDS
C WHICH HAVE BEEN ASSIGNED THE SAME REAL CONSTANT.
C
IVTNUM = 8
IF (ICZERO) 30080, 0080, 30080
0080 CONTINUE
RVON01 = 1.0001 E17
RVON02 = 1.0001 E17
IVCOMP = 0
IVCORR = 0
40080 IF (RVON01 .EQ. RVON02) GO TO 40081
IVCOMP = 1
40081 IF (RVON01 .NE. RVON02) IVCOMP = IVCOMP + 2
IF (IVCOMP) 20080, 10080, 20080
30080 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10080, 0091, 20080
10080 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0091
20080 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0091 CONTINUE
C
C **** FCVS PROGRAM 352 - TEST 009 ****
C
C TEST 9 CHECKS THE .GT. OPERATOR USING TWO REAL OPERANDS
C WHERE THE MANTISSAS ARE EQUAL BUT THE EXPONENTS ARE DIFFERENT.
C
IVTNUM = 9
IF (ICZERO) 30090, 0090, 30090
0090 CONTINUE
RVON01 = 1.0001 E18
RVON02 = 1.0001 E17
IVCOMP = 0
IVCORR = 0
40090 IF(RVON01 .GT. RVON02) GO TO 40091
IVCOMP = 1
40091 IF (RVON01 .LE. RVON02) IVCOMP = IVCOMP + 2
IF (IVCOMP) 20090, 10090, 20090
30090 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10090, 0101, 20090
10090 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0101
20090 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0101 CONTINUE
C
C **** FCVS PROGRAM 352 - TEST 010 ****
C
C TEST 10 CHECKS THE .GT. OPERATOR USING TWO REAL OPERANDS
C WHERE THE EXPONENTS ARE EQUAL BUT THE MANTISSAS ARE DIFFERENT.
C
IVTNUM = 10
IF (ICZERO) 30100, 0100, 30100
0100 CONTINUE
RVON01 = 1.9999 E17
RVON02 = 1.0001 E17
IVCOMP = 0
IVCORR = 0
40100 IF (RVON01 .GT. RVON02) GO TO 40101
IVCOMP = 1
40101 IF (RVON01 .LE. RVON02) IVCOMP = IVCOMP + 2
IF (IVCOMP) 20100, 10100, 20100
30100 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10100, 0111, 20100
10100 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0111
20100 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0111 CONTINUE
C
C **** FCVS PROGRAM 352 - TEST 011 ****
C
C TEST 11 CHECKS THE .GE. OPERATOR USING TWO REAL OPERANDS
C WHERE THE MANTISSAS ARE EQUAL BUT THE EXPONENTS ARE DIFFERENT.
C
IVTNUM = 11
IF (ICZERO) 30110, 0110, 30110
0110 CONTINUE
RVON01 = 1.0001 E18
RVON02 = 1.0001 E17
IVCOMP = 0
IVCORR = 0
40110 IF (RVON01 .GE. RVON02) GO TO 40111
IVCOMP = 1
40111 IF (RVON01 .LT. RVON02) IVCOMP = IVCOMP + 2
IF (IVCOMP) 20110, 10110, 20110
30110 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10110, 0121, 20110
10110 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0121
20110 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0121 CONTINUE
C
C **** FCVS PROGRAM 352 - TEST 012 ****
C
C TEST 12 CHECKS THE .GE. OPERATOR USING TWO REAL OPERANDS
C WHERE THE EXPONENTS ARE EQUAL BUT THE MANTISSAS ARE DIFFERENT.
C
IVTNUM = 12
IF (ICZERO) 30120, 0120, 30120
0120 CONTINUE
RVON01 = 1.9999 E17
RVON02 = 1.0001 E17
IVCOMP = 0
IVCORR = 0
40120 IF (RVON01 .GE. RVON02) GO TO 40121
IVCOMP = 1
40121 IF (RVON01 .LT. RVON02) IVCOMP = IVCOMP + 2
IF (IVCOMP) 20120, 10120, 20120
30120 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10120, 0131, 20120
10120 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0131
20120 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0131 CONTINUE
C
C **** FCVS PROGRAM 352 - TEST 013 ****
C
C TEST 13 CHECKS THE .GE. OPERATOR USING TWO REAL OPERANDS
C WHERE EACH HAS BEEN ASSIGNED THE SAME REAL CONSTANT.
C
IVTNUM = 13
IF (ICZERO) 30130, 0130, 30130
0130 CONTINUE
RVON01 = 1.0001 E17
RVON02 = 1.0001 E17
IVCOMP = 0
IVCORR = 0
40130 IF (RVON01 .GE. RVON02) GO TO 40131
IVCOMP = 1
40131 IF (RVON01 .LT. RVON02) IVCOMP = IVCOMP + 2
IF (IVCOMP) 20130, 10130, 20130
30130 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10130, 0141, 20130
10130 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0141
20130 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0141 CONTINUE
C
C TESTS 14 THROUGH 28 REPETITIVELY CHECK THE .LT. RELATIONSHIP
C USING ALL TYPES AND ORDERINGS OF TWO REAL OPERANDS.
C
C
C TESTS 14 THROUGH 16 CHECK REAL-VARIABLE .LT OTHER-REAL-TYPES.
C
C
C **** FCVS PROGRAM 352 - TEST 014 ****
C
C TEST 14 CHECKS REAL-VARIABLE .LT. REAL-CONSTANT
C
IVTNUM = 14
IF (ICZERO) 30140, 0140, 30140
0140 CONTINUE
RVON01 = 1.0001 E17
IVCOMP = 0
IVCORR = 0
40140 IF (RVON01 .LT. 1.9999 E17) GO TO 40141
IVCOMP = 1
40141 IF (RVON01 .GE. 1.9999 E17) IVCOMP = IVCOMP + 2
IF (IVCOMP) 20140, 10140, 20140
30140 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10140, 0151, 20140
10140 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0151
20140 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0151 CONTINUE
C
C **** FCVS PROGRAM 352 - TEST 015 ****
C
C TEST 15 CHECKS REAL-VARIABLE .LT. ARRAY-ELEMENT
C
IVTNUM = 15
IF (ICZERO) 30150, 0150, 30150
0150 CONTINUE
RADN11(1) = 1.9999 E17
RVON01 = 1.0001 E17
IVCOMP = 0
IVCORR = 0
40150 IF (RVON01 .LT. RADN11(1)) GO TO 40151
IVCOMP = 1
40151 IF (RVON01 .GE. RADN11(1)) IVCOMP = IVCOMP + 2
IF (IVCOMP) 20150, 10150, 20150
30150 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10150, 0161, 20150
10150 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0161
20150 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0161 CONTINUE
C
C **** FCVS PROGRAM 352 - TEST 016 ****
C
C TEST 16 CHECKS REAL-VARIABLE .LT. FUNCTION-REFERENCE
C
IVTNUM = 16
IF (ICZERO) 30160, 0160, 30160
0160 CONTINUE
RVON01 = 1.0001 E17
RVON02 = 1 E17
RVON03 = 0.9999 E17
IVCOMP = 0
IVCORR = 0
40160 IF (RVON01 .LT. RFOS01(RVON02,RVON03)) GO TO 40161
IVCOMP = 1
40161 IF (RVON01 .GE. RFOS01(RVON02,RVON03)) IVCOMP = IVCOMP + 2
IF (IVCOMP) 20160, 10160, 20160
30160 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10160, 0171, 20160
10160 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0171
20160 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0171 CONTINUE
C
C TESTS 17 THROUGH 20 CHECK REAL-CONSTANT .LT. OTHER-REAL-TYPES
C
C
C **** FCVS PROGRAM 352 - TEST 017 ****
C
C TEST 17 CHECKS REAL-CONSTANT .LT. REAL-CONSTANT
C
IVTNUM = 17
IF (ICZERO) 30170, 0170, 30170
0170 CONTINUE
IVCOMP = 0
IVCORR = 0
40170 IF (1.0001 E17 .LT. 1.9999 E17) GO TO 40171
IVCOMP = 1
40171 IF (1.0001 E17 .GE. 1.9999 E17) IVCOMP = IVCOMP + 2
IF (IVCOMP) 20170, 10170, 20170
30170 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10170, 0181, 20170
10170 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0181
20170 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0181 CONTINUE
C
C **** FCVS PROGRAM 352 - TEST 018 ****
C
C TEST 18 CHECKS REAL-CONSTANT .LT. REAL-ARRAY-ELEMENT
C
IVTNUM = 18
IF (ICZERO) 30180, 0180, 30180
0180 CONTINUE
RADN11(1) = 1.9999 E17
IVCOMP = 0
IVCORR = 0
40180 IF (1.0001 E17 .LT. RADN11(1)) GO TO 40181
IVCOMP = 1
40181 IF (1.0001 E17 .GE. RADN11(1)) IVCOMP = IVCOMP + 2
IF (IVCOMP) 20180, 10180, 20180
30180 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10180, 0191, 20180
10180 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0191
20180 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0191 CONTINUE
C
C **** FCVS PROGRAM 352 - TEST 019 ****
C
C TEST 19 CHECKS REAL-CONSTANT .LT. REAL-VARIABLE
C
IVTNUM = 19
IF (ICZERO) 30190, 0190, 30190
0190 CONTINUE
RVON01 = 1.9999 E17
IVCOMP = 0
IVCORR = 0
40190 IF (1.0001 E17 .LT. RVON01) GO TO 40191
IVCOMP = 1
40191 IF (1.0001 E17 .GE. RVON01) IVCOMP = IVCOMP + 2
IF (IVCOMP) 20190, 10190, 20190
30190 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10190, 0201, 20190
10190 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0201
20190 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0201 CONTINUE
C
C **** FCVS PROGRAM 352 - TEST 020 ****
C
C TEST 20 CHECKS REAL-CONSTANT .LT. REAL-FUNCTION-REFERENCE
C
IVTNUM = 20
IF (ICZERO) 30200, 0200, 30200
0200 CONTINUE
RVON01 = 1 E17
RVON02 = 0.9999 E17
IVCOMP = 0
IVCORR = 0
40200 IF (1.0001 E17 .LT. RFOS01(RVON01,RVON02)) GO TO 40201
IVCOMP = 1
40201 IF (1.0001 E17 .GE. RFOS01(RVON01,RVON02)) IVCOMP = IVCOMP + 2
IF (IVCOMP) 20200, 10200, 20200
30200 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10200, 0211, 20200
10200 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0211
20200 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0211 CONTINUE
C
C TESTS 21 THROUGH 24 CHECK REAL-ARRAY-ELEMENT .LT. OTHER-REALS
C
C
C **** FCVS PROGRAM 352 - TEST 021 ****
C
C TEST 21 CHECKS REAL-ARRAY-ELEMENT .LT. REAL-CONSTANT
C
IVTNUM = 21
IF (ICZERO) 30210, 0210, 30210
0210 CONTINUE
RADN11(1) = 1.0001 E17
IVCOMP = 0
IVCORR = 0
40210 IF (RADN11(1) .LT. 1.9999 E17) GO TO 40211
IVCOMP = 1
40211 IF (RADN11(1) .GE. 1.9999 E17) IVCOMP = IVCOMP + 2
IF (IVCOMP) 20210, 10210, 20210
30210 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10210, 0221, 20210
10210 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0221
20210 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0221 CONTINUE
C
C **** FCVS PROGRAM 352 - TEST 022 ****
C
C TEST 22 CHECKS REAL-ARRAY-ELEMENT .LT. REAL-ARRAY-ELEMENT
C
IVTNUM = 22
IF (ICZERO) 30220, 0220, 30220
0220 CONTINUE
RADN11(1) = 1.0001 E17
RADN11(2) = 1.9999 E17
IVCOMP = 0
IVCORR = 0
40220 IF (RADN11(1) .LT. RADN11(2)) GO TO 40221
IVCOMP = 1
40221 IF (RADN11(1) .GE. RADN11(2)) IVCOMP = IVCOMP + 2
IF (IVCOMP) 20220, 10220, 20220
30220 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10220, 0231, 20220
10220 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0231
20220 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0231 CONTINUE
C
C **** FCVS PROGRAM 352 - TEST 023 ****
C
C TEST 23 CHECKS REAL-ARRAY-ELEMENT .LT. REAL-VARIABLE
C
IVTNUM = 23
IF (ICZERO) 30230, 0230, 30230
0230 CONTINUE
RVON01 = 1.9999 E17
RADN11(1) = 1.0001 E17
IVCORR = 0
IVCOMP = 0
40230 IF (RADN11(1) .LT. RVON01) GO TO 40231
IVCOMP = 1
40231 IF (RADN11(1) .GE. RVON01) IVCOMP = IVCOMP + 2
IF (IVCOMP) 20230, 10230, 20230
30230 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10230, 0241, 20230
10230 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0241
20230 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0241 CONTINUE
C
C **** FCVS PROGRAM 352 - TEST 024 ****
C
C TEST 24 CHECKS REAL-ARRAY-ELEMENT .LT. REAL-FUNCTION-REF.
C
IVTNUM = 24
IF (ICZERO) 30240, 0240, 30240
0240 CONTINUE
RVON01 = 1.0000 E17
RVON02 = 0.9999 E17
RADN11(1) = 1.0001 E17
IVCORR = 0
IVCOMP = 0
40240 IF (RADN11(1) .LT. RFOS01(RVON01,RVON02)) GO TO 40241
IVCOMP = 1
40241 IF (RADN11(1) .GE. RFOS01(RVON01,RVON02)) IVCOMP = IVCOMP + 2
IF (IVCOMP) 20240, 10240, 20240
30240 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10240, 0251, 20240
10240 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0251
20240 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0251 CONTINUE
C
C TESTS 25 THROUGH 28 CHECK REAL-FUNCTION-REFERENCE .LT.
C OTHER-REAL-TYPES
C
C
C **** FCVS PROGRAM 352 - TEST 025 ****
C
C TEST 25 CHECKS REAL-FUNCTION-REFERENCE .LT. REAL-CONSTANT
C
IVTNUM = 25
IF (ICZERO) 30250, 0250, 30250
0250 CONTINUE
RVON01 = 1.0000 E17
RVON02 = 0.0001 E17
IVCOMP = 0
IVCORR = 0
40250 IF (RFOS01(RVON01,RVON02) .LT. 1.9999 E17) GO TO 40251
IVCOMP = 1
40251 IF (RFOS01(RVON01,RVON02) .GE. 1.9999 E17) IVCOMP = IVCOMP + 2
IF (IVCOMP) 20250, 10250, 20250
30250 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10250, 0261, 20250
10250 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0261
20250 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0261 CONTINUE
C
C **** FCVS PROGRAM 352 - TEST 026 ****
C
C TEST 26 CHECKS REAL-FUNCTION-REFERENCE .LT. REAL-ARRAY-ELEMNT
C
IVTNUM = 26
IF (ICZERO) 30260, 0260, 30260
0260 CONTINUE
RVON01 = 1 E17
RVON02 = 0.0001 E17
RADN11(1) = 1.9999 E17
IVCOMP = 0
IVCORR = 0
40260 IF (RFOS01(RVON01,RVON02) .LT. RADN11(1)) GO TO 40261
IVCOMP = 1
40261 IF (RFOS01(RVON01,RVON02) .GE. RADN11(1)) IVCOMP = IVCOMP + 2
IF (IVCOMP) 20260, 10260, 20260
30260 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10260, 0271, 20260
10260 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0271
20260 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0271 CONTINUE
C
C **** FCVS PROGRAM 352 - TEST 027 ****
C
C TEST 27 CHECKS REAL-FUNCTION-REFERENCE .LT. REAL-VARIABLE
C
IVTNUM = 27
IF (ICZERO) 30270, 0270, 30270
0270 CONTINUE
RVON01 = 1 E17
RVON02 = 0.0001 E17
RVON03 = 1.9999 E17
IVCOMP = 0
IVCORR = 0
40270 IF (RFOS01(RVON01,RVON02) .LT. RVON03) GO TO 40271
IVCOMP = 1
40271 IF (RFOS01(RVON01,RVON02) .GE. RVON03) IVCOMP = IVCOMP + 2
IF (IVCOMP) 20270, 10270, 20270
30270 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10270, 0281, 20270
10270 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0281
20270 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0281 CONTINUE
C
C **** FCVS PROGRAM 352 - TEST 028 ****
C
C TEST 28 CHECKS REAL-FUNCTION-REFERENCE .LT REAL-FUNCTION-REF.
C
IVTNUM = 28
IF (ICZERO) 30280, 0280, 30280
0280 CONTINUE
RVON01 = 1 E17
RVON02 = 0.0001 E17
RVON03 = 0.9999 E17
IVCOMP = 0
IVCORR = 0
40280 IF (RFOS01(RVON01,RVON02) .LT. RFOS01(RVON01,RVON03)) GO TO 40281
IVCOMP = 1
40281 IF (RFOS01(RVON01,RVON02) .GE. RFOS01(RVON01,RVON03))
1 IVCOMP = IVCOMP + 2
IF (IVCOMP) 20280, 10280, 20280
30280 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10280, 0291, 20280
10280 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0291
20280 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0291 CONTINUE
C
C
C WRITE OUT TEST SUMMARY
C
WRITE (I02,90004)
WRITE (I02,90014)
WRITE (I02,90004)
WRITE (I02,90000)
WRITE (I02,90004)
WRITE (I02,90020) IVFAIL
WRITE (I02,90022) IVPASS
WRITE (I02,90024) IVDELE
STOP
90001 FORMAT (1H ,24X,5HFM352)
90000 FORMAT (1H ,20X,20HEND OF PROGRAM FM352)
C
C FORMATS FOR TEST DETAIL LINES
C
80000 FORMAT (1H ,4X,I5,6X,7HDELETED)
80002 FORMAT (1H ,4X,I5,7X,4HPASS)
80010 FORMAT (1H ,4X,I5,7X,4HFAIL,10X,I6,9X,I6)
80012 FORMAT (1H ,4X,I5,7X,4HFAIL,4X,E12.5,3X,E12.5)
80018 FORMAT (1H ,4X,I5,7X,4HFAIL,2X,A14,1X,A14)
C
C FORMAT STATEMENTS FOR PAGE HEADERS
C
90002 FORMAT (1H1)
90004 FORMAT (1H )
90006 FORMAT (1H ,10X,34HFORTRAN COMPILER VALIDATION SYSTEM)
90008 FORMAT (1H ,21X,11HVERSION 1.0)
90010 FORMAT (1H ,8X,38HFOR OFFICIAL USE ONLY - COPYRIGHT 1978)
90012 FORMAT (1H ,5X,4HTEST,5X,9HPASS/FAIL,5X,8HCOMPUTED,8X,7HCORRECT)
90014 FORMAT (1H ,5X,46H----------------------------------------------)
90016 FORMAT (1H ,18X,17HSUBSET LEVEL TEST)
C
C FORMAT STATEMENTS FOR RUN SUMMARY
C
90020 FORMAT (1H ,19X,I5,13H TESTS FAILED)
90022 FORMAT (1H ,19X,I5,13H TESTS PASSED)
90024 FORMAT (1H ,19X,I5,14H TESTS DELETED)
END
*END-OF,FM352
FM353.f 481036245 170 2 100666 11947 `
*HEADER,FORTR,FM353
*FILES1,FORTR,FM353,X
C***********************************************************************
C***** FORTRAN 77
C***** FM353 XINT - (150)
C*****
C***********************************************************************
C***** GENERAL PURPOSE SUBSET REF
C***** TEST INTRINSIC FUNCTION - IFIX - (CONVERSION FROM 15.3
C***** REAL TO INTEGER) (TABLE 5)
C***** TEST INTRINSIC FUNCTION - INT - (TRUNCATION -- SIGN
C***** OF A * LARGEST INTEGER LE ABS(A) )
C*****
C*****
CBB** ********************** BBCCOMNT **********************************
C****
C**** 1978 FORTRAN COMPILER VALIDATION SYSTEM
C**** VERSION 2.0
C****
C****
C**** SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO
C**** GENERAL SERVICES ADMINISTRATION
C**** FEDERAL SOFTWARE TESTING CENTER
C**** 5203 LEESBURG PIKE, SUITE 1100
C**** FALLS CHURCH, VA. 22041
C****
C**** (703) 756-6153
C****
CBE** ********************** BBCCOMNT **********************************
CBB** ********************** BBCINITA **********************************
C**** SPECIFICATION STATEMENTS
C****
CHARACTER ZVERS*13, ZVERSD*17, ZDATE*17, ZPROG*5, ZCOMPL*20,
1 ZNAME*20, ZTAPE*10, ZPROJ*13, REMRKS*31, ZTAPED*13
CBE** ********************** BBCINITA **********************************
CBB** ********************** BBCINITB **********************************
C**** INITIALIZE SECTION
DATA ZVERS, ZVERSD, ZDATE
1 /'VERSION 2.0 ', '82/08/02*18.33.46', '*NO DATE*TIME'/
DATA ZCOMPL, ZNAME, ZTAPE
1 /'*NONE SPECIFIED*', '*NO COMPANY NAME*', '*NO TAPE*'/
DATA ZPROJ, ZTAPED, ZPROG
1 /'*NO PROJECT*', '*NO TAPE DATE', 'XXXXX'/
DATA REMRKS /' '/
C**** THE FOLLOWING 9 COMMENT LINES (CZ01, CZ02, ...) CAN BE REPLACED
C**** FOR IDENTIFYING THE TEST ENVIRONMENT
C****
CZ01 ZVERS = 'VERSION OF THE COMPILER VALIDATION SYSTEM'
CZ02 ZVERSD = 'CREATION DATE/TIME OF THE COMPILER VALIDATION SYSTEM'
CZ03 ZPROG = 'PROGRAM NAME'
CZ04 ZDATE = 'DATE OF TEST'
CZ05 ZCOMPL = 'COMPILER IDENTIFICATION'
CZ06 ZPROJ = 'PROJECT NUMBER/IDENTIFICATION'
CZ07 ZNAME = 'NAME OF USER'
CZ08 ZTAPE = 'TAPE OWNER/ID'
CZ09 ZTAPED = 'DATE TAPE COPIED'
C
IVPASS = 0
IVFAIL = 0
IVDELE = 0
IVINSP = 0
IVTOTL = 0
IVTOTN = 0
ICZERO = 0
C
C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER.
I01 = 05
C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER.
I02 = 06
C
CX010 REPLACED BY FEXEC X-010 CONTROL CARD (CARD-READER UNIT NUMBER).
C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5
CX011 REPLACED BY FEXEC X-011 CONTROL CARD. CX011 IS FOR SYSTEMS
C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX010.
C
CX020 REPLACED BY FEXEC X-020 CONTROL CARD (PRINTER UNIT NUMBER).
C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02= 6
CX021 REPLACED BY FEXEC X-021 CONTROL CARD. CX021 IS FOR SYSTEMS
C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX020.
C
CBE** ********************** BBCINITB **********************************
NUVI = I02
IVTOTL = 14
ZPROG='FM353'
CBB** ********************** BBCHED0A **********************************
C****
C**** WRITE REPORT TITLE
C****
WRITE (I02, 90002)
WRITE (I02, 90006)
WRITE (I02, 90007)
WRITE (I02, 90008) ZVERS, ZVERSD
WRITE (I02, 90009) ZPROG, ZPROG
WRITE (I02, 90010) ZDATE, ZCOMPL
CBE** ********************** BBCHED0A **********************************
C*****
C***** HEADER FOR SEGMENT 150
WRITE (NUVI,15001)
15001 FORMAT (1H ,/ 2X,34HXINT - (150) INTRINSIC FUNCTIONS-- /17X,
1 28H IFIX, INT (TYPE CONVERSION)/ 2X,
2 18HSUBSET REF. - 15.3)
C*****
CBB** ********************** BBCHED0B **********************************
C**** WRITE DETAIL REPORT HEADERS
C****
WRITE (I02,90004)
WRITE (I02,90004)
WRITE (I02,90013)
WRITE (I02,90014)
WRITE (I02,90015) IVTOTL
CBE** ********************** BBCHED0B **********************************
15003 FORMAT(1X,2X,I3,4X,7HINSPECT,5X, I5, 5X, I5)
15004 FORMAT( /48X,30H BELOW ANSWERS SHOULD BE ZERO /49X,
1 25HFOR TEST SEGMENT TO PASS )
15005 FORMAT (49X,26H- EACH TEST HAS TWO PARTS.)
WRITE (NUVI, 15005)
WRITE(NUVI, 15004)
WRITE(NUVI,15002)
15002 FORMAT (23X, 5H IFIX, 5X, 5H INT )
C*****
CT001* TEST 1 THE VALUE ZERO
IVTNUM = 1
RACVS = 0.0
IAAVI = IFIX(RACVS)
IABVI = INT(RACVS)
IADVI = IAAVI - 0
IAEVI = IABVI - 0
WRITE(NUVI,15003) IVTNUM,IADVI, IAEVI
CT002* TEST 2 A VALUE IN (0,1)
IVTNUM = 2
RACVS = 0.375
IAAVI = IFIX(RACVS)
IABVI = INT(RACVS)
IADVI = IAAVI - 0
IAEVI = IABVI - 0
WRITE(NUVI,15003) IVTNUM, IADVI, IAEVI
CT003* TEST 3 THE VALUE ONE
IVTNUM = 3
RACVS = 1.00001
IAAVI = IFIX(RACVS)
IABVI = INT(RACVS)
IADVI = IAAVI - 1
IAEVI = IABVI - 1
WRITE(NUVI,15003) IVTNUM, IADVI, IAEVI
CT004* TEST 4 AN INTEGRAL VALUE OTHER THAN 0 OR 1
IVTNUM = 4
RACVS = 6.00001
IAAVI = IFIX(RACVS)
IABVI = INT(RACVS)
IADVI = IAAVI - 6
IAEVI = IABVI - 6
WRITE(NUVI,15003) IVTNUM, IADVI, IAEVI
CT005* TEST 5 A VALUE IN (X,X+1)
IVTNUM = 5
RACVS = 3.75
IAAVI = IFIX(RACVS)
IABVI = INT(RACVS)
IADVI = IAAVI - 3
IAEVI = IABVI - 3
WRITE(NUVI,15003) IVTNUM, IADVI, IAEVI
CT006* TEST 6 A NEGATIVE VALUE WITH MAGNITUDE IN (0,1)
IVTNUM = 6
RACVS = -0.375
IAAVI = IFIX(RACVS)
IABVI = INT(RACVS)
IADVI = IAAVI - 0
IAEVI = IABVI - 0
WRITE(NUVI,15003) IVTNUM, IADVI, IAEVI
CT007* TEST 7 THE VALUE -1
IVTNUM = 7
RACVS = -1.00001
IAAVI = IFIX(RACVS)
IABVI = INT(RACVS)
IADVI = IAAVI + 1
IAEVI = IABVI + 1
WRITE(NUVI,15003) IVTNUM, IADVI, IAEVI
CT008* TEST 8 A NEGATIVE INTEGRAL VALUE
IVTNUM = 8
RACVS = -6.00001
IAAVI = IFIX(RACVS)
IABVI = INT(RACVS)
IADVI = IAAVI + 6
IAEVI = IABVI + 6
WRITE(NUVI,15003) IVTNUM, IADVI, IAEVI
CT009* TEST 9 A NEGATIVE VALUE WITH MAGNITUDE IN (X,X+1)
IVTNUM = 9
RACVS = -3.75
IAAVI = IFIX(RACVS)
IABVI = INT(RACVS)
IADVI = IAAVI + 3
IAEVI = IABVI + 3
WRITE(NUVI,15003) IVTNUM, IADVI, IAEVI
CT010* TEST 10 ZERO PREFIXED WITH A MINUS SIGN
IVTNUM = 10
RACVS = 0
IAAVI = IFIX(-RACVS)
IABVI = INT(-RACVS)
IADVI = IAAVI - 0
IAEVI = IABVI - 0
WRITE(NUVI,15003) IVTNUM, IADVI, IAEVI
CT011* TEST 011 IFIX, INT USED IN AN ARITHMETIC EXPRESSION
IVTNUM = 011
RAAVS = 3.75
IAFVI = 3
IAAVI = 25 + IAFVI * IFIX(RAAVS)
IABVI = 25 + IAFVI * INT(RAAVS)
IADVI = IAAVI - 34
IAEVI = IABVI - 34
WRITE(NUVI,15003) IVTNUM, IADVI, IAEVI
CT012* TEST 12 AN ARITHMETIC EXPRESSION PRESENTED TO IFIX, INT
IVTNUM = 12
RAAVS = 25.5
RABVS = 12.25
IAAVI = IFIX(RAAVS - RABVS)
IABVI = INT(RAAVS - RABVS)
IADVI = IAAVI - 13
IAEVI = IABVI - 13
WRITE(NUVI,15003) IVTNUM, IADVI, IAEVI
CT013* TEST 13 COMPARE AUTOMATIC TYPE CONVERSION TO EXPLICIT
IVTNUM = 13
RAAVS = 11.75
RABVS = 12.625
IAAVI = IFIX(RAAVS + RABVS)
IABVI = INT(RAAVS + RABVS)
IACVI = RAAVS + RABVS
IADVI = IAAVI - IACVI
IAEVI = IABVI - IACVI
WRITE(NUVI,15003) IVTNUM, IADVI, IAEVI
CT014* TEST 14 ARGUMENT OF LOW MAGNITUDE
IVTNUM = 14
RACVS = -3.05923E-33
IAAVI = IFIX(RACVS)
IABVI = INT(RACVS)
IADVI = IAAVI - 0
IAEVI = IABVI - 0
WRITE(NUVI,15003) IVTNUM, IADVI, IAEVI
C*****
C*****
IVINSP = 14
CBB** ********************** BBCSUM0 **********************************
C**** WRITE OUT TEST SUMMARY
C****
IVTOTN = IVPASS + IVFAIL + IVDELE + IVINSP
WRITE (I02, 90004)
WRITE (I02, 90014)
WRITE (I02, 90004)
WRITE (I02, 90020) IVPASS
WRITE (I02, 90022) IVFAIL
WRITE (I02, 90024) IVDELE
WRITE (I02, 90026) IVINSP
WRITE (I02, 90028) IVTOTN, IVTOTL
CBE** ********************** BBCSUM0 **********************************
CBB** ********************** BBCFOOT0 **********************************
C**** WRITE OUT REPORT FOOTINGS
C****
WRITE (I02,90016) ZPROG, ZPROG
WRITE (I02,90018) ZPROJ, ZNAME, ZTAPE, ZTAPED
WRITE (I02,90019)
CBE** ********************** BBCFOOT0 **********************************
CBB** ********************** BBCFMT0A **********************************
C**** FORMATS FOR TEST DETAIL LINES
C****
80000 FORMAT (1H ,2X,I3,4X,7HDELETED,32X,A31)
80002 FORMAT (1H ,2X,I3,4X,7H PASS ,32X,A31)
80004 FORMAT (1H ,2X,I3,4X,7HINSPECT,32X,A31)
80008 FORMAT (1H ,2X,I3,4X,7H FAIL ,32X,A31)
80010 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,15X,10HCOMPUTED= ,
1I6,/,1H ,15X,10HCORRECT= ,I6)
80012 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
1E12.5,/,1H ,16X,10HCORRECT= ,E12.5)
80018 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
1A21,/,1H ,16X,10HCORRECT= ,A21)
80020 FORMAT (1H ,16X,10HCOMPUTED= ,A21,1X,A31)
80022 FORMAT (1H ,16X,10HCORRECT= ,A21,1X,A31)
80024 FORMAT (1H ,16X,10HCOMPUTED= ,I6,16X,A31)
80026 FORMAT (1H ,16X,10HCORRECT= ,I6,16X,A31)
80028 FORMAT (1H ,16X,10HCOMPUTED= ,E12.5,10X,A31)
80030 FORMAT (1H ,16X,10HCORRECT= ,E12.5,10X,A31)
80050 FORMAT (1H ,48X,A31)
CBE** ********************** BBCFMT0A **********************************
CBB** ********************** BBCFMT0B **********************************
C**** FORMAT STATEMENTS FOR PAGE HEADERS
C****
90002 FORMAT (1H1)
90004 FORMAT (1H )
90006 FORMAT (1H ,20X,31HFEDERAL SOFTWARE TESTING CENTER)
90007 FORMAT (1H ,19X,34HFORTRAN COMPILER VALIDATION SYSTEM)
90008 FORMAT (1H ,21X,A13,A17)
90009 FORMAT (1H ,/,2H *,A5,6HBEGIN*,12X,15HTEST RESULTS - ,A5,/)
90010 FORMAT (1H ,8X,16HTEST DATE*TIME= ,A17,15H - COMPILER= ,A20)
90013 FORMAT (1H ,8H TEST ,10HPASS/FAIL ,6X,17HDISPLAYED RESULTS,
1 7X,7HREMARKS,24X)
90014 FORMAT (1H ,46H----------------------------------------------,
1 33H---------------------------------)
90015 FORMAT (1H ,48X,17HTHIS PROGRAM HAS ,I3,6H TESTS,/)
C****
C**** FORMAT STATEMENTS FOR REPORT FOOTINGS
C****
90016 FORMAT (1H ,/,2H *,A5,4HEND*,14X,14HEND OF TEST - ,A5,/)
90018 FORMAT (1H ,A13,13X,A20,7H * ,A10,1H/,
1 A13)
90019 FORMAT (1H ,26HFOR OFFICIAL USE ONLY ,35X,15HCOPYRIGHT 1982)
C****
C**** FORMAT STATEMENTS FOR RUN SUMMARY
C****
90020 FORMAT (1H ,21X,I5,13H TESTS PASSED)
90022 FORMAT (1H ,21X,I5,13H TESTS FAILED)
90024 FORMAT (1H ,21X,I5,14H TESTS DELETED)
90026 FORMAT (1H ,21X,I5,25H TESTS REQUIRE INSPECTION)
90028 FORMAT (1H ,21X,I5,4H OF ,I3,15H TESTS EXECUTED)
CBE** ********************** BBCFMT0B **********************************
C*****
C***** END OF TEST SEGMENT 150
STOP
END
*END-OF,FM353
FM354.f 481036248 170 2 100666 14377 `
*HEADER,FORTR,FM354
*FILES1,FORTR,FM354,X
C***********************************************************************
C***** FORTRAN 77
C***** FM354 XREAL - (152)
C*****
C***********************************************************************
C***** GENERAL PURPOSE SUBSET REF
C***** TEST INTRINSIC FUNCTIONS FLOAT AND REAL 15.3
C***** (CONVERSION FROM INTEGER TO REAL) (TABLE 5)
C*****
CBB** ********************** BBCCOMNT **********************************
C****
C**** 1978 FORTRAN COMPILER VALIDATION SYSTEM
C**** VERSION 2.0
C****
C****
C**** SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO
C**** GENERAL SERVICES ADMINISTRATION
C**** FEDERAL SOFTWARE TESTING CENTER
C**** 5203 LEESBURG PIKE, SUITE 1100
C**** FALLS CHURCH, VA. 22041
C****
C**** (703) 756-6153
C****
CBE** ********************** BBCCOMNT **********************************
CBB** ********************** BBCINITA **********************************
C**** SPECIFICATION STATEMENTS
C****
CHARACTER ZVERS*13, ZVERSD*17, ZDATE*17, ZPROG*5, ZCOMPL*20,
1 ZNAME*20, ZTAPE*10, ZPROJ*13, REMRKS*31, ZTAPED*13
CBE** ********************** BBCINITA **********************************
CBB** ********************** BBCINITB **********************************
C**** INITIALIZE SECTION
DATA ZVERS, ZVERSD, ZDATE
1 /'VERSION 2.0 ', '82/08/02*18.33.46', '*NO DATE*TIME'/
DATA ZCOMPL, ZNAME, ZTAPE
1 /'*NONE SPECIFIED*', '*NO COMPANY NAME*', '*NO TAPE*'/
DATA ZPROJ, ZTAPED, ZPROG
1 /'*NO PROJECT*', '*NO TAPE DATE', 'XXXXX'/
DATA REMRKS /' '/
C**** THE FOLLOWING 9 COMMENT LINES (CZ01, CZ02, ...) CAN BE REPLACED
C**** FOR IDENTIFYING THE TEST ENVIRONMENT
C****
CZ01 ZVERS = 'VERSION OF THE COMPILER VALIDATION SYSTEM'
CZ02 ZVERSD = 'CREATION DATE/TIME OF THE COMPILER VALIDATION SYSTEM'
CZ03 ZPROG = 'PROGRAM NAME'
CZ04 ZDATE = 'DATE OF TEST'
CZ05 ZCOMPL = 'COMPILER IDENTIFICATION'
CZ06 ZPROJ = 'PROJECT NUMBER/IDENTIFICATION'
CZ07 ZNAME = 'NAME OF USER'
CZ08 ZTAPE = 'TAPE OWNER/ID'
CZ09 ZTAPED = 'DATE TAPE COPIED'
C
IVPASS = 0
IVFAIL = 0
IVDELE = 0
IVINSP = 0
IVTOTL = 0
IVTOTN = 0
ICZERO = 0
C
C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER.
I01 = 05
C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER.
I02 = 06
C
CX010 REPLACED BY FEXEC X-010 CONTROL CARD (CARD-READER UNIT NUMBER).
C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5
CX011 REPLACED BY FEXEC X-011 CONTROL CARD. CX011 IS FOR SYSTEMS
C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX010.
C
CX020 REPLACED BY FEXEC X-020 CONTROL CARD (PRINTER UNIT NUMBER).
C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02= 6
CX021 REPLACED BY FEXEC X-021 CONTROL CARD. CX021 IS FOR SYSTEMS
C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX020.
C
CBE** ********************** BBCINITB **********************************
NUVI = I02
IVTOTL = 14
ZPROG = 'FM354'
CBB** ********************** BBCHED0A **********************************
C****
C**** WRITE REPORT TITLE
C****
WRITE (I02, 90002)
WRITE (I02, 90006)
WRITE (I02, 90007)
WRITE (I02, 90008) ZVERS, ZVERSD
WRITE (I02, 90009) ZPROG, ZPROG
WRITE (I02, 90010) ZDATE, ZCOMPL
CBE** ********************** BBCHED0A **********************************
C*****
C***** HEADER FOR SEGMENT 152
WRITE (NUVI,15201)
15201 FORMAT (1H , // 2X,35HXREAL - (152) INTRINSIC FUNCTIONS--//17X,
1 29HFLOAT, REAL (TYPE CONVERSION)// 2X,
2 18HSUBSET REF. - 15.3)
CBB** ********************** BBCHED0B **********************************
C**** WRITE DETAIL REPORT HEADERS
C****
WRITE (I02,90004)
WRITE (I02,90004)
WRITE (I02,90013)
WRITE (I02,90014)
WRITE (I02,90015) IVTOTL
CBE** ********************** BBCHED0B **********************************
C*****
C***** TEST OF FLOAT
C*****
WRITE(NUVI, 15204)
15204 FORMAT (/ 8X, 13HTEST OF FLOAT)
CT001* TEST 1 THE VALUE ZERO
IVTNUM = 1
IBCVI = 0
RBAVS = FLOAT(IBCVI)
IF (RBAVS + 0.00005) 20010, 10010, 40010
40010 IF (RBAVS - 0.00005) 10010, 10010, 20010
10010 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0011
20010 IVFAIL = IVFAIL + 1
RVCORR = 0.0
WRITE(NUVI, 80012) IVTNUM, RBAVS, RVCORR
0011 CONTINUE
CT002* TEST 2 A POSITIVE INTEGER
IVTNUM = 2
IBCVI = 3
RBAVS = FLOAT(IBCVI)
IF (RBAVS - 2.9998) 20020, 10020, 40020
40020 IF (RBAVS - 3.0002) 10020, 10020, 20020
10020 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0021
20020 IVFAIL = IVFAIL + 1
RVCORR = 3.0
WRITE(NUVI, 80012) IVTNUM, RBAVS, RVCORR
0021 CONTINUE
CT003* TEST 3 A NEGATIVE INTEGER
IVTNUM = 3
IBCVI = -3
RBAVS = FLOAT(IBCVI)
IF (RBAVS + 3.0002) 20030, 10030, 40030
40030 IF (RBAVS + 2.9998) 10030, 10030, 20030
10030 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0031
20030 IVFAIL = IVFAIL + 1
RVCORR = -3.0
WRITE(NUVI, 80012) IVTNUM, RBAVS, RVCORR
0031 CONTINUE
CT004* TEST 4 A ZERO PREFIXED WITH A MINUS SIGN
IVTNUM = 4
IBCVI = 0
RBAVS = FLOAT(-IBCVI)
IF (RBAVS + 0.00005) 20040, 10040, 40040
40040 IF (RBAVS - 0.00005) 10040, 10040, 20040
10040 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0041
20040 IVFAIL = IVFAIL + 1
RVCORR = 0.0
WRITE(NUVI, 80012) IVTNUM, RBAVS, RVCORR
0041 CONTINUE
CT005* TEST 5 FLOAT USED IN AN ARITHMETIC EXPRESSION
IVTNUM = 5
RBFVS = -3.0
IBCVI = 3
RBAVS = 16.1875 + RBFVS/FLOAT(IBCVI)
IF (RBAVS - 15.186) 20050, 10050, 40050
40050 IF (RBAVS - 15.189) 10050, 10050, 20050
10050 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0051
20050 IVFAIL = IVFAIL + 1
RVCORR = 15.1875
WRITE(NUVI, 80012) IVTNUM, RBAVS, RVCORR
0051 CONTINUE
CT006* TEST 6 AN ARITHMETIC EXPRESSION PRESENTED TO FLOAT
IVTNUM = 6
IBAVI = -7
IBBVI = 27
RBAVS = FLOAT(IBAVI - IBBVI * 2)
IF (RBAVS + 61.003) 20060, 10060, 40060
40060 IF (RBAVS + 60.997) 10060, 10060, 20060
10060 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0061
20060 IVFAIL = IVFAIL + 1
RVCORR = -61.0
WRITE(NUVI, 80012) IVTNUM, RBAVS, RVCORR
0061 CONTINUE
CT007* TEST 7 COMPARE AUTOMATIC TYPE CONVERSION TO EXPLICIT
IVTNUM = 7
IBAVI = 2
IBBVI = 10
RBAVS = FLOAT(IBBVI ** IBAVI)
IF (RBAVS - 99.995) 20070, 10070, 40070
40070 IF (RBAVS - 100.01) 10070, 10070, 20070
10070 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0071
20070 IVFAIL = IVFAIL + 1
RVCORR = 100.0
WRITE(NUVI, 80012) IVTNUM, RBAVS, RVCORR
0071 CONTINUE
C*****
C***** TEST OF REAL
C*****
WRITE(NUVI, 15202)
15202 FORMAT (/ 08X, 12HTEST OF REAL)
CT008* TEST 8 THE VALUE ZERO
IVTNUM = 8
IBCVI = 0
RBBVS = REAL(IBCVI)
IF (RBBVS + 0.00005) 20080, 10080, 40080
40080 IF (RBBVS - 0.00005) 10080, 10080, 20080
10080 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0081
20080 IVFAIL = IVFAIL + 1
RVCORR = 0.0
WRITE(NUVI, 80012) IVTNUM, RBBVS, RVCORR
0081 CONTINUE
CT009* TEST 9 A POSITIVE INTEGER
IVTNUM = 9
IBCVI = 3
RBBVS = REAL(IBCVI)
IF (RBBVS - 2.9998) 20090, 10090, 40090
40090 IF (RBBVS - 3.0002) 10090, 10090, 20090
10090 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0091
20090 IVFAIL = IVFAIL + 1
RVCORR = 3.0
WRITE(NUVI, 80012) IVTNUM, RBBVS, RVCORR
0091 CONTINUE
CT010* TEST 10 A NEGATIVE INTEGER
IVTNUM = 10
IBCVI = -3
RBBVS = REAL(IBCVI)
IF (RBBVS + 3.0002) 20100, 10100, 40100
40100 IF (RBBVS + 2.9998) 10100, 10100, 20100
10100 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0101
20100 IVFAIL = IVFAIL + 1
RVCORR = -3.0
WRITE(NUVI, 80012) IVTNUM, RBBVS, RVCORR
0101 CONTINUE
CT011* TEST 11 A ZERO PREFIXED WITH A MINUS SIGN
IVTNUM = 11
IBCVI = 0
RBBVS = REAL(-IBCVI)
IF (RBBVS + 0.00005) 20110, 10110, 40110
40110 IF (RBBVS - 0.00005) 10110, 10110, 20110
10110 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0111
20110 IVFAIL = IVFAIL + 1
RVCORR = 0.0
WRITE(NUVI, 80012) IVTNUM, RBBVS, RVCORR
0111 CONTINUE
CT012* TEST 12 REAL USED IN AN ARITHMETIC EXPRESSION
IVTNUM = 12
RBFVS = -3.0
IBCVI = 3
RBBVS = 16.1875 + RBFVS/REAL(IBCVI)
IF (RBBVS - 15.186) 20120, 10120, 40120
40120 IF (RBBVS - 15.189) 10120, 10120, 20120
10120 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0121
20120 IVFAIL = IVFAIL + 1
RVCORR = 15.1875
WRITE(NUVI, 80012) IVTNUM, RBBVS, RVCORR
0121 CONTINUE
CT013* TEST 13 AN ARITHMETIC EXPRESSION PRESENTED TO REAL
IVTNUM = 13
IBAVI = -7
IBBVI = 27
RBBVS = REAL(IBAVI - IBBVI * 2)
IF (RBBVS + 61.003) 20130, 10130, 40130
40130 IF (RBBVS + 60.997) 10130, 10130, 20130
10130 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0131
20130 IVFAIL = IVFAIL + 1
RVCORR = 61.0
WRITE(NUVI, 80012) IVTNUM, RBBVS, RVCORR
0131 CONTINUE
CT014* TEST 14 COMPARE AUTOMATIC TYPE CONVERSION TO EXPLICIT
IVTNUM = 14
IBAVI = 2
IBBVI = 10
RBBVS = REAL(IBBVI ** IBAVI)
IF (RBBVS - 99.995) 20140, 10140, 40140
40140 IF (RBBVS - 100.01) 10140, 10140, 20140
10140 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0141
20140 IVFAIL = IVFAIL + 1
RVCORR = 100.0
WRITE(NUVI, 80012) IVTNUM, RBBVS, RVCORR
0141 CONTINUE
CBB** ********************** BBCSUM0 **********************************
C**** WRITE OUT TEST SUMMARY
C****
IVTOTN = IVPASS + IVFAIL + IVDELE + IVINSP
WRITE (I02, 90004)
WRITE (I02, 90014)
WRITE (I02, 90004)
WRITE (I02, 90020) IVPASS
WRITE (I02, 90022) IVFAIL
WRITE (I02, 90024) IVDELE
WRITE (I02, 90026) IVINSP
WRITE (I02, 90028) IVTOTN, IVTOTL
CBE** ********************** BBCSUM0 **********************************
CBB** ********************** BBCFOOT0 **********************************
C**** WRITE OUT REPORT FOOTINGS
C****
WRITE (I02,90016) ZPROG, ZPROG
WRITE (I02,90018) ZPROJ, ZNAME, ZTAPE, ZTAPED
WRITE (I02,90019)
CBE** ********************** BBCFOOT0 **********************************
CBB** ********************** BBCFMT0A **********************************
C**** FORMATS FOR TEST DETAIL LINES
C****
80000 FORMAT (1H ,2X,I3,4X,7HDELETED,32X,A31)
80002 FORMAT (1H ,2X,I3,4X,7H PASS ,32X,A31)
80004 FORMAT (1H ,2X,I3,4X,7HINSPECT,32X,A31)
80008 FORMAT (1H ,2X,I3,4X,7H FAIL ,32X,A31)
80010 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,15X,10HCOMPUTED= ,
1I6,/,1H ,15X,10HCORRECT= ,I6)
80012 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
1E12.5,/,1H ,16X,10HCORRECT= ,E12.5)
80018 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
1A21,/,1H ,16X,10HCORRECT= ,A21)
80020 FORMAT (1H ,16X,10HCOMPUTED= ,A21,1X,A31)
80022 FORMAT (1H ,16X,10HCORRECT= ,A21,1X,A31)
80024 FORMAT (1H ,16X,10HCOMPUTED= ,I6,16X,A31)
80026 FORMAT (1H ,16X,10HCORRECT= ,I6,16X,A31)
80028 FORMAT (1H ,16X,10HCOMPUTED= ,E12.5,10X,A31)
80030 FORMAT (1H ,16X,10HCORRECT= ,E12.5,10X,A31)
80050 FORMAT (1H ,48X,A31)
CBE** ********************** BBCFMT0A **********************************
CBB** ********************** BBCFMT0B **********************************
C**** FORMAT STATEMENTS FOR PAGE HEADERS
C****
90002 FORMAT (1H1)
90004 FORMAT (1H )
90006 FORMAT (1H ,20X,31HFEDERAL SOFTWARE TESTING CENTER)
90007 FORMAT (1H ,19X,34HFORTRAN COMPILER VALIDATION SYSTEM)
90008 FORMAT (1H ,21X,A13,A17)
90009 FORMAT (1H ,/,2H *,A5,6HBEGIN*,12X,15HTEST RESULTS - ,A5,/)
90010 FORMAT (1H ,8X,16HTEST DATE*TIME= ,A17,15H - COMPILER= ,A20)
90013 FORMAT (1H ,8H TEST ,10HPASS/FAIL ,6X,17HDISPLAYED RESULTS,
1 7X,7HREMARKS,24X)
90014 FORMAT (1H ,46H----------------------------------------------,
1 33H---------------------------------)
90015 FORMAT (1H ,48X,17HTHIS PROGRAM HAS ,I3,6H TESTS,/)
C****
C**** FORMAT STATEMENTS FOR REPORT FOOTINGS
C****
90016 FORMAT (1H ,/,2H *,A5,4HEND*,14X,14HEND OF TEST - ,A5,/)
90018 FORMAT (1H ,A13,13X,A20,7H * ,A10,1H/,
1 A13)
90019 FORMAT (1H ,26HFOR OFFICIAL USE ONLY ,35X,15HCOPYRIGHT 1982)
C****
C**** FORMAT STATEMENTS FOR RUN SUMMARY
C****
90020 FORMAT (1H ,21X,I5,13H TESTS PASSED)
90022 FORMAT (1H ,21X,I5,13H TESTS FAILED)
90024 FORMAT (1H ,21X,I5,14H TESTS DELETED)
90026 FORMAT (1H ,21X,I5,25H TESTS REQUIRE INSPECTION)
90028 FORMAT (1H ,21X,I5,4H OF ,I3,15H TESTS EXECUTED)
CBE** ********************** BBCFMT0B **********************************
C*****
C***** END OF TEST SEGMENT 152
STOP
END
*END-OF,FM354
FM355.f 481036253 170 2 100666 29785 `
*HEADER,FORTR,FM355
*FILES1,FORTR,FM355,X
C***********************************************************************
C***** FORTRAN 77
C***** FM355 XAINT - (154)
C*****
C***********************************************************************
C***** GENERAL PURPOSE SUBSET REF
C***** TEST INTRINSIC FUNCTIONS AINT, ANINT, NINT 15.3
C***** TRUNCATION (SIGN OF A * LARGEST INTEGER LE ABS(A) ) (TABLE 5)
C*****
C***** GENERAL COMMENTS
C***** FLOAT FUNCTION ASSUMED WORKING
C*****
CBB** ********************** BBCCOMNT **********************************
C****
C**** 1978 FORTRAN COMPILER VALIDATION SYSTEM
C**** VERSION 2.0
C****
C****
C**** SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO
C**** GENERAL SERVICES ADMINISTRATION
C**** FEDERAL SOFTWARE TESTING CENTER
C**** 5203 LEESBURG PIKE, SUITE 1100
C**** FALLS CHURCH, VA. 22041
C****
C**** (703) 756-6153
C****
CBE** ********************** BBCCOMNT **********************************
CBB** ********************** BBCINITA **********************************
C**** SPECIFICATION STATEMENTS
C****
CHARACTER ZVERS*13, ZVERSD*17, ZDATE*17, ZPROG*5, ZCOMPL*20,
1 ZNAME*20, ZTAPE*10, ZPROJ*13, REMRKS*31, ZTAPED*13
CBE** ********************** BBCINITA **********************************
CBB** ********************** BBCINITB **********************************
C**** INITIALIZE SECTION
DATA ZVERS, ZVERSD, ZDATE
1 /'VERSION 2.0 ', '82/08/02*18.33.46', '*NO DATE*TIME'/
DATA ZCOMPL, ZNAME, ZTAPE
1 /'*NONE SPECIFIED*', '*NO COMPANY NAME*', '*NO TAPE*'/
DATA ZPROJ, ZTAPED, ZPROG
1 /'*NO PROJECT*', '*NO TAPE DATE', 'XXXXX'/
DATA REMRKS /' '/
C**** THE FOLLOWING 9 COMMENT LINES (CZ01, CZ02, ...) CAN BE REPLACED
C**** FOR IDENTIFYING THE TEST ENVIRONMENT
C****
CZ01 ZVERS = 'VERSION OF THE COMPILER VALIDATION SYSTEM'
CZ02 ZVERSD = 'CREATION DATE/TIME OF THE COMPILER VALIDATION SYSTEM'
CZ03 ZPROG = 'PROGRAM NAME'
CZ04 ZDATE = 'DATE OF TEST'
CZ05 ZCOMPL = 'COMPILER IDENTIFICATION'
CZ06 ZPROJ = 'PROJECT NUMBER/IDENTIFICATION'
CZ07 ZNAME = 'NAME OF USER'
CZ08 ZTAPE = 'TAPE OWNER/ID'
CZ09 ZTAPED = 'DATE TAPE COPIED'
C
IVPASS = 0
IVFAIL = 0
IVDELE = 0
IVINSP = 0
IVTOTL = 0
IVTOTN = 0
ICZERO = 0
C
C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER.
I01 = 05
C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER.
I02 = 06
C
CX010 REPLACED BY FEXEC X-010 CONTROL CARD (CARD-READER UNIT NUMBER).
C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5
CX011 REPLACED BY FEXEC X-011 CONTROL CARD. CX011 IS FOR SYSTEMS
C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX010.
C
CX020 REPLACED BY FEXEC X-020 CONTROL CARD (PRINTER UNIT NUMBER).
C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02= 6
CX021 REPLACED BY FEXEC X-021 CONTROL CARD. CX021 IS FOR SYSTEMS
C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX020.
C
CBE** ********************** BBCINITB **********************************
NUVI = I02
IVTOTL = 48
ZPROG = 'FM355'
CBB** ********************** BBCHED0A **********************************
C****
C**** WRITE REPORT TITLE
C****
WRITE (I02, 90002)
WRITE (I02, 90006)
WRITE (I02, 90007)
WRITE (I02, 90008) ZVERS, ZVERSD
WRITE (I02, 90009) ZPROG, ZPROG
WRITE (I02, 90010) ZDATE, ZCOMPL
CBE** ********************** BBCHED0A **********************************
C*****
C***** HEADER FOR SEGMENT 154
WRITE (NUVI,15401)
15401 FORMAT (1H , // 2X,35HXAINT - (154) INTRINSIC FUNCTIONS--//10X,
1 36HAINT, ANINT, NINT (TYPE CONVERSION) //
2 20H SUBSET REF. - 15.3)
CBB** ********************** BBCHED0B **********************************
C**** WRITE DETAIL REPORT HEADERS
C****
WRITE (I02,90004)
WRITE (I02,90004)
WRITE (I02,90013)
WRITE (I02,90014)
WRITE (I02,90015) IVTOTL
CBE** ********************** BBCHED0B **********************************
C*****
C***** TEST OF AINT
C*****
WRITE(NUVI, 15402)
15402 FORMAT (/ 8X, 12HTEST OF AINT)
CT001* TEST 1 THE VALUE ZERO
IVTNUM = 1
RCBVS = 0.0
RCAVS = AINT(RCBVS)
IF (RCAVS + 0.00005) 20010, 10010, 40010
40010 IF (RCAVS - 0.00005) 10010, 10010, 20010
10010 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0011
20010 IVFAIL = IVFAIL + 1
RVCORR = 0.0
WRITE(NUVI, 80012) IVTNUM, RCAVS, RVCORR
0011 CONTINUE
CT002* TEST 2 ZERO PREFIXED WITH A MINUS SIGN
IVTNUM = 2
RCDVS = -0.0
RCAVS = AINT(RCBVS)
IF (RCAVS + 0.00005) 20020, 10020, 40020
40020 IF (RCAVS - 0.00005) 10020, 10020, 20020
10020 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0021
20020 IVFAIL = IVFAIL + 1
RVCORR = -0.0
WRITE(NUVI, 80012) IVTNUM, RCAVS, RVCORR
0021 CONTINUE
CT003* TEST 3 A VALUE IN (0,1)
IVTNUM = 3
RCDVS = 0.375
RCAVS = AINT(RCBVS)
IF (RCAVS + 0.00005) 20030, 10030, 40030
40030 IF (RCAVS - 0.00005) 10030, 10030, 20030
10030 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0031
20030 IVFAIL = IVFAIL + 1
RVCORR = 0.0
WRITE(NUVI, 80012) IVTNUM, RCAVS, RVCORR
0031 CONTINUE
CT004* TEST 4 THE VALUE 1
IVTNUM = 4
RCBVS = FLOAT(1)
RCAVS = AINT(RCBVS)
IF (RCAVS - 0.99995) 20040, 10040, 40040
40040 IF (RCAVS - 1.0001) 10040, 10040, 20040
10040 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0041
20040 IVFAIL = IVFAIL + 1
RVCORR = 1.0
WRITE(NUVI, 80012) IVTNUM, RCAVS, RVCORR
0041 CONTINUE
CT005* TEST 5 AN INTEGRAL VALUE OTHER THAN 0, 1
IVTNUM = 5
RCBVS = FLOAT(6)
RCAVS = AINT(RCBVS)
IF (RCAVS - 5.9997) 20050, 10050, 40050
40050 IF (RCAVS - 6.0003) 10050, 10050, 20050
10050 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0051
20050 IVFAIL = IVFAIL + 1
RVCORR = 6.0
WRITE(NUVI, 80012) IVTNUM, RCAVS, RVCORR
0051 CONTINUE
CT006* TEST 6 A VALUE IN (X,X+1)
IVTNUM = 6
RCBVS = 3.75
RCAVS = AINT(RCBVS)
IF (RCAVS - 2.9998) 20060, 10060, 40060
40060 IF (RCAVS - 3.0002) 10060, 10060, 20060
10060 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0061
20060 IVFAIL = IVFAIL + 1
RVCORR = 3.0
WRITE(NUVI, 80012) IVTNUM, RCAVS, RVCORR
0061 CONTINUE
CT007* TEST 7 A NEGATIVE VALUE WITH MAGNITUDE IN (0,1)
IVTNUM = 7
RCBVS = -0.375
RCAVS = AINT(RCBVS)
IF (RCAVS + 0.00005) 20070, 10070, 40070
40070 IF (RCAVS - 0.00005) 10070, 10070, 20070
10070 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0071
20070 IVFAIL = IVFAIL + 1
RVCORR = 0.0
WRITE(NUVI, 80012) IVTNUM, RCAVS, RVCORR
0071 CONTINUE
CT008* TEST 8 THE VALUE -1
IVTNUM = 8
RCBVS = FLOAT(-1)
RCAVS = AINT(RCBVS)
IF (RCAVS + 1.0001) 20080, 10080, 40080
40080 IF (RCAVS + 0.99995) 10080, 10080, 20080
10080 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0081
20080 IVFAIL = IVFAIL + 1
RVCORR = -1.0
WRITE(NUVI, 80012) IVTNUM, RCAVS, RVCORR
0081 CONTINUE
CT009* TEST 9 A NEGATIVE INTEGRAL VALUE
IVTNUM = 9
RCBVS = FLOAT(-6)
RCAVS = AINT(RCBVS)
IF (RCAVS + 6.0003) 20090, 10090, 40090
40090 IF (RCAVS + 5.9997) 10090, 10090, 20090
10090 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0091
20090 IVFAIL = IVFAIL + 1
RVCORR = -6.0
WRITE(NUVI, 80012) IVTNUM, RCAVS, RVCORR
0091 CONTINUE
CT010* TEST 10 A NEGATIVE VALUE WITH MAGNITUDE IN (X,X+1)
IVTNUM = 10
RCBVS = -3.75
RCAVS = AINT(RCBVS)
IF (RCAVS + 3.0002) 20100, 10100, 40100
40100 IF (RCAVS + 2.9998) 10100, 10100, 20100
10100 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0101
20100 IVFAIL = IVFAIL + 1
RVCORR = -3.0
WRITE(NUVI, 80012) IVTNUM, RCAVS, RVCORR
0101 CONTINUE
CT011* TEST 11 AN ARITHMETIC EXPRESSION PRESENTED TO AINT
IVTNUM = 11
RCBVS = 3.25
RCDVS = 3.0
RCAVS = AINT(FLOAT(25) + RCDVS * RCBVS)
IF (RCAVS - 33.998) 20110, 10110, 40110
40110 IF (RCAVS - 34.002) 10110, 10110, 20110
10110 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0111
20110 IVFAIL = IVFAIL + 1
RVCORR = 34.0
WRITE(NUVI, 80012) IVTNUM, RCAVS, RVCORR
0111 CONTINUE
CT012* TEST 12 AN ARGUMENT OF LOW MAGNITUDE
IVTNUM = 12
RCBVS = 3.7521E-36
RCAVS = AINT(RCBVS)
IF (RCAVS + 0.00005) 20120, 10120, 40120
40120 IF (RCAVS - 0.00005) 10120, 10120, 20120
10120 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0121
20120 IVFAIL = IVFAIL + 1
RVCORR = 0.0
WRITE(NUVI, 80012) IVTNUM, RCAVS, RVCORR
0121 CONTINUE
C*****
WRITE(NUVI, 90002)
WRITE(NUVI, 90013)
WRITE(NUVI, 90014)
C*****
C***** TEST OF ANINT
C*****
WRITE(NUVI, 15404)
15404 FORMAT (/ 08X, 13HTEST OF ANINT)
C*****
CT013* TEST 13 THE VALUE ZERO
IVTNUM = 13
RCBVS = 0.0
RCAVS = ANINT(RCBVS)
IF (RCAVS + 0.00005) 20130, 10130, 40130
40130 IF (RCAVS - 0.00005) 10130, 10130, 20130
10130 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0131
20130 IVFAIL = IVFAIL + 1
RVCORR = 0.0
WRITE(NUVI, 80012) IVTNUM, RCAVS, RVCORR
0131 CONTINUE
CT014* TEST 14 THE VALUE ZERO PREFIXED WITH A MINUS SIGN
IVTNUM = 14
RCDVS = 0.0
RCAVS = ANINT(-RCBVS)
IF (RCAVS + 0.00005) 20140, 10140, 40140
40140 IF (RCAVS - 0.00005) 10140, 10140, 20140
10140 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0141
20140 IVFAIL = IVFAIL + 1
RVCORR = 0.0
WRITE(NUVI, 80012) IVTNUM, RCAVS, RVCORR
0141 CONTINUE
CT015* TEST 15 A VALUE IN (0,.5)
IVTNUM = 15
RCBVS = 0.25
RCAVS = ANINT(RCBVS)
IF (RCAVS + 0.00005) 20150, 10150, 40150
40150 IF (RCAVS - 0.00005) 10150, 10150, 20150
10150 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0151
20150 IVFAIL = IVFAIL + 1
RVCORR = 0.0
WRITE(NUVI, 80012) IVTNUM, RCAVS, RVCORR
0151 CONTINUE
CT016* TEST 16 THE VALUE 0.5
IVTNUM = 16
RCBVS = FLOAT(1) / FLOAT(2)
RCAVS = ANINT(RCBVS)
IF (RCAVS - 0.99995) 20160, 10160, 40160
40160 IF (RCAVS - 1.0001) 10160, 10160, 20160
10160 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0161
20160 IVFAIL = IVFAIL + 1
RVCORR = 1.0
WRITE(NUVI, 80012) IVTNUM, RCAVS, RVCORR
0161 CONTINUE
CT017* TEST 17 A VALUE IN (.5,1)
IVTNUM = 17
RCBVS = 0.75
RCAVS = ANINT(RCBVS)
IF (RCAVS - 0.99995) 20170, 10170, 40170
40170 IF (RCAVS - 1.0001) 10170, 10170, 20170
10170 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0171
20170 IVFAIL = IVFAIL + 1
RVCORR = 1.0
WRITE(NUVI, 80012) IVTNUM, RCAVS, RVCORR
0171 CONTINUE
CT018* TEST 18 AN INTEGRAL VALUE OTHER THAN 0,1
IVTNUM = 18
RCBVS = FLOAT(5)
RCAVS = ANINT(RCBVS)
IF (RCAVS - 4.9997) 20180, 10180, 40180
40180 IF (RCAVS - 5.0003) 10180, 10180, 20180
10180 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0181
20180 IVFAIL = IVFAIL + 1
RVCORR = 5.0
WRITE(NUVI, 80012) IVTNUM, RCAVS, RVCORR
0181 CONTINUE
CT019* TEST 19 A VALUE IN (X,X+.5)
IVTNUM = 19
RCBVS = 10.46875
RCAVS = ANINT(RCBVS)
IF (RCAVS - 9.9995) 20190, 10190, 40190
40190 IF (RCAVS - 10.001) 10190, 10190, 20190
10190 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0191
20190 IVFAIL = IVFAIL + 1
RVCORR = 10.0
WRITE(NUVI, 80012) IVTNUM, RCAVS, RVCORR
0191 CONTINUE
CT020* TEST 20 A VALUE WITH FRACTIONAL PART OF 0.5
IVTNUM = 20
RCBVS = FLOAT(16) - FLOAT(1) / FLOAT(2)
RCAVS = ANINT(RCBVS)
IF (RCAVS - 15.999) 20200, 10200, 40200
40200 IF (RCAVS - 16.001) 10200, 10200, 20200
10200 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0201
20200 IVFAIL = IVFAIL + 1
RVCORR = 16.0
WRITE(NUVI, 80012) IVTNUM, RCAVS, RVCORR
0201 CONTINUE
CT021* TEST 21 A VALUE IN (X+.5,X+1)
IVTNUM = 21
RCBVS = 27.96875
RCAVS = ANINT(RCBVS)
IF (RCAVS - 27.998) 20210, 10210, 40210
40210 IF (RCAVS - 28.002) 10210, 10210, 20210
10210 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0211
20210 IVFAIL = IVFAIL + 1
RVCORR = 28.0
WRITE(NUVI, 80012) IVTNUM, RCAVS, RVCORR
0211 CONTINUE
CT022* TEST 22 A NEGATIVE VALUE WITH MAGNITUDE IN (0,.5)
IVTNUM = 22
RCBVS = -0.25
RCAVS = ANINT(RCBVS)
IF (RCAVS + 0.00005) 20220, 10220, 40220
40220 IF (RCAVS - 0.00005) 10220, 10220, 20220
10220 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0221
20220 IVFAIL = IVFAIL + 1
RVCORR = -0.0
WRITE(NUVI, 80012) IVTNUM, RCAVS, RVCORR
0221 CONTINUE
CT023* TEST 23 THE VALUE -0.5
IVTNUM = 23
RCBVS = FLOAT(-1) / FLOAT(2)
RCAVS = ANINT(RCBVS)
IF (RCAVS + 1.0001) 20230, 10230, 40230
40230 IF (RCAVS + 0.99995) 10230, 10230, 20230
10230 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0231
20230 IVFAIL = IVFAIL + 1
RVCORR = -1.0
WRITE(NUVI, 80012) IVTNUM, RCAVS, RVCORR
0231 CONTINUE
CT024* TEST 24 A NEGATIVE VALUE WITH MAGNITUDE IN (.5,1)
IVTNUM = 24
RCBVS = -0.75
RCAVS = ANINT(RCBVS)
IF (RCAVS + 1.0001) 20240, 10240, 40240
40240 IF (RCAVS + 0.99995) 10240, 10240, 20240
10240 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0241
20240 IVFAIL = IVFAIL + 1
RVCORR = -1.0
WRITE(NUVI, 80012) IVTNUM, RCAVS, RVCORR
0241 CONTINUE
CT025* TEST 25 A NEGATIVE INTEGRAL VALUE
IVTNUM = 25
RCBVS = FLOAT(-5)
RCAVS = ANINT(RCBVS)
IF (RCAVS + 5.0003) 20250, 10250, 40250
40250 IF (RCAVS + 4.9997) 10250, 10250, 20250
10250 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0251
20250 IVFAIL = IVFAIL + 1
RVCORR = -5.0
WRITE(NUVI, 80012) IVTNUM, RCAVS, RVCORR
0251 CONTINUE
CT026* TEST 26 A NEGATIVE VALUE WITH MAGNITUDE IN (X,X+.5)
IVTNUM = 26
RCBVS = -10.46875
RCAVS = ANINT(RCBVS)
IF (RCAVS + 10.001) 20260, 10260, 40260
40260 IF (RCAVS + 9.9995) 10260, 10260, 20260
10260 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0261
20260 IVFAIL = IVFAIL + 1
RVCORR = -10.0
WRITE(NUVI, 80012) IVTNUM, RCAVS, RVCORR
0261 CONTINUE
CT027* TEST 27 A NEGATIVE VALUE WITH FRACTIONAL COMPONENT .5
IVTNUM = 27
RCBVS = FLOAT(-15) - FLOAT(1) / FLOAT(2)
RCAVS = ANINT(RCBVS)
IF (RCAVS + 16.001) 20270, 10270, 40270
40270 IF (RCAVS + 15.999) 10270, 10270, 20270
10270 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0271
20270 IVFAIL = IVFAIL + 1
RVCORR = -16.0
WRITE(NUVI, 80012) IVTNUM, RCAVS, RVCORR
0271 CONTINUE
CT028* TEST 28 A NEGATIVE VALUE WITH MAGNITUDE IN (X+.5,X+1)
IVTNUM = 28
RCBVS = -27.96875
RCAVS = ANINT(RCBVS)
IF (RCAVS + 28.002) 20280, 10280, 40280
40280 IF (RCAVS + 27.998) 10280, 10280, 20280
10280 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0281
20280 IVFAIL = IVFAIL + 1
RVCORR = -28.0
WRITE(NUVI, 80012) IVTNUM, RCAVS, RVCORR
0281 CONTINUE
CT029* TEST 29 AN ARITHMETIC EXPRESSION PRESENTED TO ANINT
IVTNUM = 29
RCDVS = 8.00
RCBVS = 7.25
RCAVS = ANINT(RCDVS - RCBVS)
IF (RCAVS - 0.99995) 20290, 10290, 40290
40290 IF (RCAVS - 1.0001) 10290, 10290, 20290
10290 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0291
20290 IVFAIL = IVFAIL + 1
RVCORR = 1.0
WRITE(NUVI, 80012) IVTNUM, RCAVS, RVCORR
0291 CONTINUE
CT030* TEST 30 AN ARGUMENT OF LOW MAGNITUDE
IVTNUM = 30
RCBVS = -5.9876E-35
RCAVS = ANINT(RCBVS)
IF (RCAVS + 0.00005) 20300, 10300, 40300
40300 IF (RCAVS - 0.00005) 10300, 10300, 20300
10300 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0301
20300 IVFAIL = IVFAIL + 1
RVCORR = 0.0
WRITE(NUVI, 80012) IVTNUM, RCAVS, RVCORR
0301 CONTINUE
C*****
WRITE(NUVI, 90002)
WRITE(NUVI, 90013)
WRITE(NUVI, 90014)
C*****
C***** TEST OF NINT
C*****
WRITE(NUVI, 15405)
15405 FORMAT (/ 8X, 12HTEST OF NINT)
C*****
CT031* TEST 31 THE VALUE ZERO
IVTNUM = 31
RCBVS = 0.0
ICAVI = NINT(RCBVS)
IF (ICAVI - 0) 20310, 10310, 20310
10310 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0311
20310 IVFAIL = IVFAIL + 1
IVCORR = 0
WRITE (NUVI, 80010) IVTNUM, ICAVI, IVCORR
0311 CONTINUE
CT032* TEST 32 ZERO PREFIXED WITH A MINUS SIGN
IVTNUM = 32
RCDVS = 0.0
ICAVI = NINT(-RCDVS)
IF (ICAVI - 0) 20320, 10320, 20320
10320 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0321
20320 IVFAIL = IVFAIL + 1
IVCORR = 0
WRITE (NUVI, 80010) IVTNUM, ICAVI, IVCORR
0321 CONTINUE
CT033* TEST 33 A VALUE IN (0,.5)
IVTNUM = 33
RCBVS = 0.25
ICAVI = NINT(RCBVS)
IF (ICAVI - 0) 20330, 10330, 20330
10330 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0331
20330 IVFAIL = IVFAIL + 1
IVCORR = 0
WRITE (NUVI, 80010) IVTNUM, ICAVI, IVCORR
0331 CONTINUE
CT034* TEST 34 THE VALUE 0.5
IVTNUM = 34
RCBVS = FLOAT(1) / FLOAT(2)
ICAVI = NINT(RCBVS)
IF (ICAVI - 1) 20340, 10340, 20340
10340 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0341
20340 IVFAIL = IVFAIL + 1
IVCORR = 1
WRITE (NUVI, 80010) IVTNUM, ICAVI, IVCORR
0341 CONTINUE
CT035* TEST 35 A VALUE IN (.5,1)
IVTNUM = 35
RCBVS = 0.75
ICAVI = NINT(RCBVS)
IF (ICAVI - 1) 20350, 10350, 20350
10350 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0351
20350 IVFAIL = IVFAIL + 1
IVCORR = 1
WRITE (NUVI, 80010) IVTNUM, ICAVI, IVCORR
0351 CONTINUE
CT036* TEST 36 AN INTEGRAL VALUE OTHER THAN 0, 1
IVTNUM = 36
RCBVS = FLOAT(5)
ICAVI = NINT(RCBVS)
IF (ICAVI - 5) 20360, 10360, 20360
10360 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0361
20360 IVFAIL = IVFAIL + 1
IVCORR = 5
WRITE (NUVI, 80010) IVTNUM, ICAVI, IVCORR
0361 CONTINUE
CT037* TEST 37 A VALUE IN (X,X+.5)
IVTNUM = 37
RCBVS = 10.46875
ICAVI = NINT(RCBVS)
IF (ICAVI - 10) 20370, 10370, 20370
10370 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0371
20370 IVFAIL = IVFAIL + 1
IVCORR = 10
WRITE (NUVI, 80010) IVTNUM, ICAVI, IVCORR
0371 CONTINUE
CT038* TEST 38 A VALUE WITH FRACTIONAL PART OF 0.5
IVTNUM = 38
RCBVS = FLOAT(15) + FLOAT(1) / FLOAT(2)
ICAVI = NINT(RCBVS)
IF (ICAVI - 16) 20380, 10380, 20380
10380 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0381
20380 IVFAIL = IVFAIL + 1
IVCORR = 16
WRITE (NUVI, 80010) IVTNUM, ICAVI, IVCORR
0381 CONTINUE
CT039* TEST 39 A VALUE IN (X+.5,X+1)
IVTNUM = 39
RCBVS = 27.96875
ICAVI = NINT(RCBVS)
IF (ICAVI - 28) 20390, 10390, 20390
10390 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0391
20390 IVFAIL = IVFAIL + 1
IVCORR = 28
WRITE (NUVI, 80010) IVTNUM, ICAVI, IVCORR
0391 CONTINUE
CT040* TEST 40 A NEGATIVE VALUE WITH MAGNITUDE IN (0.,5)
IVTNUM = 40
RCBVS = -0.25
ICAVI = NINT(RCBVS)
IF (ICAVI - 0) 20400, 10400, 20400
10400 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0401
20400 IVFAIL = IVFAIL + 1
IVCORR = 0
WRITE (NUVI, 80010) IVTNUM, ICAVI, IVCORR
0401 CONTINUE
CT041* TEST 41 THE VALUE -0.5
IVTNUM = 41
RCBVS = FLOAT(-1) / FLOAT(2)
ICAVI = NINT(RCBVS)
IF (ICAVI + 1) 20410, 10410, 20410
10410 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0411
20410 IVFAIL = IVFAIL + 1
IVCORR = -1
WRITE (NUVI, 80010) IVTNUM, ICAVI, IVCORR
0411 CONTINUE
CT042* TEST 42 A NEGATIVE VALUE WITH MAGNITUDE IN (.5,1)
IVTNUM = 42
RCBVS = -0.75
ICAVI = NINT(RCBVS)
IF (ICAVI + 1) 20420, 10420, 20420
10420 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0421
20420 IVFAIL = IVFAIL + 1
IVCORR = -1
WRITE (NUVI, 80010) IVTNUM, ICAVI, IVCORR
0421 CONTINUE
CT043* TEST 43 A NEGATIVE INTEGRAL VALUE
IVTNUM = 43
RCBVS = FLOAT(-5)
ICAVI = NINT(RCBVS)
IF (ICAVI + 5) 20430, 10430, 20430
10430 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0431
20430 IVFAIL = IVFAIL + 1
IVCORR = -5
WRITE (NUVI, 80010) IVTNUM, ICAVI, IVCORR
0431 CONTINUE
CT044* TEST 44 A NEGATIVE VALUE WITH MAGNITUDE IN (X,X+.5)
IVTNUM = 44
RCBVS = -10.46875
ICAVI = NINT(RCBVS)
IF (ICAVI + 10) 20440, 10440, 20440
10440 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0441
20440 IVFAIL = IVFAIL + 1
IVCORR = -10
WRITE (NUVI, 80010) IVTNUM, ICAVI, IVCORR
0441 CONTINUE
CT045* TEST 45 A NEGATIVE VALUE WITH FRACTIONAL COMPONENT 0.5 S1
IVTNUM = 45
RCBVS = FLOAT(-15) - FLOAT(1) / FLOAT(2)
ICAVI = NINT(RCBVS)
IF (ICAVI + 16) 20450, 10450, 20450
10450 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0451
20450 IVFAIL = IVFAIL + 1
IVCORR = -16
WRITE (NUVI, 80010) IVTNUM, ICAVI, IVCORR
0451 CONTINUE
CT046* TEST 46 A NEGATIVE VALUE WITH MAGNITUDE IN (X+.5,X+1) S1
IVTNUM = 46
RCBVS = -27.96875
ICAVI = NINT(RCBVS)
IF (ICAVI + 28) 20460, 10460, 20460
10460 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0461
20460 IVFAIL = IVFAIL + 1
IVCORR = -28
WRITE (NUVI, 80010) IVTNUM, ICAVI, IVCORR
0461 CONTINUE
CT047* TEST 47 AN ARITHMETIC EXPRESSION PRESENTED TO NINT S1
IVTNUM = 47
RCDVS = 8.00
RCEVS = 7.25
ICAVI = NINT(RCDVS - RCEVS)
IF (ICAVI - 1) 20470, 10470, 20470
10470 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0471
20470 IVFAIL = IVFAIL + 1
IVCORR = 1
WRITE (NUVI, 80010) IVTNUM, ICAVI, IVCORR
0471 CONTINUE
CT048* TEST 48 AN ARGUMENT OF LOW MAGNITUDE
IVTNUM = 48
RCBVS = -5.9876E-33
ICAVI = NINT(RCBVS)
IF (ICAVI - 0) 20480, 10480, 20480
10480 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0481
20480 IVFAIL = IVFAIL + 1
IVCORR = 0
WRITE (NUVI, 80010) IVTNUM, ICAVI, IVCORR
0481 CONTINUE
C*****
CBB** ********************** BBCSUM0 **********************************
C**** WRITE OUT TEST SUMMARY
C****
IVTOTN = IVPASS + IVFAIL + IVDELE + IVINSP
WRITE (I02, 90004)
WRITE (I02, 90014)
WRITE (I02, 90004)
WRITE (I02, 90020) IVPASS
WRITE (I02, 90022) IVFAIL
WRITE (I02, 90024) IVDELE
WRITE (I02, 90026) IVINSP
WRITE (I02, 90028) IVTOTN, IVTOTL
CBE** ********************** BBCSUM0 **********************************
CBB** ********************** BBCFOOT0 **********************************
C**** WRITE OUT REPORT FOOTINGS
C****
WRITE (I02,90016) ZPROG, ZPROG
WRITE (I02,90018) ZPROJ, ZNAME, ZTAPE, ZTAPED
WRITE (I02,90019)
CBE** ********************** BBCFOOT0 **********************************
CBB** ********************** BBCFMT0A **********************************
C**** FORMATS FOR TEST DETAIL LINES
C****
80000 FORMAT (1H ,2X,I3,4X,7HDELETED,32X,A31)
80002 FORMAT (1H ,2X,I3,4X,7H PASS ,32X,A31)
80004 FORMAT (1H ,2X,I3,4X,7HINSPECT,32X,A31)
80008 FORMAT (1H ,2X,I3,4X,7H FAIL ,32X,A31)
80010 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,15X,10HCOMPUTED= ,
1I6,/,1H ,15X,10HCORRECT= ,I6)
80012 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
1E12.5,/,1H ,16X,10HCORRECT= ,E12.5)
80018 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
1A21,/,1H ,16X,10HCORRECT= ,A21)
80020 FORMAT (1H ,16X,10HCOMPUTED= ,A21,1X,A31)
80022 FORMAT (1H ,16X,10HCORRECT= ,A21,1X,A31)
80024 FORMAT (1H ,16X,10HCOMPUTED= ,I6,16X,A31)
80026 FORMAT (1H ,16X,10HCORRECT= ,I6,16X,A31)
80028 FORMAT (1H ,16X,10HCOMPUTED= ,E12.5,10X,A31)
80030 FORMAT (1H ,16X,10HCORRECT= ,E12.5,10X,A31)
80050 FORMAT (1H ,48X,A31)
CBE** ********************** BBCFMT0A **********************************
CBB** ********************** BBCFMT0B **********************************
C**** FORMAT STATEMENTS FOR PAGE HEADERS
C****
90002 FORMAT (1H1)
90004 FORMAT (1H )
90006 FORMAT (1H ,20X,31HFEDERAL SOFTWARE TESTING CENTER)
90007 FORMAT (1H ,19X,34HFORTRAN COMPILER VALIDATION SYSTEM)
90008 FORMAT (1H ,21X,A13,A17)
90009 FORMAT (1H ,/,2H *,A5,6HBEGIN*,12X,15HTEST RESULTS - ,A5,/)
90010 FORMAT (1H ,8X,16HTEST DATE*TIME= ,A17,15H - COMPILER= ,A20)
90013 FORMAT (1H ,8H TEST ,10HPASS/FAIL ,6X,17HDISPLAYED RESULTS,
1 7X,7HREMARKS,24X)
90014 FORMAT (1H ,46H----------------------------------------------,
1 33H---------------------------------)
90015 FORMAT (1H ,48X,17HTHIS PROGRAM HAS ,I3,6H TESTS,/)
C****
C**** FORMAT STATEMENTS FOR REPORT FOOTINGS
C****
90016 FORMAT (1H ,/,2H *,A5,4HEND*,14X,14HEND OF TEST - ,A5,/)
90018 FORMAT (1H ,A13,13X,A20,7H * ,A10,1H/,
1 A13)
90019 FORMAT (1H ,26HFOR OFFICIAL USE ONLY ,35X,15HCOPYRIGHT 1982)
C****
C**** FORMAT STATEMENTS FOR RUN SUMMARY
C****
90020 FORMAT (1H ,21X,I5,13H TESTS PASSED)
90022 FORMAT (1H ,21X,I5,13H TESTS FAILED)
90024 FORMAT (1H ,21X,I5,14H TESTS DELETED)
90026 FORMAT (1H ,21X,I5,25H TESTS REQUIRE INSPECTION)
90028 FORMAT (1H ,21X,I5,4H OF ,I3,15H TESTS EXECUTED)
CBE** ********************** BBCFMT0B **********************************
C*****
C***** END OF TEST SEGMENT 154
STOP
END
*END-OF,FM355
FM356.f 481036256 170 2 100666 12083 `
*HEADER,FORTR,FM356
*FILES1,FORTR,FM356,X
C***********************************************************************
C***** FORTRAN 77
C***** FM356 XABS - (156)
C*****
C***********************************************************************
C***** GENERAL PURPOSE SUBSET REF
C***** TEST INTRINSIC FUNCTION ABS,IABS (ABSOLUTE VALUE) 15.3
C***** (TABLE 5)
C*****
CBB** ********************** BBCCOMNT **********************************
C****
C**** 1978 FORTRAN COMPILER VALIDATION SYSTEM
C**** VERSION 2.0
C****
C****
C**** SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO
C**** GENERAL SERVICES ADMINISTRATION
C**** FEDERAL SOFTWARE TESTING CENTER
C**** 5203 LEESBURG PIKE, SUITE 1100
C**** FALLS CHURCH, VA. 22041
C****
C**** (703) 756-6153
C****
CBE** ********************** BBCCOMNT **********************************
CBB** ********************** BBCINITA **********************************
C**** SPECIFICATION STATEMENTS
C****
CHARACTER ZVERS*13, ZVERSD*17, ZDATE*17, ZPROG*5, ZCOMPL*20,
1 ZNAME*20, ZTAPE*10, ZPROJ*13, REMRKS*31, ZTAPED*13
CBE** ********************** BBCINITA **********************************
CBB** ********************** BBCINITB **********************************
C**** INITIALIZE SECTION
DATA ZVERS, ZVERSD, ZDATE
1 /'VERSION 2.0 ', '82/08/02*18.33.46', '*NO DATE*TIME'/
DATA ZCOMPL, ZNAME, ZTAPE
1 /'*NONE SPECIFIED*', '*NO COMPANY NAME*', '*NO TAPE*'/
DATA ZPROJ, ZTAPED, ZPROG
1 /'*NO PROJECT*', '*NO TAPE DATE', 'XXXXX'/
DATA REMRKS /' '/
C**** THE FOLLOWING 9 COMMENT LINES (CZ01, CZ02, ...) CAN BE REPLACED
C**** FOR IDENTIFYING THE TEST ENVIRONMENT
C****
CZ01 ZVERS = 'VERSION OF THE COMPILER VALIDATION SYSTEM'
CZ02 ZVERSD = 'CREATION DATE/TIME OF THE COMPILER VALIDATION SYSTEM'
CZ03 ZPROG = 'PROGRAM NAME'
CZ04 ZDATE = 'DATE OF TEST'
CZ05 ZCOMPL = 'COMPILER IDENTIFICATION'
CZ06 ZPROJ = 'PROJECT NUMBER/IDENTIFICATION'
CZ07 ZNAME = 'NAME OF USER'
CZ08 ZTAPE = 'TAPE OWNER/ID'
CZ09 ZTAPED = 'DATE TAPE COPIED'
C
IVPASS = 0
IVFAIL = 0
IVDELE = 0
IVINSP = 0
IVTOTL = 0
IVTOTN = 0
ICZERO = 0
C
C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER.
I01 = 05
C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER.
I02 = 06
C
CX010 REPLACED BY FEXEC X-010 CONTROL CARD (CARD-READER UNIT NUMBER).
C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5
CX011 REPLACED BY FEXEC X-011 CONTROL CARD. CX011 IS FOR SYSTEMS
C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX010.
C
CX020 REPLACED BY FEXEC X-020 CONTROL CARD (PRINTER UNIT NUMBER).
C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02= 6
CX021 REPLACED BY FEXEC X-021 CONTROL CARD. CX021 IS FOR SYSTEMS
C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX020.
C
CBE** ********************** BBCINITB **********************************
NUVI = I02
IVTOTL = 10
ZPROG = 'FM356'
CBB** ********************** BBCHED0A **********************************
C****
C**** WRITE REPORT TITLE
C****
WRITE (I02, 90002)
WRITE (I02, 90006)
WRITE (I02, 90007)
WRITE (I02, 90008) ZVERS, ZVERSD
WRITE (I02, 90009) ZPROG, ZPROG
WRITE (I02, 90010) ZDATE, ZCOMPL
CBE** ********************** BBCHED0A **********************************
C*****
C***** HEADER FOR SEGMENT 156
WRITE(NUVI,15601)
15601 FORMAT( 1H , // 36H XABS - (156) INTRINSIC FUNCTIONS--// 11X,
1 26HABS, IABS (ABSOLUTE VALUE)//
2 20H SUBSET REF. - 15.3)
CBB** ********************** BBCHED0B **********************************
C**** WRITE DETAIL REPORT HEADERS
C****
WRITE (I02,90004)
WRITE (I02,90004)
WRITE (I02,90013)
WRITE (I02,90014)
WRITE (I02,90015) IVTOTL
CBE** ********************** BBCHED0B **********************************
C*****
C***** TEST OF ABS
C*****
WRITE(NUVI, 15602)
15602 FORMAT (/ 8X, 11HTEST OF ABS)
CT001* TEST 1 THE VALUE ZERO
IVTNUM = 1
RDDVS = 0.0
RDAVS = ABS(RDDVS)
IF (RDAVS + .00005) 20010, 10010, 40010
40010 IF (RDAVS - .00005) 10010, 10010, 20010
10010 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0011
20010 IVFAIL = IVFAIL + 1
RVCORR = 0.0
WRITE (NUVI, 80012) IVTNUM, RDAVS, RVCORR
0011 CONTINUE
CT002* TEST 2 ZERO PREFIXED WITH A MINUS SIGN
IVTNUM = 2
RDDVS = 0.0
RDAVS = ABS(-RDDVS)
IF (RDAVS + .00005) 20020, 10020, 40020
40020 IF (RDAVS - .00005) 10020, 10020, 20020
10020 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0021
20020 IVFAIL = IVFAIL + 1
RVCORR = 0.0
WRITE (NUVI, 80012) IVTNUM, RDAVS, RVCORR
0021 CONTINUE
CT003* TEST 3 A POSITIVE NON-INTEGRAL VALUE
IVTNUM = 3
RDDVS = 35.875
RDAVS = ABS(RDDVS)
IF (RDAVS - 35.873) 20030, 10030, 40030
40030 IF (RDAVS - 35.877) 10030, 10030, 20030
10030 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0031
20030 IVFAIL = IVFAIL + 1
RVCORR = 35.875
WRITE (NUVI, 80012) IVTNUM, RDAVS, RVCORR
0031 CONTINUE
CT004* TEST 4 A NEGATIVE NON-INTEGRAL VALUE
IVTNUM = 4
RDBVS = -35.875
RDAVS = ABS(RDBVS)
IF (RDAVS - 35.873) 20040, 10040, 40040
40040 IF (RDAVS - 35.877) 10040, 10040, 20040
10040 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0041
20040 IVFAIL = IVFAIL + 1
RVCORR = 35.875
WRITE (NUVI, 80012) IVTNUM, RDAVS, RVCORR
0041 CONTINUE
CT005* TEST 5 ARITHMETIC EXPRESSION PRESENTED TO FUNCTION
IVTNUM = 5
RDDVS = 2.625
RDEVS = 3.0
RDAVS = ABS(-RDDVS - RDEVS ** 3)
IF (RDAVS - 29.623) 20050, 10050, 40050
40050 IF (RDAVS - 29.627) 10050, 10050, 20050
10050 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0051
20050 IVFAIL = IVFAIL + 1
RVCORR = 29.625
WRITE (NUVI, 80012) IVTNUM, RDAVS, RVCORR
0051 CONTINUE
C*****
C***** TEST OF IABS
C*****
WRITE(NUVI, 15604)
15604 FORMAT (/ 8X, 12HTEST OF IABS)
C*****
CT006* TEST 6 THE VALUE ZERO
IVTNUM = 6
IDDVI = 0
IDAVI = IABS(IDDVI)
IF (IDAVI - 0) 20060, 10060, 20060
10060 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0061
20060 IVFAIL = IVFAIL + 1
IVCORR = 0
WRITE (NUVI, 80010) IVTNUM, IDAVI, IVCORR
0061 CONTINUE
CT007* TEST 7 ZERO PREFIXED WITH A MINUS SIGN
IVTNUM = 7
IDDVI = 0
IDAVI = IABS(-IDDVI)
IF (IDAVI - 0) 20070, 10070, 20070
10070 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0071
20070 IVFAIL = IVFAIL + 1
IVCORR = 0
WRITE (NUVI, 80010) IVTNUM, IDAVI, IVCORR
0071 CONTINUE
CT008* TEST 8 A POSITIVE INTEGER
IVTNUM = 8
IDBVI = 73
IDAVI = IABS(IDBVI)
IF (IDAVI - 73) 20080, 10080, 20080
10080 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0081
20080 IVFAIL = IVFAIL + 1
IVCORR = 73
WRITE (NUVI, 80010) IVTNUM, IDAVI, IVCORR
0081 CONTINUE
CT009* TEST 9 A NEGATIVE INTEGER
IVTNUM = 9
IDDVI = -10
IDAVI = IABS(IDDVI)
IF (IDAVI - 10) 20090, 10090, 20090
10090 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0091
20090 IVFAIL = IVFAIL + 1
IVCORR = 10
WRITE (NUVI, 80010) IVTNUM, IDAVI, IVCORR
0091 CONTINUE
CT010* TEST 10 ARITHMETIC EXPRESSION PRESENTED TO FUNCTION
IVTNUM = 10
IDDVI = -3
IDAVI = IABS(IDDVI ** 3)
IF (IDAVI - 27) 20100, 10100, 20100
10100 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0101
20100 IVFAIL = IVFAIL + 1
IVCORR = 27
WRITE (NUVI, 80010) IVTNUM, IDAVI, IVCORR
0101 CONTINUE
C*****
CBB** ********************** BBCSUM0 **********************************
C**** WRITE OUT TEST SUMMARY
C****
IVTOTN = IVPASS + IVFAIL + IVDELE + IVINSP
WRITE (I02, 90004)
WRITE (I02, 90014)
WRITE (I02, 90004)
WRITE (I02, 90020) IVPASS
WRITE (I02, 90022) IVFAIL
WRITE (I02, 90024) IVDELE
WRITE (I02, 90026) IVINSP
WRITE (I02, 90028) IVTOTN, IVTOTL
CBE** ********************** BBCSUM0 **********************************
CBB** ********************** BBCFOOT0 **********************************
C**** WRITE OUT REPORT FOOTINGS
C****
WRITE (I02,90016) ZPROG, ZPROG
WRITE (I02,90018) ZPROJ, ZNAME, ZTAPE, ZTAPED
WRITE (I02,90019)
CBE** ********************** BBCFOOT0 **********************************
CBB** ********************** BBCFMT0A **********************************
C**** FORMATS FOR TEST DETAIL LINES
C****
80000 FORMAT (1H ,2X,I3,4X,7HDELETED,32X,A31)
80002 FORMAT (1H ,2X,I3,4X,7H PASS ,32X,A31)
80004 FORMAT (1H ,2X,I3,4X,7HINSPECT,32X,A31)
80008 FORMAT (1H ,2X,I3,4X,7H FAIL ,32X,A31)
80010 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,15X,10HCOMPUTED= ,
1I6,/,1H ,15X,10HCORRECT= ,I6)
80012 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
1E12.5,/,1H ,16X,10HCORRECT= ,E12.5)
80018 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
1A21,/,1H ,16X,10HCORRECT= ,A21)
80020 FORMAT (1H ,16X,10HCOMPUTED= ,A21,1X,A31)
80022 FORMAT (1H ,16X,10HCORRECT= ,A21,1X,A31)
80024 FORMAT (1H ,16X,10HCOMPUTED= ,I6,16X,A31)
80026 FORMAT (1H ,16X,10HCORRECT= ,I6,16X,A31)
80028 FORMAT (1H ,16X,10HCOMPUTED= ,E12.5,10X,A31)
80030 FORMAT (1H ,16X,10HCORRECT= ,E12.5,10X,A31)
80050 FORMAT (1H ,48X,A31)
CBE** ********************** BBCFMT0A **********************************
CBB** ********************** BBCFMT0B **********************************
C**** FORMAT STATEMENTS FOR PAGE HEADERS
C****
90002 FORMAT (1H1)
90004 FORMAT (1H )
90006 FORMAT (1H ,20X,31HFEDERAL SOFTWARE TESTING CENTER)
90007 FORMAT (1H ,19X,34HFORTRAN COMPILER VALIDATION SYSTEM)
90008 FORMAT (1H ,21X,A13,A17)
90009 FORMAT (1H ,/,2H *,A5,6HBEGIN*,12X,15HTEST RESULTS - ,A5,/)
90010 FORMAT (1H ,8X,16HTEST DATE*TIME= ,A17,15H - COMPILER= ,A20)
90013 FORMAT (1H ,8H TEST ,10HPASS/FAIL ,6X,17HDISPLAYED RESULTS,
1 7X,7HREMARKS,24X)
90014 FORMAT (1H ,46H----------------------------------------------,
1 33H---------------------------------)
90015 FORMAT (1H ,48X,17HTHIS PROGRAM HAS ,I3,6H TESTS,/)
C****
C**** FORMAT STATEMENTS FOR REPORT FOOTINGS
C****
90016 FORMAT (1H ,/,2H *,A5,4HEND*,14X,14HEND OF TEST - ,A5,/)
90018 FORMAT (1H ,A13,13X,A20,7H * ,A10,1H/,
1 A13)
90019 FORMAT (1H ,26HFOR OFFICIAL USE ONLY ,35X,15HCOPYRIGHT 1982)
C****
C**** FORMAT STATEMENTS FOR RUN SUMMARY
C****
90020 FORMAT (1H ,21X,I5,13H TESTS PASSED)
90022 FORMAT (1H ,21X,I5,13H TESTS FAILED)
90024 FORMAT (1H ,21X,I5,14H TESTS DELETED)
90026 FORMAT (1H ,21X,I5,25H TESTS REQUIRE INSPECTION)
90028 FORMAT (1H ,21X,I5,4H OF ,I3,15H TESTS EXECUTED)
CBE** ********************** BBCFMT0B **********************************
C*****
C***** END OF TEST SEGMENT 156
STOP
END
*END-OF,FM356
FM357.f 481036260 170 2 100666 18009 `
*HEADER,FORTR,FM357
*FILES1,FORTR,FM357,X
C***********************************************************************
C***** FORTRAN 77
C***** FM357 XAMOD - (159)
C*****
C***********************************************************************
C***** GENERAL PURPOSE ANS REF
C***** TEST INTRINSIC FUNCTIONS AMOD AND MOD - REMAINDERING, 15.3
C***** WHICH IS DEFINED AS A1-(A1/A2)A2 WHERE (X) IS AN (TABLE 5)
C***** INTEGER WHOSE MAGNITUDE IS LE ABS(X) AND WHOSE SIGN
C***** IS THE SAME AS X.
C*****
CBB** ********************** BBCCOMNT **********************************
C****
C**** 1978 FORTRAN COMPILER VALIDATION SYSTEM
C**** VERSION 2.0
C****
C****
C**** SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO
C**** GENERAL SERVICES ADMINISTRATION
C**** FEDERAL SOFTWARE TESTING CENTER
C**** 5203 LEESBURG PIKE, SUITE 1100
C**** FALLS CHURCH, VA. 22041
C****
C**** (703) 756-6153
C****
CBE** ********************** BBCCOMNT **********************************
CBB** ********************** BBCINITA **********************************
C**** SPECIFICATION STATEMENTS
C****
CHARACTER ZVERS*13, ZVERSD*17, ZDATE*17, ZPROG*5, ZCOMPL*20,
1 ZNAME*20, ZTAPE*10, ZPROJ*13, REMRKS*31, ZTAPED*13
CBE** ********************** BBCINITA **********************************
CBB** ********************** BBCINITB **********************************
C**** INITIALIZE SECTION
DATA ZVERS, ZVERSD, ZDATE
1 /'VERSION 2.0 ', '82/08/02*18.33.46', '*NO DATE*TIME'/
DATA ZCOMPL, ZNAME, ZTAPE
1 /'*NONE SPECIFIED*', '*NO COMPANY NAME*', '*NO TAPE*'/
DATA ZPROJ, ZTAPED, ZPROG
1 /'*NO PROJECT*', '*NO TAPE DATE', 'XXXXX'/
DATA REMRKS /' '/
C**** THE FOLLOWING 9 COMMENT LINES (CZ01, CZ02, ...) CAN BE REPLACED
C**** FOR IDENTIFYING THE TEST ENVIRONMENT
C****
CZ01 ZVERS = 'VERSION OF THE COMPILER VALIDATION SYSTEM'
CZ02 ZVERSD = 'CREATION DATE/TIME OF THE COMPILER VALIDATION SYSTEM'
CZ03 ZPROG = 'PROGRAM NAME'
CZ04 ZDATE = 'DATE OF TEST'
CZ05 ZCOMPL = 'COMPILER IDENTIFICATION'
CZ06 ZPROJ = 'PROJECT NUMBER/IDENTIFICATION'
CZ07 ZNAME = 'NAME OF USER'
CZ08 ZTAPE = 'TAPE OWNER/ID'
CZ09 ZTAPED = 'DATE TAPE COPIED'
C
IVPASS = 0
IVFAIL = 0
IVDELE = 0
IVINSP = 0
IVTOTL = 0
IVTOTN = 0
ICZERO = 0
C
C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER.
I01 = 05
C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER.
I02 = 06
C
CX010 REPLACED BY FEXEC X-010 CONTROL CARD (CARD-READER UNIT NUMBER).
C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5
CX011 REPLACED BY FEXEC X-011 CONTROL CARD. CX011 IS FOR SYSTEMS
C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX010.
C
CX020 REPLACED BY FEXEC X-020 CONTROL CARD (PRINTER UNIT NUMBER).
C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02= 6
CX021 REPLACED BY FEXEC X-021 CONTROL CARD. CX021 IS FOR SYSTEMS
C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX020.
C
CBE** ********************** BBCINITB **********************************
NUVI = I02
IVTOTL = 22
ZPROG = 'FM357'
CBB** ********************** BBCHED0A **********************************
C****
C**** WRITE REPORT TITLE
C****
WRITE (I02, 90002)
WRITE (I02, 90006)
WRITE (I02, 90007)
WRITE (I02, 90008) ZVERS, ZVERSD
WRITE (I02, 90009) ZPROG, ZPROG
WRITE (I02, 90010) ZDATE, ZCOMPL
CBE** ********************** BBCHED0A **********************************
C*****
C***** HEADER FOR SEGMENT 159 WRITTEN
WRITE (NUVI,15901)
15901 FORMAT (1H , //, 2X,35HXAMOD - (159) INTRINSIC FUNCTION-- //16X,
1 24HAMOD, MOD (REMAINDERING)//19H SUBSET REF. - 15.3)
CBB** ********************** BBCHED0B **********************************
C**** WRITE DETAIL REPORT HEADERS
C****
WRITE (I02,90004)
WRITE (I02,90004)
WRITE (I02,90013)
WRITE (I02,90014)
WRITE (I02,90015) IVTOTL
CBE** ********************** BBCHED0B **********************************
C*****
C***** TEST OF AMOD
C*****
WRITE(NUVI, 15902)
15902 FORMAT (/ 8X, 12HTEST OF AMOD)
C*****
CT001* TEST 1 FIRST VALUE ZERO, SECOND NON-ZERO
IVTNUM = 1
REBVS = 0.0
REDVS = 4.5
REAVS = AMOD(REBVS, REDVS)
IF (REAVS + 0.00005) 20010, 10010, 40010
40010 IF (REAVS - 0.00005) 10010, 10010, 20010
10010 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0011
20010 IVFAIL = IVFAIL + 1
RVCORR = 0.0
WRITE (NUVI,80012) IVTNUM, REAVS, RVCORR
0011 CONTINUE
CT002* TEST 2 BOTH VALUES EQUAL
IVTNUM = 2
REBVS = 3.5
REDVS = 3.5
REAVS = AMOD(REBVS, REDVS)
IF (REAVS + 0.00005) 20020, 10020, 40020
40020 IF (REAVS - 0.00005) 10020, 10020, 20020
10020 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0021
20020 IVFAIL = IVFAIL + 1
RVCORR = 0.0
WRITE(NUVI, 80012) IVTNUM, REAVS, RVCORR
0021 CONTINUE
CT003* TEST 3 FIRST MAGNITUDE LARGER, NOT MULTIPLE OF SECOND
IVTNUM = 3
REBVS = -10.9
REDVS = -3.3
REAVS = AMOD(REBVS, REDVS)
IF (REAVS + 1.0001) 20030, 10030, 40030
40030 IF (REAVS + 0.99995) 10030, 10030, 20030
10030 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0031
20030 IVFAIL = IVFAIL + 1
RVCORR = -1.0
WRITE(NUVI, 80012) IVTNUM, REAVS, RVCORR
0031 CONTINUE
CT004* TEST 4 FIRST MAGNITUDE LARGER, MULTIPLE OF SECOND
IVTNUM = 4
REDVS = 1.5
REBVS = 1.5 + REDVS + 1.5
REAVS = AMOD(REBVS, REDVS)
IF (REAVS + 0.00005) 20040, 10040, 40040
40040 IF (REAVS - 0.00005) 10040, 10040, 20040
10040 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0041
20040 IVFAIL = IVFAIL + 1
RVCORR = 0.0
WRITE(NUVI, 80012) IVTNUM, REAVS, RVCORR
0041 CONTINUE
CT005* TEST 5 FIRST MAGNITUDE LARGER, NOT MULTIPLE OF SECOND
IVTNUM = 5
REBVS = 7.625
REDVS = 2.125
REAVS = AMOD(REBVS, REDVS)
IF (REAVS - 1.2499) 20050, 10050, 40050
40050 IF (REAVS - 1.2501) 10050, 10050, 20050
10050 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0051
20050 IVFAIL = IVFAIL + 1
RVCORR = 1.25
WRITE(NUVI, 80012) IVTNUM, REAVS, RVCORR
0051 CONTINUE
CT006* TEST 6 FIRST VALUE ZERO, SECOND NEGATIVE
IVTNUM = 6
REBVS = 0.0
REDVS = -4.5
REAVS = AMOD(REBVS, REDVS)
IF (REAVS + 0.00005) 20060, 10060, 40060
40060 IF (REAVS - 0.00005) 10060, 10060, 20060
10060 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0061
20060 IVFAIL = IVFAIL + 1
RVCORR = 0.0
WRITE(NUVI, 80012) IVTNUM, REAVS, RVCORR
0061 CONTINUE
CT007* TEST 7 BOTH VALUES EQUAL, BOTH NEGATIVE
IVTNUM = 7
REBVS = -3.5
REDVS = -3.5
REAVS = AMOD(REBVS, REDVS)
IF (REAVS + 0.00005) 20070, 10070, 40070
40070 IF (REAVS - 0.00005) 10070, 10070, 20070
10070 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0071
20070 IVFAIL = IVFAIL + 1
RVCORR = 0.0
WRITE(NUVI, 80012) IVTNUM, REAVS, RVCORR
0071 CONTINUE
CT008* TEST 8 FIRST VALUE NEGATIVE, SECOND POSITIVE, MULTIPLE
IVTNUM = 8
REBVS = 1.5
REDVS = -(1.5 + REDVS + 1.5)
REAVS = AMOD(-REBVS, -REDVS)
IF (REAVS + 0.00005) 20080, 10080, 40080
40080 IF (REAVS - 0.00005) 10080, 10080, 20080
10080 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0081
20080 IVFAIL = IVFAIL + 1
RVCORR = 0.0
WRITE(NUVI, 80012) IVTNUM, REAVS, RVCORR
0081 CONTINUE
CT009* TEST 9 FIRST MAGNITUDE LARGER, NOT MULTIPLE OF SECOND
IVTNUM = 9
REBVS = 10.5
REDVS = -3.3
REAVS = AMOD(REBVS, REDVS)
IF (REAVS - 0.59997) 20090, 10090, 40090
40090 IF (REAVS - 0.60003) 10090, 10090, 20090
10090 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0091
20090 IVFAIL = IVFAIL + 1
RVCORR = 0.6
WRITE(NUVI, 80012) IVTNUM, REAVS, RVCORR
0091 CONTINUE
CT010* TEST 10 PAIR OF ARITHMETIC EXPRESSIONS USED AS ARGUMENT
IVTNUM = 10
RECVS = 7.625
REDVS = 2.125
REFVS = 2.0
REAVS = AMOD(RECVS - REFVS, REDVS + REFVS)
IF (REAVS - 1.4999) 20100, 10100, 40100
40100 IF (REAVS - 1.5001) 10100, 10100, 20100
10100 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0101
20100 IVFAIL = IVFAIL + 1
RVCORR = 1.5
WRITE(NUVI, 80012) IVTNUM, REAVS, RVCORR
0101 CONTINUE
CT011* TEST 11 TEST LOW AND HIGH MAGNITUDE ARGUMENTS
IVTNUM = 11
RECVS = 1.0E-16
REDVS = 1.0E+16
REAVS = AMOD(RECVS, REDVS)
IF (REAVS - 0.99995E-16) 20110, 10110, 40110
40110 IF (REAVS - 1.0001E-16) 10110, 10110, 20110
10110 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0111
20110 IVFAIL = IVFAIL + 1
RVCORR = 1.0E-16
WRITE(NUVI, 80012) IVTNUM, REAVS, RVCORR
0111 CONTINUE
C*****
C***** TEST OF MOD
C*****
WRITE(NUVI, 15904)
15904 FORMAT (/ 8X, 11HTEST OF MOD)
C*****
CT012* TEST 12 FIRST VALUE ZERO, SECOND NON-ZERO
IVTNUM = 12
IEBVI = 0
IEDVI = 4
IEAVI = MOD(IEBVI, IEDVI)
IF (IEAVI - 0) 20120, 10120, 20120
10120 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0121
20120 IVFAIL = IVFAIL + 1
IVCORR = 0
WRITE (NUVI, 80010) IVTNUM, IEAVI, IVCORR
0121 CONTINUE
CT013* TEST 13 BOTH VALUES EQUAL
IVTNUM = 13
IEBVI = 3
IEDVI = 3
IEAVI = MOD(IEBVI, IEDVI)
IF (IEAVI - 0) 20130, 10130, 20130
10130 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0131
20130 IVFAIL = IVFAIL + 1
IVCORR = 0
WRITE (NUVI, 80010) IVTNUM, IEAVI, IVCORR
0131 CONTINUE
CT014* TEST 14 FIRST MAGNITUDE LARGER, NOT MULTIPLE OF SECOND
IVTNUM = 14
IEBVI = -10
IEDVI = -3
IEAVI = MOD(IEBVI, IEDVI)
IF (IEAVI + 1) 20140, 10140, 20140
10140 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0141
20140 IVFAIL = IVFAIL + 1
IVCORR = -1
WRITE (NUVI, 80010) IVTNUM, IEAVI, IVCORR
0141 CONTINUE
CT015* TEST 15 FIRST MAGNITUDE LARGER, MULTIPLE OF SECOND
IVTNUM = 15
IEBVI = 9
IEDVI = 3
IEAVI = MOD(IEBVI, IEDVI)
IF (IEAVI - 0) 20150, 10150, 20150
10150 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0151
20150 IVFAIL = IVFAIL + 1
IVCORR = 0
WRITE (NUVI, 80010) IVTNUM, IEAVI, IVCORR
0151 CONTINUE
CT016* TEST 16 FIRST MAGNITUDE LARGER, NOT MULTIPLE OF SECOND
IVTNUM = 16
IEBVI = 7
IEDVI = 2
IEAVI = MOD(IEBVI, IEDVI)
IF (IEAVI - 1) 20160, 10160, 20160
10160 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0161
20160 IVFAIL = IVFAIL + 1
IVCORR = 1
WRITE (NUVI, 80010) IVTNUM, IEAVI, IVCORR
0161 CONTINUE
CT017* TEST 17 FIRST VALUE ZERO, SECOND NEGATIVE
IVTNUM = 17
IEBVI = 0
IEDVI = -4
IEAVI = MOD(IEBVI, IEDVI)
IF (IEAVI - 0) 20170, 10170, 20170
10170 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0171
20170 IVFAIL = IVFAIL + 1
IVCORR = 0
WRITE (NUVI, 80010) IVTNUM, IEAVI, IVCORR
0171 CONTINUE
CT018* TEST 18 BOTH VALUES EQUAL, BOTH NEGATIVE
IVTNUM = 18
IEBVI = -3
IEDVI = -3
IEAVI = MOD(IEBVI, IEDVI)
IF (IEAVI - 0) 20180, 10180, 20180
10180 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0181
20180 IVFAIL = IVFAIL + 1
IVCORR = 0
WRITE (NUVI, 80010) IVTNUM, IEAVI, IVCORR
0181 CONTINUE
CT019* TEST 19 FIRST MAGNITUDE LARGER, MULTIPLE, BOTH NEGATIVE
IVTNUM = 19
IEBVI = -9
IEDVI = -3
IEAVI = MOD(IEBVI, IEDVI)
IF (IEAVI - 0) 20190, 10190, 20190
10190 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0191
20190 IVFAIL = IVFAIL + 1
IVCORR = 0
WRITE (NUVI, 80010) IVTNUM, IEAVI, IVCORR
0191 CONTINUE
CT020* TEST 20 FIRST NUMBER NEGATIVE, SECOND POSITIVE, MULTIPLE
IVTNUM = 20
IEBVI = -9
IEDVI = 3
IEAVI = MOD(IEBVI, IEDVI)
IF (IEAVI - 0) 20200, 10200, 20200
10200 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0201
20200 IVFAIL = IVFAIL + 1
IVCORR = 0
WRITE (NUVI, 80010) IVTNUM, IEAVI, IVCORR
0201 CONTINUE
CT021* TEST 21 FIRST VALUE ZERO PRECEDED BY MINUS SIGN
IVTNUM = 21
IEBVI = 0
IEDVI = 4
IEAVI = MOD(-IEBVI, IEDVI)
IF (IEAVI - 0) 20210, 10210, 20210
10210 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0211
20210 IVFAIL = IVFAIL + 1
IVCORR = 0
WRITE (NUVI, 80010) IVTNUM, IEAVI, IVCORR
0211 CONTINUE
CT022* TEST 22 PAIR OF ARITHMETIC EXPRESSIONS USED AS ARGUMENT
IVTNUM = 22
IEDVI = 10
IEEVI = 3
IEFVI = 2
IEAVI = MOD(IEDVI - IEFVI, IEEVI + IEFVI)
IF (IEAVI - 3) 20220, 10220, 20220
10220 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0221
20220 IVFAIL = IVFAIL + 1
IVCORR = 3
WRITE (NUVI, 80010) IVTNUM, IEAVI, IVCORR
0221 CONTINUE
C*****
CBB** ********************** BBCSUM0 **********************************
C**** WRITE OUT TEST SUMMARY
C****
IVTOTN = IVPASS + IVFAIL + IVDELE + IVINSP
WRITE (I02, 90004)
WRITE (I02, 90014)
WRITE (I02, 90004)
WRITE (I02, 90020) IVPASS
WRITE (I02, 90022) IVFAIL
WRITE (I02, 90024) IVDELE
WRITE (I02, 90026) IVINSP
WRITE (I02, 90028) IVTOTN, IVTOTL
CBE** ********************** BBCSUM0 **********************************
CBB** ********************** BBCFOOT0 **********************************
C**** WRITE OUT REPORT FOOTINGS
C****
WRITE (I02,90016) ZPROG, ZPROG
WRITE (I02,90018) ZPROJ, ZNAME, ZTAPE, ZTAPED
WRITE (I02,90019)
CBE** ********************** BBCFOOT0 **********************************
CBB** ********************** BBCFMT0A **********************************
C**** FORMATS FOR TEST DETAIL LINES
C****
80000 FORMAT (1H ,2X,I3,4X,7HDELETED,32X,A31)
80002 FORMAT (1H ,2X,I3,4X,7H PASS ,32X,A31)
80004 FORMAT (1H ,2X,I3,4X,7HINSPECT,32X,A31)
80008 FORMAT (1H ,2X,I3,4X,7H FAIL ,32X,A31)
80010 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,15X,10HCOMPUTED= ,
1I6,/,1H ,15X,10HCORRECT= ,I6)
80012 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
1E12.5,/,1H ,16X,10HCORRECT= ,E12.5)
80018 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
1A21,/,1H ,16X,10HCORRECT= ,A21)
80020 FORMAT (1H ,16X,10HCOMPUTED= ,A21,1X,A31)
80022 FORMAT (1H ,16X,10HCORRECT= ,A21,1X,A31)
80024 FORMAT (1H ,16X,10HCOMPUTED= ,I6,16X,A31)
80026 FORMAT (1H ,16X,10HCORRECT= ,I6,16X,A31)
80028 FORMAT (1H ,16X,10HCOMPUTED= ,E12.5,10X,A31)
80030 FORMAT (1H ,16X,10HCORRECT= ,E12.5,10X,A31)
80050 FORMAT (1H ,48X,A31)
CBE** ********************** BBCFMT0A **********************************
CBB** ********************** BBCFMT0B **********************************
C**** FORMAT STATEMENTS FOR PAGE HEADERS
C****
90002 FORMAT (1H1)
90004 FORMAT (1H )
90006 FORMAT (1H ,20X,31HFEDERAL SOFTWARE TESTING CENTER)
90007 FORMAT (1H ,19X,34HFORTRAN COMPILER VALIDATION SYSTEM)
90008 FORMAT (1H ,21X,A13,A17)
90009 FORMAT (1H ,/,2H *,A5,6HBEGIN*,12X,15HTEST RESULTS - ,A5,/)
90010 FORMAT (1H ,8X,16HTEST DATE*TIME= ,A17,15H - COMPILER= ,A20)
90013 FORMAT (1H ,8H TEST ,10HPASS/FAIL ,6X,17HDISPLAYED RESULTS,
1 7X,7HREMARKS,24X)
90014 FORMAT (1H ,46H----------------------------------------------,
1 33H---------------------------------)
90015 FORMAT (1H ,48X,17HTHIS PROGRAM HAS ,I3,6H TESTS,/)
C****
C**** FORMAT STATEMENTS FOR REPORT FOOTINGS
C****
90016 FORMAT (1H ,/,2H *,A5,4HEND*,14X,14HEND OF TEST - ,A5,/)
90018 FORMAT (1H ,A13,13X,A20,7H * ,A10,1H/,
1 A13)
90019 FORMAT (1H ,26HFOR OFFICIAL USE ONLY ,35X,15HCOPYRIGHT 1982)
C****
C**** FORMAT STATEMENTS FOR RUN SUMMARY
C****
90020 FORMAT (1H ,21X,I5,13H TESTS PASSED)
90022 FORMAT (1H ,21X,I5,13H TESTS FAILED)
90024 FORMAT (1H ,21X,I5,14H TESTS DELETED)
90026 FORMAT (1H ,21X,I5,25H TESTS REQUIRE INSPECTION)
90028 FORMAT (1H ,21X,I5,4H OF ,I3,15H TESTS EXECUTED)
CBE** ********************** BBCFMT0B **********************************
C*****
C***** END OF TEST SEGMENT 159
STOP
END
*END-OF,FM357
FM359.f 481036265 170 2 100666 17885 `
*HEADER,FORTR,FM359
*FILES1,FORTR,FM359,X
C***********************************************************************
C***** FORTRAN 77
C***** FM359 XSIGN - (161)
C*****
C***********************************************************************
C***** GENERAL PURPOSE SUBSET REF
C***** TEST INTRINSIC FUNCTION - SIGN, ISIGN - (TRANSFER 15.3
C***** OF SIGN - SIGN OF A2 TIMES ABS(A1) ) (TABLE 5)
C*****
CBB** ********************** BBCCOMNT **********************************
C****
C**** 1978 FORTRAN COMPILER VALIDATION SYSTEM
C**** VERSION 2.0
C****
C****
C**** SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO
C**** GENERAL SERVICES ADMINISTRATION
C**** FEDERAL SOFTWARE TESTING CENTER
C**** 5203 LEESBURG PIKE, SUITE 1100
C**** FALLS CHURCH, VA. 22041
C****
C**** (703) 756-6153
C****
CBE** ********************** BBCCOMNT **********************************
CBB** ********************** BBCINITA **********************************
C**** SPECIFICATION STATEMENTS
C****
CHARACTER ZVERS*13, ZVERSD*17, ZDATE*17, ZPROG*5, ZCOMPL*20,
1 ZNAME*20, ZTAPE*10, ZPROJ*13, REMRKS*31, ZTAPED*13
CBE** ********************** BBCINITA **********************************
CBB** ********************** BBCINITB **********************************
C**** INITIALIZE SECTION
DATA ZVERS, ZVERSD, ZDATE
1 /'VERSION 2.0 ', '82/08/02*18.33.46', '*NO DATE*TIME'/
DATA ZCOMPL, ZNAME, ZTAPE
1 /'*NONE SPECIFIED*', '*NO COMPANY NAME*', '*NO TAPE*'/
DATA ZPROJ, ZTAPED, ZPROG
1 /'*NO PROJECT*', '*NO TAPE DATE', 'XXXXX'/
DATA REMRKS /' '/
C**** THE FOLLOWING 9 COMMENT LINES (CZ01, CZ02, ...) CAN BE REPLACED
C**** FOR IDENTIFYING THE TEST ENVIRONMENT
C****
CZ01 ZVERS = 'VERSION OF THE COMPILER VALIDATION SYSTEM'
CZ02 ZVERSD = 'CREATION DATE/TIME OF THE COMPILER VALIDATION SYSTEM'
CZ03 ZPROG = 'PROGRAM NAME'
CZ04 ZDATE = 'DATE OF TEST'
CZ05 ZCOMPL = 'COMPILER IDENTIFICATION'
CZ06 ZPROJ = 'PROJECT NUMBER/IDENTIFICATION'
CZ07 ZNAME = 'NAME OF USER'
CZ08 ZTAPE = 'TAPE OWNER/ID'
CZ09 ZTAPED = 'DATE TAPE COPIED'
C
IVPASS = 0
IVFAIL = 0
IVDELE = 0
IVINSP = 0
IVTOTL = 0
IVTOTN = 0
ICZERO = 0
C
C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER.
I01 = 05
C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER.
I02 = 06
C
CX010 REPLACED BY FEXEC X-010 CONTROL CARD (CARD-READER UNIT NUMBER).
C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5
CX011 REPLACED BY FEXEC X-011 CONTROL CARD. CX011 IS FOR SYSTEMS
C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX010.
C
CX020 REPLACED BY FEXEC X-020 CONTROL CARD (PRINTER UNIT NUMBER).
C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02= 6
CX021 REPLACED BY FEXEC X-021 CONTROL CARD. CX021 IS FOR SYSTEMS
C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX020.
C
CBE** ********************** BBCINITB **********************************
NUVI = I02
IVTOTL = 22
ZPROG = 'FM359'
CBB** ********************** BBCHED0A **********************************
C****
C**** WRITE REPORT TITLE
C****
WRITE (I02, 90002)
WRITE (I02, 90006)
WRITE (I02, 90007)
WRITE (I02, 90008) ZVERS, ZVERSD
WRITE (I02, 90009) ZPROG, ZPROG
WRITE (I02, 90010) ZDATE, ZCOMPL
CBE** ********************** BBCHED0A **********************************
C*****
C***** HEADER FOR SEGMENT 161
WRITE (NUVI,16101)
16101 FORMAT(1H , // 2X,36HXSIGN - (161) INTRINSIC FUNCTIONS-- //12X,
1 30HSIGN, ISIGN (TRANSFER OF SIGN)//
2 2X,19HSUBSET REF. - 15.3 )
CBB** ********************** BBCHED0B **********************************
C**** WRITE DETAIL REPORT HEADERS
C****
WRITE (I02,90004)
WRITE (I02,90004)
WRITE (I02,90013)
WRITE (I02,90014)
WRITE (I02,90015) IVTOTL
CBE** ********************** BBCHED0B **********************************
C*****
C***** TEST OF SIGN
C*****
WRITE(NUVI, 16102)
16102 FORMAT (/ 8X, 12HTEST OF SIGN)
CT001* TEST 1 BOTH VALUES ZERO
IVTNUM = 1
RFBVS = 0.0
RFAVS = SIGN(RFBVS, RFBVS)
IF (RFAVS + 0.00005) 20010, 10010, 40010
40010 IF (RFAVS - 0.00005) 10010, 10010, 20010
10010 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0011
20010 IVFAIL = IVFAIL + 1
RVCORR = 0.0
WRITE (NUVI, 80012) IVTNUM, RFAVS, RVCORR
0011 CONTINUE
CT002* TEST 2 FIRST VALUE POSITIVE, SECOND ZERO
IVTNUM = 2
RFBVS = 1.5
RFDVS = 0.0
RFAVS = SIGN(RFBVS, RFDVS)
IF (RFAVS - 1.4999) 20020, 10020, 40020
40020 IF (RFAVS - 1.5001) 10020, 10020, 20020
10020 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0021
20020 IVFAIL = IVFAIL + 1
RVCORR = 1.5
WRITE (NUVI, 80012) IVTNUM, RFAVS, RVCORR
0021 CONTINUE
CT003* TEST 3 FIRST VALUE NEGATIVE, SECOND ZERO
IVTNUM = 3
RFBVS = -1.5
RFDVS = 0.0
RFAVS = SIGN(RFBVS, RFDVS)
IF (RFAVS - 1.4999) 20030, 10030, 40030
40030 IF (RFAVS - 1.5001) 10030, 10030, 20030
10030 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0031
20030 IVFAIL = IVFAIL + 1
RVCORR = 1.5
WRITE (NUVI, 80012) IVTNUM, RFAVS, RVCORR
0031 CONTINUE
CT004* TEST 4 FIRST VALUE ZERO, SECOND POSITIVE
IVTNUM = 4
RFBVS = 0.0
RFDVS = 2.5
RFAVS = SIGN(RFBVS, RFDVS)
IF (RFAVS + 0.00005) 20040, 10040, 40040
40040 IF (RFAVS - 0.00005) 10040, 10040, 20040
10040 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0041
20040 IVFAIL = IVFAIL + 1
RVCORR = 0.0
WRITE (NUVI, 80012) IVTNUM, RFAVS, RVCORR
0041 CONTINUE
CT005* TEST 5 BOTH VALUES POSITIVE
IVTNUM = 5
RFBVS = 1.5
RFDVS = 2.5
RFAVS = SIGN(RFBVS, RFDVS)
IF (RFAVS - 1.4999) 20050, 10050, 40050
40050 IF (RFAVS - 1.5001) 10050, 10050, 20050
10050 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0051
20050 IVFAIL = IVFAIL + 1
RVCORR = 1.5
WRITE (NUVI, 80012) IVTNUM, RFAVS, RVCORR
0051 CONTINUE
CT006* TEST 6 FIRST VALUE NEGATIVE, SECOND POSITIVE
IVTNUM = 6
RFBVS = -1.5
RFDVS = 2.5
RFAVS = SIGN(RFBVS, RFDVS)
IF (RFAVS - 1.4999) 20060, 10060, 40060
40060 IF (RFAVS - 1.5001) 10060, 10060, 20060
10060 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0061
20060 IVFAIL = IVFAIL + 1
RVCORR = 1.5
WRITE (NUVI, 80012) IVTNUM, RFAVS, RVCORR
0061 CONTINUE
CT007* TEST 7 FIRST VALUE ZERO, SECOND NEGATIVE
IVTNUM = 7
RFBVS = 0.0
RFDVS = -2.5
RFAVS = SIGN(RFBVS, RFDVS)
IF (RFAVS + 0.00005) 20070, 10070, 40070
40070 IF (RFAVS - 0.00005) 10070, 10070, 20070
10070 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0071
20070 IVFAIL = IVFAIL + 1
RVCORR = 0.0
WRITE (NUVI, 80012) IVTNUM, RFAVS, RVCORR
0071 CONTINUE
CT008* TEST 8 BOTH VALUES NEGATIVE
IVTNUM = 8
RFBVS = -1.5
RFDVS = -2.5
RFAVS = SIGN(RFBVS, RFDVS)
IF (RFAVS + 1.5001) 20080, 10080, 40080
40080 IF (RFAVS + 1.4999) 10080, 10080, 20080
10080 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0081
20080 IVFAIL = IVFAIL + 1
RVCORR = -1.5
WRITE (NUVI, 80012) IVTNUM, RFAVS, RVCORR
0081 CONTINUE
CT009* TEST 9 FIRST VALUE POSITIVE, SECOND NEGATIVE
IVTNUM = 9
RFBVS = 1.5
RFDVS = -2.5
RFAVS = SIGN(RFBVS, RFDVS)
IF (RFAVS + 1.5001) 20090, 10090, 40090
40090 IF (RFAVS + 1.4999) 10090, 10090, 20090
10090 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0091
20090 IVFAIL = IVFAIL + 1
RVCORR = -1.5
WRITE (NUVI, 80012) IVTNUM, RFAVS, RVCORR
0091 CONTINUE
CT010* TEST 10 BOTH VALUES ZERO, 1ST ZERO PRECEDED BY A MINUS SIGN
IVTNUM = 10
RFDVS = 0.0
RFEVS = 0.0
RFAVS = SIGN(-RFDVS, RFEVS)
IF (RFAVS + 0.0005) 20100, 10100, 40100
40100 IF (RFAVS - 0.00005) 10100, 10100, 20100
10100 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0101
20100 IVFAIL = IVFAIL + 1
RVCORR = 0.0
WRITE (NUVI, 80012) IVTNUM, RFAVS, RVCORR
0101 CONTINUE
CT011* TEST 11 ARITHMETIC EXPRESSIONS PRESENTED TO SIGN
IVTNUM = 11
RFDVS = 1.5
RFEVS = 2.0
RFAVS = SIGN(RFDVS + RFEVS, RFDVS - RFEVS)
IF (RFAVS + 3.5002) 20110, 10110, 40110
40110 IF (RFAVS + 3.4998) 10110, 10110, 20110
10110 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0111
20110 IVFAIL = IVFAIL + 1
RVCORR = -3.5
WRITE (NUVI, 80012) IVTNUM, RFAVS, RVCORR
0111 CONTINUE
C*****
C***** TEST OF ISIGN
C*****
WRITE(NUVI, 16104)
16104 FORMAT (/ 8X, 13HTEST OF ISIGN)
C*****
CT012* TEST 12 BOTH VALUES ZERO
IVTNUM = 12
IFBVI = 0
IFDVI = 0
IFAVI = ISIGN(IFBVI, IFDVI)
IF (IFAVI - 0) 20120, 10120, 20120
10120 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0121
20120 IVFAIL = IVFAIL + 1
IVCORR = 0
WRITE (NUVI, 80010) IVTNUM, IFAVI, IVCORR
0121 CONTINUE
CT013* TEST 13 FIRST VALUE POSITIVE, SECOND ZERO
IVTNUM = 13
IFBVI = 2
IFDVI = 0
IFAVI = ISIGN(IFBVI, IFDVI)
IF (IFAVI - 2) 20130, 10130, 20130
10130 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0131
20130 IVFAIL = IVFAIL + 1
IVCORR = 2
WRITE (NUVI, 80010) IVTNUM, IFAVI, IVCORR
0131 CONTINUE
CT014* TEST 14 FIRST VALUE NEGATIVE, SECOND ZERO
IVTNUM = 14
IFBVI = -2
IFDVI = 0
IFAVI = ISIGN(IFBVI, IFDVI)
IF (IFAVI - 2) 20140, 10140, 20140
10140 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0141
20140 IVFAIL = IVFAIL + 1
IVCORR = 2
WRITE (NUVI, 80010) IVTNUM, IFAVI, IVCORR
0141 CONTINUE
CT015* TEST 15 FIRST VALUE ZERO, SECOND POSITIVE
IVTNUM = 15
IFBVI = 0
IFDVI = 5
IFAVI = ISIGN(IFBVI, IFDVI)
IF (IFAVI - 0) 20150, 10150, 20150
10150 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0151
20150 IVFAIL = IVFAIL + 1
IVCORR = 0
WRITE (NUVI, 80010) IVTNUM, IFAVI, IVCORR
0151 CONTINUE
CT016* TEST 16 BOTH VALUES POSITIVE
IVTNUM = 16
IFBVI = 2
IFDVI = 5
IFAVI = ISIGN(IFBVI, IFDVI)
IF (IFAVI - 2) 20160, 10160, 20160
10160 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0161
20160 IVFAIL = IVFAIL + 1
IVCORR = 2
WRITE (NUVI, 80010) IVTNUM, IFAVI, IVCORR
0161 CONTINUE
CT017* TEST 17 FIRST VALUE NEGATIVE, SECOND POSITIVE
IVTNUM = 17
IFBVI = -2
IFDVI = 5
IFAVI = ISIGN(IFBVI, IFDVI)
IF (IFAVI - 2) 20170, 10170, 20170
10170 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0171
20170 IVFAIL = IVFAIL + 1
IVCORR = 2
WRITE (NUVI, 80010) IVTNUM, IFAVI, IVCORR
0171 CONTINUE
CT018* TEST 18 FIRST VALUE ZERO, SECOND NEGATIVE
IVTNUM = 18
IFBVI = 0
IFDVI = -5
IFAVI = ISIGN(IFBVI, IFDVI)
IF (IFAVI - 0) 20180, 10180, 20180
10180 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0181
20180 IVFAIL = IVFAIL + 1
IVCORR = 0
WRITE (NUVI, 80010) IVTNUM, IFAVI, IVCORR
0181 CONTINUE
CT019* TEST 19 BOTH VALUES NEGATIVE
IVTNUM = 19
IFBVI = -2
IFDVI = -5
IFAVI = ISIGN(IFBVI, IFDVI)
IF (IFAVI + 2) 20190, 10190, 20190
10190 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0191
20190 IVFAIL = IVFAIL + 1
IVCORR = -2
WRITE (NUVI, 80010) IVTNUM, IFAVI, IVCORR
0191 CONTINUE
CT020* TEST 20 FIRST VALUE POSITIVE, SECOND NEGATIVE
IVTNUM = 20
IFBVI = 2
IFDVI = -5
IFAVI = ISIGN(IFBVI, IFDVI)
IF (IFAVI + 2) 20200, 10200, 20200
10200 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0201
20200 IVFAIL = IVFAIL + 1
IVCORR = -2
WRITE (NUVI, 80010) IVTNUM, IFAVI, IVCORR
0201 CONTINUE
CT021* TEST 21 BOTH VALUES ZERO, 1ST ZERO PRECEDED BY A MINUS SIGN
IVTNUM = 21
IFDVI = 0
IFEVI = 0
IFAVI = ISIGN(-IFDVI, IFEVI)
IF (IFAVI - 0) 20210, 10210, 20210
10210 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0211
20210 IVFAIL = IVFAIL + 1
IVCORR = 0
WRITE (NUVI, 80010) IVTNUM, IFAVI, IVCORR
0211 CONTINUE
CT022* TEST 22 ARITHMETIC EXPRESSIONS PRESENTED TO ISIGN
IVTNUM = 22
IFDVI = 2
IFEVI = 3
IFAVI = ISIGN(IFDVI + IFEVI, IFDVI - IFEVI)
IF (IFAVI + 5) 20220, 10220, 20220
10220 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0221
20220 IVFAIL = IVFAIL + 1
IVCORR = -5
WRITE (NUVI, 80010) IVTNUM, IFAVI, IVCORR
0221 CONTINUE
C*****
CBB** ********************** BBCSUM0 **********************************
C**** WRITE OUT TEST SUMMARY
C****
IVTOTN = IVPASS + IVFAIL + IVDELE + IVINSP
WRITE (I02, 90004)
WRITE (I02, 90014)
WRITE (I02, 90004)
WRITE (I02, 90020) IVPASS
WRITE (I02, 90022) IVFAIL
WRITE (I02, 90024) IVDELE
WRITE (I02, 90026) IVINSP
WRITE (I02, 90028) IVTOTN, IVTOTL
CBE** ********************** BBCSUM0 **********************************
CBB** ********************** BBCFOOT0 **********************************
C**** WRITE OUT REPORT FOOTINGS
C****
WRITE (I02,90016) ZPROG, ZPROG
WRITE (I02,90018) ZPROJ, ZNAME, ZTAPE, ZTAPED
WRITE (I02,90019)
CBE** ********************** BBCFOOT0 **********************************
CBB** ********************** BBCFMT0A **********************************
C**** FORMATS FOR TEST DETAIL LINES
C****
80000 FORMAT (1H ,2X,I3,4X,7HDELETED,32X,A31)
80002 FORMAT (1H ,2X,I3,4X,7H PASS ,32X,A31)
80004 FORMAT (1H ,2X,I3,4X,7HINSPECT,32X,A31)
80008 FORMAT (1H ,2X,I3,4X,7H FAIL ,32X,A31)
80010 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,15X,10HCOMPUTED= ,
1I6,/,1H ,15X,10HCORRECT= ,I6)
80012 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
1E12.5,/,1H ,16X,10HCORRECT= ,E12.5)
80018 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
1A21,/,1H ,16X,10HCORRECT= ,A21)
80020 FORMAT (1H ,16X,10HCOMPUTED= ,A21,1X,A31)
80022 FORMAT (1H ,16X,10HCORRECT= ,A21,1X,A31)
80024 FORMAT (1H ,16X,10HCOMPUTED= ,I6,16X,A31)
80026 FORMAT (1H ,16X,10HCORRECT= ,I6,16X,A31)
80028 FORMAT (1H ,16X,10HCOMPUTED= ,E12.5,10X,A31)
80030 FORMAT (1H ,16X,10HCORRECT= ,E12.5,10X,A31)
80050 FORMAT (1H ,48X,A31)
CBE** ********************** BBCFMT0A **********************************
CBB** ********************** BBCFMT0B **********************************
C**** FORMAT STATEMENTS FOR PAGE HEADERS
C****
90002 FORMAT (1H1)
90004 FORMAT (1H )
90006 FORMAT (1H ,20X,31HFEDERAL SOFTWARE TESTING CENTER)
90007 FORMAT (1H ,19X,34HFORTRAN COMPILER VALIDATION SYSTEM)
90008 FORMAT (1H ,21X,A13,A17)
90009 FORMAT (1H ,/,2H *,A5,6HBEGIN*,12X,15HTEST RESULTS - ,A5,/)
90010 FORMAT (1H ,8X,16HTEST DATE*TIME= ,A17,15H - COMPILER= ,A20)
90013 FORMAT (1H ,8H TEST ,10HPASS/FAIL ,6X,17HDISPLAYED RESULTS,
1 7X,7HREMARKS,24X)
90014 FORMAT (1H ,46H----------------------------------------------,
1 33H---------------------------------)
90015 FORMAT (1H ,48X,17HTHIS PROGRAM HAS ,I3,6H TESTS,/)
C****
C**** FORMAT STATEMENTS FOR REPORT FOOTINGS
C****
90016 FORMAT (1H ,/,2H *,A5,4HEND*,14X,14HEND OF TEST - ,A5,/)
90018 FORMAT (1H ,A13,13X,A20,7H * ,A10,1H/,
1 A13)
90019 FORMAT (1H ,26HFOR OFFICIAL USE ONLY ,35X,15HCOPYRIGHT 1982)
C****
C**** FORMAT STATEMENTS FOR RUN SUMMARY
C****
90020 FORMAT (1H ,21X,I5,13H TESTS PASSED)
90022 FORMAT (1H ,21X,I5,13H TESTS FAILED)
90024 FORMAT (1H ,21X,I5,14H TESTS DELETED)
90026 FORMAT (1H ,21X,I5,25H TESTS REQUIRE INSPECTION)
90028 FORMAT (1H ,21X,I5,4H OF ,I3,15H TESTS EXECUTED)
CBE** ********************** BBCFMT0B **********************************
C*****
C***** END OF TEST SEGMENT 161
STOP
END
*END-OF,FM359
FM360.f 481036269 170 2 100666 14244 `
*HEADER,FORTR,FM360
*FILES1,FORTR,FM360,X
C***********************************************************************
C***** FORTRAN 77
C***** FM360 XDIM - (163)
C*****
C***********************************************************************
C***** GENERAL PURPOSE SUBSET REF
C***** TEST INTRINSIC FUNCTION DIM AND IDIM--POSITIVE 15.3
C***** DIFFERENCE, WHICH IS DEFINED AS A1 - MIN(A1,A2) (TABLE 5)
C*****
CBB** ********************** BBCCOMNT **********************************
C****
C**** 1978 FORTRAN COMPILER VALIDATION SYSTEM
C**** VERSION 2.0
C****
C****
C**** SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO
C**** GENERAL SERVICES ADMINISTRATION
C**** FEDERAL SOFTWARE TESTING CENTER
C**** 5203 LEESBURG PIKE, SUITE 1100
C**** FALLS CHURCH, VA. 22041
C****
C**** (703) 756-6153
C****
CBE** ********************** BBCCOMNT **********************************
CBB** ********************** BBCINITA **********************************
C**** SPECIFICATION STATEMENTS
C****
CHARACTER ZVERS*13, ZVERSD*17, ZDATE*17, ZPROG*5, ZCOMPL*20,
1 ZNAME*20, ZTAPE*10, ZPROJ*13, REMRKS*31, ZTAPED*13
CBE** ********************** BBCINITA **********************************
CBB** ********************** BBCINITB **********************************
C**** INITIALIZE SECTION
DATA ZVERS, ZVERSD, ZDATE
1 /'VERSION 2.0 ', '82/08/02*18.33.46', '*NO DATE*TIME'/
DATA ZCOMPL, ZNAME, ZTAPE
1 /'*NONE SPECIFIED*', '*NO COMPANY NAME*', '*NO TAPE*'/
DATA ZPROJ, ZTAPED, ZPROG
1 /'*NO PROJECT*', '*NO TAPE DATE', 'XXXXX'/
DATA REMRKS /' '/
C**** THE FOLLOWING 9 COMMENT LINES (CZ01, CZ02, ...) CAN BE REPLACED
C**** FOR IDENTIFYING THE TEST ENVIRONMENT
C****
CZ01 ZVERS = 'VERSION OF THE COMPILER VALIDATION SYSTEM'
CZ02 ZVERSD = 'CREATION DATE/TIME OF THE COMPILER VALIDATION SYSTEM'
CZ03 ZPROG = 'PROGRAM NAME'
CZ04 ZDATE = 'DATE OF TEST'
CZ05 ZCOMPL = 'COMPILER IDENTIFICATION'
CZ06 ZPROJ = 'PROJECT NUMBER/IDENTIFICATION'
CZ07 ZNAME = 'NAME OF USER'
CZ08 ZTAPE = 'TAPE OWNER/ID'
CZ09 ZTAPED = 'DATE TAPE COPIED'
C
IVPASS = 0
IVFAIL = 0
IVDELE = 0
IVINSP = 0
IVTOTL = 0
IVTOTN = 0
ICZERO = 0
C
C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER.
I01 = 05
C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER.
I02 = 06
C
CX010 REPLACED BY FEXEC X-010 CONTROL CARD (CARD-READER UNIT NUMBER).
C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5
CX011 REPLACED BY FEXEC X-011 CONTROL CARD. CX011 IS FOR SYSTEMS
C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX010.
C
CX020 REPLACED BY FEXEC X-020 CONTROL CARD (PRINTER UNIT NUMBER).
C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02= 6
CX021 REPLACED BY FEXEC X-021 CONTROL CARD. CX021 IS FOR SYSTEMS
C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX020.
C
CBE** ********************** BBCINITB **********************************
NUVI = I02
IVTOTL = 14
ZPROG = 'FM360'
CBB** ********************** BBCHED0A **********************************
C****
C**** WRITE REPORT TITLE
C****
WRITE (I02, 90002)
WRITE (I02, 90006)
WRITE (I02, 90007)
WRITE (I02, 90008) ZVERS, ZVERSD
WRITE (I02, 90009) ZPROG, ZPROG
WRITE (I02, 90010) ZDATE, ZCOMPL
CBE** ********************** BBCHED0A **********************************
C*****
C***** HEADER FOR SEGMENT 163
WRITE (NUVI,16301)
16301 FORMAT(1H , //,2X,35HXDIM - (163) INTRINSIC FUNCTIONS-- //12X,
1 31HDIM, IDIM (POSITIVE DIFFERENCE)//
2 2X,18HSUBSET REF. - 15.3)
CBB** ********************** BBCHED0B **********************************
C**** WRITE DETAIL REPORT HEADERS
C****
WRITE (I02,90004)
WRITE (I02,90004)
WRITE (I02,90013)
WRITE (I02,90014)
WRITE (I02,90015) IVTOTL
CBE** ********************** BBCHED0B **********************************
C*****
C***** TEST OF DIM
C*****
WRITE(NUVI, 16304)
16304 FORMAT (/ 8X, 11HTEST OF DIM)
CT001* TEST 1 BOTH VALUES EQUAL
IVTNUM = 1
RGBVS = 2.5
RGDVS = 2.5
RGAVS = DIM(RGBVS, RGDVS)
IF (RGAVS + .00005) 20010, 10010, 40010
40010 IF (RGAVS - .00005) 10010, 10010, 20010
10010 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0011
20010 IVFAIL = IVFAIL + 1
RVCORR = 0.0
WRITE (NUVI, 80012) IVTNUM, RGAVS, RVCORR
0011 CONTINUE
CT002* TEST 2 FIRST VALUE LESS THAN SECOND
IVTNUM = 2
RGBVS = 2.5
RGDVS = 5.5
RGAVS = DIM(RGBVS, RGDVS)
IF (RGAVS + .00005) 20020, 10020, 40020
40020 IF (RGAVS - .00005) 10020, 10020, 20020
10020 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0021
20020 IVFAIL = IVFAIL + 1
RVCORR = 0.0
WRITE (NUVI, 80012) IVTNUM, RGAVS, RVCORR
0021 CONTINUE
CT003* TEST 3 FIRST VALUE GREATER THAN SECOND
IVTNUM = 3
RGBVS = 5.5
RGDVS = 2.5
RGAVS = DIM(RGBVS, RGDVS)
IF (RGAVS - 2.9998) 20030, 10030, 40030
40030 IF (RGAVS - 3.0002) 10030, 10030, 20030
10030 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0031
20030 IVFAIL = IVFAIL + 1
RVCORR = 3.0
WRITE (NUVI, 80012) IVTNUM, RGAVS, RVCORR
0031 CONTINUE
CT004* TEST 4 BOTH VALUES EQUAL, BOTH NEGATIVE
IVTNUM = 4
RGBVS = -2.5
RGDVS = -2.5
RGAVS = DIM(RGBVS, RGDVS)
IF (RGAVS + .00005) 20040, 10040, 40040
40040 IF (RGAVS - .00005) 10040, 10040, 20040
10040 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0041
20040 IVFAIL = IVFAIL + 1
RVCORR = 0.0
WRITE (NUVI, 80012) IVTNUM, RGAVS, RVCORR
0041 CONTINUE
CT005* TEST 5 FIRST VALUE GREATER THAN SECOND, BOTH NEGATIVE
IVTNUM = 5
RGBVS = -2.5
RGDVS = -5.5
RGAVS = DIM(RGBVS, RGDVS)
IF (RGAVS - 2.9998) 20050, 10050, 40050
40050 IF (RGAVS - 3.0002) 10050, 10050, 20050
10050 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0051
20050 IVFAIL = IVFAIL + 1
RVCORR = 3.0
WRITE (NUVI, 80012) IVTNUM, RGAVS, RVCORR
0051 CONTINUE
CT006* TEST 6 FIRST VALUE LESS THAN SECOND, BOTH NEGATIVE
IVTNUM = 6
RGBVS = -5.5
RGDVS = -2.5
RGAVS = DIM(RGBVS, RGDVS)
IF (RGAVS + .00005) 20060, 10060, 40060
40060 IF (RGAVS - .00005) 10060, 10060, 20060
10060 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0061
20060 IVFAIL = IVFAIL + 1
RVCORR = 0.0
WRITE (NUVI, 80012) IVTNUM, RGAVS, RVCORR
0061 CONTINUE
CT007* TEST 7 EXPRESSIONS PRESENTED TO DIM
IVTNUM = 7
RGDVS = 2.5
RGEVS = 1.25
RGAVS = DIM(RGDVS / RGEVS, RGDVS * RGEVS)
IF (RGAVS + .00005) 20070, 10070, 40070
40070 IF (RGAVS - .00005) 10070, 10070, 20070
10070 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0071
20070 IVFAIL = IVFAIL + 1
RVCORR = 0.0
WRITE (NUVI, 80012) IVTNUM, RGAVS, RVCORR
0071 CONTINUE
C*****
C***** TEST OF IDIM
C*****
WRITE(NUVI, 16302)
16302 FORMAT (/ 08X, 12HTEST OF IDIM)
CT008* TEST 8 BOTH VALUES EQUAL
IVTNUM = 8
IGBVI = 2
IGDVI = 2
IGAVI = IDIM(IGBVI, IGDVI)
IF (IGAVI - 0) 20080, 10080, 20080
10080 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0081
20080 IVFAIL = IVFAIL + 1
IVCORR = 0
WRITE (NUVI, 80010) IVTNUM, IGAVI, IVCORR
0081 CONTINUE
CT009* TEST 9 FIRST VALUE LESS THAN SECOND
IVTNUM = 9
IGBVI = 2
IGDVI = 5
IGAVI = IDIM(IGBVI, IGDVI)
IF (IGAVI - 0) 20090, 10090, 20090
10090 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0091
20090 IVFAIL = IVFAIL + 1
IVCORR = 0
WRITE (NUVI, 80010) IVTNUM, IGAVI, IVCORR
0091 CONTINUE
CT010* TEST 10 FIRST VALUE GREATER THAN SECOND
IVTNUM = 10
IGBVI = 5
IGDVI = 2
IGAVI = IDIM(IGBVI, IGDVI)
IF (IGAVI - 3) 20100, 10100, 20100
10100 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0101
20100 IVFAIL = IVFAIL + 1
IVCORR = 3
WRITE (NUVI, 80010) IVTNUM, IGAVI, IVCORR
0101 CONTINUE
CT011* TEST 11 BOTH VALUES EQUAL, BOTH NEGATIVE
IVTNUM = 11
IGBVI = -2
IGDVI = -2
IGAVI = IDIM(IGBVI, IGDVI)
IF (IGAVI - 0) 20110, 10110, 20110
10110 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0111
20110 IVFAIL = IVFAIL + 1
IVCORR = 0
WRITE (NUVI, 80010) IVTNUM, IGAVI, IVCORR
0111 CONTINUE
CT012* TEST 12 FIRST VALUE GREATER THAN SECOND, BOTH NEGATIVE
IVTNUM = 12
IGBVI = -2
IGDVI = -5
IGAVI = IDIM(IGBVI, IGDVI)
IF (IGAVI - 3) 20120, 10120, 20120
10120 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0121
20120 IVFAIL = IVFAIL + 1
IVCORR = 3
WRITE (NUVI, 80010) IVTNUM, IGAVI, IVCORR
0121 CONTINUE
CT013* TEST 13 FIRST VALUE LESS THAN SECOND, BOTH NEGATIVE
IVTNUM = 13
IGBVI = -5
IGDVI = -2
IGAVI = IDIM(IGBVI, IGDVI)
IF (IGAVI - 0) 20130, 10130, 20130
10130 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0131
20130 IVFAIL = IVFAIL + 1
IVCORR = 0
WRITE (NUVI, 80010) IVTNUM, IGAVI, IVCORR
0131 CONTINUE
CT014* TEST 14 ARITHMETIC EXPRESSIONS PRESENTED TO IDIM
IVTNUM = 14
IGDVI = 2
IGEVI = 1.25
IGAVI = IDIM(IGDVI / IGEVI, IGDVI * IGEVI)
IF (IGAVI - 0) 20140, 10140, 20140
10140 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0141
20140 IVFAIL = IVFAIL + 1
IVCORR = 0
WRITE (NUVI, 80010) IVTNUM, IGAVI, IVCORR
0141 CONTINUE
C*****
CBB** ********************** BBCSUM0 **********************************
C**** WRITE OUT TEST SUMMARY
C****
IVTOTN = IVPASS + IVFAIL + IVDELE + IVINSP
WRITE (I02, 90004)
WRITE (I02, 90014)
WRITE (I02, 90004)
WRITE (I02, 90020) IVPASS
WRITE (I02, 90022) IVFAIL
WRITE (I02, 90024) IVDELE
WRITE (I02, 90026) IVINSP
WRITE (I02, 90028) IVTOTN, IVTOTL
CBE** ********************** BBCSUM0 **********************************
CBB** ********************** BBCFOOT0 **********************************
C**** WRITE OUT REPORT FOOTINGS
C****
WRITE (I02,90016) ZPROG, ZPROG
WRITE (I02,90018) ZPROJ, ZNAME, ZTAPE, ZTAPED
WRITE (I02,90019)
CBE** ********************** BBCFOOT0 **********************************
CBB** ********************** BBCFMT0A **********************************
C**** FORMATS FOR TEST DETAIL LINES
C****
80000 FORMAT (1H ,2X,I3,4X,7HDELETED,32X,A31)
80002 FORMAT (1H ,2X,I3,4X,7H PASS ,32X,A31)
80004 FORMAT (1H ,2X,I3,4X,7HINSPECT,32X,A31)
80008 FORMAT (1H ,2X,I3,4X,7H FAIL ,32X,A31)
80010 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,15X,10HCOMPUTED= ,
1I6,/,1H ,15X,10HCORRECT= ,I6)
80012 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
1E12.5,/,1H ,16X,10HCORRECT= ,E12.5)
80018 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
1A21,/,1H ,16X,10HCORRECT= ,A21)
80020 FORMAT (1H ,16X,10HCOMPUTED= ,A21,1X,A31)
80022 FORMAT (1H ,16X,10HCORRECT= ,A21,1X,A31)
80024 FORMAT (1H ,16X,10HCOMPUTED= ,I6,16X,A31)
80026 FORMAT (1H ,16X,10HCORRECT= ,I6,16X,A31)
80028 FORMAT (1H ,16X,10HCOMPUTED= ,E12.5,10X,A31)
80030 FORMAT (1H ,16X,10HCORRECT= ,E12.5,10X,A31)
80050 FORMAT (1H ,48X,A31)
CBE** ********************** BBCFMT0A **********************************
CBB** ********************** BBCFMT0B **********************************
C**** FORMAT STATEMENTS FOR PAGE HEADERS
C****
90002 FORMAT (1H1)
90004 FORMAT (1H )
90006 FORMAT (1H ,20X,31HFEDERAL SOFTWARE TESTING CENTER)
90007 FORMAT (1H ,19X,34HFORTRAN COMPILER VALIDATION SYSTEM)
90008 FORMAT (1H ,21X,A13,A17)
90009 FORMAT (1H ,/,2H *,A5,6HBEGIN*,12X,15HTEST RESULTS - ,A5,/)
90010 FORMAT (1H ,8X,16HTEST DATE*TIME= ,A17,15H - COMPILER= ,A20)
90013 FORMAT (1H ,8H TEST ,10HPASS/FAIL ,6X,17HDISPLAYED RESULTS,
1 7X,7HREMARKS,24X)
90014 FORMAT (1H ,46H----------------------------------------------,
1 33H---------------------------------)
90015 FORMAT (1H ,48X,17HTHIS PROGRAM HAS ,I3,6H TESTS,/)
C****
C**** FORMAT STATEMENTS FOR REPORT FOOTINGS
C****
90016 FORMAT (1H ,/,2H *,A5,4HEND*,14X,14HEND OF TEST - ,A5,/)
90018 FORMAT (1H ,A13,13X,A20,7H * ,A10,1H/,
1 A13)
90019 FORMAT (1H ,26HFOR OFFICIAL USE ONLY ,35X,15HCOPYRIGHT 1982)
C****
C**** FORMAT STATEMENTS FOR RUN SUMMARY
C****
90020 FORMAT (1H ,21X,I5,13H TESTS PASSED)
90022 FORMAT (1H ,21X,I5,13H TESTS FAILED)
90024 FORMAT (1H ,21X,I5,14H TESTS DELETED)
90026 FORMAT (1H ,21X,I5,25H TESTS REQUIRE INSPECTION)
90028 FORMAT (1H ,21X,I5,4H OF ,I3,15H TESTS EXECUTED)
CBE** ********************** BBCFMT0B **********************************
C*****
16303 FORMAT(2X, F7.2)
16305 FORMAT(3X, I5)
C*****
C***** END OF TEST SEGMENT 163
STOP
END
*END-OF,FM360
FM361.f 481036274 170 2 100666 30714 `
*HEADER,FORTR,FM361
*FILES1,FORTR,FM361,X
C***********************************************************************
C***** FORTRAN 77
C***** FM361 XMAX - (165)
C*****
C***********************************************************************
C***** GENERAL PURPOSE SUBSET REF
C***** TEST OF INTRINSIC FUNCTIONS AMAX0,AMAX1,MAX0,MAX1 15.3
C***** CHOOSING LARGEST VALUE (TABLE 5)
C*****
CBB** ********************** BBCCOMNT **********************************
C****
C**** 1978 FORTRAN COMPILER VALIDATION SYSTEM
C**** VERSION 2.0
C****
C****
C**** SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO
C**** GENERAL SERVICES ADMINISTRATION
C**** FEDERAL SOFTWARE TESTING CENTER
C**** 5203 LEESBURG PIKE, SUITE 1100
C**** FALLS CHURCH, VA. 22041
C****
C**** (703) 756-6153
C****
CBE** ********************** BBCCOMNT **********************************
CBB** ********************** BBCINITA **********************************
C**** SPECIFICATION STATEMENTS
C****
CHARACTER ZVERS*13, ZVERSD*17, ZDATE*17, ZPROG*5, ZCOMPL*20,
1 ZNAME*20, ZTAPE*10, ZPROJ*13, REMRKS*31, ZTAPED*13
CBE** ********************** BBCINITA **********************************
CBB** ********************** BBCINITB **********************************
C**** INITIALIZE SECTION
DATA ZVERS, ZVERSD, ZDATE
1 /'VERSION 2.0 ', '82/08/02*18.33.46', '*NO DATE*TIME'/
DATA ZCOMPL, ZNAME, ZTAPE
1 /'*NONE SPECIFIED*', '*NO COMPANY NAME*', '*NO TAPE*'/
DATA ZPROJ, ZTAPED, ZPROG
1 /'*NO PROJECT*', '*NO TAPE DATE', 'XXXXX'/
DATA REMRKS /' '/
C**** THE FOLLOWING 9 COMMENT LINES (CZ01, CZ02, ...) CAN BE REPLACED
C**** FOR IDENTIFYING THE TEST ENVIRONMENT
C****
CZ01 ZVERS = 'VERSION OF THE COMPILER VALIDATION SYSTEM'
CZ02 ZVERSD = 'CREATION DATE/TIME OF THE COMPILER VALIDATION SYSTEM'
CZ03 ZPROG = 'PROGRAM NAME'
CZ04 ZDATE = 'DATE OF TEST'
CZ05 ZCOMPL = 'COMPILER IDENTIFICATION'
CZ06 ZPROJ = 'PROJECT NUMBER/IDENTIFICATION'
CZ07 ZNAME = 'NAME OF USER'
CZ08 ZTAPE = 'TAPE OWNER/ID'
CZ09 ZTAPED = 'DATE TAPE COPIED'
C
IVPASS = 0
IVFAIL = 0
IVDELE = 0
IVINSP = 0
IVTOTL = 0
IVTOTN = 0
ICZERO = 0
C
C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER.
I01 = 05
C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER.
I02 = 06
C
CX010 REPLACED BY FEXEC X-010 CONTROL CARD (CARD-READER UNIT NUMBER).
C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5
CX011 REPLACED BY FEXEC X-011 CONTROL CARD. CX011 IS FOR SYSTEMS
C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX010.
C
CX020 REPLACED BY FEXEC X-020 CONTROL CARD (PRINTER UNIT NUMBER).
C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02= 6
CX021 REPLACED BY FEXEC X-021 CONTROL CARD. CX021 IS FOR SYSTEMS
C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX020.
C
CBE** ********************** BBCINITB **********************************
NUVI = I02
IVTOTL = 48
ZPROG = 'FM361'
CBB** ********************** BBCHED0A **********************************
C****
C**** WRITE REPORT TITLE
C****
WRITE (I02, 90002)
WRITE (I02, 90006)
WRITE (I02, 90007)
WRITE (I02, 90008) ZVERS, ZVERSD
WRITE (I02, 90009) ZPROG, ZPROG
WRITE (I02, 90010) ZDATE, ZCOMPL
CBE** ********************** BBCHED0A **********************************
C*****
C***** HEADER FOR SEGMENT 165
WRITE (NUVI,16501)
16501 FORMAT (1H , // 2X,36HXMAX - (165) INTRINSIC FUNCTIONS-- //13X,
1 26HAMAX0, AMAX1, MAX0, MAX1 /13X,
2 24H(CHOOSING LARGEST VALUE)//2X,
3 18HSUBSET REF. - 15.3)
CBB** ********************** BBCHED0B **********************************
C**** WRITE DETAIL REPORT HEADERS
C****
WRITE (I02,90004)
WRITE (I02,90004)
WRITE (I02,90013)
WRITE (I02,90014)
WRITE (I02,90015) IVTOTL
CBE** ********************** BBCHED0B **********************************
C*****
C***** TEST OF AMAX0
C*****
WRITE(NUVI, 16502)
16502 FORMAT (/ 8X, 13HTEST OF AMAX0)
CT001* TEST 1 BOTH ZEROES
IVTNUM = 1
IHBVI = 0
IHDVI = 0
RHAVS = AMAX0(IHBVI,IHDVI)
IF (RHAVS + 0.00005) 20010, 10010, 40010
40010 IF (RHAVS - 0.00005) 10010, 10010, 20010
10010 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0011
20010 IVFAIL = IVFAIL + 1
RVCORR = 0.0
WRITE (NUVI, 80012) IVTNUM, RHAVS, RVCORR
0011 CONTINUE
CT002* TEST 2 ONE NON-ZERO, ONE ZERO
IVTNUM = 2
IHBVI = 6
IHDVI = 0
RHAVS = AMAX0(IHBVI,IHDVI)
IF (RHAVS - 5.9997) 20020, 10020, 40020
40020 IF (RHAVS - 6.0003) 10020, 10020, 20020
10020 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0021
20020 IVFAIL = IVFAIL + 1
RVCORR = 6.0
WRITE (NUVI, 80012) IVTNUM, RHAVS, RVCORR
0021 CONTINUE
CT003* TEST 3 BOTH VALUES EQUAL
IVTNUM = 3
IHBVI = 7
IHDVI = 7
RHAVS = AMAX0(IHBVI,IHDVI)
IF (RHAVS - 6.9996) 20030, 10030, 40030
40030 IF (RHAVS - 7.0004) 10030, 10030, 20030
10030 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0031
20030 IVFAIL = IVFAIL + 1
RVCORR = 7.0
WRITE (NUVI, 80012) IVTNUM, RHAVS, RVCORR
0031 CONTINUE
CT004* TEST 4 UNEQUAL VALUES, BOTH POSITIVE
IVTNUM = 4
IHBVI = 7
IHDVI = 5
RHAVS = AMAX0(IHBVI,IHDVI)
IF (RHAVS - 6.9996) 20040, 10040, 40040
40040 IF (RHAVS - 7.0004) 10040, 10040, 20040
10040 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0041
20040 IVFAIL = IVFAIL + 1
RVCORR = 7.0
WRITE (NUVI, 80012) IVTNUM, RHAVS, RVCORR
0041 CONTINUE
CT005* TEST 5 ONE NEGATIVE, ONE ZERO
IVTNUM = 5
IHBVI = -6
IHDVI = 0
RHAVS = AMAX0(IHBVI,IHDVI)
IF (RHAVS + 0.00005) 20050, 10050, 40050
40050 IF (RHAVS - 0.00005) 10050, 10050, 20050
10050 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0051
20050 IVFAIL = IVFAIL + 1
RVCORR = 0.0
WRITE (NUVI, 80012) IVTNUM, RHAVS, RVCORR
0051 CONTINUE
CT006* TEST 6 BOTH VALUES EQUAL, BOTH NEGATIVE
IVTNUM = 6
IHBVI = -7
IHDVI = -7
RHAVS = AMAX0(IHBVI,IHDVI)
IF (RHAVS + 7.0004) 20060, 10060, 40060
40060 IF (RHAVS + 6.9996) 10060, 10060, 20060
10060 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0061
20060 IVFAIL = IVFAIL + 1
RVCORR = -7.0
WRITE (NUVI, 80012) IVTNUM, RHAVS, RVCORR
0061 CONTINUE
CT007* TEST 7 BOTH VALUES NOT EQUAL, BOTH NEGATIVE
IVTNUM = 7
IHBVI = -7
IHDVI = -5
RHAVS = AMAX0(IHBVI,IHDVI)
IF (RHAVS + 5.0003) 20070, 10070, 40070
40070 IF (RHAVS + 4.9997) 10070, 10070, 20070
10070 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0071
20070 IVFAIL = IVFAIL + 1
RVCORR = -5.0
WRITE (NUVI, 80012) IVTNUM, RHAVS, RVCORR
0071 CONTINUE
CT008* TEST 8 1ST VALUE NON-ZERO, 2ND ZERO PRECEDED BY A MINUS SIGN
IVTNUM = 8
IHDVI = 6
IHEVI = 0
RHAVS = AMAX0(IHDVI, -IHEVI)
IF (RHAVS - 5.9997) 20080, 10080, 40080
40080 IF (RHAVS - 6.0003) 10080, 10080, 20080
10080 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0081
20080 IVFAIL = IVFAIL + 1
RVCORR = 6.0
WRITE (NUVI, 80012) IVTNUM, RHAVS, RVCORR
0081 CONTINUE
CT009* TEST 9 EXPRESSIONS PRESENTED TO FUNCTION
IVTNUM = 9
IHDVI = 3
IHEVI = 4
RHAVS = AMAX0(IHDVI + IHEVI, -IHEVI - IHDVI)
IF (RHAVS - 6.9996) 20090, 10090, 40090
40090 IF (RHAVS - 7.0004) 10090, 10090, 20090
10090 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0091
20090 IVFAIL = IVFAIL + 1
RVCORR = 7.0
WRITE (NUVI, 80012) IVTNUM, RHAVS, RVCORR
0091 CONTINUE
CT010* TEST 10 3 ARGUMENTS
IVTNUM = 10
IHBVI = 0
IHCVI = 1
IHDVI = 3
RHAVS = AMAX0(IHBVI, IHCVI, IHDVI)
IF (RHAVS - 2.9998) 20100, 10100, 40100
40100 IF (RHAVS - 3.0002) 10100, 10100, 20100
10100 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0101
20100 IVFAIL = IVFAIL + 1
RVCORR = 3.0
WRITE (NUVI, 80012) IVTNUM, RHAVS, RVCORR
0101 CONTINUE
CT011* TEST 11 4 ARGUMENTS
IVTNUM = 11
IHBVI = 0
IHCVI = 1
IHDVI = 4
RHAVS = AMAX0(IHDVI, -IHBVI, IHCVI, IHBVI)
IF (RHAVS - 3.9998) 20110, 10110, 40110
40110 IF (RHAVS - 4.0002) 10110, 10110, 20110
10110 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0111
20110 IVFAIL = IVFAIL + 1
RVCORR = 4.0
WRITE (NUVI, 80012) IVTNUM, RHAVS, RVCORR
0111 CONTINUE
CT012* TEST 12 5 ARGUMENTS
IVTNUM = 12
IHDVI = 4.0
IHEVI = 5.0
RHAVS = AMAX0(IHDVI, -IHDVI, -IHEVI, +IHDVI, IHEVI)
IF (RHAVS - 4.9997) 20120, 10120, 40120
40120 IF (RHAVS - 5.0003) 10120, 10120, 20120
10120 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0121
20120 IVFAIL = IVFAIL + 1
RVCORR = 5.0
WRITE (NUVI, 80012) IVTNUM, RHAVS, RVCORR
0121 CONTINUE
C*****
WRITE (NUVI, 90002)
WRITE (NUVI, 90013)
WRITE (NUVI, 90014)
C***** TEST OF AMAX1
C*****
WRITE(NUVI, 16504)
16504 FORMAT (/ 8X, 13HTEST OF AMAX1)
CT013* TEST 13 BOTH VALUES ZERO
IVTNUM = 13
RHBVS = 0.0
RHDVS = 0.0
RHAVS = AMAX1(RHBVS, RHDVS)
IF (RHAVS + 0.00005) 20130, 10130, 40130
40130 IF (RHAVS - 0.00005) 10130, 10130, 20130
10130 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0131
20130 IVFAIL = IVFAIL + 1
RVCORR = 0.0
WRITE (NUVI, 80012) IVTNUM, RHAVS, RVCORR
0131 CONTINUE
CT014* TEST 14 FIRST VALUE NON-ZERO, SECOND ZERO
IVTNUM = 14
RHBVS = 5.625
RHDVS = 0.0
RHAVS = AMAX1(RHBVS, RHDVS)
IF (RHAVS - 5.6247) 20140, 10140, 40140
40140 IF (RHAVS - 5.6253) 10140, 10140, 20140
10140 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0141
20140 IVFAIL = IVFAIL + 1
RVCORR = 5.625
WRITE (NUVI, 80012) IVTNUM, RHAVS, RVCORR
0141 CONTINUE
CT015* TEST 15 BOTH VALUES EQUAL
IVTNUM = 15
RHBVS = 6.5
RHDVS = 6.5
RHAVS = AMAX1(RHBVS, RHDVS)
IF (RHAVS - 6.4996) 20150, 10150, 40150
40150 IF (RHAVS - 6.5004) 10150, 10150, 20150
10150 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0151
20150 IVFAIL = IVFAIL + 1
RVCORR = 6.5
WRITE (NUVI, 80012) IVTNUM, RHAVS, RVCORR
0151 CONTINUE
CT016* TEST 16 VALUES NOT EQUAL
IVTNUM = 16
RHBVS = 7.125
RHDVS = 5.125
RHAVS = AMAX1(RHBVS, RHDVS)
IF (RHAVS - 7.1246) 20160, 10160, 40160
40160 IF (RHAVS - 7.1254) 10160, 10160, 20160
10160 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0161
20160 IVFAIL = IVFAIL + 1
RVCORR = 7.125
WRITE (NUVI, 80012) IVTNUM, RHAVS, RVCORR
0161 CONTINUE
CT017* TEST 17 FIRST VALUE NEGATIVE, SECOND ZERO
IVTNUM = 17
RHBVS = -5.625
RHDVS = 0.0
RHAVS = AMAX1(RHBVS, RHDVS)
IF (RHAVS + 0.00005) 20170, 10170, 40170
40170 IF (RHAVS - 0.00005) 10170, 10170, 20170
10170 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0171
20170 IVFAIL = IVFAIL + 1
RVCORR = 0.0
WRITE (NUVI, 80012) IVTNUM, RHAVS, RVCORR
0171 CONTINUE
CT018* TEST 18 BOTH VALUES EQUAL, BOTH NEGATIVE
IVTNUM = 18
RHBVS = -6.5
RHDVS = -6.5
RHAVS = AMAX1(RHBVS, RHDVS)
IF (RHAVS + 6.5004) 20180, 10180, 40180
40180 IF (RHAVS + 6.4996) 10180, 10180, 20180
10180 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0181
20180 IVFAIL = IVFAIL + 1
RVCORR = -6.5
WRITE (NUVI, 80012) IVTNUM, RHAVS, RVCORR
0181 CONTINUE
CT019* TEST 19 VALUES NOT EQUAL, BOTH NEGATIVE
IVTNUM = 19
RHBVS = -7.125
RHDVS = -5.125
RHAVS = AMAX1(RHBVS, RHDVS)
IF (RHAVS + 5.1253) 20190, 10190, 40190
40190 IF (RHAVS + 5.1247) 10190, 10190, 20190
10190 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0191
20190 IVFAIL = IVFAIL + 1
RVCORR = -5.125
WRITE (NUVI, 80012) IVTNUM, RHAVS, RVCORR
0191 CONTINUE
CT020* TEST 20 1ST VALUE NON-ZERO, 2ND ZERO PRECEDED BY MINUS SIGN
IVTNUM = 20
RHDVS = 5.625
RHEVS = 0.0
RHAVS = AMAX1(RHDVS, -RHEVS)
IF (RHAVS - 5.6247) 20200, 10200, 40200
40200 IF (RHAVS - 5.6253) 10200, 10200, 20200
10200 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0201
20200 IVFAIL = IVFAIL + 1
RVCORR = 5.625
WRITE (NUVI, 80012) IVTNUM, RHAVS, RVCORR
0201 CONTINUE
CT021* TEST 21 EXPRESSIONS PRESENTED TO FUNCTION
IVTNUM = 21
RHDVS = 3.5
RHEVS = 4.0
RHAVS = AMAX1(RHDVS + RHEVS, -RHEVS - RHDVS)
IF (RHAVS - 7.4996) 20210, 10210, 40210
40210 IF (RHAVS - 7.5004) 10210, 10210, 20210
10210 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0211
20210 IVFAIL = IVFAIL + 1
RVCORR = 7.5
WRITE (NUVI, 80012) IVTNUM, RHAVS, RVCORR
0211 CONTINUE
CT022* TEST 22 3 ARGUMENTS
IVTNUM = 22
RHBVS = 0.0
RHCVS = 1.0
RHDVS = 0.5
RHAVS = AMAX1(RHBVS, RHCVS, RHDVS)
IF (RHAVS - 0.99995) 20220, 10220, 40220
40220 IF (RHAVS - 1.0001) 10220, 10220, 20220
10220 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0221
20220 IVFAIL = IVFAIL + 1
RVCORR = 1.0
WRITE (NUVI, 80012) IVTNUM, RHAVS, RVCORR
0221 CONTINUE
CT023* TEST 23 4 ARGUMENTS
IVTNUM = 23
RHBVS = 1.5
RHCVS = 3.4
RHDVS = 3.5
RHAVS = AMAX1(-RHDVS, RHCVS, RHBVS, RHDVS)
IF (RHAVS - 3.4998) 20230, 10230, 40230
40230 IF (RHAVS - 3.5002) 10230, 10230, 20230
10230 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0231
20230 IVFAIL = IVFAIL + 1
RVCORR = 3.5
WRITE (NUVI, 80012) IVTNUM, RHAVS, RVCORR
0231 CONTINUE
CT024* TEST 24 5 ARGUMENTS
IVTNUM = 24
RHDVS = 3.5
RHEVS = 4.5
RHAVS = AMAX1(RHDVS, -RHDVS, -RHEVS, +RHDVS, RHEVS)
IF (RHAVS - 4.4997) 20240, 10240, 40240
40240 IF (RHAVS - 4.5003) 10240, 10240, 20240
10240 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0241
20240 IVFAIL = IVFAIL + 1
RVCORR = 4.5
WRITE (NUVI, 80012) IVTNUM, RHAVS, RVCORR
0241 CONTINUE
C*****
WRITE (NUVI, 90002)
WRITE (NUVI, 90013)
WRITE (NUVI, 90014)
C***** TEST OF MAX0
C*****
WRITE(NUVI, 16505)
16505 FORMAT (/ 8X, 12HTEST OF MAX0)
C*****
CT025* TEST 25 BOTH VALUES ZERO
IVTNUM = 25
IHBVI = 0
IHDVI = 0
IHAVI = MAX0(IHBVI, IHDVI)
IF (IHAVI - 0) 20250, 10250, 20250
10250 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0251
20250 IVFAIL = IVFAIL + 1
IVCORR = 0
WRITE (NUVI, 80010) IVTNUM, IHAVI, IVCORR
0251 CONTINUE
CT026* TEST 26 FIRST VALUE NON-ZERO, SECOND ZERO
IVTNUM = 26
IHBVI = 6
IHDVI = 0
IHAVI = MAX0(IHBVI, IHDVI)
IF (IHAVI - 6) 20260, 10260, 20260
10260 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0261
20260 IVFAIL = IVFAIL + 1
IVCORR = 6
WRITE (NUVI, 80010) IVTNUM, IHAVI, IVCORR
0261 CONTINUE
CT027* TEST 27 BOTH VALUES EQUAL
IVTNUM = 27
IHBVI = 7
IHDVI = 7
IHAVI = MAX0(IHBVI, IHDVI)
IF (IHAVI - 7) 20270, 10270, 20270
10270 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0271
20270 IVFAIL = IVFAIL + 1
IVCORR = 7
WRITE (NUVI, 80010) IVTNUM, IHAVI, IVCORR
0271 CONTINUE
CT028* TEST 28 VALUES NOT EQUAL
IVTNUM = 28
IHBVI = 7
IHDVI = 5
IHAVI = MAX0(IHBVI, IHDVI)
IF (IHAVI - 7) 20280, 10280, 20280
10280 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0281
20280 IVFAIL = IVFAIL + 1
IVCORR = 7
WRITE (NUVI, 80010) IVTNUM, IHAVI, IVCORR
0281 CONTINUE
CT029* TEST 29 FIRST VALUE NEGATIVE, SECOND ZERO
IVTNUM = 29
IHBVI = -6
IHDVI = 0
IHAVI = MAX0(IHBVI, IHDVI)
IF (IHAVI - 0) 20290, 10290, 20290
10290 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0291
20290 IVFAIL = IVFAIL + 1
IVCORR = 0
WRITE (NUVI, 80010) IVTNUM, IHAVI, IVCORR
0291 CONTINUE
CT030* TEST 30 BOTH VALUES EQUAL, BOTH NEGATIVE
IVTNUM = 30
IHBVI = -7
IHDVI = -7
IHAVI = MAX0(IHBVI, IHDVI)
IF (IHAVI + 7) 20300, 10300, 20300
10300 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0301
20300 IVFAIL = IVFAIL + 1
IVCORR = -7
WRITE (NUVI, 80010) IVTNUM, IHAVI, IVCORR
0301 CONTINUE
CT031* TEST 31 VALUES NOT EQUAL, BOTH NEGATIVE
IVTNUM = 31
IHBVI = -7
IHDVI = -5
IHAVI = MAX0(IHBVI, IHDVI)
IF (IHAVI + 5) 20310, 10310, 20310
10310 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0311
20310 IVFAIL = IVFAIL + 1
IVCORR = -5
WRITE (NUVI, 80010) IVTNUM, IHAVI, IVCORR
0311 CONTINUE
CT032* TEST 32 1ST VALUE NON-ZERO, 2ND ZERO PRECEDED BY MINUS SIGN
IVTNUM = 32
IHDVI = 6
IHEVI = 0
IHAVI = MAX0(IHDVI, -IHEVI)
IF (IHAVI - 6) 20320, 10320, 20320
10320 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0321
20320 IVFAIL = IVFAIL + 1
IVCORR = 6
WRITE (NUVI, 80010) IVTNUM, IHAVI, IVCORR
0321 CONTINUE
CT033* TEST 33 EXPRESSIONS PRESENTED TO FUNCTION
IVTNUM = 33
IHDVI = 3
IHEVI = 4
IHAVI = MAX0(IHDVI + IHEVI, -IHEVI - IHDVI)
IF (IHAVI - 7) 20330, 10330, 20330
10330 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0331
20330 IVFAIL = IVFAIL + 1
IVCORR = 7
WRITE (NUVI, 80010) IVTNUM, IHAVI, IVCORR
0331 CONTINUE
CT034* TEST 34 3 ARGUMENTS
IVTNUM = 34
IHBVI = 0
IHCVI = 3
IHDVI = -4
IHAVI = MAX0(IHDVI, IHBVI, IHCVI)
IF (IHAVI - 3) 20340, 10340, 20340
10340 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0341
20340 IVFAIL = IVFAIL + 1
IVCORR = 3
WRITE (NUVI, 80010) IVTNUM, IHAVI, IVCORR
0341 CONTINUE
CT035* TEST 35 4 ARGUMENTS
IVTNUM = 35
IHBVI = -1
IHCVI = 0
IHDVI = 4
IHAVI = MAX0(IHDVI, IHCVI, IHBVI, IHDVI)
IF (IHAVI - 4) 20350, 10350, 20350
10350 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0351
20350 IVFAIL = IVFAIL + 1
IVCORR = 4
WRITE (NUVI, 80010) IVTNUM, IHAVI, IVCORR
0351 CONTINUE
CT036* TEST 36 5 ARGUMENTS
IVTNUM = 36
IHDVI = 4
IHEVI = 5
IHAVI = MAX0(IHDVI, -IHDVI, -IHEVI, +IHDVI, IHEVI)
IF (IHAVI - 5) 20360, 10360, 20360
10360 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0361
20360 IVFAIL = IVFAIL + 1
IVCORR = 5
WRITE (NUVI, 80010) IVTNUM, IHAVI, IVCORR
0361 CONTINUE
C*****
WRITE (NUVI, 90002)
WRITE (NUVI, 90013)
WRITE (NUVI, 90014)
C***** TEST OF MAX1
C*****
WRITE(NUVI, 16507)
16507 FORMAT (/ 8X, 12HTEST OF MAX1)
CT037* TEST 37 BOTH VALUES EQUAL
IVTNUM = 37
RHBVS = 0.0
RHDVS = 0.0
IHAVI = MAX1(RHBVS, RHDVS)
IF (IHAVI - 0) 20370, 10370, 20370
10370 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0371
20370 IVFAIL = IVFAIL + 1
IVCORR = 0
WRITE (NUVI, 80010) IVTNUM, IHAVI, IVCORR
0371 CONTINUE
CT038* TEST 38 FIRST VALUE NON-ZERO, SECOND ZERO
IVTNUM = 38
RHBVS = 5.625
RHDVS = 0.0
IHAVI = MAX1(RHBVS, RHDVS)
IF (IHAVI - 5) 20380, 10380, 20380
10380 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0381
20380 IVFAIL = IVFAIL + 1
IVCORR = 5
WRITE (NUVI, 80010) IVTNUM, IHAVI, IVCORR
0381 CONTINUE
CT039* TEST 39 BOTH VALUES EQUAL
IVTNUM = 39
RHBVS = 6.5
RHDVS = 6.5
IHAVI = MAX1(RHBVS, RHDVS)
IF (IHAVI - 6) 20390, 10390, 20390
10390 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0391
20390 IVFAIL = IVFAIL + 1
IVCORR = 6
WRITE (NUVI, 80010) IVTNUM, IHAVI, IVCORR
0391 CONTINUE
CT040* TEST 40 VALUES NOT EQUAL
IVTNUM = 40
RHBVS = 7.125
RHDVS = 5.125
IHAVI = MAX1(RHBVS, RHDVS)
IF (IHAVI - 7) 20400, 10400, 20400
10400 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0401
20400 IVFAIL = IVFAIL + 1
IVCORR = 7
WRITE (NUVI, 80010) IVTNUM, IHAVI, IVCORR
0401 CONTINUE
CT041* TEST 41 FIRST VALUE NEGATIVE, SECOND ZERO
IVTNUM = 41
RHBVS = -5.625
RHDVS = 0.0
IHAVI = MAX1(RHBVS, RHDVS)
IF (IHAVI - 0) 20410, 10410, 20410
10410 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0411
20410 IVFAIL = IVFAIL + 1
IVCORR = 0
WRITE (NUVI, 80010) IVTNUM, IHAVI, IVCORR
0411 CONTINUE
CT042* TEST 42 BOTH VALUES EQUAL, BOTH NEGATIVE
IVTNUM = 42
RHBVS = - 6.5
RHDVS = - 6.5
IHAVI = MAX1(RHBVS, RHDVS)
IF (IHAVI + 6) 20420, 10420, 20420
10420 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0421
20420 IVFAIL = IVFAIL + 1
IVCORR = -6
WRITE (NUVI, 80010) IVTNUM, IHAVI, IVCORR
0421 CONTINUE
CT043* TEST 43 VALUES NOT EQUAL, BOTH NEGATIVE
IVTNUM = 43
RHBVS = -7.125
RHDVS = -5.125
IHAVI = MAX1(RHBVS, RHDVS)
IF (IHAVI + 5) 20430, 10430, 20430
10430 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0431
20430 IVFAIL = IVFAIL + 1
IVCORR = -5
WRITE (NUVI, 80010) IVTNUM, IHAVI, IVCORR
0431 CONTINUE
CT044* TEST 44 1ST VALUE NON-ZERO, 2ND ZERO PRECEDED BY A MINUS SIGN
IVTNUM = 44
RHDVS = 5.625
RHEVS = 0.0
IHAVI = MAX1(RHDVS, -RHEVS)
IF (IHAVI - 5) 20440, 10440, 20440
10440 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0441
20440 IVFAIL = IVFAIL + 1
IVCORR = 5
WRITE (NUVI, 80010) IVTNUM, IHAVI, IVCORR
0441 CONTINUE
CT045* TEST 45 EXPRESSIONS PRESENTED TO FUNCTION
IVTNUM = 45
RHDVS = 3.5
RHEVS = 4.0
IHAVI = MAX1(RHDVS + RHEVS, -RHEVS - RHDVS)
IF (IHAVI - 7) 20450, 10450, 20450
10450 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0451
20450 IVFAIL = IVFAIL + 1
IVCORR = 7
WRITE (NUVI, 80010) IVTNUM, IHAVI, IVCORR
0451 CONTINUE
CT046* TEST 46 3 ARGUMENTS
IVTNUM = 46
RHBVS = 0.0
RHCVS = 4.0
RHDVS = 0.0
IHAVI = MAX1(RHBVS, -RHCVS, RHDVS)
IF (IHAVI - 0) 20460, 10460, 20460
10460 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0461
20460 IVFAIL = IVFAIL + 1
IVCORR = 0
WRITE (NUVI, 80010) IVTNUM, IHAVI, IVCORR
0461 CONTINUE
CT047* TEST 47 4 ARGUMENTS
IVTNUM = 47
RHBVS = 3.49
RHCVS = 0.0
RHDVS = 3.5
IHAVI = MAX1(RHDVS, RHBVS, -RHBVS, RHCVS)
IF (IHAVI - 3) 20470, 10470, 20470
10470 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0471
20470 IVFAIL = IVFAIL + 1
IVCORR = 3
WRITE (NUVI, 80010) IVTNUM, IHAVI, IVCORR
0471 CONTINUE
CT048* TEST 48 5 ARGUMENTS
IVTNUM = 48
RHDVS = 3.5
RHEVS = 4.5
IHAVI = MAX1(RHDVS, -RHDVS, -RHEVS, +RHDVS, RHEVS)
IF (IHAVI - 4) 20480, 10480, 20480
10480 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0481
20480 IVFAIL = IVFAIL + 1
IVCORR = 4
WRITE (NUVI, 80010) IVTNUM, IHAVI, IVCORR
0481 CONTINUE
C*****
CBB** ********************** BBCSUM0 **********************************
C**** WRITE OUT TEST SUMMARY
C****
IVTOTN = IVPASS + IVFAIL + IVDELE + IVINSP
WRITE (I02, 90004)
WRITE (I02, 90014)
WRITE (I02, 90004)
WRITE (I02, 90020) IVPASS
WRITE (I02, 90022) IVFAIL
WRITE (I02, 90024) IVDELE
WRITE (I02, 90026) IVINSP
WRITE (I02, 90028) IVTOTN, IVTOTL
CBE** ********************** BBCSUM0 **********************************
CBB** ********************** BBCFOOT0 **********************************
C**** WRITE OUT REPORT FOOTINGS
C****
WRITE (I02,90016) ZPROG, ZPROG
WRITE (I02,90018) ZPROJ, ZNAME, ZTAPE, ZTAPED
WRITE (I02,90019)
CBE** ********************** BBCFOOT0 **********************************
CBB** ********************** BBCFMT0A **********************************
C**** FORMATS FOR TEST DETAIL LINES
C****
80000 FORMAT (1H ,2X,I3,4X,7HDELETED,32X,A31)
80002 FORMAT (1H ,2X,I3,4X,7H PASS ,32X,A31)
80004 FORMAT (1H ,2X,I3,4X,7HINSPECT,32X,A31)
80008 FORMAT (1H ,2X,I3,4X,7H FAIL ,32X,A31)
80010 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,15X,10HCOMPUTED= ,
1I6,/,1H ,15X,10HCORRECT= ,I6)
80012 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
1E12.5,/,1H ,16X,10HCORRECT= ,E12.5)
80018 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
1A21,/,1H ,16X,10HCORRECT= ,A21)
80020 FORMAT (1H ,16X,10HCOMPUTED= ,A21,1X,A31)
80022 FORMAT (1H ,16X,10HCORRECT= ,A21,1X,A31)
80024 FORMAT (1H ,16X,10HCOMPUTED= ,I6,16X,A31)
80026 FORMAT (1H ,16X,10HCORRECT= ,I6,16X,A31)
80028 FORMAT (1H ,16X,10HCOMPUTED= ,E12.5,10X,A31)
80030 FORMAT (1H ,16X,10HCORRECT= ,E12.5,10X,A31)
80050 FORMAT (1H ,48X,A31)
CBE** ********************** BBCFMT0A **********************************
CBB** ********************** BBCFMT0B **********************************
C**** FORMAT STATEMENTS FOR PAGE HEADERS
C****
90002 FORMAT (1H1)
90004 FORMAT (1H )
90006 FORMAT (1H ,20X,31HFEDERAL SOFTWARE TESTING CENTER)
90007 FORMAT (1H ,19X,34HFORTRAN COMPILER VALIDATION SYSTEM)
90008 FORMAT (1H ,21X,A13,A17)
90009 FORMAT (1H ,/,2H *,A5,6HBEGIN*,12X,15HTEST RESULTS - ,A5,/)
90010 FORMAT (1H ,8X,16HTEST DATE*TIME= ,A17,15H - COMPILER= ,A20)
90013 FORMAT (1H ,8H TEST ,10HPASS/FAIL ,6X,17HDISPLAYED RESULTS,
1 7X,7HREMARKS,24X)
90014 FORMAT (1H ,46H----------------------------------------------,
1 33H---------------------------------)
90015 FORMAT (1H ,48X,17HTHIS PROGRAM HAS ,I3,6H TESTS,/)
C****
C**** FORMAT STATEMENTS FOR REPORT FOOTINGS
C****
90016 FORMAT (1H ,/,2H *,A5,4HEND*,14X,14HEND OF TEST - ,A5,/)
90018 FORMAT (1H ,A13,13X,A20,7H * ,A10,1H/,
1 A13)
90019 FORMAT (1H ,26HFOR OFFICIAL USE ONLY ,35X,15HCOPYRIGHT 1982)
C****
C**** FORMAT STATEMENTS FOR RUN SUMMARY
C****
90020 FORMAT (1H ,21X,I5,13H TESTS PASSED)
90022 FORMAT (1H ,21X,I5,13H TESTS FAILED)
90024 FORMAT (1H ,21X,I5,14H TESTS DELETED)
90026 FORMAT (1H ,21X,I5,25H TESTS REQUIRE INSPECTION)
90028 FORMAT (1H ,21X,I5,4H OF ,I3,15H TESTS EXECUTED)
CBE** ********************** BBCFMT0B **********************************
C*****
C***** END OF TEST SEGMENT 165
STOP
END
*END-OF,FM361
FM362.f 481036280 170 2 100666 30268 `
*HEADER,FORTR,FM362
*FILES1,FORTR,FM362,X
C***********************************************************************
C***** FORTRAN 77
C***** FM362 XMIN - (167)
C*****
C***********************************************************************
C***** GENERAL PURPOSE SUBSET REF
C***** TEST INTRINSIC FUNCTIONS AMIN0,AMIN1,MIN0,MIN1 15.3
C***** CHOOSING SMALLEST VALUE. (TABLE 5)
C*****
CBB** ********************** BBCCOMNT **********************************
C****
C**** 1978 FORTRAN COMPILER VALIDATION SYSTEM
C**** VERSION 2.0
C****
C****
C**** SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO
C**** GENERAL SERVICES ADMINISTRATION
C**** FEDERAL SOFTWARE TESTING CENTER
C**** 5203 LEESBURG PIKE, SUITE 1100
C**** FALLS CHURCH, VA. 22041
C****
C**** (703) 756-6153
C****
CBE** ********************** BBCCOMNT **********************************
CBB** ********************** BBCINITA **********************************
C**** SPECIFICATION STATEMENTS
C****
CHARACTER ZVERS*13, ZVERSD*17, ZDATE*17, ZPROG*5, ZCOMPL*20,
1 ZNAME*20, ZTAPE*10, ZPROJ*13, REMRKS*31, ZTAPED*13
CBE** ********************** BBCINITA **********************************
CBB** ********************** BBCINITB **********************************
C**** INITIALIZE SECTION
DATA ZVERS, ZVERSD, ZDATE
1 /'VERSION 2.0 ', '82/08/02*18.33.46', '*NO DATE*TIME'/
DATA ZCOMPL, ZNAME, ZTAPE
1 /'*NONE SPECIFIED*', '*NO COMPANY NAME*', '*NO TAPE*'/
DATA ZPROJ, ZTAPED, ZPROG
1 /'*NO PROJECT*', '*NO TAPE DATE', 'XXXXX'/
DATA REMRKS /' '/
C**** THE FOLLOWING 9 COMMENT LINES (CZ01, CZ02, ...) CAN BE REPLACED
C**** FOR IDENTIFYING THE TEST ENVIRONMENT
C****
CZ01 ZVERS = 'VERSION OF THE COMPILER VALIDATION SYSTEM'
CZ02 ZVERSD = 'CREATION DATE/TIME OF THE COMPILER VALIDATION SYSTEM'
CZ03 ZPROG = 'PROGRAM NAME'
CZ04 ZDATE = 'DATE OF TEST'
CZ05 ZCOMPL = 'COMPILER IDENTIFICATION'
CZ06 ZPROJ = 'PROJECT NUMBER/IDENTIFICATION'
CZ07 ZNAME = 'NAME OF USER'
CZ08 ZTAPE = 'TAPE OWNER/ID'
CZ09 ZTAPED = 'DATE TAPE COPIED'
C
IVPASS = 0
IVFAIL = 0
IVDELE = 0
IVINSP = 0
IVTOTL = 0
IVTOTN = 0
ICZERO = 0
C
C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER.
I01 = 05
C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER.
I02 = 06
C
CX010 REPLACED BY FEXEC X-010 CONTROL CARD (CARD-READER UNIT NUMBER).
C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5
CX011 REPLACED BY FEXEC X-011 CONTROL CARD. CX011 IS FOR SYSTEMS
C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX010.
C
CX020 REPLACED BY FEXEC X-020 CONTROL CARD (PRINTER UNIT NUMBER).
C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02= 6
CX021 REPLACED BY FEXEC X-021 CONTROL CARD. CX021 IS FOR SYSTEMS
C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX020.
C
CBE** ********************** BBCINITB **********************************
NUVI = I02
IVTOTL = 47
ZPROG = 'FM362'
CBB** ********************** BBCHED0A **********************************
C****
C**** WRITE REPORT TITLE
C****
WRITE (I02, 90002)
WRITE (I02, 90006)
WRITE (I02, 90007)
WRITE (I02, 90008) ZVERS, ZVERSD
WRITE (I02, 90009) ZPROG, ZPROG
WRITE (I02, 90010) ZDATE, ZCOMPL
CBE** ********************** BBCHED0A **********************************
C*****
C***** HEADER FOR SEGMENT 167
WRITE (NUVI,16700)
16700 FORMAT (1H , // 2X,36HXMIN - (167) INTRINSIC FUNCTIONS-- //13X,
1 24HAMIN0, AMIN1, MIN0, MIN1/ 13X,
2 25H(CHOOSING SMALLEST VALUE)//2X,
3 18HSUBSET REF. - 15.3)
CBB** ********************** BBCHED0B **********************************
C**** WRITE DETAIL REPORT HEADERS
C****
WRITE (I02,90004)
WRITE (I02,90004)
WRITE (I02,90013)
WRITE (I02,90014)
WRITE (I02,90015) IVTOTL
CBE** ********************** BBCHED0B **********************************
C*****
C***** TEST OF AMIN0
C*****
WRITE(NUVI, 16702)
16702 FORMAT (/ 8X, 13HTEST OF AMIN0)
CT001* TEST 1 BOTH VALUES ZERO
IVTNUM = 1
IIBVI = 0
IIDVI = 0
RIAVS = AMIN0(IIBVI, IIDVI)
IF (RIAVS + 0.00005) 20010, 10010, 40010
40010 IF (RIAVS - 0.00005) 10010, 10010, 20010
10010 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0011
20010 IVFAIL = IVFAIL + 1
RVCORR = 0.0
WRITE (NUVI, 80012) IVTNUM, RIAVS, RVCORR
0011 CONTINUE
CT002* TEST 2 FIRST VALUE NON-ZERO, SECOND ZERO
IVTNUM = 2
IIBVI = 6
IIDVI = 0
RIAVS = AMIN0(IIBVI, IIDVI)
IF (RIAVS + 0.00005) 20020, 10020, 40020
40020 IF (RIAVS - 0.00005) 10020, 10020, 20020
10020 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0021
20020 IVFAIL = IVFAIL + 1
RVCORR = 0.0
WRITE (NUVI, 80012) IVTNUM, RIAVS, RVCORR
0021 CONTINUE
CT003* TEST 3 BOTH VALUES EQUAL
IVTNUM = 3
IIBVI = 7
IIDVI = 7
RIAVS = AMIN0(IIBVI, IIDVI)
IF (RIAVS - 6.9996) 20030, 10030, 40030
40030 IF (RIAVS - 7.0004) 10030, 10030, 20030
10030 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0031
20030 IVFAIL = IVFAIL + 1
RVCORR = 7.0
WRITE (NUVI, 80012) IVTNUM, RIAVS, RVCORR
0031 CONTINUE
CT004* TEST 4 VALUES NOT EQUAL
IVTNUM = 4
IIBVI = 7
IIDVI = 5
RIAVS = AMIN0(IIBVI, IIDVI)
IF (RIAVS - 4.9997) 20040, 10040, 40040
40040 IF (RIAVS - 5.0003) 10040, 10040, 20040
10040 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0041
20040 IVFAIL = IVFAIL + 1
RVCORR = 5.0
WRITE (NUVI, 80012) IVTNUM, RIAVS, RVCORR
0041 CONTINUE
CT005* TEST 5 FIRST VALUE NEGATIVE, SECOND ZERO
IVTNUM = 5
IIBVI = -6
IIDVI = 0
RIAVS = AMIN0(IIBVI, IIDVI)
IF (RIAVS + 6.0003) 20050, 10050, 40050
40050 IF (RIAVS + 5.9997) 10050, 10050, 20050
10050 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0051
20050 IVFAIL = IVFAIL + 1
RVCORR = -6.0
WRITE (NUVI, 80012) IVTNUM, RIAVS, RVCORR
0051 CONTINUE
CT006* TEST 6 BOTH VALUES EQUAL, BOTH NEGATIVE
IVTNUM = 6
IIBVI = -7
IIDVI = -7
RIAVS = AMIN0(IIBVI, IIDVI)
IF (RIAVS + 7.0004) 20060, 10060, 40060
40060 IF (RIAVS + 6.9996) 10060, 10060, 20060
10060 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0061
20060 IVFAIL = IVFAIL + 1
RVCORR = -7.0
WRITE (NUVI, 80012) IVTNUM, RIAVS, RVCORR
0061 CONTINUE
CT007* TEST 7 VALUES NOT EQUAL, BOTH NEGATIVE
IVTNUM = 7
IIBVI = -7
IIDVI = -5
RIAVS = AMIN0(IIBVI, IIDVI)
IF (RIAVS + 7.0004) 20070, 10070, 40070
40070 IF (RIAVS + 6.9996) 10070, 10070, 20070
10070 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0071
20070 IVFAIL = IVFAIL + 1
RVCORR = -7.0
WRITE (NUVI, 80012) IVTNUM, RIAVS, RVCORR
0071 CONTINUE
CT008* TEST 8 FIRST VALUE NON-ZERO, 2ND ZERO PRECEDED BY MINUS SIGN
IVTNUM = 8
IIDVI = 6
IIEVI = 0
RIAVS = AMIN0(IIDVI, -IIEVI)
IF (RIAVS + 0.00005) 20080, 10080, 40080
40080 IF (RIAVS - 0.00005) 10080, 10080, 20080
10080 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0081
20080 IVFAIL = IVFAIL + 1
RVCORR = 0.0
WRITE (NUVI, 80012) IVTNUM, RIAVS, RVCORR
0081 CONTINUE
CT009* TEST 9 3 ARGUMENTS
IVTNUM = 9
IIBVI = 0
IICVI = 9
IIDVI = 8
RIAVS = AMIN0(IIBVI, IICVI, IIDVI)
IF (RIAVS + 0.00005) 20090, 10090, 40090
40090 IF (RIAVS - 0.00005) 10090, 10090, 20090
10090 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0091
20090 IVFAIL = IVFAIL + 1
RVCORR = 0.0
WRITE (NUVI, 80012) IVTNUM, RIAVS, RVCORR
0091 CONTINUE
CT010* TEST 10 4 ARGUMENTS
IVTNUM = 10
IIBVI = 34
IICVI = 8
IIDVI = 4
RIAVS = AMIN0(IIDVI, IIBVI, IICVI, IIDVI)
IF (RIAVS - 3.9998) 20100, 10100, 40100
40100 IF (RIAVS - 4.0002) 10100, 10100, 20100
10100 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0101
20100 IVFAIL = IVFAIL + 1
RVCORR = 4.0
WRITE (NUVI, 80012) IVTNUM, RIAVS, RVCORR
0101 CONTINUE
CT011* TEST 11 5 ARGUMENTS
IVTNUM = 11
IIDVI = 4.0
IIEVI = 5.0
RIAVS = AMIN0(IIDVI, -IIDVI, -IIEVI, +IIDVI, IIEVI)
IF (RIAVS + 5.0003) 20110, 10110, 40110
40110 IF (RIAVS + 4.9997) 10110, 10110, 20110
10110 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0111
20110 IVFAIL = IVFAIL + 1
RVCORR = -5.0
WRITE (NUVI, 80012) IVTNUM, RIAVS, RVCORR
0111 CONTINUE
C*****
WRITE (NUVI, 90002)
WRITE (NUVI, 90013)
WRITE (NUVI, 90014)
C***** TEST OF AMIN1
C*****
WRITE(NUVI, 16704)
16704 FORMAT (/ 8X, 13HTEST OF AMIN1)
CT012* TEST 12 BOTH VALUES ZERO
IVTNUM = 12
RIBVS = 0.0
RIDVS = 0.0
RIAVS = AMIN1(RIBVS, RIDVS)
IF (RIAVS + 0.00005) 20120, 10120, 40120
40120 IF (RIAVS - 0.00005) 10120, 10120, 20120
10120 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0121
20120 IVFAIL = IVFAIL + 1
RVCORR = 0.0
WRITE (NUVI, 80012) IVTNUM, RIAVS, RVCORR
0121 CONTINUE
CT013* TEST 13 FIRST VALUE NON-ZERO, SECOND ZERO
IVTNUM = 13
RIBVS = 5.625
RIDVS = 0.0
RIAVS = AMIN1(RIBVS, RIDVS)
IF (RIAVS + 0.00005) 20130, 10130, 40130
40130 IF (RIAVS - 0.00005) 10130, 10130, 20130
10130 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0131
20130 IVFAIL = IVFAIL + 1
RVCORR = 0.0
WRITE (NUVI, 80012) IVTNUM, RIAVS, RVCORR
0131 CONTINUE
CT014* TEST 14 BOTH VALUES EQUAL
IVTNUM = 14
RIBVS = 6.5
RIDVS = 6.5
RIAVS = AMIN1(RIBVS, RIDVS)
IF (RIAVS - 6.4996) 20140, 10140, 40140
40140 IF (RIAVS - 6.5004) 10140, 10140, 20140
10140 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0141
20140 IVFAIL = IVFAIL + 1
RVCORR = 6.5
WRITE (NUVI, 80012) IVTNUM, RIAVS, RVCORR
0141 CONTINUE
CT015* TEST 15 VALUES NOT EQUAL
IVTNUM = 15
RIBVS = 7.125
RIDVS = 5.125
RIAVS = AMIN1(RIBVS, RIDVS)
IF (RIAVS - 5.1247) 20150, 10150, 40150
40150 IF (RIAVS - 5.1253) 10150, 10150, 20150
10150 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0151
20150 IVFAIL = IVFAIL + 1
RVCORR = 5.125
WRITE (NUVI, 80012) IVTNUM, RIAVS, RVCORR
0151 CONTINUE
CT016* TEST 16 FIRST VALUE NEGATIVE, SECOND ZERO
IVTNUM = 16
RIBVS = -5.625
RIDVS = 0.0
RIAVS = AMIN1(RIBVS, RIDVS)
IF (RIAVS + 5.6253) 20160, 10160, 40160
40160 IF (RIAVS + 5.6247) 10160, 10160, 20160
10160 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0161
20160 IVFAIL = IVFAIL + 1
RVCORR = -5.625
WRITE (NUVI, 80012) IVTNUM, RIAVS, RVCORR
0161 CONTINUE
CT017* TEST 17 BOTH VALUES EQUAL, BOTH NEGATIVE
IVTNUM = 17
RIBVS = -6.5
RIDVS = -6.5
RIAVS = AMIN1(RIBVS, RIDVS)
IF (RIAVS + 6.5004) 20170, 10170, 40170
40170 IF (RIAVS + 6.4996) 10170, 10170, 20170
10170 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0171
20170 IVFAIL = IVFAIL + 1
RVCORR = -6.5
WRITE (NUVI, 80012) IVTNUM, RIAVS, RVCORR
0171 CONTINUE
CT018* TEST 18 VALUES NOT EQUAL, BOTH NEGATIVE
IVTNUM = 18
RIBVS = -7.125
RIDVS = -5.125
RIAVS = AMIN1(RIBVS, RIDVS)
IF (RIAVS + 7.1254) 20180, 10180, 40180
40180 IF (RIAVS + 7.1246) 10180, 10180, 20180
10180 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0181
20180 IVFAIL = IVFAIL + 1
RVCORR = -7.125
WRITE (NUVI, 80012) IVTNUM, RIAVS, RVCORR
0181 CONTINUE
CT019* TEST 19 FIRST VALUE NON-ZERO, 2ND ZERO PRECEDED BY MINUS SIGN
IVTNUM = 19
RIDVS = 5.625
RIEVS = 0.0
RIAVS = AMIN1(RIDVS, -RIEVS)
IF (RIAVS + 0.00005) 20190, 10190, 40190
40190 IF (RIAVS - 0.00005) 10190, 10190, 20190
10190 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0191
20190 IVFAIL = IVFAIL + 1
RVCORR = 0.0
WRITE (NUVI, 80012) IVTNUM, RIAVS, RVCORR
0191 CONTINUE
CT020* TEST 20 EXPRESSION AS ARGUMENT
IVTNUM = 20
RIDVS = 3.5
RIEVS = 4.0
RIAVS = AMIN1(RIDVS + RIEVS, -RIEVS - RIDVS)
IF (RIAVS + 7.5004) 20200, 10200, 40200
40200 IF (RIAVS + 7.4996) 10200, 10200, 20200
10200 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0201
20200 IVFAIL = IVFAIL + 1
RVCORR = -7.5
WRITE (NUVI, 80012) IVTNUM, RIAVS, RVCORR
0201 CONTINUE
CT021* TEST 21 3 ARGUMENTS
IVTNUM = 21
RIBVS = 0.0
RICVS = 1.0
RIDVS = 10.9
RIAVS = AMIN1(RIDVS, RICVS, RIBVS)
IF (RIAVS + 0.00005) 20210, 10210, 40210
40210 IF (RIAVS - 0.00005) 10210, 10210, 20210
10210 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0211
20210 IVFAIL = IVFAIL + 1
RVCORR = 0.0
WRITE (NUVI, 80012) IVTNUM, RIAVS, RVCORR
0211 CONTINUE
CT022* TEST 22 4 ARGUMENTS
IVTNUM = 22
RIBVS = -9.0
RICVS = 10.0
RIDVS = 3.5
RIAVS = AMIN1(RIDVS, RICVS, -RIBVS, RIDVS)
IF (RIAVS - 3.4998) 20220, 10220, 40220
40220 IF (RIAVS - 3.5002) 10220, 10220, 20220
10220 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0221
20220 IVFAIL = IVFAIL + 1
RVCORR = 3.5
WRITE (NUVI, 80012) IVTNUM, RIAVS, RVCORR
0221 CONTINUE
CT023* TEST 23 5 ARGUMENTS
IVTNUM = 23
RIDVS = 3.5
RIEVS = 4.5
RIAVS = AMIN1(RIDVS, -RIDVS, -RIEVS, +RIDVS, RIEVS)
IF (RIAVS + 4.5003) 20230, 10230, 40230
40230 IF (RIAVS + 4.4997) 10230, 10230, 20230
10230 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0231
20230 IVFAIL = IVFAIL + 1
RVCORR = -4.5
WRITE (NUVI, 80012) IVTNUM, RIAVS, RVCORR
0231 CONTINUE
C*****
WRITE (NUVI, 90002)
WRITE (NUVI, 90013)
WRITE (NUVI, 90014)
C***** TEST OF MIN0
C*****
WRITE(NUVI, 16705)
16705 FORMAT (/ 8X, 12HTEST OF MIN0)
CT024* TEST 24 BOTH VALUES ZERO
IVTNUM = 24
IIBVI = 0
IIDVI = 0
IIAVI = MIN0(IIBVI, IIDVI)
IF (IIAVI - 0) 20240, 10240, 20240
10240 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0241
20240 IVFAIL = IVFAIL + 1
IVCORR = 0
WRITE (NUVI, 80010) IVTNUM, IIAVI, IVCORR
0241 CONTINUE
CT025* TEST 25 FIRST VALUE NON-ZERO, SECOND ZERO
IVTNUM = 25
IIBVI = 6
IIDVI = 0
IIAVI = MIN0(IIBVI, IIDVI)
IF (IIAVI - 0) 20250, 10250, 20250
10250 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0251
20250 IVFAIL = IVFAIL + 1
IVCORR = 0
WRITE (NUVI, 80010) IVTNUM, IIAVI, IVCORR
0251 CONTINUE
CT026* TEST 26 BOTH VALUES EQUAL
IVTNUM = 26
IIBVI = 7
IIDVI = 7
IIAVI = MIN0(IIBVI, IIDVI)
IF (IIAVI - 7) 20260, 10260, 20260
10260 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0261
20260 IVFAIL = IVFAIL + 1
IVCORR = 7
WRITE (NUVI, 80010) IVTNUM, IIAVI, IVCORR
0261 CONTINUE
CT027* TEST 27 VALUES NOT EQUAL
IVTNUM = 27
IIBVI = 7
IIDVI = 5
IIAVI = MIN0(IIBVI, IIDVI)
IF (IIAVI - 5) 20270, 10270, 20270
10270 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0271
20270 IVFAIL = IVFAIL + 1
IVCORR = 5
WRITE (NUVI, 80010) IVTNUM, IIAVI, IVCORR
0271 CONTINUE
CT028* TEST 28 FIRST VALUE NEGATIVE, SECOND ZERO
IVTNUM = 28
IIBVI = -6
IIDVI = 0
IIAVI = MIN0(IIBVI, IIDVI)
IF (IIAVI + 6) 20280, 10280, 20280
10280 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0281
20280 IVFAIL = IVFAIL + 1
IVCORR = -6
WRITE (NUVI, 80010) IVTNUM, IIAVI, IVCORR
0281 CONTINUE
CT029* TEST 29 BOTH VALUES EQUAL, BOTH NEGATIVE
IVTNUM = 29
IIBVI = -7
IIDVI = -7
IIAVI = MIN0(IIBVI, IIDVI)
IF (IIAVI + 7) 20290, 10290, 20290
10290 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0291
20290 IVFAIL = IVFAIL + 1
IVCORR = -7
WRITE (NUVI, 80010) IVTNUM, IIAVI, IVCORR
0291 CONTINUE
CT030* TEST 30 VALUES NOT EQUAL, BOTH NEGATIVE
IVTNUM = 30
IIBVI = -7
IIDVI = -5
IIAVI = MIN0(IIBVI, IIDVI)
IF (IIAVI + 7) 20300, 10300, 20300
10300 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0301
20300 IVFAIL = IVFAIL + 1
IVCORR = -7
WRITE (NUVI, 80010) IVTNUM, IIAVI, IVCORR
0301 CONTINUE
CT031* TEST 31 FIRST VALUE NON-ZERO, 2ND ZERO PRECEDED BY MINUS SIGN
IVTNUM = 31
IIDVI = 6
IIEVI = 0
IIAVI = MIN0(IIDVI, -IIEVI)
IF (IIAVI - 0) 20310, 10310, 20310
10310 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0311
20310 IVFAIL = IVFAIL + 1
IVCORR = 0
WRITE (NUVI, 80010) IVTNUM, IIAVI, IVCORR
0311 CONTINUE
CT032* TEST 32 EXPRESSION PRESENTED TO FUNCTION
IVTNUM = 32
IIDVI = 3
IIEVI = 4
IIAVI = MIN0(IIDVI + IIEVI, -IIEVI - IIDVI)
IF (IIAVI + 7) 20320, 10320, 20320
10320 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0321
20320 IVFAIL = IVFAIL + 1
IVCORR = -7
WRITE (NUVI, 80010) IVTNUM, IIAVI, IVCORR
0321 CONTINUE
CT033* TEST 33 3 ARGUMENTS
IVTNUM = 33
IIBVI = 0
IICVI = 10
IIDVI = -11
IIAVI = MIN0(IICVI, IIBVI, -IIDVI)
IF (IIAVI - 0) 20330, 10330, 20330
10330 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0331
20330 IVFAIL = IVFAIL + 1
IVCORR = 0
WRITE (NUVI, 80010) IVTNUM, IIAVI, IVCORR
0331 CONTINUE
CT034* TEST 34 4 ARGUMENTS
IVTNUM = 34
IIAVI = 10
IIBVI = -4
IICVI = 8
IIDVI = 4
IIAVI = MIN0(IIAVI, -IIBVI, IICVI, IIDVI)
IF (IIAVI - 4) 20340, 10340, 20340
10340 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0341
20340 IVFAIL = IVFAIL + 1
IVCORR = 4
WRITE (NUVI, 80010) IVTNUM, IIAVI, IVCORR
0341 CONTINUE
CT035* TEST 35 5 ARGUMENTS
IVTNUM = 35
IIDVI = 4
IIEVI = 5
IIAVI = MIN0(IIDVI, -IIDVI, -IIEVI, +IIDVI, IIEVI)
IF (IIAVI + 5) 20350, 10350, 20350
10350 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0351
20350 IVFAIL = IVFAIL + 1
IVCORR = -5
WRITE (NUVI, 80010) IVTNUM, IIAVI, IVCORR
0351 CONTINUE
C*****
WRITE (NUVI, 90002)
WRITE (NUVI, 90013)
WRITE (NUVI, 90014)
C***** TEST OF MIN1
C*****
WRITE(NUVI, 16707)
16707 FORMAT (/ 8X, 12HTEST OF MIN1)
CT036* TEST 36 BOTH VALUES ZERO
IVTNUM = 36
RIBVS = 0.0
RIDVS = 0.0
IIAVI = MIN1(RIBVS, RIDVS)
IF (IIAVI - 0) 20360, 10360, 20360
10360 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0361
20360 IVFAIL = IVFAIL + 1
IVCORR = 0
WRITE (NUVI, 80010) IVTNUM, IIAVI, IVCORR
0361 CONTINUE
CT037* TEST 37 FIRST VALUE NON-ZERO, SECOND ZERO
IVTNUM = 37
RIBVS = 5.625
RIDVS = 0.0
IIAVI = MIN1(RIBVS, RIDVS)
IF (IIAVI - 0) 20370, 10370, 20370
10370 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0371
20370 IVFAIL = IVFAIL + 1
IVCORR = 0
WRITE (NUVI, 80010) IVTNUM, IIAVI, IVCORR
0371 CONTINUE
CT038* TEST 38 BOTH VALUES EQUAL
IVTNUM = 38
RIBVS = 6.5
RIDVS = 6.5
IIAVI = MIN1(RIBVS, RIDVS)
IF (IIAVI - 6) 20380, 10380, 20380
10380 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0381
20380 IVFAIL = IVFAIL + 1
IVCORR = 6
WRITE (NUVI, 80010) IVTNUM, IIAVI, IVCORR
0381 CONTINUE
CT039* TEST 39 VALUES NOT EQUAL
IVTNUM = 39
RIBVS = 7.125
RIDVS = 5.125
IIAVI = MIN1(RIBVS, RIDVS)
IF (IIAVI - 5) 20390, 10390, 20390
10390 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0391
20390 IVFAIL = IVFAIL + 1
IVCORR = 5
WRITE (NUVI, 80010) IVTNUM, IIAVI, IVCORR
0391 CONTINUE
CT040* TEST 40 FIRST VALUE NEGATIVE, SECOND ZERO
IVTNUM = 40
RIBVS = -5.625
RIDVS = 0.0
IIAVI = MIN1(RIBVS, RIDVS)
IF (IIAVI + 5) 20400, 10400, 20400
10400 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0401
20400 IVFAIL = IVFAIL + 1
IVCORR = -5
WRITE (NUVI, 80010) IVTNUM, IIAVI, IVCORR
0401 CONTINUE
CT041* TEST 41 BOTH VALUES EQUAL, BOTH NEGATIVE
IVTNUM = 41
RIBVS = -6.5
RIDVS = -6.5
IIAVI = MIN1(RIBVS, RIDVS)
IF (IIAVI + 6) 20410, 10410, 20410
10410 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0411
20410 IVFAIL = IVFAIL + 1
IVCORR = -6
WRITE (NUVI, 80010) IVTNUM, IIAVI, IVCORR
0411 CONTINUE
CT042* TEST 42 VALUES NOT EQUAL, BOTH NEGATIVE
IVTNUM = 42
RIBVS = -7.125
RIDVS = -5.125
IIAVI = MIN1(RIBVS, RIDVS)
IF (IIAVI + 7) 20420, 10420, 20420
10420 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0421
20420 IVFAIL = IVFAIL + 1
IVCORR = -7
WRITE (NUVI, 80010) IVTNUM, IIAVI, IVCORR
0421 CONTINUE
CT043* TEST 43 FIRST VALUE NON-ZERO, 2ND ZERO PRECEDED BY MINUS SIGN
IVTNUM = 43
RIDVS = 5.625
RIEVS = 0.0
IIAVI = MIN1(RIDVS, -RIEVS)
IF (IIAVI - 0) 20430, 10430, 20430
10430 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0431
20430 IVFAIL = IVFAIL + 1
IVCORR = 0
WRITE (NUVI, 80010) IVTNUM, IIAVI, IVCORR
0431 CONTINUE
CT044* TEST 44 EXPRESSION PRESENTED TO FUNCTION
IVTNUM = 44
RIDVS = 3.5
RIEVS = 4.0
IIAVI = MIN1(RIDVS + RIEVS, -RIEVS - RIDVS)
IF (IIAVI + 7) 20440, 10440, 20440
10440 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0441
20440 IVFAIL = IVFAIL + 1
IVCORR = -7
WRITE (NUVI, 80010) IVTNUM, IIAVI, IVCORR
0441 CONTINUE
CT045* TEST 45 3 ARGUMENTS
IVTNUM = 45
RIBVS = 0.0
RICVS = 1.0
RIDVS = 2.0
IIAVI = MIN1(RIBVS, RICVS, RIDVS)
IF (IIAVI - 0) 20450, 10450, 20450
10450 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0451
20450 IVFAIL = IVFAIL + 1
IVCORR = 0
WRITE (NUVI, 80010) IVTNUM, IIAVI, IVCORR
0451 CONTINUE
CT046* TEST 46 4 ARGUMENTS
IVTNUM = 46
RIAVS = -3.5
RIBVS = 12.0
RICVS = 3.6
RIDVS = 3.5
IIAVI = MIN1(-RIAVS, RIBVS, RICVS, RIDVS)
IF (IIAVI - 3) 20460, 10460, 20460
10460 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0461
20460 IVFAIL = IVFAIL + 1
IVCORR = 3
WRITE (NUVI, 80010) IVTNUM, IIAVI, IVCORR
0461 CONTINUE
CT047* TEST 47 5 ARGUMENTS
IVTNUM = 47
RIDVS = 3.5
RIEVS = 4.5
IIAVI = MIN1(RIDVS, -RIDVS, -RIEVS, +RIDVS, RIEVS)
IF (IIAVI + 4) 20470, 10470, 20470
10470 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0471
20470 IVFAIL = IVFAIL + 1
IVCORR = -4
WRITE (NUVI, 80010) IVTNUM, IIAVI, IVCORR
0471 CONTINUE
C*****
CBB** ********************** BBCSUM0 **********************************
C**** WRITE OUT TEST SUMMARY
C****
IVTOTN = IVPASS + IVFAIL + IVDELE + IVINSP
WRITE (I02, 90004)
WRITE (I02, 90014)
WRITE (I02, 90004)
WRITE (I02, 90020) IVPASS
WRITE (I02, 90022) IVFAIL
WRITE (I02, 90024) IVDELE
WRITE (I02, 90026) IVINSP
WRITE (I02, 90028) IVTOTN, IVTOTL
CBE** ********************** BBCSUM0 **********************************
CBB** ********************** BBCFOOT0 **********************************
C**** WRITE OUT REPORT FOOTINGS
C****
WRITE (I02,90016) ZPROG, ZPROG
WRITE (I02,90018) ZPROJ, ZNAME, ZTAPE, ZTAPED
WRITE (I02,90019)
CBE** ********************** BBCFOOT0 **********************************
CBB** ********************** BBCFMT0A **********************************
C**** FORMATS FOR TEST DETAIL LINES
C****
80000 FORMAT (1H ,2X,I3,4X,7HDELETED,32X,A31)
80002 FORMAT (1H ,2X,I3,4X,7H PASS ,32X,A31)
80004 FORMAT (1H ,2X,I3,4X,7HINSPECT,32X,A31)
80008 FORMAT (1H ,2X,I3,4X,7H FAIL ,32X,A31)
80010 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,15X,10HCOMPUTED= ,
1I6,/,1H ,15X,10HCORRECT= ,I6)
80012 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
1E12.5,/,1H ,16X,10HCORRECT= ,E12.5)
80018 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
1A21,/,1H ,16X,10HCORRECT= ,A21)
80020 FORMAT (1H ,16X,10HCOMPUTED= ,A21,1X,A31)
80022 FORMAT (1H ,16X,10HCORRECT= ,A21,1X,A31)
80024 FORMAT (1H ,16X,10HCOMPUTED= ,I6,16X,A31)
80026 FORMAT (1H ,16X,10HCORRECT= ,I6,16X,A31)
80028 FORMAT (1H ,16X,10HCOMPUTED= ,E12.5,10X,A31)
80030 FORMAT (1H ,16X,10HCORRECT= ,E12.5,10X,A31)
80050 FORMAT (1H ,48X,A31)
CBE** ********************** BBCFMT0A **********************************
CBB** ********************** BBCFMT0B **********************************
C**** FORMAT STATEMENTS FOR PAGE HEADERS
C****
90002 FORMAT (1H1)
90004 FORMAT (1H )
90006 FORMAT (1H ,20X,31HFEDERAL SOFTWARE TESTING CENTER)
90007 FORMAT (1H ,19X,34HFORTRAN COMPILER VALIDATION SYSTEM)
90008 FORMAT (1H ,21X,A13,A17)
90009 FORMAT (1H ,/,2H *,A5,6HBEGIN*,12X,15HTEST RESULTS - ,A5,/)
90010 FORMAT (1H ,8X,16HTEST DATE*TIME= ,A17,15H - COMPILER= ,A20)
90013 FORMAT (1H ,8H TEST ,10HPASS/FAIL ,6X,17HDISPLAYED RESULTS,
1 7X,7HREMARKS,24X)
90014 FORMAT (1H ,46H----------------------------------------------,
1 33H---------------------------------)
90015 FORMAT (1H ,48X,17HTHIS PROGRAM HAS ,I3,6H TESTS,/)
C****
C**** FORMAT STATEMENTS FOR REPORT FOOTINGS
C****
90016 FORMAT (1H ,/,2H *,A5,4HEND*,14X,14HEND OF TEST - ,A5,/)
90018 FORMAT (1H ,A13,13X,A20,7H * ,A10,1H/,
1 A13)
90019 FORMAT (1H ,26HFOR OFFICIAL USE ONLY ,35X,15HCOPYRIGHT 1982)
C****
C**** FORMAT STATEMENTS FOR RUN SUMMARY
C****
90020 FORMAT (1H ,21X,I5,13H TESTS PASSED)
90022 FORMAT (1H ,21X,I5,13H TESTS FAILED)
90024 FORMAT (1H ,21X,I5,14H TESTS DELETED)
90026 FORMAT (1H ,21X,I5,25H TESTS REQUIRE INSPECTION)
90028 FORMAT (1H ,21X,I5,4H OF ,I3,15H TESTS EXECUTED)
CBE** ********************** BBCFMT0B **********************************
C*****
C***** END OF TEST SEGMENT 167
STOP
END
*END-OF,FM362
FM363.f 481036284 170 2 100666 13687 `
*HEADER,FORTR,FM363
*FILES1,FORTR,FM363,X
C***********************************************************************
C***** FORTRAN 77
C***** FM363 X66MX - (171)
C*****
C***********************************************************************
C***** GENERAL PURPOSE SUBSET REF
C***** TEST THAT ALL INTRINSIC FUNCTIONS WOULD ACCEPT 15.3
C***** ANY EXPRESSION OF THE TYPE SPECIFIED IN THE (TABLE 5)
C***** INTRINSIC FUNCTION TABLE - ANS REFS - 15.10
C*****
C***** GENERAL COMMENTS
C***** SEGMENTS XINT, XREAL, XAINT, XABS, XAMOD,
C***** XSIGN, XDIM, XMAX, XMIN ASSUMED WORKING
C*****
CBB** ********************** BBCCOMNT **********************************
C****
C**** 1978 FORTRAN COMPILER VALIDATION SYSTEM
C**** VERSION 2.0
C****
C****
C**** SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO
C**** GENERAL SERVICES ADMINISTRATION
C**** FEDERAL SOFTWARE TESTING CENTER
C**** 5203 LEESBURG PIKE, SUITE 1100
C**** FALLS CHURCH, VA. 22041
C****
C**** (703) 756-6153
C****
CBE** ********************** BBCCOMNT **********************************
CBB** ********************** BBCINITA **********************************
C**** SPECIFICATION STATEMENTS
C****
CHARACTER ZVERS*13, ZVERSD*17, ZDATE*17, ZPROG*5, ZCOMPL*20,
1 ZNAME*20, ZTAPE*10, ZPROJ*13, REMRKS*31, ZTAPED*13
CBE** ********************** BBCINITA **********************************
CBB** ********************** BBCINITB **********************************
C**** INITIALIZE SECTION
DATA ZVERS, ZVERSD, ZDATE
1 /'VERSION 2.0 ', '82/08/02*18.33.46', '*NO DATE*TIME'/
DATA ZCOMPL, ZNAME, ZTAPE
1 /'*NONE SPECIFIED*', '*NO COMPANY NAME*', '*NO TAPE*'/
DATA ZPROJ, ZTAPED, ZPROG
1 /'*NO PROJECT*', '*NO TAPE DATE', 'XXXXX'/
DATA REMRKS /' '/
C**** THE FOLLOWING 9 COMMENT LINES (CZ01, CZ02, ...) CAN BE REPLACED
C**** FOR IDENTIFYING THE TEST ENVIRONMENT
C****
CZ01 ZVERS = 'VERSION OF THE COMPILER VALIDATION SYSTEM'
CZ02 ZVERSD = 'CREATION DATE/TIME OF THE COMPILER VALIDATION SYSTEM'
CZ03 ZPROG = 'PROGRAM NAME'
CZ04 ZDATE = 'DATE OF TEST'
CZ05 ZCOMPL = 'COMPILER IDENTIFICATION'
CZ06 ZPROJ = 'PROJECT NUMBER/IDENTIFICATION'
CZ07 ZNAME = 'NAME OF USER'
CZ08 ZTAPE = 'TAPE OWNER/ID'
CZ09 ZTAPED = 'DATE TAPE COPIED'
C
IVPASS = 0
IVFAIL = 0
IVDELE = 0
IVINSP = 0
IVTOTL = 0
IVTOTN = 0
ICZERO = 0
C
C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER.
I01 = 05
C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER.
I02 = 06
C
CX010 REPLACED BY FEXEC X-010 CONTROL CARD (CARD-READER UNIT NUMBER).
C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5
CX011 REPLACED BY FEXEC X-011 CONTROL CARD. CX011 IS FOR SYSTEMS
C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX010.
C
CX020 REPLACED BY FEXEC X-020 CONTROL CARD (PRINTER UNIT NUMBER).
C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02= 6
CX021 REPLACED BY FEXEC X-021 CONTROL CARD. CX021 IS FOR SYSTEMS
C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX020.
C
CBE** ********************** BBCINITB **********************************
NUVI = I02
IVTOTL = 14
ZPROG = 'FM363'
CBB** ********************** BBCHED0A **********************************
C****
C**** WRITE REPORT TITLE
C****
WRITE (I02, 90002)
WRITE (I02, 90006)
WRITE (I02, 90007)
WRITE (I02, 90008) ZVERS, ZVERSD
WRITE (I02, 90009) ZPROG, ZPROG
WRITE (I02, 90010) ZDATE, ZCOMPL
CBE** ********************** BBCHED0A **********************************
C*****
C***** HEADER FOR SEGMENT 171 WRITTEN
WRITE (NUVI,17101)
17101 FORMAT(1H ,// 2X,42HX66MX - (171) SUBSET INTRINSIC FUNCTIONS--//
1 10X,25HIN ARITHMETIC EXPRESSIONS
2 //2X, 27H SUBSET REF. - 15.10, 6.1.4)
CBB** ********************** BBCHED0B **********************************
C**** WRITE DETAIL REPORT HEADERS
C****
WRITE (I02,90004)
WRITE (I02,90004)
WRITE (I02,90013)
WRITE (I02,90014)
WRITE (I02,90015) IVTOTL
CBE** ********************** BBCHED0B **********************************
C*****
C***** TEST OF INTRINSIC FUNCTIONS IN EXPRESSIONS
C*****
CT001* TEST 1
IVTNUM = 1
RJBVS = 5.2
IJAVI = INT(RJBVS) + 3
IF (IJAVI - 8) 20010, 10010, 20010
10010 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0011
20010 IVFAIL = IVFAIL + 1
IVCORR = 8
WRITE (NUVI, 80010) IVTNUM, IJAVI, IVCORR
0011 CONTINUE
CT002* TEST 2
IVTNUM = 2
RJBVS = 4.8
IJAVI = IFIX(RJBVS) - 2
IF (IJAVI - 2) 20020, 10020, 20020
10020 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0021
20020 IVFAIL = IVFAIL + 1
IVCORR = 2
WRITE (NUVI, 80010) IVTNUM, IJAVI, IVCORR
0021 CONTINUE
CT003* TEST 3
IVTNUM = 3
RJBVS = 2.8
IJAVI = 50 * NINT(RJBVS)
IF (IJAVI - 150) 20030, 10030, 20030
10030 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0031
20030 IVFAIL = IVFAIL + 1
IVCORR = 150
WRITE (NUVI, 80010) IVTNUM, IJAVI, IVCORR
0031 CONTINUE
CT004* TEST 4
IVTNUM = 4
IJBVI = -4
IJAVI = IABS(IJBVI) / (-4)
IF (IJAVI + 1) 20040, 10040, 20040
10040 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0041
20040 IVFAIL = IVFAIL + 1
IVCORR = -1
WRITE (NUVI, 80010) IVTNUM, IJAVI, IVCORR
0041 CONTINUE
CT005* TEST 5
IVTNUM = 5
IJBVI = 7
IJDVI = 4
IJAVI = MOD(IJBVI, IJDVI) ** 2
IF (IJAVI - 9) 20050, 10050, 20050
10050 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0051
20050 IVFAIL = IVFAIL + 1
IVCORR = 9
WRITE (NUVI, 80010) IVTNUM, IJAVI, IVCORR
0051 CONTINUE
CT006* TEST 6
IVTNUM = 6
IJBVI = -3
IJDVI = 1
IJAVI = 2 ** ISIGN(IJBVI, IJDVI)
IF (IJAVI - 8) 20060, 10060, 20060
10060 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0061
20060 IVFAIL = IVFAIL + 1
IVCORR = 8
WRITE (NUVI, 80010) IVTNUM, IJAVI, IVCORR
0061 CONTINUE
CT007* TEST 7
IVTNUM = 7
IJBVI = 5
IJDVI = 2
IJEVI = -2
IJAVI = IDIM(IJBVI, IJDVI) * 2 + MAX0(IJEVI, IJDVI) - 7
IF (IJAVI - 1) 20070, 10070, 20070
10070 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0071
20070 IVFAIL = IVFAIL + 1
IVCORR = 1
WRITE (NUVI, 80010) IVTNUM, IJAVI, IVCORR
0071 CONTINUE
CT008* TEST 8
IVTNUM = 8
IJBVI = 2
IJDVI = 3
RJBVS = 2.2
RJDVS = 4.8
RJEVS = -2.2
RJFVS = -3.8
IJAVI = MIN0(IJBVI, IJDVI) * 2 - MAX1(RJBVS, RJDVS) / 2
1 + MIN1(RJEVS, RJFVS) + 5
IF (IJAVI - 4) 20080, 10080, 20080
10080 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0081
20080 IVFAIL = IVFAIL + 1
IVCORR = 4
WRITE (NUVI, 80010) IVTNUM, IJAVI, IVCORR
0081 CONTINUE
CT009* TEST 9
IVTNUM = 9
IJBVI = 2
RJAVS = FLOAT(IJBVI) + 3.5
IF (RJAVS - 5.4997) 20090, 10090, 40090
40090 IF (RJAVS - 5.5003) 10090, 10090, 20090
10090 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0091
20090 IVFAIL = IVFAIL + 1
RVCORR = 5.5
WRITE (NUVI, 80012) IVTNUM, RJAVS, RVCORR
0091 CONTINUE
CT010* TEST 10
IVTNUM = 10
IJBVI = 2
RJAVS = REAL(IJBVI) * 3.0
IF (RJAVS - 5.9997) 20100, 10100, 40100
40100 IF (RJAVS - 6.0003) 10100, 10100, 20100
10100 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0101
20100 IVFAIL = IVFAIL + 1
RVCORR = 6.0
WRITE (NUVI, 80012) IVTNUM, RJAVS, RVCORR
0101 CONTINUE
CT011* TEST 11
IVTNUM = 11
RJBVS = 4.5
RJAVS = AINT(RJBVS) ** 0.5
IF (RJAVS - 1.9999) 20110, 10110, 40110
40110 IF (RJAVS - 2.0001) 10110, 10110, 20110
10110 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0111
20110 IVFAIL = IVFAIL + 1
RVCORR = 2.0
WRITE (NUVI, 80012) IVTNUM, RJAVS, RVCORR
0111 CONTINUE
CT012* TEST 12
IVTNUM = 12
RJBVS = 2.8
RJDVS = 2.2
RJAVS = 1.5 * ANINT(RJBVS) + 6.6 / ABS(RJDVS)
IF (RJAVS - 7.4996 ) 20120, 10120, 40120
40120 IF (RJAVS - 7.5004 ) 10120, 10120, 20120
10120 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0121
20120 IVFAIL = IVFAIL + 1
RVCORR = 7.5
WRITE (NUVI, 80012) IVTNUM, RJAVS, RVCORR
0121 CONTINUE
CT013* TEST 13
IVTNUM = 13
RJBVS = 4.5
RJDVS = 2.2
IJBVI = -5
IJDVI = 5
RJAVS = (AMOD(RJBVS, RJDVS) + 1.4) * (SIGN(IJBVI, IJDVI) - 3.0)
IF (RJAVS - 2.9998) 20130, 10130, 40130
40130 IF (RJAVS - 3.0002) 10130, 10130, 20130
10130 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0131
20130 IVFAIL = IVFAIL + 1
RVCORR = 3.0
WRITE (NUVI, 80012) IVTNUM, RJAVS, RVCORR
0131 CONTINUE
CT014* TEST 14
IVTNUM = 14
RJBVS = 6.2
RJDVS = 5.2
IJBVI = 2
IJDVI = 3
RJEVS = 2.0
RJFVS = 3.0
RJAVS = (DIM(RJBVS, RJDVS) * AMAX0(IJBVI, IJDVI)) **
1 (AMIN0(IJBVI, IJDVI) - AMIN1(RJEVS, RJFVS))
IF (RJAVS - 0.99995) 20140, 10140, 40140
40140 IF (RJAVS - 1.0001) 10140, 10140, 20140
10140 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0141
20140 IVFAIL = IVFAIL + 1
RVCORR = 1.0
WRITE (NUVI, 80012) IVTNUM, RJAVS, RVCORR
0141 CONTINUE
C*****
CBB** ********************** BBCSUM0 **********************************
C**** WRITE OUT TEST SUMMARY
C****
IVTOTN = IVPASS + IVFAIL + IVDELE + IVINSP
WRITE (I02, 90004)
WRITE (I02, 90014)
WRITE (I02, 90004)
WRITE (I02, 90020) IVPASS
WRITE (I02, 90022) IVFAIL
WRITE (I02, 90024) IVDELE
WRITE (I02, 90026) IVINSP
WRITE (I02, 90028) IVTOTN, IVTOTL
CBE** ********************** BBCSUM0 **********************************
CBB** ********************** BBCFOOT0 **********************************
C**** WRITE OUT REPORT FOOTINGS
C****
WRITE (I02,90016) ZPROG, ZPROG
WRITE (I02,90018) ZPROJ, ZNAME, ZTAPE, ZTAPED
WRITE (I02,90019)
CBE** ********************** BBCFOOT0 **********************************
CBB** ********************** BBCFMT0A **********************************
C**** FORMATS FOR TEST DETAIL LINES
C****
80000 FORMAT (1H ,2X,I3,4X,7HDELETED,32X,A31)
80002 FORMAT (1H ,2X,I3,4X,7H PASS ,32X,A31)
80004 FORMAT (1H ,2X,I3,4X,7HINSPECT,32X,A31)
80008 FORMAT (1H ,2X,I3,4X,7H FAIL ,32X,A31)
80010 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,15X,10HCOMPUTED= ,
1I6,/,1H ,15X,10HCORRECT= ,I6)
80012 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
1E12.5,/,1H ,16X,10HCORRECT= ,E12.5)
80018 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
1A21,/,1H ,16X,10HCORRECT= ,A21)
80020 FORMAT (1H ,16X,10HCOMPUTED= ,A21,1X,A31)
80022 FORMAT (1H ,16X,10HCORRECT= ,A21,1X,A31)
80024 FORMAT (1H ,16X,10HCOMPUTED= ,I6,16X,A31)
80026 FORMAT (1H ,16X,10HCORRECT= ,I6,16X,A31)
80028 FORMAT (1H ,16X,10HCOMPUTED= ,E12.5,10X,A31)
80030 FORMAT (1H ,16X,10HCORRECT= ,E12.5,10X,A31)
80050 FORMAT (1H ,48X,A31)
CBE** ********************** BBCFMT0A **********************************
CBB** ********************** BBCFMT0B **********************************
C**** FORMAT STATEMENTS FOR PAGE HEADERS
C****
90002 FORMAT (1H1)
90004 FORMAT (1H )
90006 FORMAT (1H ,20X,31HFEDERAL SOFTWARE TESTING CENTER)
90007 FORMAT (1H ,19X,34HFORTRAN COMPILER VALIDATION SYSTEM)
90008 FORMAT (1H ,21X,A13,A17)
90009 FORMAT (1H ,/,2H *,A5,6HBEGIN*,12X,15HTEST RESULTS - ,A5,/)
90010 FORMAT (1H ,8X,16HTEST DATE*TIME= ,A17,15H - COMPILER= ,A20)
90013 FORMAT (1H ,8H TEST ,10HPASS/FAIL ,6X,17HDISPLAYED RESULTS,
1 7X,7HREMARKS,24X)
90014 FORMAT (1H ,46H----------------------------------------------,
1 33H---------------------------------)
90015 FORMAT (1H ,48X,17HTHIS PROGRAM HAS ,I3,6H TESTS,/)
C****
C**** FORMAT STATEMENTS FOR REPORT FOOTINGS
C****
90016 FORMAT (1H ,/,2H *,A5,4HEND*,14X,14HEND OF TEST - ,A5,/)
90018 FORMAT (1H ,A13,13X,A20,7H * ,A10,1H/,
1 A13)
90019 FORMAT (1H ,26HFOR OFFICIAL USE ONLY ,35X,15HCOPYRIGHT 1982)
C****
C**** FORMAT STATEMENTS FOR RUN SUMMARY
C****
90020 FORMAT (1H ,21X,I5,13H TESTS PASSED)
90022 FORMAT (1H ,21X,I5,13H TESTS FAILED)
90024 FORMAT (1H ,21X,I5,14H TESTS DELETED)
90026 FORMAT (1H ,21X,I5,25H TESTS REQUIRE INSPECTION)
90028 FORMAT (1H ,21X,I5,4H OF ,I3,15H TESTS EXECUTED)
CBE** ********************** BBCFMT0B **********************************
C*****
C***** END OF TEST SEGMENT 171
STOP
END
*END-OF,FM363
FM364.f 481036289 170 2 100666 14770 `
*HEADER,FORTR,FM364
*FILES1,FORTR,FM364,X
C***********************************************************************
C***** FORTRAN 77
C***** FM364 XRMNX - (172)
C*****
C***********************************************************************
C***** GENERAL PURPOSE SUBSET REF
C***** TESTS THE USE OF MIXED MODE ARITHMETIC 15.10
C***** EXPRESSIONS CONTAINING REFERENCES TO THE 15.3
C***** INTRINSIC FUNCTIONS 6.1.4
C*****
C***** GENERAL COMMENTS
C***** SEGMENTS TESTING XINT, XREAL, XAINT, XABS, XAMOD,
C***** XSIGN, XDIM, XMAX, XMIN ASSUMED WORKING
C*****
CBB** ********************** BBCCOMNT **********************************
C****
C**** 1978 FORTRAN COMPILER VALIDATION SYSTEM
C**** VERSION 2.0
C****
C****
C**** SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO
C**** GENERAL SERVICES ADMINISTRATION
C**** FEDERAL SOFTWARE TESTING CENTER
C**** 5203 LEESBURG PIKE, SUITE 1100
C**** FALLS CHURCH, VA. 22041
C****
C**** (703) 756-6153
C****
CBE** ********************** BBCCOMNT **********************************
CBB** ********************** BBCINITA **********************************
C**** SPECIFICATION STATEMENTS
C****
CHARACTER ZVERS*13, ZVERSD*17, ZDATE*17, ZPROG*5, ZCOMPL*20,
1 ZNAME*20, ZTAPE*10, ZPROJ*13, REMRKS*31, ZTAPED*13
CBE** ********************** BBCINITA **********************************
CBB** ********************** BBCINITB **********************************
C**** INITIALIZE SECTION
DATA ZVERS, ZVERSD, ZDATE
1 /'VERSION 2.0 ', '82/08/02*18.33.46', '*NO DATE*TIME'/
DATA ZCOMPL, ZNAME, ZTAPE
1 /'*NONE SPECIFIED*', '*NO COMPANY NAME*', '*NO TAPE*'/
DATA ZPROJ, ZTAPED, ZPROG
1 /'*NO PROJECT*', '*NO TAPE DATE', 'XXXXX'/
DATA REMRKS /' '/
C**** THE FOLLOWING 9 COMMENT LINES (CZ01, CZ02, ...) CAN BE REPLACED
C**** FOR IDENTIFYING THE TEST ENVIRONMENT
C****
CZ01 ZVERS = 'VERSION OF THE COMPILER VALIDATION SYSTEM'
CZ02 ZVERSD = 'CREATION DATE/TIME OF THE COMPILER VALIDATION SYSTEM'
CZ03 ZPROG = 'PROGRAM NAME'
CZ04 ZDATE = 'DATE OF TEST'
CZ05 ZCOMPL = 'COMPILER IDENTIFICATION'
CZ06 ZPROJ = 'PROJECT NUMBER/IDENTIFICATION'
CZ07 ZNAME = 'NAME OF USER'
CZ08 ZTAPE = 'TAPE OWNER/ID'
CZ09 ZTAPED = 'DATE TAPE COPIED'
C
IVPASS = 0
IVFAIL = 0
IVDELE = 0
IVINSP = 0
IVTOTL = 0
IVTOTN = 0
ICZERO = 0
C
C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER.
I01 = 05
C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER.
I02 = 06
C
CX010 REPLACED BY FEXEC X-010 CONTROL CARD (CARD-READER UNIT NUMBER).
C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5
CX011 REPLACED BY FEXEC X-011 CONTROL CARD. CX011 IS FOR SYSTEMS
C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX010.
C
CX020 REPLACED BY FEXEC X-020 CONTROL CARD (PRINTER UNIT NUMBER).
C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02= 6
CX021 REPLACED BY FEXEC X-021 CONTROL CARD. CX021 IS FOR SYSTEMS
C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX020.
C
CBE** ********************** BBCINITB **********************************
C***** O U T P U T T A P E ASSIGNMENT STATEMENT. NO INPUT TAPE.
NUVI = I02
IVTOTL = 14
ZPROG = 'FM364'
C*****
CBB** ********************** BBCHED0A **********************************
C****
C**** WRITE REPORT TITLE
C****
WRITE (I02, 90002)
WRITE (I02, 90006)
WRITE (I02, 90007)
WRITE (I02, 90008) ZVERS, ZVERSD
WRITE (I02, 90009) ZPROG, ZPROG
WRITE (I02, 90010) ZDATE, ZCOMPL
CBE** ********************** BBCHED0A **********************************
C***** HEADER FOR SEGMENT 172 WRITTEN
WRITE (NUVI,17201)
17201 FORMAT(/41H XRMNX - (172) SUBSET INTRINSIC FUNCTIONS/
1 15X,25HIN MIXED MODE EXPRESSIONS //,
2 33H SUBSET REF. - 15.10, 15.3, 6.1.4)
C*****
CBB** ********************** BBCHED0B **********************************
C**** WRITE DETAIL REPORT HEADERS
C****
WRITE (I02,90004)
WRITE (I02,90004)
WRITE (I02,90013)
WRITE (I02,90014)
WRITE (I02,90015) IVTOTL
CBE** ********************** BBCHED0B **********************************
CT001* TEST 1
IVTNUM = 1
RKBVS = 3.2
RKDVS = 3.8
RKAVS = 3.5 + INT(RKBVS) + IFIX(RKDVS)
RKCVS = RKAVS - 9.5
IF (RKCVS + .00005) 20010, 10010, 40010
40010 IF (RKCVS - .00005) 10010, 10010, 20010
10010 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0011
20010 IVFAIL = IVFAIL + 1
RVCORR = 0.0
WRITE (NUVI, 80012) IVTNUM, RKCVS, RVCORR
0011 CONTINUE
CT002* TEST 2
IVTNUM = 2
IKBVI = 3
IKDVI = 6
RKAVS = FLOAT(IKBVI) - 3 + REAL(IKDVI)
RKCVS = RKAVS - 6.0
IF (RKCVS + .00005) 20020, 10020, 40020
40020 IF (RKCVS - .00005) 10020, 10020, 20020
10020 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0021
20020 IVFAIL = IVFAIL + 1
RVCORR = 0.0
WRITE (NUVI, 80012) IVTNUM, RKCVS, RVCORR
0021 CONTINUE
CT003* TEST 3
IVTNUM = 3
IKAVI = 3
RKBVS = 5.25
RKAVS = ANINT(RKBVS) * IKAVI
RKCVS = RKAVS - 15.0
IF (RKCVS + .00005) 20030, 10030, 40030
40030 IF (RKCVS - .00005) 10030, 10030, 20030
10030 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0031
20030 IVFAIL = IVFAIL + 1
RVCORR = 0.0
WRITE (NUVI, 80012) IVTNUM, RKCVS, RVCORR
0031 CONTINUE
CT004* TEST 4
IVTNUM = 4
RKBVS = 5.25
RKAVS = AINT(RKBVS) * IKAVI
RKCVS = RKAVS - 15.0
IF (RKCVS + .00005) 20040, 10040, 40040
40040 IF (RKCVS - .00005) 10040, 10040, 20040
10040 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0041
20040 IVFAIL = IVFAIL + 1
RVCORR = 0.0
WRITE (NUVI, 80012) IVTNUM, RKCVS, RVCORR
0041 CONTINUE
CT005* TEST 5
IVTNUM = 5
RKBVS = -5.5
RKAVS = ABS(RKBVS) / 2
RKCVS = RKAVS - 2.75
IF (RKCVS + .00005) 20050, 10050, 40050
40050 IF (RKCVS - .00005) 10050, 10050, 20050
10050 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0051
20050 IVFAIL = IVFAIL + 1
RVCORR = 0.0
WRITE (NUVI, 80012) IVTNUM, RKCVS, RVCORR
0051 CONTINUE
CT006* TEST 6
IVTNUM = 6
RKDVS = 5.0
IKBVI = -5
RKAVS = RKDVS / IABS(IKBVI)
RKCVS = RKAVS - 1.0
IF (RKCVS + .00005) 20060, 10060, 40060
40060 IF (RKCVS - .00005) 10060, 10060, 20060
10060 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0061
20060 IVFAIL = IVFAIL + 1
RVCORR = 0.0
WRITE (NUVI, 80012) IVTNUM, RKCVS, RVCORR
0061 CONTINUE
CT007* TEST 7
IVTNUM = 7
RKDVS = -2.0
IKAVI = -2
IKBVI = 5
IKCVI = 2
RKAVS = RKDVS / (IABS(IKAVI) * MOD(IKBVI, IKCVI))
RKCVS = RKAVS + 1.0
IF (RKCVS + .00005) 20070, 10070, 40070
40070 IF (RKCVS - .00005) 10070, 10070, 20070
10070 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0071
20070 IVFAIL = IVFAIL + 1
RVCORR = 0.0
WRITE (NUVI, 80012) IVTNUM, RKCVS, RVCORR
0071 CONTINUE
CT008* TEST 8
IVTNUM = 8
IKAVI = -2
IKBVI = 2
RKAVS = 3 * ISIGN(IKAVI, IKBVI)
RKCVS = RKAVS - 6.0
IF (RKCVS + .00005) 20080, 10080, 40080
40080 IF (RKCVS - .00005) 10080, 10080, 20080
10080 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0081
20080 IVFAIL = IVFAIL + 1
RVCORR = 0.0
WRITE (NUVI, 80012) IVTNUM, RKCVS, RVCORR
0081 CONTINUE
CT009* TEST 9
IVTNUM = 9
RKBVS = 5.25
RKDVS = 3.25
RKEVS = 2.25
RKAVS = AMOD(RKBVS, RKDVS) * NINT(RKEVS)
RKCVS = RKAVS - 4.0
IF (RKCVS + .00005) 20090, 10090, 40090
40090 IF (RKCVS - .00005) 10090, 10090, 20090
10090 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0091
20090 IVFAIL = IVFAIL + 1
RVCORR = 0.0
WRITE (NUVI, 80012) IVTNUM, RKCVS, RVCORR
0091 CONTINUE
CT010* TEST 10
IVTNUM = 10
IKAVI = 2
RKDVS = -4.5
RKBVS = 1.0
RKAVS = (IKAVI + SIGN(RKDVS, RKBVS)) * 1.5
RKCVS = RKAVS - 9.75
IF (RKCVS + .00005) 20100, 10100, 40100
40100 IF (RKCVS - .00005) 10100, 10100, 20100
10100 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0101
20100 IVFAIL = IVFAIL + 1
RVCORR = 0.0
WRITE (NUVI, 80012) IVTNUM, RKCVS, RVCORR
0101 CONTINUE
CT011* TEST 11
RKDVS = 6.0
IKAVI = 5
IKBVI = 2
IKCVI = 1
RKAVS = (IDIM(IKAVI, IKBVI) / RKDVS) ** MAX0(IKCVI, IKBVI)
RKCVS = RKAVS - 0.25
IF (RKCVS + .00005) 20110, 10110, 40110
40110 IF (RKCVS - .00005) 10110, 10110, 20110
10110 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0111
20110 IVFAIL = IVFAIL + 1
RVCORR = 0.0
WRITE (NUVI, 80012) IVTNUM, RKCVS, RVCORR
0111 CONTINUE
CT012* TEST 12
IVTNUM = 12
IKAVI = 12
RKBVS = 5.5
RKDVS = 3.25
IKBVI = 2
IKCVI = 3
RKAVS = 2 * DIM(RKBVS, RKDVS) + AMAX0(IKBVI, IKCVI) / IKAVI
RKCVS = RKAVS - 4.75
IF (RKCVS + .00005) 20120, 10120, 40120
40120 IF (RKCVS - .00005) 10120, 10120, 20120
10120 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0121
20120 IVFAIL = IVFAIL + 1
RVCORR = 0.0
WRITE (NUVI, 80012) IVTNUM, RKCVS, RVCORR
0121 CONTINUE
CT013* TEST 13
IVTNUM = 13
IKAVI = 5
RKBVS = 4.5
RKDVS = 3.5
IKBVI = 2
IKCVI = 3
RKAVS = (AMAX1(RKBVS, RKDVS) * MIN0(IKBVI, IKCVI)) + (IKAVI -
1 ANINT(RKDVS))
RKCVS = RKAVS - 10.0
IF (RKCVS + .00005) 20130, 10130, 40130
40130 IF (RKCVS - .00005) 10130, 10130, 20130
10130 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0131
20130 IVFAIL = IVFAIL + 1
RVCORR = 0.0
WRITE (NUVI, 80012) IVTNUM, RKCVS, RVCORR
0131 CONTINUE
CT014* TEST 14
IVTNUM = 14
IKAVI = 2
RKBVS = 4.5
RKDVS = 3.5
RKEVS = 2.5
RKFVS = 1.5
IKBVI = 5
IKCVI = 2
RKAVS = (FLOAT(MAX1(RKBVS, RKDVS)) ** (AMIN1(RKEVS, RKDVS) -
1 IKAVI) + AMIN0(IKBVI, IKCVI)) / MIN1(RKFVS, RKEVS)
RKCVS = RKAVS - 4.0
IF (RKCVS + .00005) 20140, 10140, 40140
40140 IF (RKCVS - .00005) 10140, 10140, 20140
10140 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0141
20140 IVFAIL = IVFAIL + 1
RVCORR = 0.0
WRITE (NUVI, 80012) IVTNUM, RKCVS, RVCORR
0141 CONTINUE
C*****
CBB** ********************** BBCSUM0 **********************************
C**** WRITE OUT TEST SUMMARY
C****
IVTOTN = IVPASS + IVFAIL + IVDELE + IVINSP
WRITE (I02, 90004)
WRITE (I02, 90014)
WRITE (I02, 90004)
WRITE (I02, 90020) IVPASS
WRITE (I02, 90022) IVFAIL
WRITE (I02, 90024) IVDELE
WRITE (I02, 90026) IVINSP
WRITE (I02, 90028) IVTOTN, IVTOTL
CBE** ********************** BBCSUM0 **********************************
CBB** ********************** BBCFOOT0 **********************************
C**** WRITE OUT REPORT FOOTINGS
C****
WRITE (I02,90016) ZPROG, ZPROG
WRITE (I02,90018) ZPROJ, ZNAME, ZTAPE, ZTAPED
WRITE (I02,90019)
CBE** ********************** BBCFOOT0 **********************************
CBB** ********************** BBCFMT0A **********************************
C**** FORMATS FOR TEST DETAIL LINES
C****
80000 FORMAT (1H ,2X,I3,4X,7HDELETED,32X,A31)
80002 FORMAT (1H ,2X,I3,4X,7H PASS ,32X,A31)
80004 FORMAT (1H ,2X,I3,4X,7HINSPECT,32X,A31)
80008 FORMAT (1H ,2X,I3,4X,7H FAIL ,32X,A31)
80010 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,15X,10HCOMPUTED= ,
1I6,/,1H ,15X,10HCORRECT= ,I6)
80012 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
1E12.5,/,1H ,16X,10HCORRECT= ,E12.5)
80018 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
1A21,/,1H ,16X,10HCORRECT= ,A21)
80020 FORMAT (1H ,16X,10HCOMPUTED= ,A21,1X,A31)
80022 FORMAT (1H ,16X,10HCORRECT= ,A21,1X,A31)
80024 FORMAT (1H ,16X,10HCOMPUTED= ,I6,16X,A31)
80026 FORMAT (1H ,16X,10HCORRECT= ,I6,16X,A31)
80028 FORMAT (1H ,16X,10HCOMPUTED= ,E12.5,10X,A31)
80030 FORMAT (1H ,16X,10HCORRECT= ,E12.5,10X,A31)
80050 FORMAT (1H ,48X,A31)
CBE** ********************** BBCFMT0A **********************************
CBB** ********************** BBCFMT0B **********************************
C**** FORMAT STATEMENTS FOR PAGE HEADERS
C****
90002 FORMAT (1H1)
90004 FORMAT (1H )
90006 FORMAT (1H ,20X,31HFEDERAL SOFTWARE TESTING CENTER)
90007 FORMAT (1H ,19X,34HFORTRAN COMPILER VALIDATION SYSTEM)
90008 FORMAT (1H ,21X,A13,A17)
90009 FORMAT (1H ,/,2H *,A5,6HBEGIN*,12X,15HTEST RESULTS - ,A5,/)
90010 FORMAT (1H ,8X,16HTEST DATE*TIME= ,A17,15H - COMPILER= ,A20)
90013 FORMAT (1H ,8H TEST ,10HPASS/FAIL ,6X,17HDISPLAYED RESULTS,
1 7X,7HREMARKS,24X)
90014 FORMAT (1H ,46H----------------------------------------------,
1 33H---------------------------------)
90015 FORMAT (1H ,48X,17HTHIS PROGRAM HAS ,I3,6H TESTS,/)
C****
C**** FORMAT STATEMENTS FOR REPORT FOOTINGS
C****
90016 FORMAT (1H ,/,2H *,A5,4HEND*,14X,14HEND OF TEST - ,A5,/)
90018 FORMAT (1H ,A13,13X,A20,7H * ,A10,1H/,
1 A13)
90019 FORMAT (1H ,26HFOR OFFICIAL USE ONLY ,35X,15HCOPYRIGHT 1982)
C****
C**** FORMAT STATEMENTS FOR RUN SUMMARY
C****
90020 FORMAT (1H ,21X,I5,13H TESTS PASSED)
90022 FORMAT (1H ,21X,I5,13H TESTS FAILED)
90024 FORMAT (1H ,21X,I5,14H TESTS DELETED)
90026 FORMAT (1H ,21X,I5,25H TESTS REQUIRE INSPECTION)
90028 FORMAT (1H ,21X,I5,4H OF ,I3,15H TESTS EXECUTED)
CBE** ********************** BBCFMT0B **********************************
C*****
C***** END OF TEST SEGMENT 172
STOP
END
*END-OF,FM364
FM368.f 481036292 170 2 100666 13053 `
*HEADER,FORTR,FM368
*FILES1,FORTR,FM368,X
C***********************************************************************
C***** FORTRAN 77
C***** FM368
C***** XSQRT - (175)
C*****
C***********************************************************************
C***** GENERAL PURPOSE SUBSET REF
C***** TEST INTRINSIC FUNCTION SQRT 15.3
C***** TABLE 5
C*****
CBB** ********************** BBCCOMNT **********************************
C****
C**** 1978 FORTRAN COMPILER VALIDATION SYSTEM
C**** VERSION 2.0
C****
C****
C**** SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO
C**** GENERAL SERVICES ADMINISTRATION
C**** FEDERAL SOFTWARE TESTING CENTER
C**** 5203 LEESBURG PIKE, SUITE 1100
C**** FALLS CHURCH, VA. 22041
C****
C**** (703) 756-6153
C****
CBE** ********************** BBCCOMNT **********************************
CBB** ********************** BBCINITA **********************************
C**** SPECIFICATION STATEMENTS
C****
CHARACTER ZVERS*13, ZVERSD*17, ZDATE*17, ZPROG*5, ZCOMPL*20,
1 ZNAME*20, ZTAPE*10, ZPROJ*13, REMRKS*31, ZTAPED*13
CBE** ********************** BBCINITA **********************************
CBB** ********************** BBCINITB **********************************
C**** INITIALIZE SECTION
DATA ZVERS, ZVERSD, ZDATE
1 /'VERSION 2.0 ', '82/08/02*18.33.46', '*NO DATE*TIME'/
DATA ZCOMPL, ZNAME, ZTAPE
1 /'*NONE SPECIFIED*', '*NO COMPANY NAME*', '*NO TAPE*'/
DATA ZPROJ, ZTAPED, ZPROG
1 /'*NO PROJECT*', '*NO TAPE DATE', 'XXXXX'/
DATA REMRKS /' '/
C**** THE FOLLOWING 9 COMMENT LINES (CZ01, CZ02, ...) CAN BE REPLACED
C**** FOR IDENTIFYING THE TEST ENVIRONMENT
C****
CZ01 ZVERS = 'VERSION OF THE COMPILER VALIDATION SYSTEM'
CZ02 ZVERSD = 'CREATION DATE/TIME OF THE COMPILER VALIDATION SYSTEM'
CZ03 ZPROG = 'PROGRAM NAME'
CZ04 ZDATE = 'DATE OF TEST'
CZ05 ZCOMPL = 'COMPILER IDENTIFICATION'
CZ06 ZPROJ = 'PROJECT NUMBER/IDENTIFICATION'
CZ07 ZNAME = 'NAME OF USER'
CZ08 ZTAPE = 'TAPE OWNER/ID'
CZ09 ZTAPED = 'DATE TAPE COPIED'
C
IVPASS = 0
IVFAIL = 0
IVDELE = 0
IVINSP = 0
IVTOTL = 0
IVTOTN = 0
ICZERO = 0
C
C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER.
I01 = 05
C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER.
I02 = 06
C
CX010 REPLACED BY FEXEC X-010 CONTROL CARD (CARD-READER UNIT NUMBER).
C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5
CX011 REPLACED BY FEXEC X-011 CONTROL CARD. CX011 IS FOR SYSTEMS
C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX010.
C
CX020 REPLACED BY FEXEC X-020 CONTROL CARD (PRINTER UNIT NUMBER).
C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02= 6
CX021 REPLACED BY FEXEC X-021 CONTROL CARD. CX021 IS FOR SYSTEMS
C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX020.
C
CBE** ********************** BBCINITB **********************************
NUVI = I02
IVTOTL = 13
ZPROG = 'FM368'
CBB** ********************** BBCHED0A **********************************
C****
C**** WRITE REPORT TITLE
C****
WRITE (I02, 90002)
WRITE (I02, 90006)
WRITE (I02, 90007)
WRITE (I02, 90008) ZVERS, ZVERSD
WRITE (I02, 90009) ZPROG, ZPROG
WRITE (I02, 90010) ZDATE, ZCOMPL
CBE** ********************** BBCHED0A **********************************
C*****
C***** HEADER FOR SEGMENT 175
WRITE(NUVI,17500)
17500 FORMAT(1H , / 35H XSQRT - (175) INTRINSIC FUNCTIONS//
1 20H SQRT (SQUARE ROOT)//
2 20H SUBSET REF. - 15.3)
CBB** ********************** BBCHED0B **********************************
C**** WRITE DETAIL REPORT HEADERS
C****
WRITE (I02,90004)
WRITE (I02,90004)
WRITE (I02,90013)
WRITE (I02,90014)
WRITE (I02,90015) IVTOTL
CBE** ********************** BBCHED0B **********************************
C*****
CT001* TEST 1 FIXED POINT OF FUNCTION
IVTNUM = 1
BVS = 0.0
AVS = SQRT(BVS)
IF (AVS + 0.50000E-04) 20010, 10010, 40010
40010 IF (AVS - 0.50000E-04) 10010, 10010, 20010
10010 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0011
20010 IVFAIL = IVFAIL + 1
RVCORR = 0.00000000000000
WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR
0011 CONTINUE
CT002* TEST 2 FIXED POINT OF FUNCTION
IVTNUM = 2
AVS = SQRT(1.0)
IF (AVS - 0.99995E+00) 20020, 10020, 40020
40020 IF (AVS - 0.10001E+01) 10020, 10020, 20020
10020 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0021
20020 IVFAIL = IVFAIL + 1
RVCORR = 1.00000000000000
WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR
0021 CONTINUE
CT003* TEST 3
IVTNUM = 3
AVS = SQRT(2.0)
IF (AVS - 0.14141E+01) 20030, 10030, 40030
40030 IF (AVS - 0.14143E+01) 10030, 10030, 20030
10030 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0031
20030 IVFAIL = IVFAIL + 1
RVCORR = 1.41421356237310
WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR
0031 CONTINUE
CT004* TEST 4
IVTNUM = 4
AVS = SQRT(4.0)
IF (AVS - 0.19999E+01) 20040, 10040, 40040
40040 IF (AVS - 0.20001E+01) 10040, 10040, 20040
10040 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0041
20040 IVFAIL = IVFAIL + 1
RVCORR = 2.00000000000000
WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR
0041 CONTINUE
CT005* TEST 5
IVTNUM = 5
AVS = SQRT(15.0)
IF (AVS - 0.38727E+01) 20050, 10050, 40050
40050 IF (AVS - 0.38732E+01) 10050, 10050, 20050
10050 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0051
20050 IVFAIL = IVFAIL + 1
RVCORR = 3.87298334620742
WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR
0051 CONTINUE
CT006* TEST 6
IVTNUM = 6
AVS = SQRT(31.0)
IF (AVS - 0.55674E+01) 20060, 10060, 40060
40060 IF (AVS - 0.55681E+01) 10060, 10060, 20060
10060 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0061
20060 IVFAIL = IVFAIL + 1
RVCORR = 5.56776436283002
WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR
0061 CONTINUE
CT007* TEST 7
IVTNUM = 7
BVS = 2.0/4.0
AVS = SQRT(BVS)
IF (AVS - 0.70707E+00) 20070, 10070, 40070
40070 IF (AVS - 0.70715E+00) 10070, 10070, 20070
10070 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0071
20070 IVFAIL = IVFAIL + 1
RVCORR = 0.70710678118655
WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR
0071 CONTINUE
CT008* TEST 8
IVTNUM = 8
BVS = 25.0
AVS = SQRT(BVS/100.0)
IF (AVS - 0.49997E+00) 20080, 10080, 40080
40080 IF (AVS - 0.50003E+00) 10080, 10080, 20080
10080 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0081
20080 IVFAIL = IVFAIL + 1
RVCORR = 0.50000000000000
WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR
0081 CONTINUE
CT009* TEST 9
IVTNUM = 9
BVS = 0.0875
AVS = SQRT(BVS * 10.0)
IF (AVS - 0.93536E+00) 20090, 10090, 40090
40090 IF (AVS - 0.93546E+00) 10090, 10090, 20090
10090 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0091
20090 IVFAIL = IVFAIL + 1
RVCORR = 0.93541434669349
WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR
0091 CONTINUE
CT010* TEST 10
IVTNUM = 10
AVS = SQRT(31.0/32.0)
IF (AVS - 0.98420E+00) 20100, 10100, 40100
40100 IF (AVS - 0.98430E+00) 10100, 10100, 20100
10100 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0101
20100 IVFAIL = IVFAIL + 1
RVCORR = 0.98425098425148
WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR
0101 CONTINUE
CT011* TEST 11 AN ARGUMENT OF LOW MAGNITUDE
IVTNUM = 11
AVS = SQRT(1.6E-35)
IF (AVS - 0.39998E-17) 20110, 10110, 40110
40110 IF (AVS - 0.40002E-17) 10110, 10110, 20110
10110 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0111
20110 IVFAIL = IVFAIL + 1
RVCORR = 0.40000000000000E-17
WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR
0111 CONTINUE
CT012* TEST 12 AN ARGUMENT OF HIGH MAGNITUDE
IVTNUM = 12
AVS = SQRT(1.0E+35)
IF (AVS - 0.31621E+18) 20120, 10120, 40120
40120 IF (AVS - 0.31625E+18) 10120, 10120, 20120
10120 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0121
20120 IVFAIL = IVFAIL + 1
RVCORR = 0.31622776601684E+18
WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR
0121 CONTINUE
CT013* TEST 13
IVTNUM = 13
BVS = SQRT(1.6)
AVS = SQRT(0.625) * BVS
IF (AVS - 0.99995E+00) 20130, 10130, 40130
40130 IF (AVS - 0.10001E+01) 10130, 10130, 20130
10130 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0131
20130 IVFAIL = IVFAIL + 1
RVCORR = 1.0000000
WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR
0131 CONTINUE
C*****
CBB** ********************** BBCSUM0 **********************************
C**** WRITE OUT TEST SUMMARY
C****
IVTOTN = IVPASS + IVFAIL + IVDELE + IVINSP
WRITE (I02, 90004)
WRITE (I02, 90014)
WRITE (I02, 90004)
WRITE (I02, 90020) IVPASS
WRITE (I02, 90022) IVFAIL
WRITE (I02, 90024) IVDELE
WRITE (I02, 90026) IVINSP
WRITE (I02, 90028) IVTOTN, IVTOTL
CBE** ********************** BBCSUM0 **********************************
CBB** ********************** BBCFOOT0 **********************************
C**** WRITE OUT REPORT FOOTINGS
C****
WRITE (I02,90016) ZPROG, ZPROG
WRITE (I02,90018) ZPROJ, ZNAME, ZTAPE, ZTAPED
WRITE (I02,90019)
CBE** ********************** BBCFOOT0 **********************************
CBB** ********************** BBCFMT0A **********************************
C**** FORMATS FOR TEST DETAIL LINES
C****
80000 FORMAT (1H ,2X,I3,4X,7HDELETED,32X,A31)
80002 FORMAT (1H ,2X,I3,4X,7H PASS ,32X,A31)
80004 FORMAT (1H ,2X,I3,4X,7HINSPECT,32X,A31)
80008 FORMAT (1H ,2X,I3,4X,7H FAIL ,32X,A31)
80010 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,15X,10HCOMPUTED= ,
1I6,/,1H ,15X,10HCORRECT= ,I6)
80012 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
1E12.5,/,1H ,16X,10HCORRECT= ,E12.5)
80018 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
1A21,/,1H ,16X,10HCORRECT= ,A21)
80020 FORMAT (1H ,16X,10HCOMPUTED= ,A21,1X,A31)
80022 FORMAT (1H ,16X,10HCORRECT= ,A21,1X,A31)
80024 FORMAT (1H ,16X,10HCOMPUTED= ,I6,16X,A31)
80026 FORMAT (1H ,16X,10HCORRECT= ,I6,16X,A31)
80028 FORMAT (1H ,16X,10HCOMPUTED= ,E12.5,10X,A31)
80030 FORMAT (1H ,16X,10HCORRECT= ,E12.5,10X,A31)
80050 FORMAT (1H ,48X,A31)
CBE** ********************** BBCFMT0A **********************************
CBB** ********************** BBCFMT0B **********************************
C**** FORMAT STATEMENTS FOR PAGE HEADERS
C****
90002 FORMAT (1H1)
90004 FORMAT (1H )
90006 FORMAT (1H ,20X,31HFEDERAL SOFTWARE TESTING CENTER)
90007 FORMAT (1H ,19X,34HFORTRAN COMPILER VALIDATION SYSTEM)
90008 FORMAT (1H ,21X,A13,A17)
90009 FORMAT (1H ,/,2H *,A5,6HBEGIN*,12X,15HTEST RESULTS - ,A5,/)
90010 FORMAT (1H ,8X,16HTEST DATE*TIME= ,A17,15H - COMPILER= ,A20)
90013 FORMAT (1H ,8H TEST ,10HPASS/FAIL ,6X,17HDISPLAYED RESULTS,
1 7X,7HREMARKS,24X)
90014 FORMAT (1H ,46H----------------------------------------------,
1 33H---------------------------------)
90015 FORMAT (1H ,48X,17HTHIS PROGRAM HAS ,I3,6H TESTS,/)
C****
C**** FORMAT STATEMENTS FOR REPORT FOOTINGS
C****
90016 FORMAT (1H ,/,2H *,A5,4HEND*,14X,14HEND OF TEST - ,A5,/)
90018 FORMAT (1H ,A13,13X,A20,7H * ,A10,1H/,
1 A13)
90019 FORMAT (1H ,26HFOR OFFICIAL USE ONLY ,35X,15HCOPYRIGHT 1982)
C****
C**** FORMAT STATEMENTS FOR RUN SUMMARY
C****
90020 FORMAT (1H ,21X,I5,13H TESTS PASSED)
90022 FORMAT (1H ,21X,I5,13H TESTS FAILED)
90024 FORMAT (1H ,21X,I5,14H TESTS DELETED)
90026 FORMAT (1H ,21X,I5,25H TESTS REQUIRE INSPECTION)
90028 FORMAT (1H ,21X,I5,4H OF ,I3,15H TESTS EXECUTED)
CBE** ********************** BBCFMT0B **********************************
C*****
C***** END OF TEST SEGMENT 175
STOP
END
*END-OF,FM368
FM369.f 481036296 170 2 100666 15913 `
*HEADER,FORTR,FM369
*FILES1,FORTR,FM369,X
C***********************************************************************
C***** FORTRAN 77
C***** FM369
C***** XEXP - (178)
C*****
C***********************************************************************
C***** GENERAL PURPOSE SUBSET REF
C***** TEST INTRINSIC FUNCTION EXP 15.3
C***** TABLE 5
C*****
CBB** ********************** BBCCOMNT **********************************
C****
C**** 1978 FORTRAN COMPILER VALIDATION SYSTEM
C**** VERSION 2.0
C****
C****
C**** SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO
C**** GENERAL SERVICES ADMINISTRATION
C**** FEDERAL SOFTWARE TESTING CENTER
C**** 5203 LEESBURG PIKE, SUITE 1100
C**** FALLS CHURCH, VA. 22041
C****
C**** (703) 756-6153
C****
CBE** ********************** BBCCOMNT **********************************
CBB** ********************** BBCINITA **********************************
C**** SPECIFICATION STATEMENTS
C****
CHARACTER ZVERS*13, ZVERSD*17, ZDATE*17, ZPROG*5, ZCOMPL*20,
1 ZNAME*20, ZTAPE*10, ZPROJ*13, REMRKS*31, ZTAPED*13
CBE** ********************** BBCINITA **********************************
CBB** ********************** BBCINITB **********************************
C**** INITIALIZE SECTION
DATA ZVERS, ZVERSD, ZDATE
1 /'VERSION 2.0 ', '82/08/02*18.33.46', '*NO DATE*TIME'/
DATA ZCOMPL, ZNAME, ZTAPE
1 /'*NONE SPECIFIED*', '*NO COMPANY NAME*', '*NO TAPE*'/
DATA ZPROJ, ZTAPED, ZPROG
1 /'*NO PROJECT*', '*NO TAPE DATE', 'XXXXX'/
DATA REMRKS /' '/
C**** THE FOLLOWING 9 COMMENT LINES (CZ01, CZ02, ...) CAN BE REPLACED
C**** FOR IDENTIFYING THE TEST ENVIRONMENT
C****
CZ01 ZVERS = 'VERSION OF THE COMPILER VALIDATION SYSTEM'
CZ02 ZVERSD = 'CREATION DATE/TIME OF THE COMPILER VALIDATION SYSTEM'
CZ03 ZPROG = 'PROGRAM NAME'
CZ04 ZDATE = 'DATE OF TEST'
CZ05 ZCOMPL = 'COMPILER IDENTIFICATION'
CZ06 ZPROJ = 'PROJECT NUMBER/IDENTIFICATION'
CZ07 ZNAME = 'NAME OF USER'
CZ08 ZTAPE = 'TAPE OWNER/ID'
CZ09 ZTAPED = 'DATE TAPE COPIED'
C
IVPASS = 0
IVFAIL = 0
IVDELE = 0
IVINSP = 0
IVTOTL = 0
IVTOTN = 0
ICZERO = 0
C
C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER.
I01 = 05
C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER.
I02 = 06
C
CX010 REPLACED BY FEXEC X-010 CONTROL CARD (CARD-READER UNIT NUMBER).
C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5
CX011 REPLACED BY FEXEC X-011 CONTROL CARD. CX011 IS FOR SYSTEMS
C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX010.
C
CX020 REPLACED BY FEXEC X-020 CONTROL CARD (PRINTER UNIT NUMBER).
C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02= 6
CX021 REPLACED BY FEXEC X-021 CONTROL CARD. CX021 IS FOR SYSTEMS
C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX020.
C
CBE** ********************** BBCINITB **********************************
NUVI = I02
IVTOTL = 19
ZPROG = 'FM369'
CBB** ********************** BBCHED0A **********************************
C****
C**** WRITE REPORT TITLE
C****
WRITE (I02, 90002)
WRITE (I02, 90006)
WRITE (I02, 90007)
WRITE (I02, 90008) ZVERS, ZVERSD
WRITE (I02, 90009) ZPROG, ZPROG
WRITE (I02, 90010) ZDATE, ZCOMPL
CBE** ********************** BBCHED0A **********************************
C*****
C***** HEADER FOR SEGMENT 178
WRITE(NUVI,17800)
17800 FORMAT(1H , / 34H XEXP - (178) INTRINSIC FUNCTIONS//
1 19H EXP (EXPONENTIAL)//
2 20H SUBSET REF. - 15.3)
CBB** ********************** BBCHED0B **********************************
C**** WRITE DETAIL REPORT HEADERS
C****
WRITE (I02,90004)
WRITE (I02,90004)
WRITE (I02,90013)
WRITE (I02,90014)
WRITE (I02,90015) IVTOTL
CBE** ********************** BBCHED0B **********************************
C*****
CT001* TEST 1 ZERO SINCE EXP(0.0) = 1
IVTNUM = 1
BVS = 0.0
AVS = EXP(BVS)
IF (AVS - 0.99995E+00) 20010, 10010, 40010
40010 IF (AVS - 0.10001E+01) 10010, 10010, 20010
10010 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0011
20010 IVFAIL = IVFAIL + 1
RVCORR = 0.10000000000000E+01
WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR
0011 CONTINUE
CT002* TEST 2 ONE SINCE EXP(1.0) = E
IVTNUM = 2
AVS = EXP(1.0)
IF (AVS - 0.27181E+01) 20020, 10020, 40020
40020 IF (AVS - 0.27185E+01) 10020, 10020, 20020
10020 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0021
20020 IVFAIL = IVFAIL + 1
RVCORR = 0.27182818284590E+01
WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR
0021 CONTINUE
C***** TESTS 3 THRU 5 - POSITIVE VALUES
CT003* TEST 3
IVTNUM = 3
AVS = EXP(2.0)
IF (AVS - 0.73886E+01) 20030, 10030, 40030
40030 IF (AVS - 0.73895E+01) 10030, 10030, 20030
10030 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0031
20030 IVFAIL = IVFAIL + 1
RVCORR = 0.73890560989307E+01
WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR
0031 CONTINUE
CT004* TEST 4
IVTNUM = 4
AVS = EXP(5.125)
IF (AVS - 0.16816E+03) 20040, 10040, 40040
40040 IF (AVS - 0.16819E+03) 10040, 10040, 20040
10040 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0041
20040 IVFAIL = IVFAIL + 1
RVCORR = 0.16817414165185E+03
WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR
0041 CONTINUE
CT005* TEST 5
IVTNUM = 5
AVS = EXP(15.0)
IF (AVS - 0.32688E+07) 20050, 10050, 40050
40050 IF (AVS - 0.32692E+07) 10050, 10050, 20050
10050 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0051
20050 IVFAIL = IVFAIL + 1
RVCORR = 0.32690173724721E+07
WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR
0051 CONTINUE
CT006* TEST 6
IVTNUM = 6
BVS = 20.5
AVS = EXP(BVS)
IF (AVS - 0.79986E+09) 20060, 10060, 40060
40060 IF (AVS - 0.79995E+09) 10060, 10060, 20060
10060 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0061
20060 IVFAIL = IVFAIL + 1
RVCORR = 0.79990217747551E+09
WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR
0061 CONTINUE
C***** TESTS 7 THRU 10 - EXPRESSION PRESENTED TO EXP
CT007* TEST 7
IVTNUM = 7
BVS = 4.5
AVS = EXP(BVS - 7.5)
IF (AVS - 0.49784E-01) 20070, 10070, 40070
40070 IF (AVS - 0.49790E-01) 10070, 10070, 20070
10070 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0071
20070 IVFAIL = IVFAIL + 1
RVCORR = 0.49787068367864E-01
WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR
0071 CONTINUE
CT008* TEST 8
IVTNUM = 8
BVS = 0.25
AVS = EXP(BVS - 5.0)
IF (AVS - 0.86512E-02) 20080, 10080, 40080
40080 IF (AVS - 0.86522E-02) 10080, 10080, 20080
10080 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0081
20080 IVFAIL = IVFAIL + 1
RVCORR = 0.86516952031206E-02
WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR
0081 CONTINUE
CT009* TEST 9
IVTNUM = 9
AVS = EXP(0.5 * (-20.0))
IF (AVS - 0.45397E-04) 20090, 10090, 40090
40090 IF (AVS - 0.45403E-04) 10090, 10090, 20090
10090 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0091
20090 IVFAIL = IVFAIL + 1
RVCORR = 0.45399929762485E-04
WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR
0091 CONTINUE
CT010* TEST 10
IVTNUM = 10
BVS = 30.5
AVS = EXP(BVS * (-0.5))
IF (AVS - 0.23822E-06) 20100, 10100, 40100
40100 IF (AVS - 0.23825E-06) 10100, 10100, 20100
10100 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0101
20100 IVFAIL = IVFAIL + 1
RVCORR = 0.23823696675018E-06
WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR
0101 CONTINUE
C***** TESTS 11 THRU 14 - VALUES CLOSE TO ONE
CT011* TEST 11
IVTNUM = 11
AVS = EXP(0.9921875)
IF (AVS - 0.26970E+01) 20110, 10110, 40110
40110 IF (AVS - 0.26973E+01) 10110, 10110, 20110
10110 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0111
20110 IVFAIL = IVFAIL + 1
RVCORR = 0.26971279914439E+01
WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR
0111 CONTINUE
CT012* TEST 12
IVTNUM = 12
BVS = 0.9990234375
AVS = EXP(BVS)
IF (AVS - 0.27155E+01) 20120, 10120, 40120
40120 IF (AVS - 0.27158E+01) 10120, 10120, 20120
10120 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0121
20120 IVFAIL = IVFAIL + 1
RVCORR = 0.27156285521169E+01
WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR
0121 CONTINUE
C*****
C***** ADVANCE TO TOP-OF-PAGE AND WRITE HEADERS
WRITE (NUVI, 90002)
WRITE (NUVI, 90013)
WRITE (NUVI, 90014)
C*****
CT013* TEST 13
IVTNUM = 13
AVS = EXP(1.00390625)
IF (AVS - 0.27287E+01) 20130, 10130, 40130
40130 IF (AVS - 0.27291E+01) 10130, 10130, 20130
10130 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0131
20130 IVFAIL = IVFAIL + 1
RVCORR = 0.27289208827261E+01
WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR
0131 CONTINUE
CT014* TEST 14
IVTNUM = 14
BVS = 1.001953125
AVS = EXP(BVS)
IF (AVS - 0.27234E+01) 20140, 10140, 40140
40140 IF (AVS - 0.27238E+01) 10140, 10140, 20140
10140 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0141
20140 IVFAIL = IVFAIL + 1
RVCORR = 0.27235961607435E+01
WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR
0141 CONTINUE
C***** TESTS 15 THRU 19 - VALUES CLOSE TO 1/E
CT015* TEST 15
IVTNUM = 15
BVS = 128.0
AVS = EXP(44. / BVS)
IF (AVS - 0.14101E+01) 20150, 10150, 40150
40150 IF (AVS - 0.14103E+01) 10150, 10150, 20150
10150 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0151
20150 IVFAIL = IVFAIL + 1
RVCORR = 0.14102260349257E+01
WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR
0151 CONTINUE
CT016* TEST 16
IVTNUM = 16
BVS = 128.
AVS = EXP(45. / BVS)
IF (AVS - 0.14212E+01) 20160, 10160, 40160
40160 IF (AVS - 0.14214E+01) 10160, 10160, 20160
10160 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0161
20160 IVFAIL = IVFAIL + 1
RVCORR = 0.14212865748007E+01
WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR
0161 CONTINUE
CT017* TEST 17
IVTNUM = 17
BVS = 128.
AVS = EXP(46. / BVS)
IF (AVS - 0.14323E+01) 20170, 10170, 40170
40170 IF (AVS - 0.14325E+01) 10170, 10170, 20170
10170 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0171
20170 IVFAIL = IVFAIL + 1
RVCORR = 0.14324338635651E+01
WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR
0171 CONTINUE
CT018* TEST 18
IVTNUM = 18
BVS = 128.
AVS = EXP(47. / BVS)
IF (AVS - 0.14436E+01) 20180, 10180, 40180
40180 IF (AVS - 0.14438E+01) 10180, 10180, 20180
10180 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0181
20180 IVFAIL = IVFAIL + 1
RVCORR = 0.14436685815988E+01
WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR
0181 CONTINUE
CT019* TEST 19
IVTNUM = 19
BVS = 128.
AVS = EXP(48. / BVS)
IF (AVS - 0.14549E+01) 20190, 10190, 40190
40190 IF (AVS - 0.14551E+01) 10190, 10190, 20190
10190 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0191
20190 IVFAIL = IVFAIL + 1
RVCORR = 0.14549914146182E+01
WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR
0191 CONTINUE
CBB** ********************** BBCSUM0 **********************************
C**** WRITE OUT TEST SUMMARY
C****
IVTOTN = IVPASS + IVFAIL + IVDELE + IVINSP
WRITE (I02, 90004)
WRITE (I02, 90014)
WRITE (I02, 90004)
WRITE (I02, 90020) IVPASS
WRITE (I02, 90022) IVFAIL
WRITE (I02, 90024) IVDELE
WRITE (I02, 90026) IVINSP
WRITE (I02, 90028) IVTOTN, IVTOTL
CBE** ********************** BBCSUM0 **********************************
CBB** ********************** BBCFOOT0 **********************************
C**** WRITE OUT REPORT FOOTINGS
C****
WRITE (I02,90016) ZPROG, ZPROG
WRITE (I02,90018) ZPROJ, ZNAME, ZTAPE, ZTAPED
WRITE (I02,90019)
CBE** ********************** BBCFOOT0 **********************************
CBB** ********************** BBCFMT0A **********************************
C**** FORMATS FOR TEST DETAIL LINES
C****
80000 FORMAT (1H ,2X,I3,4X,7HDELETED,32X,A31)
80002 FORMAT (1H ,2X,I3,4X,7H PASS ,32X,A31)
80004 FORMAT (1H ,2X,I3,4X,7HINSPECT,32X,A31)
80008 FORMAT (1H ,2X,I3,4X,7H FAIL ,32X,A31)
80010 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,15X,10HCOMPUTED= ,
1I6,/,1H ,15X,10HCORRECT= ,I6)
80012 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
1E12.5,/,1H ,16X,10HCORRECT= ,E12.5)
80018 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
1A21,/,1H ,16X,10HCORRECT= ,A21)
80020 FORMAT (1H ,16X,10HCOMPUTED= ,A21,1X,A31)
80022 FORMAT (1H ,16X,10HCORRECT= ,A21,1X,A31)
80024 FORMAT (1H ,16X,10HCOMPUTED= ,I6,16X,A31)
80026 FORMAT (1H ,16X,10HCORRECT= ,I6,16X,A31)
80028 FORMAT (1H ,16X,10HCOMPUTED= ,E12.5,10X,A31)
80030 FORMAT (1H ,16X,10HCORRECT= ,E12.5,10X,A31)
80050 FORMAT (1H ,48X,A31)
CBE** ********************** BBCFMT0A **********************************
CBB** ********************** BBCFMT0B **********************************
C**** FORMAT STATEMENTS FOR PAGE HEADERS
C****
90002 FORMAT (1H1)
90004 FORMAT (1H )
90006 FORMAT (1H ,20X,31HFEDERAL SOFTWARE TESTING CENTER)
90007 FORMAT (1H ,19X,34HFORTRAN COMPILER VALIDATION SYSTEM)
90008 FORMAT (1H ,21X,A13,A17)
90009 FORMAT (1H ,/,2H *,A5,6HBEGIN*,12X,15HTEST RESULTS - ,A5,/)
90010 FORMAT (1H ,8X,16HTEST DATE*TIME= ,A17,15H - COMPILER= ,A20)
90013 FORMAT (1H ,8H TEST ,10HPASS/FAIL ,6X,17HDISPLAYED RESULTS,
1 7X,7HREMARKS,24X)
90014 FORMAT (1H ,46H----------------------------------------------,
1 33H---------------------------------)
90015 FORMAT (1H ,48X,17HTHIS PROGRAM HAS ,I3,6H TESTS,/)
C****
C**** FORMAT STATEMENTS FOR REPORT FOOTINGS
C****
90016 FORMAT (1H ,/,2H *,A5,4HEND*,14X,14HEND OF TEST - ,A5,/)
90018 FORMAT (1H ,A13,13X,A20,7H * ,A10,1H/,
1 A13)
90019 FORMAT (1H ,26HFOR OFFICIAL USE ONLY ,35X,15HCOPYRIGHT 1982)
C****
C**** FORMAT STATEMENTS FOR RUN SUMMARY
C****
90020 FORMAT (1H ,21X,I5,13H TESTS PASSED)
90022 FORMAT (1H ,21X,I5,13H TESTS FAILED)
90024 FORMAT (1H ,21X,I5,14H TESTS DELETED)
90026 FORMAT (1H ,21X,I5,25H TESTS REQUIRE INSPECTION)
90028 FORMAT (1H ,21X,I5,4H OF ,I3,15H TESTS EXECUTED)
CBE** ********************** BBCFMT0B **********************************
C*****
C***** END OF TEST SEGMENT 178
STOP
END
*END-OF,FM369
FM370.f 481036300 170 2 100666 14522 `
*HEADER,FORTR,FM370
*FILES1,FORTR,FM370,X
C***********************************************************************
C***** FORTRAN 77
C***** FM370
C***** XALOG - (181)
C*****
C***********************************************************************
C***** GENERAL PURPOSE SUBSET REF
C***** TEST INTRINSIC FUNCTION ALOG 15.3
C***** TABLE 5
C*****
C*****
CBB** ********************** BBCCOMNT **********************************
C****
C**** 1978 FORTRAN COMPILER VALIDATION SYSTEM
C**** VERSION 2.0
C****
C****
C**** SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO
C**** GENERAL SERVICES ADMINISTRATION
C**** FEDERAL SOFTWARE TESTING CENTER
C**** 5203 LEESBURG PIKE, SUITE 1100
C**** FALLS CHURCH, VA. 22041
C****
C**** (703) 756-6153
C****
CBE** ********************** BBCCOMNT **********************************
CBB** ********************** BBCINITA **********************************
C**** SPECIFICATION STATEMENTS
C****
CHARACTER ZVERS*13, ZVERSD*17, ZDATE*17, ZPROG*5, ZCOMPL*20,
1 ZNAME*20, ZTAPE*10, ZPROJ*13, REMRKS*31, ZTAPED*13
CBE** ********************** BBCINITA **********************************
CBB** ********************** BBCINITB **********************************
C**** INITIALIZE SECTION
DATA ZVERS, ZVERSD, ZDATE
1 /'VERSION 2.0 ', '82/08/02*18.33.46', '*NO DATE*TIME'/
DATA ZCOMPL, ZNAME, ZTAPE
1 /'*NONE SPECIFIED*', '*NO COMPANY NAME*', '*NO TAPE*'/
DATA ZPROJ, ZTAPED, ZPROG
1 /'*NO PROJECT*', '*NO TAPE DATE', 'XXXXX'/
DATA REMRKS /' '/
C**** THE FOLLOWING 9 COMMENT LINES (CZ01, CZ02, ...) CAN BE REPLACED
C**** FOR IDENTIFYING THE TEST ENVIRONMENT
C****
CZ01 ZVERS = 'VERSION OF THE COMPILER VALIDATION SYSTEM'
CZ02 ZVERSD = 'CREATION DATE/TIME OF THE COMPILER VALIDATION SYSTEM'
CZ03 ZPROG = 'PROGRAM NAME'
CZ04 ZDATE = 'DATE OF TEST'
CZ05 ZCOMPL = 'COMPILER IDENTIFICATION'
CZ06 ZPROJ = 'PROJECT NUMBER/IDENTIFICATION'
CZ07 ZNAME = 'NAME OF USER'
CZ08 ZTAPE = 'TAPE OWNER/ID'
CZ09 ZTAPED = 'DATE TAPE COPIED'
C
IVPASS = 0
IVFAIL = 0
IVDELE = 0
IVINSP = 0
IVTOTL = 0
IVTOTN = 0
ICZERO = 0
C
C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER.
I01 = 05
C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER.
I02 = 06
C
CX010 REPLACED BY FEXEC X-010 CONTROL CARD (CARD-READER UNIT NUMBER).
C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5
CX011 REPLACED BY FEXEC X-011 CONTROL CARD. CX011 IS FOR SYSTEMS
C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX010.
C
CX020 REPLACED BY FEXEC X-020 CONTROL CARD (PRINTER UNIT NUMBER).
C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02= 6
CX021 REPLACED BY FEXEC X-021 CONTROL CARD. CX021 IS FOR SYSTEMS
C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX020.
C
CBE** ********************** BBCINITB **********************************
NUVI = I02
IVTOTL = 16
ZPROG = 'FM370'
CBB** ********************** BBCHED0A **********************************
C****
C**** WRITE REPORT TITLE
C****
WRITE (I02, 90002)
WRITE (I02, 90006)
WRITE (I02, 90007)
WRITE (I02, 90008) ZVERS, ZVERSD
WRITE (I02, 90009) ZPROG, ZPROG
WRITE (I02, 90010) ZDATE, ZCOMPL
CBE** ********************** BBCHED0A **********************************
C***** HEADER FOR SEGMENT 181
WRITE(NUVI,18100)
18100 FORMAT(1H , / 35H XALOG - (181) INTRINSIC FUNCTIONS//
1 26H ALOG (NATURAL LOGARITHM)//
2 20H SUBSET REF. - 15.3)
CBB** ********************** BBCHED0B **********************************
C**** WRITE DETAIL REPORT HEADERS
C****
WRITE (I02,90004)
WRITE (I02,90004)
WRITE (I02,90013)
WRITE (I02,90014)
WRITE (I02,90015) IVTOTL
CBE** ********************** BBCHED0B **********************************
C*****
CT001* TEST 1 ONE, SINCE LN(1.0) = 0.0
IVTNUM = 1
BVS = 1.0
AVS = ALOG(BVS)
IF (AVS + 0.50000E-04) 20010, 10010, 40010
40010 IF (AVS - 0.50000E-04) 10010, 10010, 20010
10010 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0011
20010 IVFAIL = IVFAIL + 1
RVCORR = 0.00000000000000
WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR
0011 CONTINUE
CT002* TEST 2 VALUES CLOSE TO E
IVTNUM = 2
AVS = ALOG(2.6875)
IF (AVS - 0.98856E+00) 20020, 10020, 40020
40020 IF (AVS - 0.98866E+00) 10020, 10020, 20020
10020 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0021
20020 IVFAIL = IVFAIL + 1
RVCORR = 0.98861139345378
WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR
0021 CONTINUE
CT003* TEST 3
IVTNUM = 3
AVS = ALOG(5.125)
IF (AVS - 0.16340E+01) 20030, 10030, 40030
40030 IF (AVS - 0.16342E+01) 10030, 10030, 20030
10030 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0031
20030 IVFAIL = IVFAIL + 1
RVCORR = 1.63413052502447
WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR
0031 CONTINUE
CT004* TEST 4
IVTNUM = 4
AVS = ALOG(10.0)
IF (AVS - 0.23025E+01) 20040, 10040, 40040
40040 IF (AVS - 0.23027E+01) 10040, 10040, 20040
10040 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0041
20040 IVFAIL = IVFAIL + 1
RVCORR = 2.30258509299405
WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR
0041 CONTINUE
CT005* TEST 5
IVTNUM = 5
AVS = ALOG(100.0)
IF (AVS - 0.46049E+01) 20050, 10050, 40050
40050 IF (AVS - 0.46054E+01) 10050, 10050, 20050
10050 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0051
20050 IVFAIL = IVFAIL + 1
RVCORR = 4.60517018598809
WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR
0051 CONTINUE
CT006* TEST 6
IVTNUM = 6
BVS = 1.0
AVS = ALOG(BVS / 4.0)
IF (AVS + 0.13864E+01) 20060, 10060, 40060
40060 IF (AVS + 0.13862E+01) 10060, 10060, 20060
10060 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0061
20060 IVFAIL = IVFAIL + 1
RVCORR = -1.38629436111989
WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR
0061 CONTINUE
CT007* TEST 7
IVTNUM = 7
BVS = 1.0
CVS = 8.0
AVS = ALOG(3.0 * BVS / CVS)
IF (AVS + 0.98088E+00) 20070, 10070, 40070
40070 IF (AVS + 0.98078E+00) 10070, 10070, 20070
10070 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0071
20070 IVFAIL = IVFAIL + 1
RVCORR = -0.98082925301173
WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR
0071 CONTINUE
CT008* TEST 8
IVTNUM = 8
AVS = ALOG(50.0 / 100.0)
IF (AVS + 0.69318E+00) 20080, 10080, 40080
40080 IF (AVS + 0.69311E+00) 10080, 10080, 20080
10080 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0081
20080 IVFAIL = IVFAIL + 1
RVCORR = -0.69314718055995
WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR
0081 CONTINUE
CT009* TEST 9
IVTNUM = 9
BVS = 68.75
AVS = ALOG(BVS * 0.01)
IF (AVS + 0.37471E+00) 20090, 10090, 40090
40090 IF (AVS + 0.37467E+00) 10090, 10090, 20090
10090 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0091
20090 IVFAIL = IVFAIL + 1
RVCORR = -0.37469344944141
WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR
0091 CONTINUE
CT010* TEST 10 VALUES CLOSE TO ONE
IVTNUM = 10
AVS = ALOG(0.96875)
IF (AVS + 0.31750E-01) 20100, 10100, 40100
40100 IF (AVS + 0.31747E-01) 10100, 10100, 20100
10100 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0101
20100 IVFAIL = IVFAIL + 1
RVCORR = -0.03174869831458
WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR
0101 CONTINUE
CT011* TEST 11
IVTNUM = 11
BVS = 1.015625
AVS = ALOG(BVS)
IF (AVS - 0.15503E-01) 20110, 10110, 40110
40110 IF (AVS - 0.15505E-01) 10110, 10110, 20110
10110 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0111
20110 IVFAIL = IVFAIL + 1
RVCORR = 0.01550418653597
WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR
0111 CONTINUE
CT012* TEST 12 VALUES CLOSE TO ZERO
IVTNUM = 12
BVS = 128.0
AVS = ALOG(1.0 / BVS)
IF (AVS + 0.48523E+01) 20120, 10120, 40120
40120 IF (AVS + 0.48518E+01) 10120, 10120, 20120
10120 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0121
20120 IVFAIL = IVFAIL + 1
RVCORR = -4.85203026391962
WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR
0121 CONTINUE
CT013* TEST 13
IVTNUM = 13
BVS = 128.0
AVS = ALOG(1.0 / (BVS * 4.0))
IF (AVS + 0.62386E+01) 20130, 10130, 40130
40130 IF (AVS + 0.62380E+01) 10130, 10130, 20130
10130 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0131
20130 IVFAIL = IVFAIL + 1
RVCORR = -6.23832462503951
WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR
0131 CONTINUE
CT014* TEST 14 AN ARGUMENT OF HIGH MAGNITUDE
IVTNUM = 14
BVS = 1.0E+37
AVS = ALOG(BVS)
IF (AVS - 0.85191E+01) 20140, 10140, 40140
40140 IF (AVS - 0.85200E+02) 10140, 10140, 20140
10140 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0141
20140 IVFAIL = IVFAIL + 1
RVCORR = 85.19564844077969
WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR
0141 CONTINUE
CT015* TEST 15 AN ARGUMENT OF LOW MAGNITUDE
IVTNUM = 15
BVS = 1.0E-37
AVS = ALOG(BVS)
IF (AVS + 0.85200E+02) 20150, 10150, 40150
40150 IF (AVS + 0.85191E+02) 10150, 10150, 20150
10150 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0151
20150 IVFAIL = IVFAIL + 1
RVCORR = -85.19564844077969
WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR
0151 CONTINUE
CT016* TEST 16
IVTNUM = 16
AVS = ALOG(8.0) + ALOG(0.125)
IF (AVS + 0.50000E-04) 20160, 10160, 40160
40160 IF (AVS - 0.50000E-04) 10160, 10160, 20160
10160 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0161
20160 IVFAIL = IVFAIL + 1
RVCORR = 0.0000000
WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR
0161 CONTINUE
C*****
CBB** ********************** BBCSUM0 **********************************
C**** WRITE OUT TEST SUMMARY
C****
IVTOTN = IVPASS + IVFAIL + IVDELE + IVINSP
WRITE (I02, 90004)
WRITE (I02, 90014)
WRITE (I02, 90004)
WRITE (I02, 90020) IVPASS
WRITE (I02, 90022) IVFAIL
WRITE (I02, 90024) IVDELE
WRITE (I02, 90026) IVINSP
WRITE (I02, 90028) IVTOTN, IVTOTL
CBE** ********************** BBCSUM0 **********************************
CBB** ********************** BBCFOOT0 **********************************
C**** WRITE OUT REPORT FOOTINGS
C****
WRITE (I02,90016) ZPROG, ZPROG
WRITE (I02,90018) ZPROJ, ZNAME, ZTAPE, ZTAPED
WRITE (I02,90019)
CBE** ********************** BBCFOOT0 **********************************
CBB** ********************** BBCFMT0A **********************************
C**** FORMATS FOR TEST DETAIL LINES
C****
80000 FORMAT (1H ,2X,I3,4X,7HDELETED,32X,A31)
80002 FORMAT (1H ,2X,I3,4X,7H PASS ,32X,A31)
80004 FORMAT (1H ,2X,I3,4X,7HINSPECT,32X,A31)
80008 FORMAT (1H ,2X,I3,4X,7H FAIL ,32X,A31)
80010 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,15X,10HCOMPUTED= ,
1I6,/,1H ,15X,10HCORRECT= ,I6)
80012 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
1E12.5,/,1H ,16X,10HCORRECT= ,E12.5)
80018 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
1A21,/,1H ,16X,10HCORRECT= ,A21)
80020 FORMAT (1H ,16X,10HCOMPUTED= ,A21,1X,A31)
80022 FORMAT (1H ,16X,10HCORRECT= ,A21,1X,A31)
80024 FORMAT (1H ,16X,10HCOMPUTED= ,I6,16X,A31)
80026 FORMAT (1H ,16X,10HCORRECT= ,I6,16X,A31)
80028 FORMAT (1H ,16X,10HCOMPUTED= ,E12.5,10X,A31)
80030 FORMAT (1H ,16X,10HCORRECT= ,E12.5,10X,A31)
80050 FORMAT (1H ,48X,A31)
CBE** ********************** BBCFMT0A **********************************
CBB** ********************** BBCFMT0B **********************************
C**** FORMAT STATEMENTS FOR PAGE HEADERS
C****
90002 FORMAT (1H1)
90004 FORMAT (1H )
90006 FORMAT (1H ,20X,31HFEDERAL SOFTWARE TESTING CENTER)
90007 FORMAT (1H ,19X,34HFORTRAN COMPILER VALIDATION SYSTEM)
90008 FORMAT (1H ,21X,A13,A17)
90009 FORMAT (1H ,/,2H *,A5,6HBEGIN*,12X,15HTEST RESULTS - ,A5,/)
90010 FORMAT (1H ,8X,16HTEST DATE*TIME= ,A17,15H - COMPILER= ,A20)
90013 FORMAT (1H ,8H TEST ,10HPASS/FAIL ,6X,17HDISPLAYED RESULTS,
1 7X,7HREMARKS,24X)
90014 FORMAT (1H ,46H----------------------------------------------,
1 33H---------------------------------)
90015 FORMAT (1H ,48X,17HTHIS PROGRAM HAS ,I3,6H TESTS,/)
C****
C**** FORMAT STATEMENTS FOR REPORT FOOTINGS
C****
90016 FORMAT (1H ,/,2H *,A5,4HEND*,14X,14HEND OF TEST - ,A5,/)
90018 FORMAT (1H ,A13,13X,A20,7H * ,A10,1H/,
1 A13)
90019 FORMAT (1H ,26HFOR OFFICIAL USE ONLY ,35X,15HCOPYRIGHT 1982)
C****
C**** FORMAT STATEMENTS FOR RUN SUMMARY
C****
90020 FORMAT (1H ,21X,I5,13H TESTS PASSED)
90022 FORMAT (1H ,21X,I5,13H TESTS FAILED)
90024 FORMAT (1H ,21X,I5,14H TESTS DELETED)
90026 FORMAT (1H ,21X,I5,25H TESTS REQUIRE INSPECTION)
90028 FORMAT (1H ,21X,I5,4H OF ,I3,15H TESTS EXECUTED)
CBE** ********************** BBCFMT0B **********************************
C*****
C***** END OF TEST SEGMENT 181
STOP
END
*END-OF,FM370
FM371.f 481036304 170 2 100666 15179 `
*HEADER,FORTR,FM371
*FILES1,FORTR,FM371,X
C***********************************************************************
C***** FORTRAN 77
C***** FM371
C***** XALG10 - (184)
C*****
C***********************************************************************
C***** GENERAL PURPOSE SUBSET REF
C***** TEST INTRINSIC FUNCTION ALOG10 15.3
C***** TABLE 5
C*****
CBB** ********************** BBCCOMNT **********************************
C****
C**** 1978 FORTRAN COMPILER VALIDATION SYSTEM
C**** VERSION 2.0
C****
C****
C**** SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO
C**** GENERAL SERVICES ADMINISTRATION
C**** FEDERAL SOFTWARE TESTING CENTER
C**** 5203 LEESBURG PIKE, SUITE 1100
C**** FALLS CHURCH, VA. 22041
C****
C**** (703) 756-6153
C****
CBE** ********************** BBCCOMNT **********************************
CBB** ********************** BBCINITA **********************************
C**** SPECIFICATION STATEMENTS
C****
CHARACTER ZVERS*13, ZVERSD*17, ZDATE*17, ZPROG*5, ZCOMPL*20,
1 ZNAME*20, ZTAPE*10, ZPROJ*13, REMRKS*31, ZTAPED*13
CBE** ********************** BBCINITA **********************************
CBB** ********************** BBCINITB **********************************
C**** INITIALIZE SECTION
DATA ZVERS, ZVERSD, ZDATE
1 /'VERSION 2.0 ', '82/08/02*18.33.46', '*NO DATE*TIME'/
DATA ZCOMPL, ZNAME, ZTAPE
1 /'*NONE SPECIFIED*', '*NO COMPANY NAME*', '*NO TAPE*'/
DATA ZPROJ, ZTAPED, ZPROG
1 /'*NO PROJECT*', '*NO TAPE DATE', 'XXXXX'/
DATA REMRKS /' '/
C**** THE FOLLOWING 9 COMMENT LINES (CZ01, CZ02, ...) CAN BE REPLACED
C**** FOR IDENTIFYING THE TEST ENVIRONMENT
C****
CZ01 ZVERS = 'VERSION OF THE COMPILER VALIDATION SYSTEM'
CZ02 ZVERSD = 'CREATION DATE/TIME OF THE COMPILER VALIDATION SYSTEM'
CZ03 ZPROG = 'PROGRAM NAME'
CZ04 ZDATE = 'DATE OF TEST'
CZ05 ZCOMPL = 'COMPILER IDENTIFICATION'
CZ06 ZPROJ = 'PROJECT NUMBER/IDENTIFICATION'
CZ07 ZNAME = 'NAME OF USER'
CZ08 ZTAPE = 'TAPE OWNER/ID'
CZ09 ZTAPED = 'DATE TAPE COPIED'
C
IVPASS = 0
IVFAIL = 0
IVDELE = 0
IVINSP = 0
IVTOTL = 0
IVTOTN = 0
ICZERO = 0
C
C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER.
I01 = 05
C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER.
I02 = 06
C
CX010 REPLACED BY FEXEC X-010 CONTROL CARD (CARD-READER UNIT NUMBER).
C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5
CX011 REPLACED BY FEXEC X-011 CONTROL CARD. CX011 IS FOR SYSTEMS
C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX010.
C
CX020 REPLACED BY FEXEC X-020 CONTROL CARD (PRINTER UNIT NUMBER).
C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02= 6
CX021 REPLACED BY FEXEC X-021 CONTROL CARD. CX021 IS FOR SYSTEMS
C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX020.
C
CBE** ********************** BBCINITB **********************************
NUVI = I02
IVTOTL = 16
ZPROG = 'FM371'
CBB** ********************** BBCHED0A **********************************
C****
C**** WRITE REPORT TITLE
C****
WRITE (I02, 90002)
WRITE (I02, 90006)
WRITE (I02, 90007)
WRITE (I02, 90008) ZVERS, ZVERSD
WRITE (I02, 90009) ZPROG, ZPROG
WRITE (I02, 90010) ZDATE, ZCOMPL
CBE** ********************** BBCHED0A **********************************
C*****
C***** HEADER FOR SEGMENT 184
WRITE(NUVI,18400)
18400 FORMAT(1H , / 36H XALG10 - (184) INTRINSIC FUNCTIONS//
1 27H ALOG10 (COMMON LOGARITHM)//
2 20H SUBSET REF. - 15.3)
CBB** ********************** BBCHED0B **********************************
C**** WRITE DETAIL REPORT HEADERS
C****
WRITE (I02,90004)
WRITE (I02,90004)
WRITE (I02,90013)
WRITE (I02,90014)
WRITE (I02,90015) IVTOTL
CBE** ********************** BBCHED0B **********************************
C*****
CT001* TEST 1 ONE, SINCE LN(1.0) = 0.0
IVTNUM = 1
BVS = 1.0
AVS = ALOG10(BVS)
IF (AVS + 0.50000E-04) 20010, 10010, 40010
40010 IF (AVS - 0.50000E-04) 10010, 10010, 20010
10010 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0011
20010 IVFAIL = IVFAIL + 1
RVCORR = 0.00000000000000
WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR
0011 CONTINUE
CT002* TEST 2 A VALUE CLOSE TO TEN
IVTNUM = 2
AVS = ALOG10(9.875)
IF (AVS - 0.99448E+00) 20020, 10020, 40020
40020 IF (AVS - 0.99459E+00) 10020, 10020, 20020
10020 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0021
20020 IVFAIL = IVFAIL + 1
RVCORR = 0.99453710429850
WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR
0021 CONTINUE
CT003* TEST 3 THE VALUE 10.0
IVTNUM = 3
AVS = ALOG10(10.0)
IF (AVS - 0.99995E+00) 20030, 10030, 40030
40030 IF (AVS - 0.10001E+01) 10030, 10030, 20030
10030 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0031
20030 IVFAIL = IVFAIL + 1
RVCORR = 1.00000000000000
WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR
0031 CONTINUE
CT004* TEST 4 THE VALUE 20.5
IVTNUM = 4
AVS = ALOG10(20.5)
IF (AVS - 0.13116E+01) 20040, 10040, 40040
40040 IF (AVS - 0.13119E+01) 10040, 10040, 20040
10040 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0041
20040 IVFAIL = IVFAIL + 1
RVCORR = 1.31175386105575
WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR
0041 CONTINUE
CT005* TEST 5 THE VALUE 99.0
IVTNUM = 5
AVS = ALOG10(99.0)
IF (AVS - 0.19955E+01) 20050, 10050, 40050
40050 IF (AVS - 0.19958E+01) 10050, 10050, 20050
10050 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0051
20050 IVFAIL = IVFAIL + 1
RVCORR = 1.99563519459755
WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR
0051 CONTINUE
CT006* TEST 6 VARIABLES WITHIN AN EXPRESSION
IVTNUM = 6
BVS = 1.0
CVS = 8.0
AVS = ALOG10(3.0 * BVS / CVS)
IF (AVS + 0.42599E+00) 20060, 10060, 40060
40060 IF (AVS + 0.42594E+00) 10060, 10060, 20060
10060 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0061
20060 IVFAIL = IVFAIL + 1
RVCORR = -0.42596873227228
WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR
0061 CONTINUE
CT007* TEST 7 VARIABLES WITHIN AN EXPRESSION
IVTNUM = 7
BVS = 1.0
CVS = 8.0
AVS = ALOG10(5.0 * BVS / CVS)
IF (AVS + 0.20413E+00) 20070, 10070, 40070
40070 IF (AVS + 0.20411E+00) 10070, 10070, 20070
10070 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0071
20070 IVFAIL = IVFAIL + 1
RVCORR = -0.20411998265592
WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR
0071 CONTINUE
CT008* TEST 8 AN EXPRESSION SUPPLIED TO ALOG10
IVTNUM = 8
AVS = ALOG10(75.0 / 100.0)
IF (AVS + 0.12495E+00) 20080, 10080, 40080
40080 IF (AVS + 0.12493E+00) 10080, 10080, 20080
10080 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0081
20080 IVFAIL = IVFAIL + 1
RVCORR = -0.12493873660830
WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR
0081 CONTINUE
CT009* TEST 9 VARIABLES WITHIN AN EXPRESSION
IVTNUM = 9
BVS = 1.0
CVS = 8.0
AVS = ALOG10(7.0 * BVS / CVS)
IF (AVS + 0.57995E-01) 20090, 10090, 40090
40090 IF (AVS + 0.57989E-01) 10090, 10090, 20090
10090 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0091
20090 IVFAIL = IVFAIL + 1
RVCORR = -0.05799194697769
WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR
0091 CONTINUE
CT010* TEST 10 A VALUE CLOSE TO ONE
IVTNUM = 10
AVS = ALOG10(0.9921875)
IF (AVS + 0.34065E-02) 20100, 10100, 40100
40100 IF (AVS + 0.34060E-02) 10100, 10100, 20100
10100 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0101
20100 IVFAIL = IVFAIL + 1
RVCORR = -0.0034062486919115
WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR
0101 CONTINUE
CT011* TEST 11 A VALUE CLOSE TO ONE
IVTNUM = 11
BVS = 1.0009765625
AVS = ALOG10(BVS)
IF (AVS - 0.42388E-03) 20110, 10110, 40110
40110 IF (AVS - 0.42393E-03) 10110, 10110, 20110
10110 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0111
20110 IVFAIL = IVFAIL + 1
RVCORR = 0.00042390875196115
WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR
0111 CONTINUE
CT012* TEST 12 A VALUE CLOSE TO ZERO
IVTNUM = 12
BVS = 256.0
AVS = ALOG10(1.0 / BVS)
IF (AVS + 0.24084E+01) 20120, 10120, 40120
40120 IF (AVS + 0.24081E+01) 10120, 10120, 20120
10120 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0121
20120 IVFAIL = IVFAIL + 1
RVCORR = -2.40823996531185
WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR
0121 CONTINUE
CT013* TEST 13 A VALUE CLOSE TO ZERO
IVTNUM = 13
BVS = 128.0
AVS = ALOG10(1.0 / (BVS * 8.0))
IF (AVS + 0.30105E+01) 20130, 10130, 40130
40130 IF (AVS + 0.30101E+01) 10130, 10130, 20130
10130 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0131
20130 IVFAIL = IVFAIL + 1
RVCORR = -3.01029995663981
WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR
0131 CONTINUE
CT014* TEST 14 AN ARGUMENT OF HIGH MAGNITUDE
IVTNUM = 14
BVS = 2.0E+35
AVS = ALOG10(BVS)
IF (AVS - 0.35299E+02) 20140, 10140, 40140
40140 IF (AVS - 0.35303E+02) 10140, 10140, 20140
10140 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0141
20140 IVFAIL = IVFAIL + 1
RVCORR = 35.30102999566398
WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR
0141 CONTINUE
CT015* TEST 15 AN ARGUMENT OF LOW MAGNITUDE
IVTNUM = 15
BVS = 2.0E-35
AVS = ALOG10(BVS)
IF (AVS + 0.34701E+02) 20150, 10150, 40150
40150 IF (AVS + 0.34697E+02) 10150, 10150, 20150
10150 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0151
20150 IVFAIL = IVFAIL + 1
RVCORR = -34.69897000433602
WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR
0151 CONTINUE
CT016* TEST 16 THE FUNCTION APPLIED TWICE
IVTNUM = 16
AVS = ALOG10(20.0) - ALOG10(2.0)
IF (AVS - 0.99995E+00) 20160, 10160, 40160
40160 IF (AVS - 0.10001E+01) 10160, 10160, 20160
10160 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0161
20160 IVFAIL = IVFAIL + 1
RVCORR = 1.0000000
WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR
0161 CONTINUE
C*****
CBB** ********************** BBCSUM0 **********************************
C**** WRITE OUT TEST SUMMARY
C****
IVTOTN = IVPASS + IVFAIL + IVDELE + IVINSP
WRITE (I02, 90004)
WRITE (I02, 90014)
WRITE (I02, 90004)
WRITE (I02, 90020) IVPASS
WRITE (I02, 90022) IVFAIL
WRITE (I02, 90024) IVDELE
WRITE (I02, 90026) IVINSP
WRITE (I02, 90028) IVTOTN, IVTOTL
CBE** ********************** BBCSUM0 **********************************
CBB** ********************** BBCFOOT0 **********************************
C**** WRITE OUT REPORT FOOTINGS
C****
WRITE (I02,90016) ZPROG, ZPROG
WRITE (I02,90018) ZPROJ, ZNAME, ZTAPE, ZTAPED
WRITE (I02,90019)
CBE** ********************** BBCFOOT0 **********************************
CBB** ********************** BBCFMT0A **********************************
C**** FORMATS FOR TEST DETAIL LINES
C****
80000 FORMAT (1H ,2X,I3,4X,7HDELETED,32X,A31)
80002 FORMAT (1H ,2X,I3,4X,7H PASS ,32X,A31)
80004 FORMAT (1H ,2X,I3,4X,7HINSPECT,32X,A31)
80008 FORMAT (1H ,2X,I3,4X,7H FAIL ,32X,A31)
80010 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,15X,10HCOMPUTED= ,
1I6,/,1H ,15X,10HCORRECT= ,I6)
80012 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
1E12.5,/,1H ,16X,10HCORRECT= ,E12.5)
80018 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
1A21,/,1H ,16X,10HCORRECT= ,A21)
80020 FORMAT (1H ,16X,10HCOMPUTED= ,A21,1X,A31)
80022 FORMAT (1H ,16X,10HCORRECT= ,A21,1X,A31)
80024 FORMAT (1H ,16X,10HCOMPUTED= ,I6,16X,A31)
80026 FORMAT (1H ,16X,10HCORRECT= ,I6,16X,A31)
80028 FORMAT (1H ,16X,10HCOMPUTED= ,E12.5,10X,A31)
80030 FORMAT (1H ,16X,10HCORRECT= ,E12.5,10X,A31)
80050 FORMAT (1H ,48X,A31)
CBE** ********************** BBCFMT0A **********************************
CBB** ********************** BBCFMT0B **********************************
C**** FORMAT STATEMENTS FOR PAGE HEADERS
C****
90002 FORMAT (1H1)
90004 FORMAT (1H )
90006 FORMAT (1H ,20X,31HFEDERAL SOFTWARE TESTING CENTER)
90007 FORMAT (1H ,19X,34HFORTRAN COMPILER VALIDATION SYSTEM)
90008 FORMAT (1H ,21X,A13,A17)
90009 FORMAT (1H ,/,2H *,A5,6HBEGIN*,12X,15HTEST RESULTS - ,A5,/)
90010 FORMAT (1H ,8X,16HTEST DATE*TIME= ,A17,15H - COMPILER= ,A20)
90013 FORMAT (1H ,8H TEST ,10HPASS/FAIL ,6X,17HDISPLAYED RESULTS,
1 7X,7HREMARKS,24X)
90014 FORMAT (1H ,46H----------------------------------------------,
1 33H---------------------------------)
90015 FORMAT (1H ,48X,17HTHIS PROGRAM HAS ,I3,6H TESTS,/)
C****
C**** FORMAT STATEMENTS FOR REPORT FOOTINGS
C****
90016 FORMAT (1H ,/,2H *,A5,4HEND*,14X,14HEND OF TEST - ,A5,/)
90018 FORMAT (1H ,A13,13X,A20,7H * ,A10,1H/,
1 A13)
90019 FORMAT (1H ,26HFOR OFFICIAL USE ONLY ,35X,15HCOPYRIGHT 1982)
C****
C**** FORMAT STATEMENTS FOR RUN SUMMARY
C****
90020 FORMAT (1H ,21X,I5,13H TESTS PASSED)
90022 FORMAT (1H ,21X,I5,13H TESTS FAILED)
90024 FORMAT (1H ,21X,I5,14H TESTS DELETED)
90026 FORMAT (1H ,21X,I5,25H TESTS REQUIRE INSPECTION)
90028 FORMAT (1H ,21X,I5,4H OF ,I3,15H TESTS EXECUTED)
CBE** ********************** BBCFMT0B **********************************
C*****
C***** END OF TEST SEGMENT 184
STOP
END
*END-OF,FM371
FM372.f 481036307 170 2 100666 16140 `
*HEADER,FORTR,FM372
*FILES1,FORTR,FM372,X
C***********************************************************************
C***** FORTRAN 77
C***** FM372
C***** XSIN - (186)
C*****
C***********************************************************************
C***** GENERAL PURPOSE SUBSET REF
C***** TEST INTRINSIC FUNCTION SIN 15.3
C***** TABLE 5
C*****
CBB** ********************** BBCCOMNT **********************************
C****
C**** 1978 FORTRAN COMPILER VALIDATION SYSTEM
C**** VERSION 2.0
C****
C****
C**** SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO
C**** GENERAL SERVICES ADMINISTRATION
C**** FEDERAL SOFTWARE TESTING CENTER
C**** 5203 LEESBURG PIKE, SUITE 1100
C**** FALLS CHURCH, VA. 22041
C****
C**** (703) 756-6153
C****
CBE** ********************** BBCCOMNT **********************************
CBB** ********************** BBCINITA **********************************
C**** SPECIFICATION STATEMENTS
C****
CHARACTER ZVERS*13, ZVERSD*17, ZDATE*17, ZPROG*5, ZCOMPL*20,
1 ZNAME*20, ZTAPE*10, ZPROJ*13, REMRKS*31, ZTAPED*13
CBE** ********************** BBCINITA **********************************
CBB** ********************** BBCINITB **********************************
C**** INITIALIZE SECTION
DATA ZVERS, ZVERSD, ZDATE
1 /'VERSION 2.0 ', '82/08/02*18.33.46', '*NO DATE*TIME'/
DATA ZCOMPL, ZNAME, ZTAPE
1 /'*NONE SPECIFIED*', '*NO COMPANY NAME*', '*NO TAPE*'/
DATA ZPROJ, ZTAPED, ZPROG
1 /'*NO PROJECT*', '*NO TAPE DATE', 'XXXXX'/
DATA REMRKS /' '/
C**** THE FOLLOWING 9 COMMENT LINES (CZ01, CZ02, ...) CAN BE REPLACED
C**** FOR IDENTIFYING THE TEST ENVIRONMENT
C****
CZ01 ZVERS = 'VERSION OF THE COMPILER VALIDATION SYSTEM'
CZ02 ZVERSD = 'CREATION DATE/TIME OF THE COMPILER VALIDATION SYSTEM'
CZ03 ZPROG = 'PROGRAM NAME'
CZ04 ZDATE = 'DATE OF TEST'
CZ05 ZCOMPL = 'COMPILER IDENTIFICATION'
CZ06 ZPROJ = 'PROJECT NUMBER/IDENTIFICATION'
CZ07 ZNAME = 'NAME OF USER'
CZ08 ZTAPE = 'TAPE OWNER/ID'
CZ09 ZTAPED = 'DATE TAPE COPIED'
C
IVPASS = 0
IVFAIL = 0
IVDELE = 0
IVINSP = 0
IVTOTL = 0
IVTOTN = 0
ICZERO = 0
C
C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER.
I01 = 05
C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER.
I02 = 06
C
CX010 REPLACED BY FEXEC X-010 CONTROL CARD (CARD-READER UNIT NUMBER).
C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5
CX011 REPLACED BY FEXEC X-011 CONTROL CARD. CX011 IS FOR SYSTEMS
C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX010.
C
CX020 REPLACED BY FEXEC X-020 CONTROL CARD (PRINTER UNIT NUMBER).
C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02= 6
CX021 REPLACED BY FEXEC X-021 CONTROL CARD. CX021 IS FOR SYSTEMS
C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX020.
C
CBE** ********************** BBCINITB **********************************
NUVI = I02
IVTOTL = 18
ZPROG = 'FM372'
CBB** ********************** BBCHED0A **********************************
C****
C**** WRITE REPORT TITLE
C****
WRITE (I02, 90002)
WRITE (I02, 90006)
WRITE (I02, 90007)
WRITE (I02, 90008) ZVERS, ZVERSD
WRITE (I02, 90009) ZPROG, ZPROG
WRITE (I02, 90010) ZDATE, ZCOMPL
CBE** ********************** BBCHED0A **********************************
C*****
C***** HEADER FOR SEGMENT 186
WRITE(NUVI,18600)
18600 FORMAT(1H ,33H XSIN - (186) INTRINSIC FUNCTIONS//
1 12H SIN (SINE)//
2 20H SUBSET REF. - 15.3)
CBB** ********************** BBCHED0B **********************************
C**** WRITE DETAIL REPORT HEADERS
C****
WRITE (I02,90004)
WRITE (I02,90004)
WRITE (I02,90013)
WRITE (I02,90014)
WRITE (I02,90015) IVTOTL
CBE** ********************** BBCHED0B **********************************
C*****
PIVS = 3.1415926535897932384626434
C*****
CT001* TEST 1 ZERO (0.0), SINCE SIN(0)=0
IVTNUM = 1
BVS = 0.0
AVS = SIN(BVS)
IF (AVS + 0.50000E-04) 20010, 10010, 40010
40010 IF (AVS - 0.50000E-04) 10010, 10010, 20010
10010 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0011
20010 IVFAIL = IVFAIL + 1
RVCORR = 0.00000000000000
WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR
0011 CONTINUE
CT002* TEST 2 PI
IVTNUM = 2
AVS = SIN(PIVS)
IF (AVS + 0.50000E-04) 20020, 10020, 40020
40020 IF (AVS - 0.50000E-04) 10020, 10020, 20020
10020 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0021
20020 IVFAIL = IVFAIL + 1
RVCORR = 0.00000000000000
WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR
0021 CONTINUE
CT003* TEST 3 PI - 1/8
IVTNUM = 3
BVS = 3.0165926535
AVS = SIN(BVS)
IF (AVS - 0.12466E+00) 20030, 10030, 40030
40030 IF (AVS - 0.12468E+00) 10030, 10030, 20030
10030 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0031
20030 IVFAIL = IVFAIL + 1
RVCORR = 0.12467473338523
WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR
0031 CONTINUE
CT004* TEST 4 PI - 1/16
IVTNUM = 4
AVS = SIN(3.2040926535)
IF (AVS + 0.62463E-01) 20040, 10040, 40040
40040 IF (AVS + 0.62456E-01) 10040, 10040, 20040
10040 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0041
20040 IVFAIL = IVFAIL + 1
RVCORR = -0.06245931784238
WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR
0041 CONTINUE
CT005* TEST 5 2*PI
IVTNUM = 5
BVS = PIVS * 2.0
AVS = SIN(BVS)
IF (AVS + 0.50000E-04) 20050, 10050, 40050
40050 IF (AVS - 0.50000E-04) 10050, 10050, 20050
10050 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0051
20050 IVFAIL = IVFAIL + 1
RVCORR = 0.00000000000000
WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR
0051 CONTINUE
CT006* TEST 6 2*PI - 1/128
IVTNUM = 6
BVS = (2.0 * PIVS) - 1.0 / 128.0
AVS = SIN(BVS)
IF (AVS + 0.78129E-02) 20060, 10060, 40060
40060 IF (AVS + 0.78120E-02) 10060, 10060, 20060
10060 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0061
20060 IVFAIL = IVFAIL + 1
RVCORR = -0.00781242052738
WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR
0061 CONTINUE
CT007* TEST 7 THE VALUE 2.0
IVTNUM = 7
BVS = 2.0
AVS = SIN(BVS)
IF (AVS - 0.90925E+00) 20070, 10070, 40070
40070 IF (AVS - 0.90935E+00) 10070, 10070, 20070
10070 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0071
20070 IVFAIL = IVFAIL + 1
RVCORR = 0.90929742682568
WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR
0071 CONTINUE
CT008* TEST 8 THE VALUE -2.0
IVTNUM = 8
BVS = -2.0
AVS = SIN(BVS)
IF (AVS + 0.90935E+00) 20080, 10080, 40080
40080 IF (AVS + 0.90925E+00) 10080, 10080, 20080
10080 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0081
20080 IVFAIL = IVFAIL + 1
RVCORR = -0.90929742682568
WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR
0081 CONTINUE
CT009* TEST 09 A LARGE VALUE TO TEST ARGUMENT REDUCTION
IVTNUM = 09
AVS = SIN(100.0)
IF (AVS + 0.50639E+00) 20090, 10090, 40090
40090 IF (AVS + 0.50634E+00) 10090, 10090, 20090
10090 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0091
20090 IVFAIL = IVFAIL + 1
RVCORR = -0.50636564110976
WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR
0091 CONTINUE
CT010* TEST 10 A VERY LARGE VALUE
IVTNUM = 10
AVS = SIN(-1000.0)
IF (AVS + 0.82692E+00) 20100, 10100, 40100
40100 IF (AVS + 0.82683E+00) 10100, 10100, 20100
10100 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0101
20100 IVFAIL = IVFAIL + 1
RVCORR = -0.82687954053200
WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR
0101 CONTINUE
CT011* TEST 11 PI/2
IVTNUM = 11
AVS = SIN(1.5707963268)
IF (AVS - 0.99995E+00) 20110, 10110, 40110
40110 IF (AVS - 0.10001E+01) 10110, 10110, 20110
10110 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0111
20110 IVFAIL = IVFAIL + 1
RVCORR = 1.00000000000000
WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR
0111 CONTINUE
CT012* TEST 12 PI/2 - 1/32
IVTNUM = 12
BVS = 1.5395463268
AVS = SIN(BVS)
IF (AVS - 0.99946E+00) 20120, 10120, 40120
40120 IF (AVS - 0.99957E+00) 10120, 10120, 20120
10120 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0121
20120 IVFAIL = IVFAIL + 1
RVCORR = 0.99951175848514
WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR
0121 CONTINUE
CT013* TEST 13 PI/2 - 1/64
IVTNUM = 13
AVS = SIN(1.5864213268)
IF (AVS - 0.99982E+00) 20130, 10130, 40130
40130 IF (AVS - 0.99993E+00) 10130, 10130, 20130
10130 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0131
20130 IVFAIL = IVFAIL + 1
RVCORR = 0.99987793217101
WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR
0131 CONTINUE
CT014* TEST 14 3*PI/2
IVTNUM = 14
BVS = 3.0 * PIVS / 2.0
AVS = SIN(BVS)
IF (AVS + 0.10001E+01) 20140, 10140, 40140
40140 IF (AVS + 0.99995E+00) 10140, 10140, 20140
10140 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0141
20140 IVFAIL = IVFAIL + 1
RVCORR = -1.00000000000000
WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR
0141 CONTINUE
CT015* TEST 15 3*PI/2 - 1/16
IVTNUM = 15
BVS = (3.0 * PIVS / 2.0) - 1.0 / 16.0
AVS = SIN(BVS)
IF (AVS + 0.99810E+00) 20150, 10150, 40150
40150 IF (AVS + 0.99799E+00) 10150, 10150, 20150
10150 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0151
20150 IVFAIL = IVFAIL + 1
RVCORR = -0.99804751070010
WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR
0151 CONTINUE
CT016* TEST 16 3*PI/2 - 1/512
IVTNUM = 16
BVS = (3.0 * PIVS / 2.0) + 1.0 / 512.0
AVS = SIN(BVS)
IF (AVS + 0.10001E+01) 20160, 10160, 40160
40160 IF (AVS + 0.99994E+00) 10160, 10160, 20160
10160 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0161
20160 IVFAIL = IVFAIL + 1
RVCORR = -0.99999809265197
WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR
0161 CONTINUE
CT017* TEST 17 ARGUMENT OF LOW MAGNITUDE
IVTNUM = 17
BVS = PIVS * 1.0E-37
AVS = SIN(BVS)
IF (AVS + 0.50000E-04) 20170, 10170, 40170
40170 IF (AVS - 0.50000E-04) 10170, 10170, 20170
10170 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0171
20170 IVFAIL = IVFAIL + 1
RVCORR = 3.14159265358979E-37
WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR
0171 CONTINUE
CT018* TEST 18 THE FUNCTION APPLIED TWICE
IVTNUM = 18
AVS = SIN(PIVS / 4.0) * SIN(3.0 * PIVS / 4.0)
IF (AVS - 0.49997E+00) 20180, 10180, 40180
40180 IF (AVS - 0.50003E+00) 10180, 10180, 20180
10180 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0181
20180 IVFAIL = IVFAIL + 1
RVCORR = 0.50000000000000
WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR
0181 CONTINUE
C*****
CBB** ********************** BBCSUM0 **********************************
C**** WRITE OUT TEST SUMMARY
C****
IVTOTN = IVPASS + IVFAIL + IVDELE + IVINSP
WRITE (I02, 90004)
WRITE (I02, 90014)
WRITE (I02, 90004)
WRITE (I02, 90020) IVPASS
WRITE (I02, 90022) IVFAIL
WRITE (I02, 90024) IVDELE
WRITE (I02, 90026) IVINSP
WRITE (I02, 90028) IVTOTN, IVTOTL
CBE** ********************** BBCSUM0 **********************************
CBB** ********************** BBCFOOT0 **********************************
C**** WRITE OUT REPORT FOOTINGS
C****
WRITE (I02,90016) ZPROG, ZPROG
WRITE (I02,90018) ZPROJ, ZNAME, ZTAPE, ZTAPED
WRITE (I02,90019)
CBE** ********************** BBCFOOT0 **********************************
CBB** ********************** BBCFMT0A **********************************
C**** FORMATS FOR TEST DETAIL LINES
C****
80000 FORMAT (1H ,2X,I3,4X,7HDELETED,32X,A31)
80002 FORMAT (1H ,2X,I3,4X,7H PASS ,32X,A31)
80004 FORMAT (1H ,2X,I3,4X,7HINSPECT,32X,A31)
80008 FORMAT (1H ,2X,I3,4X,7H FAIL ,32X,A31)
80010 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,15X,10HCOMPUTED= ,
1I6,/,1H ,15X,10HCORRECT= ,I6)
80012 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
1E12.5,/,1H ,16X,10HCORRECT= ,E12.5)
80018 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
1A21,/,1H ,16X,10HCORRECT= ,A21)
80020 FORMAT (1H ,16X,10HCOMPUTED= ,A21,1X,A31)
80022 FORMAT (1H ,16X,10HCORRECT= ,A21,1X,A31)
80024 FORMAT (1H ,16X,10HCOMPUTED= ,I6,16X,A31)
80026 FORMAT (1H ,16X,10HCORRECT= ,I6,16X,A31)
80028 FORMAT (1H ,16X,10HCOMPUTED= ,E12.5,10X,A31)
80030 FORMAT (1H ,16X,10HCORRECT= ,E12.5,10X,A31)
80050 FORMAT (1H ,48X,A31)
CBE** ********************** BBCFMT0A **********************************
CBB** ********************** BBCFMT0B **********************************
C**** FORMAT STATEMENTS FOR PAGE HEADERS
C****
90002 FORMAT (1H1)
90004 FORMAT (1H )
90006 FORMAT (1H ,20X,31HFEDERAL SOFTWARE TESTING CENTER)
90007 FORMAT (1H ,19X,34HFORTRAN COMPILER VALIDATION SYSTEM)
90008 FORMAT (1H ,21X,A13,A17)
90009 FORMAT (1H ,/,2H *,A5,6HBEGIN*,12X,15HTEST RESULTS - ,A5,/)
90010 FORMAT (1H ,8X,16HTEST DATE*TIME= ,A17,15H - COMPILER= ,A20)
90013 FORMAT (1H ,8H TEST ,10HPASS/FAIL ,6X,17HDISPLAYED RESULTS,
1 7X,7HREMARKS,24X)
90014 FORMAT (1H ,46H----------------------------------------------,
1 33H---------------------------------)
90015 FORMAT (1H ,48X,17HTHIS PROGRAM HAS ,I3,6H TESTS,/)
C****
C**** FORMAT STATEMENTS FOR REPORT FOOTINGS
C****
90016 FORMAT (1H ,/,2H *,A5,4HEND*,14X,14HEND OF TEST - ,A5,/)
90018 FORMAT (1H ,A13,13X,A20,7H * ,A10,1H/,
1 A13)
90019 FORMAT (1H ,26HFOR OFFICIAL USE ONLY ,35X,15HCOPYRIGHT 1982)
C****
C**** FORMAT STATEMENTS FOR RUN SUMMARY
C****
90020 FORMAT (1H ,21X,I5,13H TESTS PASSED)
90022 FORMAT (1H ,21X,I5,13H TESTS FAILED)
90024 FORMAT (1H ,21X,I5,14H TESTS DELETED)
90026 FORMAT (1H ,21X,I5,25H TESTS REQUIRE INSPECTION)
90028 FORMAT (1H ,21X,I5,4H OF ,I3,15H TESTS EXECUTED)
CBE** ********************** BBCFMT0B **********************************
C*****
C***** END OF TEST SEGMENT 186
STOP
END
*END-OF,FM372
FM373.f 481036311 170 2 100666 16643 `
*HEADER,FORTR,FM373
*FILES1,FORTR,FM373,X
C***********************************************************************
C***** FORTRAN 77
C***** FM373
C***** XCOS - (189)
C*****
C***********************************************************************
C***** GENERAL PURPOSE SUBSET REF
C***** TEST INTRINSIC FUNCTION COS 15.3
C***** TABLE 5
C*****
CBB** ********************** BBCCOMNT **********************************
C****
C**** 1978 FORTRAN COMPILER VALIDATION SYSTEM
C**** VERSION 2.0
C****
C****
C**** SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO
C**** GENERAL SERVICES ADMINISTRATION
C**** FEDERAL SOFTWARE TESTING CENTER
C**** 5203 LEESBURG PIKE, SUITE 1100
C**** FALLS CHURCH, VA. 22041
C****
C**** (703) 756-6153
C****
CBE** ********************** BBCCOMNT **********************************
CBB** ********************** BBCINITA **********************************
C**** SPECIFICATION STATEMENTS
C****
CHARACTER ZVERS*13, ZVERSD*17, ZDATE*17, ZPROG*5, ZCOMPL*20,
1 ZNAME*20, ZTAPE*10, ZPROJ*13, REMRKS*31, ZTAPED*13
CBE** ********************** BBCINITA **********************************
CBB** ********************** BBCINITB **********************************
C**** INITIALIZE SECTION
DATA ZVERS, ZVERSD, ZDATE
1 /'VERSION 2.0 ', '82/08/02*18.33.46', '*NO DATE*TIME'/
DATA ZCOMPL, ZNAME, ZTAPE
1 /'*NONE SPECIFIED*', '*NO COMPANY NAME*', '*NO TAPE*'/
DATA ZPROJ, ZTAPED, ZPROG
1 /'*NO PROJECT*', '*NO TAPE DATE', 'XXXXX'/
DATA REMRKS /' '/
C**** THE FOLLOWING 9 COMMENT LINES (CZ01, CZ02, ...) CAN BE REPLACED
C**** FOR IDENTIFYING THE TEST ENVIRONMENT
C****
CZ01 ZVERS = 'VERSION OF THE COMPILER VALIDATION SYSTEM'
CZ02 ZVERSD = 'CREATION DATE/TIME OF THE COMPILER VALIDATION SYSTEM'
CZ03 ZPROG = 'PROGRAM NAME'
CZ04 ZDATE = 'DATE OF TEST'
CZ05 ZCOMPL = 'COMPILER IDENTIFICATION'
CZ06 ZPROJ = 'PROJECT NUMBER/IDENTIFICATION'
CZ07 ZNAME = 'NAME OF USER'
CZ08 ZTAPE = 'TAPE OWNER/ID'
CZ09 ZTAPED = 'DATE TAPE COPIED'
C
IVPASS = 0
IVFAIL = 0
IVDELE = 0
IVINSP = 0
IVTOTL = 0
IVTOTN = 0
ICZERO = 0
C
C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER.
I01 = 05
C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER.
I02 = 06
C
CX010 REPLACED BY FEXEC X-010 CONTROL CARD (CARD-READER UNIT NUMBER).
C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5
CX011 REPLACED BY FEXEC X-011 CONTROL CARD. CX011 IS FOR SYSTEMS
C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX010.
C
CX020 REPLACED BY FEXEC X-020 CONTROL CARD (PRINTER UNIT NUMBER).
C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02= 6
CX021 REPLACED BY FEXEC X-021 CONTROL CARD. CX021 IS FOR SYSTEMS
C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX020.
C
CBE** ********************** BBCINITB **********************************
NUVI = I02
IVTOTL = 19
ZPROG = 'FM373'
CBB** ********************** BBCHED0A **********************************
C****
C**** WRITE REPORT TITLE
C****
WRITE (I02, 90002)
WRITE (I02, 90006)
WRITE (I02, 90007)
WRITE (I02, 90008) ZVERS, ZVERSD
WRITE (I02, 90009) ZPROG, ZPROG
WRITE (I02, 90010) ZDATE, ZCOMPL
CBE** ********************** BBCHED0A **********************************
C*****
C***** HEADER FOR SEGMENT 189
WRITE(NUVI,18900)
18900 FORMAT(1H /33H XCOS - (189) INTRINSIC FUNCTIONS//
1 14H COS (COSINE)//
2 20H SUBSET REF. - 15.3)
CBB** ********************** BBCHED0B **********************************
C**** WRITE DETAIL REPORT HEADERS
C****
WRITE (I02,90004)
WRITE (I02,90004)
WRITE (I02,90013)
WRITE (I02,90014)
WRITE (I02,90015) IVTOTL
CBE** ********************** BBCHED0B **********************************
C*****
PIVS = 3.1415926535897932384626434
C*****
CT001* TEST 1 ZERO (0.0), SINCE COS(0)=1
IVTNUM = 1
BVS = 0.0
AVS = COS(BVS)
IF (AVS - 0.99995E+00) 20010, 10010, 40010
40010 IF (AVS - 0.10001E+01) 10010, 10010, 20010
10010 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0011
20010 IVFAIL = IVFAIL + 1
RVCORR = 1.00000000000000
WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR
0011 CONTINUE
CT002* TEST 2 VALUES NEAR PI
IVTNUM = 2
AVS = COS(PIVS)
IF (AVS + 0.10001E+01) 20020, 10020, 40020
40020 IF (AVS + 0.99995E+00) 10020, 10020, 20020
10020 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0021
20020 IVFAIL = IVFAIL + 1
RVCORR = -1.00000000000000
WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR
0021 CONTINUE
CT003* TEST 3 PI - 1/16
IVTNUM = 3
BVS = 3.0790926536
AVS = COS(BVS)
IF (AVS + 0.99810E+00) 20030, 10030, 40030
40030 IF (AVS + 0.99799E+00) 10030, 10030, 20030
10030 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0031
20030 IVFAIL = IVFAIL + 1
RVCORR = -0.99804751070010
WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR
0031 CONTINUE
CT004* TEST 4 PI + 1/32
IVTNUM = 4
AVS = COS(3.1728426535)
IF (AVS + 0.99957E+00) 20040, 10040, 40040
40040 IF (AVS + 0.99946E+00) 10040, 10040, 20040
10040 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0041
20040 IVFAIL = IVFAIL + 1
RVCORR = -0.99951175848514
WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR
0041 CONTINUE
CT005* TEST 5 VALUES NEAR 2*PI
IVTNUM = 5
BVS = PIVS * 2.0
AVS = COS(BVS)
IF (AVS - 0.99995E+00) 20050, 10050, 40050
40050 IF (AVS - 0.10001E+01) 10050, 10050, 20050
10050 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0051
20050 IVFAIL = IVFAIL + 1
RVCORR = 1.00000000000000
WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR
0051 CONTINUE
CT006* TEST 6 VALUES NEAR 2*PI
IVTNUM = 6
BVS = (2.0 * PIVS) - 1.0 / 64.0
AVS = COS(BVS)
IF (AVS - 0.99982E+00) 20060, 10060, 40060
40060 IF (AVS - 0.99993E+00) 10060, 10060, 20060
10060 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0061
20060 IVFAIL = IVFAIL + 1
RVCORR = 0.99987793217101
WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR
0061 CONTINUE
CT007* TEST 7 VALUES NEAR 2*PI
IVTNUM = 7
BVS = (2.0 * PIVS) + 1.0 / 128.0
AVS = COS(BVS)
IF (AVS - 0.99992E+00) 20070, 10070, 40070
40070 IF (AVS - 0.10001E+01) 10070, 10070, 20070
10070 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0071
20070 IVFAIL = IVFAIL + 1
RVCORR = 0.99996948257710
WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR
0071 CONTINUE
CT008* TEST 8 AN EXPRESSION PRESENTED TO COS
IVTNUM = 8
BVS = 350.0
AVS = COS(BVS / 100.0)
IF (AVS + 0.93651E+00) 20080, 10080, 40080
40080 IF (AVS + 0.93641E+00) 10080, 10080, 20080
10080 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0081
20080 IVFAIL = IVFAIL + 1
RVCORR = -0.93645668729080
WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR
0081 CONTINUE
CT009* TEST 9 A NEGATIVE ARGUMENT
IVTNUM = 9
BVS = -1.5
AVS = COS(BVS)
IF (AVS - 0.70733E-01) 20090, 10090, 40090
40090 IF (AVS - 0.70741E-01) 10090, 10090, 20090
10090 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0091
20090 IVFAIL = IVFAIL + 1
RVCORR = 0.07073720166770
WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR
0091 CONTINUE
CT010* TEST 10 TEST LARGE VALUES FOR ARGUMENT REDUCTION
IVTNUM = 10
AVS = COS(200.0)
IF (AVS - 0.48716E+00) 20100, 10100, 40100
40100 IF (AVS - 0.48722E+00) 10100, 10100, 20100
10100 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0101
20100 IVFAIL = IVFAIL + 1
RVCORR = 0.48718767500701
WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR
0101 CONTINUE
CT011* TEST 11 TEST LARGE VALUES FOR ARGUMENT REDUCTION
IVTNUM = 11
AVS = COS(-31416.0)
IF (AVS - 0.99725E+00) 20110, 10110, 40110
40110 IF (AVS - 0.99736E+00) 10110, 10110, 20110
10110 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0111
20110 IVFAIL = IVFAIL + 1
RVCORR = 0.99730272627420
WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR
0111 CONTINUE
CT012* TEST 12 TEST VALUES NEAR PI/2
IVTNUM = 12
AVS = COS(1.5707963268)
IF (AVS + 0.50000E-04) 20120, 10120, 40120
40120 IF (AVS - 0.50000E-04) 10120, 10120, 20120
10120 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0121
20120 IVFAIL = IVFAIL + 1
RVCORR = 0.00000000000000
WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR
0121 CONTINUE
CT013* TEST 13 (PI / 2) - 1/32
IVTNUM = 13
BVS = (1.5395463267)
AVS = COS(BVS)
IF (AVS - 0.31243E-01) 20130, 10130, 40130
40130 IF (AVS - 0.31247E-01) 10130, 10130, 20130
10130 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0131
20130 IVFAIL = IVFAIL + 1
RVCORR = 0.03124491398533
WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR
0131 CONTINUE
CT014* TEST 14 (PI / 2) + 1/16
IVTNUM = 14
AVS = COS(1.6332963267)
IF (AVS + 0.62463E-01) 20140, 10140, 40140
40140 IF (AVS + 0.62456E-01) 10140, 10140, 20140
10140 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0141
20140 IVFAIL = IVFAIL + 1
RVCORR = -0.06245931784238
WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR
0141 CONTINUE
CT015* TEST 15 TEST VALUES NEAR 3*PI/2
IVTNUM = 15
BVS = 3.0 * PIVS / 2.0
AVS = COS(BVS)
IF (AVS + 0.50000E-04) 20150, 10150, 40150
40150 IF (AVS - 0.50000E-04) 10150, 10150, 20150
10150 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0151
20150 IVFAIL = IVFAIL + 1
RVCORR = 0.00000000000000
WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR
0151 CONTINUE
CT016* TEST 16 TEST VALUES NEAR 3*PI/2
IVTNUM = 16
BVS = (3.0 * PIVS / 2.0) - 1.0 / 16.0
AVS = COS(BVS)
IF (AVS + 0.62463E-01) 20160, 10160, 40160
40160 IF (AVS + 0.62456E-01) 10160, 10160, 20160
10160 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0161
20160 IVFAIL = IVFAIL + 1
RVCORR = -0.06245931784238
WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR
0161 CONTINUE
CT017* TEST 17 TEST VALUES NEAR 3*PI/2
IVTNUM = 17
BVS = (3.0 * PIVS / 2.0) + 1.0 / 512.0
AVS = COS(BVS)
IF (AVS - 0.19530E-02) 20170, 10170, 40170
40170 IF (AVS - 0.19533E-02) 10170, 10170, 20170
10170 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0171
20170 IVFAIL = IVFAIL + 1
RVCORR = 0.00195312375824
WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR
0171 CONTINUE
CT018* TEST 18 ARGUMENT OF LOW MAGNITUDE
IVTNUM = 18
BVS = -3.141593E-35
AVS = COS(BVS)
IF (AVS - 0.99995E+00) 20180, 10180, 40180
40180 IF (AVS - 0.10001E+01) 10180, 10180, 20180
10180 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0181
20180 IVFAIL = IVFAIL + 1
RVCORR = 1.00000000000000
WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR
0181 CONTINUE
CT019* TEST 19 THE FUNCTION APPLIED TWICE
IVTNUM = 19
AVS = COS(PIVS / 4.0) * COS(3.0 * PIVS / 4.0)
IF (AVS + 0.50003E+00) 20190, 10190, 40190
40190 IF (AVS + 0.49997E+00) 10190, 10190, 20190
10190 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0191
20190 IVFAIL = IVFAIL + 1
RVCORR = -0.50000000000000
WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR
0191 CONTINUE
C*****
CBB** ********************** BBCSUM0 **********************************
C**** WRITE OUT TEST SUMMARY
C****
IVTOTN = IVPASS + IVFAIL + IVDELE + IVINSP
WRITE (I02, 90004)
WRITE (I02, 90014)
WRITE (I02, 90004)
WRITE (I02, 90020) IVPASS
WRITE (I02, 90022) IVFAIL
WRITE (I02, 90024) IVDELE
WRITE (I02, 90026) IVINSP
WRITE (I02, 90028) IVTOTN, IVTOTL
CBE** ********************** BBCSUM0 **********************************
CBB** ********************** BBCFOOT0 **********************************
C**** WRITE OUT REPORT FOOTINGS
C****
WRITE (I02,90016) ZPROG, ZPROG
WRITE (I02,90018) ZPROJ, ZNAME, ZTAPE, ZTAPED
WRITE (I02,90019)
CBE** ********************** BBCFOOT0 **********************************
CBB** ********************** BBCFMT0A **********************************
C**** FORMATS FOR TEST DETAIL LINES
C****
80000 FORMAT (1H ,2X,I3,4X,7HDELETED,32X,A31)
80002 FORMAT (1H ,2X,I3,4X,7H PASS ,32X,A31)
80004 FORMAT (1H ,2X,I3,4X,7HINSPECT,32X,A31)
80008 FORMAT (1H ,2X,I3,4X,7H FAIL ,32X,A31)
80010 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,15X,10HCOMPUTED= ,
1I6,/,1H ,15X,10HCORRECT= ,I6)
80012 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
1E12.5,/,1H ,16X,10HCORRECT= ,E12.5)
80018 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
1A21,/,1H ,16X,10HCORRECT= ,A21)
80020 FORMAT (1H ,16X,10HCOMPUTED= ,A21,1X,A31)
80022 FORMAT (1H ,16X,10HCORRECT= ,A21,1X,A31)
80024 FORMAT (1H ,16X,10HCOMPUTED= ,I6,16X,A31)
80026 FORMAT (1H ,16X,10HCORRECT= ,I6,16X,A31)
80028 FORMAT (1H ,16X,10HCOMPUTED= ,E12.5,10X,A31)
80030 FORMAT (1H ,16X,10HCORRECT= ,E12.5,10X,A31)
80050 FORMAT (1H ,48X,A31)
CBE** ********************** BBCFMT0A **********************************
CBB** ********************** BBCFMT0B **********************************
C**** FORMAT STATEMENTS FOR PAGE HEADERS
C****
90002 FORMAT (1H1)
90004 FORMAT (1H )
90006 FORMAT (1H ,20X,31HFEDERAL SOFTWARE TESTING CENTER)
90007 FORMAT (1H ,19X,34HFORTRAN COMPILER VALIDATION SYSTEM)
90008 FORMAT (1H ,21X,A13,A17)
90009 FORMAT (1H ,/,2H *,A5,6HBEGIN*,12X,15HTEST RESULTS - ,A5,/)
90010 FORMAT (1H ,8X,16HTEST DATE*TIME= ,A17,15H - COMPILER= ,A20)
90013 FORMAT (1H ,8H TEST ,10HPASS/FAIL ,6X,17HDISPLAYED RESULTS,
1 7X,7HREMARKS,24X)
90014 FORMAT (1H ,46H----------------------------------------------,
1 33H---------------------------------)
90015 FORMAT (1H ,48X,17HTHIS PROGRAM HAS ,I3,6H TESTS,/)
C****
C**** FORMAT STATEMENTS FOR REPORT FOOTINGS
C****
90016 FORMAT (1H ,/,2H *,A5,4HEND*,14X,14HEND OF TEST - ,A5,/)
90018 FORMAT (1H ,A13,13X,A20,7H * ,A10,1H/,
1 A13)
90019 FORMAT (1H ,26HFOR OFFICIAL USE ONLY ,35X,15HCOPYRIGHT 1982)
C****
C**** FORMAT STATEMENTS FOR RUN SUMMARY
C****
90020 FORMAT (1H ,21X,I5,13H TESTS PASSED)
90022 FORMAT (1H ,21X,I5,13H TESTS FAILED)
90024 FORMAT (1H ,21X,I5,14H TESTS DELETED)
90026 FORMAT (1H ,21X,I5,25H TESTS REQUIRE INSPECTION)
90028 FORMAT (1H ,21X,I5,4H OF ,I3,15H TESTS EXECUTED)
CBE** ********************** BBCFMT0B **********************************
C*****
C***** END OF TEST SEGMENT 189
STOP
END
*END-OF,FM373
FM374.f 481036315 170 2 100666 14095 `
*HEADER,FORTR,FM374
*FILES1,FORTR,FM374,X
C***********************************************************************
C***** FORTRAN 77
C***** FM374
C***** XTAN - (191)
C*****
C***********************************************************************
C***** GENERAL PURPOSE SUBSET REF
C***** TEST INTRINSIC FUNCTION TAN 15.3
C***** TABLE 5
C*****
CBB** ********************** BBCCOMNT **********************************
C****
C**** 1978 FORTRAN COMPILER VALIDATION SYSTEM
C**** VERSION 2.0
C****
C****
C**** SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO
C**** GENERAL SERVICES ADMINISTRATION
C**** FEDERAL SOFTWARE TESTING CENTER
C**** 5203 LEESBURG PIKE, SUITE 1100
C**** FALLS CHURCH, VA. 22041
C****
C**** (703) 756-6153
C****
CBE** ********************** BBCCOMNT **********************************
CBB** ********************** BBCINITA **********************************
C**** SPECIFICATION STATEMENTS
C****
CHARACTER ZVERS*13, ZVERSD*17, ZDATE*17, ZPROG*5, ZCOMPL*20,
1 ZNAME*20, ZTAPE*10, ZPROJ*13, REMRKS*31, ZTAPED*13
CBE** ********************** BBCINITA **********************************
CBB** ********************** BBCINITB **********************************
C**** INITIALIZE SECTION
DATA ZVERS, ZVERSD, ZDATE
1 /'VERSION 2.0 ', '82/08/02*18.33.46', '*NO DATE*TIME'/
DATA ZCOMPL, ZNAME, ZTAPE
1 /'*NONE SPECIFIED*', '*NO COMPANY NAME*', '*NO TAPE*'/
DATA ZPROJ, ZTAPED, ZPROG
1 /'*NO PROJECT*', '*NO TAPE DATE', 'XXXXX'/
DATA REMRKS /' '/
C**** THE FOLLOWING 9 COMMENT LINES (CZ01, CZ02, ...) CAN BE REPLACED
C**** FOR IDENTIFYING THE TEST ENVIRONMENT
C****
CZ01 ZVERS = 'VERSION OF THE COMPILER VALIDATION SYSTEM'
CZ02 ZVERSD = 'CREATION DATE/TIME OF THE COMPILER VALIDATION SYSTEM'
CZ03 ZPROG = 'PROGRAM NAME'
CZ04 ZDATE = 'DATE OF TEST'
CZ05 ZCOMPL = 'COMPILER IDENTIFICATION'
CZ06 ZPROJ = 'PROJECT NUMBER/IDENTIFICATION'
CZ07 ZNAME = 'NAME OF USER'
CZ08 ZTAPE = 'TAPE OWNER/ID'
CZ09 ZTAPED = 'DATE TAPE COPIED'
C
IVPASS = 0
IVFAIL = 0
IVDELE = 0
IVINSP = 0
IVTOTL = 0
IVTOTN = 0
ICZERO = 0
C
C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER.
I01 = 05
C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER.
I02 = 06
C
CX010 REPLACED BY FEXEC X-010 CONTROL CARD (CARD-READER UNIT NUMBER).
C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5
CX011 REPLACED BY FEXEC X-011 CONTROL CARD. CX011 IS FOR SYSTEMS
C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX010.
C
CX020 REPLACED BY FEXEC X-020 CONTROL CARD (PRINTER UNIT NUMBER).
C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02= 6
CX021 REPLACED BY FEXEC X-021 CONTROL CARD. CX021 IS FOR SYSTEMS
C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX020.
C
CBE** ********************** BBCINITB **********************************
NUVI = I02
IVTOTL = 14
ZPROG = 'FM374'
CBB** ********************** BBCHED0A **********************************
C****
C**** WRITE REPORT TITLE
C****
WRITE (I02, 90002)
WRITE (I02, 90006)
WRITE (I02, 90007)
WRITE (I02, 90008) ZVERS, ZVERSD
WRITE (I02, 90009) ZPROG, ZPROG
WRITE (I02, 90010) ZDATE, ZCOMPL
CBE** ********************** BBCHED0A **********************************
C*****
C***** HEADER FOR SEGMENT 191
WRITE(NUVI,19100)
19100 FORMAT(1H , / 34H XTAN - (191) INTRINSIC FUNCTIONS//
1 17H TAN (TANGENT)//
2 20H SUBSET REF. - 15.3)
CBB** ********************** BBCHED0B **********************************
C**** WRITE DETAIL REPORT HEADERS
C****
WRITE (I02,90004)
WRITE (I02,90004)
WRITE (I02,90013)
WRITE (I02,90014)
WRITE (I02,90015) IVTOTL
CBE** ********************** BBCHED0B **********************************
C*****
PIVS = 3.1415926535897932384626434
C*****
CT001* TEST 1 ZERO (0.0), SINCE TAN(0) = 0
IVTNUM = 1
BVS = 0.0
AVS = TAN(BVS)
IF (AVS + 0.00005) 20010, 10010, 40010
40010 IF (AVS - 0.00005) 10010, 10010, 20010
10010 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0011
20010 IVFAIL = IVFAIL + 1
RVCORR = 0.0
WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR
0011 CONTINUE
CT002* TEST 2 2*PI
IVTNUM = 2
BVS = 6.2831853071
AVS = TAN(BVS)
IF (AVS + 0.00005) 20020, 10020, 40020
40020 IF (AVS - 0.00005) 10020, 10020, 20020
10020 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0021
20020 IVFAIL = IVFAIL + 1
RVCORR = 0.0
WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR
0021 CONTINUE
CT003* TEST 3 3*PI
IVTNUM = 3
BVS = 9.424777960
AVS = TAN(BVS)
IF (AVS + 0.00005) 20030, 10030, 40030
40030 IF (AVS - 0.00005) 10030, 10030, 20030
10030 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0031
20030 IVFAIL = IVFAIL + 1
RVCORR = 0.0
WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR
0031 CONTINUE
CT004* TEST 4 PI/4
IVTNUM = 4
AVS = TAN(PIVS / 4.0)
IF (AVS - 0.99995) 20040, 10040, 40040
40040 IF (AVS - 1.0001) 10040, 10040, 20040
10040 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0041
20040 IVFAIL = IVFAIL + 1
RVCORR = 1.0
WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR
0041 CONTINUE
CT005* TEST 5 5*PI/4
IVTNUM = 5
BVS = 5.0 * PIVS / 4.0
AVS = TAN(BVS)
IF (AVS - 0.99995) 20050, 10050, 40050
40050 IF (AVS - 1.0001) 10050, 10050, 20050
10050 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0051
20050 IVFAIL = IVFAIL + 1
RVCORR = 1.0
WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR
0051 CONTINUE
CT006* TEST 6 A NEGATIVE VALUE
IVTNUM = 6
BVS = -2.0 / 1.0
AVS = TAN(BVS)
IF (AVS - 2.1849) 20060, 10060, 40060
40060 IF (AVS - 2.1852) 10060, 10060, 20060
10060 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0061
20060 IVFAIL = IVFAIL + 1
RVCORR = 2.18503986326151
WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR
0061 CONTINUE
CT007* TEST 7 A POSITIVE VALUE
IVTNUM = 7
BVS = 350.0 / 100.0
AVS = TAN(BVS)
IF (AVS - 0.37456) 20070, 10070, 40070
40070 IF (AVS - 0.37461) 10070, 10070, 20070
10070 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0071
20070 IVFAIL = IVFAIL + 1
RVCORR = 0.37458564015859
WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR
0071 CONTINUE
CT008* TEST 8 (PI / 2) - 1/8
IVTNUM = 8
BVS = 1.4457963267
AVS = TAN(BVS)
IF (AVS - 7.9578) 20080, 10080, 40080
40080 IF (AVS - 7.9587) 10080, 10080, 20080
10080 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0081
20080 IVFAIL = IVFAIL + 1
RVCORR = 7.95828986586701
WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR
0081 CONTINUE
CT009* TEST 9 (PI / 2) + 1/256
IVTNUM = 9
BVS = 1.5747025767
AVS = TAN(BVS)
IF (AVS + 256.02) 20090, 10090, 40090
40090 IF (AVS + 255.98) 10090, 10090, 20090
10090 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0091
20090 IVFAIL = IVFAIL + 1
RVCORR = -255.99869791534212
WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR
0091 CONTINUE
CT010* TEST 10 3*PI/2 - 1/1024
IVTNUM = 10
AVS = TAN((3.0 * PIVS / 2.0) - 1.0 / 1024.0)
IF (AVS - 1023.9) 20100, 10100, 40100
40100 IF (AVS - 1024.1) 10100, 10100, 20100
10100 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0101
20100 IVFAIL = IVFAIL + 1
RVCORR = 1023.99967447914597
WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR
0101 CONTINUE
CT011* TEST 11 3*PI/2 + 1/64
IVTNUM = 11
BVS = (3.0 * PIVS / 2.0) + 1.0 / 64.0
AVS = TAN(BVS)
IF (AVS + 63.998) 20110, 10110, 40110
40110 IF (AVS + 63.991) 10110, 10110, 20110
10110 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0111
20110 IVFAIL = IVFAIL + 1
RVCORR = -63.99479158189365
WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR
0111 CONTINUE
CT012* TEST 12 LARGE ARGUMENT TO TEST ARGUMENT REDUCTION
IVTNUM = 12
AVS = TAN(2000.0)
IF (AVS + 2.5312) 20120, 10120, 40120
40120 IF (AVS + 2.5308) 10120, 10120, 20120
10120 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0121
20120 IVFAIL = IVFAIL + 1
RVCORR = -2.53099832809334
WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR
0121 CONTINUE
CT013* TEST 13 ARGUMENT OF LOW MAGNITUDE
IVTNUM = 13
BVS = PIVS * 1.0E-35
AVS = TAN(BVS)
IF (AVS - 3.1414E-35) 20130, 10130, 40130
40130 IF (AVS - 3.1418E-35) 10130, 10130, 20130
10130 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0131
20130 IVFAIL = IVFAIL + 1
RVCORR = 3.14159265358979E-35
WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR
0131 CONTINUE
CT014* TEST 14 THE FUNCTION APPLIED TWICE
IVTNUM = 14
AVS = TAN(PIVS / 6.0) * TAN(PIVS / 6.0)
IF (AVS - 0.33331) 20140, 10140, 40140
40140 IF (AVS - 0.33335) 10140, 10140, 20140
10140 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0141
20140 IVFAIL = IVFAIL + 1
RVCORR = 0.33333333333333
WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR
0141 CONTINUE
C*****
CBB** ********************** BBCSUM0 **********************************
C**** WRITE OUT TEST SUMMARY
C****
IVTOTN = IVPASS + IVFAIL + IVDELE + IVINSP
WRITE (I02, 90004)
WRITE (I02, 90014)
WRITE (I02, 90004)
WRITE (I02, 90020) IVPASS
WRITE (I02, 90022) IVFAIL
WRITE (I02, 90024) IVDELE
WRITE (I02, 90026) IVINSP
WRITE (I02, 90028) IVTOTN, IVTOTL
CBE** ********************** BBCSUM0 **********************************
CBB** ********************** BBCFOOT0 **********************************
C**** WRITE OUT REPORT FOOTINGS
C****
WRITE (I02,90016) ZPROG, ZPROG
WRITE (I02,90018) ZPROJ, ZNAME, ZTAPE, ZTAPED
WRITE (I02,90019)
CBE** ********************** BBCFOOT0 **********************************
CBB** ********************** BBCFMT0A **********************************
C**** FORMATS FOR TEST DETAIL LINES
C****
80000 FORMAT (1H ,2X,I3,4X,7HDELETED,32X,A31)
80002 FORMAT (1H ,2X,I3,4X,7H PASS ,32X,A31)
80004 FORMAT (1H ,2X,I3,4X,7HINSPECT,32X,A31)
80008 FORMAT (1H ,2X,I3,4X,7H FAIL ,32X,A31)
80010 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,15X,10HCOMPUTED= ,
1I6,/,1H ,15X,10HCORRECT= ,I6)
80012 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
1E12.5,/,1H ,16X,10HCORRECT= ,E12.5)
80018 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
1A21,/,1H ,16X,10HCORRECT= ,A21)
80020 FORMAT (1H ,16X,10HCOMPUTED= ,A21,1X,A31)
80022 FORMAT (1H ,16X,10HCORRECT= ,A21,1X,A31)
80024 FORMAT (1H ,16X,10HCOMPUTED= ,I6,16X,A31)
80026 FORMAT (1H ,16X,10HCORRECT= ,I6,16X,A31)
80028 FORMAT (1H ,16X,10HCOMPUTED= ,E12.5,10X,A31)
80030 FORMAT (1H ,16X,10HCORRECT= ,E12.5,10X,A31)
80050 FORMAT (1H ,48X,A31)
CBE** ********************** BBCFMT0A **********************************
CBB** ********************** BBCFMT0B **********************************
C**** FORMAT STATEMENTS FOR PAGE HEADERS
C****
90002 FORMAT (1H1)
90004 FORMAT (1H )
90006 FORMAT (1H ,20X,31HFEDERAL SOFTWARE TESTING CENTER)
90007 FORMAT (1H ,19X,34HFORTRAN COMPILER VALIDATION SYSTEM)
90008 FORMAT (1H ,21X,A13,A17)
90009 FORMAT (1H ,/,2H *,A5,6HBEGIN*,12X,15HTEST RESULTS - ,A5,/)
90010 FORMAT (1H ,8X,16HTEST DATE*TIME= ,A17,15H - COMPILER= ,A20)
90013 FORMAT (1H ,8H TEST ,10HPASS/FAIL ,6X,17HDISPLAYED RESULTS,
1 7X,7HREMARKS,24X)
90014 FORMAT (1H ,46H----------------------------------------------,
1 33H---------------------------------)
90015 FORMAT (1H ,48X,17HTHIS PROGRAM HAS ,I3,6H TESTS,/)
C****
C**** FORMAT STATEMENTS FOR REPORT FOOTINGS
C****
90016 FORMAT (1H ,/,2H *,A5,4HEND*,14X,14HEND OF TEST - ,A5,/)
90018 FORMAT (1H ,A13,13X,A20,7H * ,A10,1H/,
1 A13)
90019 FORMAT (1H ,26HFOR OFFICIAL USE ONLY ,35X,15HCOPYRIGHT 1982)
C****
C**** FORMAT STATEMENTS FOR RUN SUMMARY
C****
90020 FORMAT (1H ,21X,I5,13H TESTS PASSED)
90022 FORMAT (1H ,21X,I5,13H TESTS FAILED)
90024 FORMAT (1H ,21X,I5,14H TESTS DELETED)
90026 FORMAT (1H ,21X,I5,25H TESTS REQUIRE INSPECTION)
90028 FORMAT (1H ,21X,I5,4H OF ,I3,15H TESTS EXECUTED)
CBE** ********************** BBCFMT0B **********************************
C*****
C***** END OF TEST SEGMENT 191
STOP
END
*END-OF,FM374
FM375.f 481036318 170 2 100666 13225 `
*HEADER,FORTR,FM375
*FILES1,FORTR,FM375,X
C***********************************************************************
C***** FORTRAN 77
C***** FM375
C***** XASIN - (193)
C*****
C***********************************************************************
C***** GENERAL PURPOSE SUBSET REF
C***** TEST INTRINSIC FUNCTION ASIN, ACOS 15.3
C***** TABLE 5
C*****
CBB** ********************** BBCCOMNT **********************************
C****
C**** 1978 FORTRAN COMPILER VALIDATION SYSTEM
C**** VERSION 2.0
C****
C****
C**** SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO
C**** GENERAL SERVICES ADMINISTRATION
C**** FEDERAL SOFTWARE TESTING CENTER
C**** 5203 LEESBURG PIKE, SUITE 1100
C**** FALLS CHURCH, VA. 22041
C****
C**** (703) 756-6153
C****
CBE** ********************** BBCCOMNT **********************************
CBB** ********************** BBCINITA **********************************
C**** SPECIFICATION STATEMENTS
C****
CHARACTER ZVERS*13, ZVERSD*17, ZDATE*17, ZPROG*5, ZCOMPL*20,
1 ZNAME*20, ZTAPE*10, ZPROJ*13, REMRKS*31, ZTAPED*13
CBE** ********************** BBCINITA **********************************
CBB** ********************** BBCINITB **********************************
C**** INITIALIZE SECTION
DATA ZVERS, ZVERSD, ZDATE
1 /'VERSION 2.0 ', '82/08/02*18.33.46', '*NO DATE*TIME'/
DATA ZCOMPL, ZNAME, ZTAPE
1 /'*NONE SPECIFIED*', '*NO COMPANY NAME*', '*NO TAPE*'/
DATA ZPROJ, ZTAPED, ZPROG
1 /'*NO PROJECT*', '*NO TAPE DATE', 'XXXXX'/
DATA REMRKS /' '/
C**** THE FOLLOWING 9 COMMENT LINES (CZ01, CZ02, ...) CAN BE REPLACED
C**** FOR IDENTIFYING THE TEST ENVIRONMENT
C****
CZ01 ZVERS = 'VERSION OF THE COMPILER VALIDATION SYSTEM'
CZ02 ZVERSD = 'CREATION DATE/TIME OF THE COMPILER VALIDATION SYSTEM'
CZ03 ZPROG = 'PROGRAM NAME'
CZ04 ZDATE = 'DATE OF TEST'
CZ05 ZCOMPL = 'COMPILER IDENTIFICATION'
CZ06 ZPROJ = 'PROJECT NUMBER/IDENTIFICATION'
CZ07 ZNAME = 'NAME OF USER'
CZ08 ZTAPE = 'TAPE OWNER/ID'
CZ09 ZTAPED = 'DATE TAPE COPIED'
C
IVPASS = 0
IVFAIL = 0
IVDELE = 0
IVINSP = 0
IVTOTL = 0
IVTOTN = 0
ICZERO = 0
C
C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER.
I01 = 05
C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER.
I02 = 06
C
CX010 REPLACED BY FEXEC X-010 CONTROL CARD (CARD-READER UNIT NUMBER).
C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5
CX011 REPLACED BY FEXEC X-011 CONTROL CARD. CX011 IS FOR SYSTEMS
C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX010.
C
CX020 REPLACED BY FEXEC X-020 CONTROL CARD (PRINTER UNIT NUMBER).
C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02= 6
CX021 REPLACED BY FEXEC X-021 CONTROL CARD. CX021 IS FOR SYSTEMS
C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX020.
C
CBE** ********************** BBCINITB **********************************
NUVI = I02
IVTOTL = 12
ZPROG = 'FM375'
CBB** ********************** BBCHED0A **********************************
C****
C**** WRITE REPORT TITLE
C****
WRITE (I02, 90002)
WRITE (I02, 90006)
WRITE (I02, 90007)
WRITE (I02, 90008) ZVERS, ZVERSD
WRITE (I02, 90009) ZPROG, ZPROG
WRITE (I02, 90010) ZDATE, ZCOMPL
CBE** ********************** BBCHED0A **********************************
C*****
C***** HEADER FOR SEGMENT 193
WRITE(NUVI,19300)
19300 FORMAT(1H , / 35H XASIN - (193) INTRINSIC FUNCTIONS//
1 34H ASIN, ACOS (ARCSIN, ARCCOSINE) //
2 20H SUBSET REF. - 15.3)
CBB** ********************** BBCHED0B **********************************
C**** WRITE DETAIL REPORT HEADERS
C****
WRITE (I02,90004)
WRITE (I02,90004)
WRITE (I02,90013)
WRITE (I02,90014)
WRITE (I02,90015) IVTOTL
CBE** ********************** BBCHED0B **********************************
C*****
WRITE(NUVI,19301)
19301 FORMAT(1H0,8X,12HTEST OF ASIN)
C*****
CT001* TEST 1 -1 TO CHECK PRINCIPAL VALUE AT ENDPOINTS
IVTNUM = 1
BVS = -1.0
AVS = ASIN(BVS)
IF (AVS + 0.15709E+01) 20010, 10010, 40010
40010 IF (AVS + 0.15707E+01) 10010, 10010, 20010
10010 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0011
20010 IVFAIL = IVFAIL + 1
RVCORR = -1.57079632679490
WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR
0011 CONTINUE
CT002* TEST 2 +1 TO CHECK PRINCIPAL VALUE AT ENDPOINTS
IVTNUM = 2
AVS = ASIN(1.0)
IF (AVS - 0.15707E+01) 20020, 10020, 40020
40020 IF (AVS - 0.15709E+01) 10020, 10020, 20020
10020 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0021
20020 IVFAIL = IVFAIL + 1
RVCORR = 1.57079632679490
WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR
0021 CONTINUE
CT003* TEST 3 THE VALUE -SQRT(0.5)
IVTNUM = 3
BVS = -SQRT(2.0) / 2.0
AVS = ASIN(BVS)
IF (AVS + 0.78544E+00) 20030, 10030, 40030
40030 IF (AVS + 0.78535E+00) 10030, 10030, 20030
10030 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0031
20030 IVFAIL = IVFAIL + 1
RVCORR = -0.78539816339745
WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR
0031 CONTINUE
CT004* TEST 4 THE VALUE 0.5
IVTNUM = 4
AVS = ASIN(1.0 / 2.0)
IF (AVS - 0.52357E+00) 20040, 10040, 40040
40040 IF (AVS - 0.52363E+00) 10040, 10040, 20040
10040 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0041
20040 IVFAIL = IVFAIL + 1
RVCORR = 0.52359877559830
WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR
0041 CONTINUE
CT005* TEST 5 AN ARGUMENT OF LOW MAGNITUDE
IVTNUM = 5
AVS = ASIN(-1.0E-33)
IF (AVS + 0.10001E-32) 20050, 10050, 40050
40050 IF (AVS + 0.99995E-33) 10050, 10050, 20050
10050 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0051
20050 IVFAIL = IVFAIL + 1
RVCORR = -1.00000000000000E-33
WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR
0051 CONTINUE
C*****
WRITE(NUVI,19307)
19307 FORMAT(1H0,8X,12HTEST OF ACOS)
C*****
CT006* TEST 6 -1 TO TEST PRINCIPAL VALUE AT ENDPOINTS
IVTNUM = 6
BVS = -1.0
AVS = ACOS(BVS)
IF (AVS - 0.31414E+01) 20060, 10060, 40060
40060 IF (AVS - 0.31418E+01) 10060, 10060, 20060
10060 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0061
20060 IVFAIL = IVFAIL + 1
RVCORR = 3.14159265358980
WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR
0061 CONTINUE
CT007* TEST 7
IVTNUM = 7
AVS = ACOS(1.0)
IF (AVS + 0.50000E-04) 20070, 10070, 40070
40070 IF (AVS - 0.50000E-04) 10070, 10070, 20070
10070 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0071
20070 IVFAIL = IVFAIL + 1
RVCORR = 0.00000000000000
WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR
0071 CONTINUE
CT008* TEST 8
IVTNUM = 8
BVS = -SQRT(2.0) / 2.0
AVS = ACOS(BVS)
IF (AVS - 0.23560E+01) 20080, 10080, 40080
40080 IF (AVS - 0.23564E+01) 10080, 10080, 20080
10080 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0081
20080 IVFAIL = IVFAIL + 1
RVCORR = 2.35619449019234
WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR
0081 CONTINUE
CT009* TEST 9
IVTNUM = 9
AVS = ACOS(1.0 / 2.0)
IF (AVS - 0.10471E+01) 20090, 10090, 40090
40090 IF (AVS - 0.10473E+01) 10090, 10090, 20090
10090 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0091
20090 IVFAIL = IVFAIL + 1
RVCORR = 1.04719755119660
WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR
0091 CONTINUE
CT010* TEST 10 AN ARGUMENT OF LOW MAGNITUDE
IVTNUM = 10
AVS = ACOS(-1.0E-33)
IF (AVS - 0.15707E+01) 20100, 10100, 40100
40100 IF (AVS - 0.15709E+01) 10100, 10100, 20100
10100 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0101
20100 IVFAIL = IVFAIL + 1
RVCORR = 1.57079632679490
WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR
0101 CONTINUE
CT011* TEST 11 COMPARISON OF ASIN AND ACOS TO TEST RELATIONSHIP
IVTNUM = 11
BVS = ASIN(SQRT(3.0) / 3.0)
CVS = ACOS(SQRT(3.0) / 3.0)
AVS = (BVS + CVS) * 2.0
IF (AVS - 0.31414E+01) 20110, 10110, 40110
40110 IF (AVS - 0.31418E+01) 10110, 10110, 20110
10110 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0111
20110 IVFAIL = IVFAIL + 1
RVCORR = 3.14159265358979
WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR
0111 CONTINUE
CT012* TEST 12 COMPARISON OF ASIN AND ACOS TO TEST RELATIONSHIP
IVTNUM = 12
AVS = (ASIN(+0.25) + ACOS(+0.25)) * 2.0
IF (AVS - 0.31414E+01) 20120, 10120, 40120
40120 IF (AVS - 0.31418E+01) 10120, 10120, 20120
10120 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0121
20120 IVFAIL = IVFAIL + 1
RVCORR = 3.14159265358979
WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR
0121 CONTINUE
C*****
CBB** ********************** BBCSUM0 **********************************
C**** WRITE OUT TEST SUMMARY
C****
IVTOTN = IVPASS + IVFAIL + IVDELE + IVINSP
WRITE (I02, 90004)
WRITE (I02, 90014)
WRITE (I02, 90004)
WRITE (I02, 90020) IVPASS
WRITE (I02, 90022) IVFAIL
WRITE (I02, 90024) IVDELE
WRITE (I02, 90026) IVINSP
WRITE (I02, 90028) IVTOTN, IVTOTL
CBE** ********************** BBCSUM0 **********************************
CBB** ********************** BBCFOOT0 **********************************
C**** WRITE OUT REPORT FOOTINGS
C****
WRITE (I02,90016) ZPROG, ZPROG
WRITE (I02,90018) ZPROJ, ZNAME, ZTAPE, ZTAPED
WRITE (I02,90019)
CBE** ********************** BBCFOOT0 **********************************
CBB** ********************** BBCFMT0A **********************************
C**** FORMATS FOR TEST DETAIL LINES
C****
80000 FORMAT (1H ,2X,I3,4X,7HDELETED,32X,A31)
80002 FORMAT (1H ,2X,I3,4X,7H PASS ,32X,A31)
80004 FORMAT (1H ,2X,I3,4X,7HINSPECT,32X,A31)
80008 FORMAT (1H ,2X,I3,4X,7H FAIL ,32X,A31)
80010 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,15X,10HCOMPUTED= ,
1I6,/,1H ,15X,10HCORRECT= ,I6)
80012 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
1E12.5,/,1H ,16X,10HCORRECT= ,E12.5)
80018 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
1A21,/,1H ,16X,10HCORRECT= ,A21)
80020 FORMAT (1H ,16X,10HCOMPUTED= ,A21,1X,A31)
80022 FORMAT (1H ,16X,10HCORRECT= ,A21,1X,A31)
80024 FORMAT (1H ,16X,10HCOMPUTED= ,I6,16X,A31)
80026 FORMAT (1H ,16X,10HCORRECT= ,I6,16X,A31)
80028 FORMAT (1H ,16X,10HCOMPUTED= ,E12.5,10X,A31)
80030 FORMAT (1H ,16X,10HCORRECT= ,E12.5,10X,A31)
80050 FORMAT (1H ,48X,A31)
CBE** ********************** BBCFMT0A **********************************
CBB** ********************** BBCFMT0B **********************************
C**** FORMAT STATEMENTS FOR PAGE HEADERS
C****
90002 FORMAT (1H1)
90004 FORMAT (1H )
90006 FORMAT (1H ,20X,31HFEDERAL SOFTWARE TESTING CENTER)
90007 FORMAT (1H ,19X,34HFORTRAN COMPILER VALIDATION SYSTEM)
90008 FORMAT (1H ,21X,A13,A17)
90009 FORMAT (1H ,/,2H *,A5,6HBEGIN*,12X,15HTEST RESULTS - ,A5,/)
90010 FORMAT (1H ,8X,16HTEST DATE*TIME= ,A17,15H - COMPILER= ,A20)
90013 FORMAT (1H ,8H TEST ,10HPASS/FAIL ,6X,17HDISPLAYED RESULTS,
1 7X,7HREMARKS,24X)
90014 FORMAT (1H ,46H----------------------------------------------,
1 33H---------------------------------)
90015 FORMAT (1H ,48X,17HTHIS PROGRAM HAS ,I3,6H TESTS,/)
C****
C**** FORMAT STATEMENTS FOR REPORT FOOTINGS
C****
90016 FORMAT (1H ,/,2H *,A5,4HEND*,14X,14HEND OF TEST - ,A5,/)
90018 FORMAT (1H ,A13,13X,A20,7H * ,A10,1H/,
1 A13)
90019 FORMAT (1H ,26HFOR OFFICIAL USE ONLY ,35X,15HCOPYRIGHT 1982)
C****
C**** FORMAT STATEMENTS FOR RUN SUMMARY
C****
90020 FORMAT (1H ,21X,I5,13H TESTS PASSED)
90022 FORMAT (1H ,21X,I5,13H TESTS FAILED)
90024 FORMAT (1H ,21X,I5,14H TESTS DELETED)
90026 FORMAT (1H ,21X,I5,25H TESTS REQUIRE INSPECTION)
90028 FORMAT (1H ,21X,I5,4H OF ,I3,15H TESTS EXECUTED)
CBE** ********************** BBCFMT0B **********************************
C*****
C***** END OF TEST SEGMENT 193
STOP
END
*END-OF,FM375
FM376.f 481036321 170 2 100666 13995 `
*HEADER,FORTR,FM376
*FILES1,FORTR,FM376,X
C***********************************************************************
C***** FORTRAN 77
C***** FM376
C***** XATAN - (195)
C*****
C***********************************************************************
C***** GENERAL PURPOSE SUBSET REF
C***** TEST INTRINSIC FUNCTION ATAN, ATAN2 15.3
C***** INTRINSIC FUNCTION SQRT ASSUMED WORKING TABLE 5
C*****
CBB** ********************** BBCCOMNT **********************************
C****
C**** 1978 FORTRAN COMPILER VALIDATION SYSTEM
C**** VERSION 2.0
C****
C****
C**** SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO
C**** GENERAL SERVICES ADMINISTRATION
C**** FEDERAL SOFTWARE TESTING CENTER
C**** 5203 LEESBURG PIKE, SUITE 1100
C**** FALLS CHURCH, VA. 22041
C****
C**** (703) 756-6153
C****
CBE** ********************** BBCCOMNT **********************************
CBB** ********************** BBCINITA **********************************
C**** SPECIFICATION STATEMENTS
C****
CHARACTER ZVERS*13, ZVERSD*17, ZDATE*17, ZPROG*5, ZCOMPL*20,
1 ZNAME*20, ZTAPE*10, ZPROJ*13, REMRKS*31, ZTAPED*13
CBE** ********************** BBCINITA **********************************
CBB** ********************** BBCINITB **********************************
C**** INITIALIZE SECTION
DATA ZVERS, ZVERSD, ZDATE
1 /'VERSION 2.0 ', '82/08/02*18.33.46', '*NO DATE*TIME'/
DATA ZCOMPL, ZNAME, ZTAPE
1 /'*NONE SPECIFIED*', '*NO COMPANY NAME*', '*NO TAPE*'/
DATA ZPROJ, ZTAPED, ZPROG
1 /'*NO PROJECT*', '*NO TAPE DATE', 'XXXXX'/
DATA REMRKS /' '/
C**** THE FOLLOWING 9 COMMENT LINES (CZ01, CZ02, ...) CAN BE REPLACED
C**** FOR IDENTIFYING THE TEST ENVIRONMENT
C****
CZ01 ZVERS = 'VERSION OF THE COMPILER VALIDATION SYSTEM'
CZ02 ZVERSD = 'CREATION DATE/TIME OF THE COMPILER VALIDATION SYSTEM'
CZ03 ZPROG = 'PROGRAM NAME'
CZ04 ZDATE = 'DATE OF TEST'
CZ05 ZCOMPL = 'COMPILER IDENTIFICATION'
CZ06 ZPROJ = 'PROJECT NUMBER/IDENTIFICATION'
CZ07 ZNAME = 'NAME OF USER'
CZ08 ZTAPE = 'TAPE OWNER/ID'
CZ09 ZTAPED = 'DATE TAPE COPIED'
C
IVPASS = 0
IVFAIL = 0
IVDELE = 0
IVINSP = 0
IVTOTL = 0
IVTOTN = 0
ICZERO = 0
C
C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER.
I01 = 05
C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER.
I02 = 06
C
CX010 REPLACED BY FEXEC X-010 CONTROL CARD (CARD-READER UNIT NUMBER).
C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5
CX011 REPLACED BY FEXEC X-011 CONTROL CARD. CX011 IS FOR SYSTEMS
C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX010.
C
CX020 REPLACED BY FEXEC X-020 CONTROL CARD (PRINTER UNIT NUMBER).
C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02= 6
CX021 REPLACED BY FEXEC X-021 CONTROL CARD. CX021 IS FOR SYSTEMS
C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX020.
C
CBE** ********************** BBCINITB **********************************
NUVI = I02
IVTOTL = 13
ZPROG = 'FM376'
CBB** ********************** BBCHED0A **********************************
C****
C**** WRITE REPORT TITLE
C****
WRITE (I02, 90002)
WRITE (I02, 90006)
WRITE (I02, 90007)
WRITE (I02, 90008) ZVERS, ZVERSD
WRITE (I02, 90009) ZPROG, ZPROG
WRITE (I02, 90010) ZDATE, ZCOMPL
CBE** ********************** BBCHED0A **********************************
C*****
C***** HEADER FOR SEGMENT 195
WRITE(NUVI,19500)
19500 FORMAT(1H , / 35H XATAN - (195) INTRINSIC FUNCTIONS//
1 28H ATAN, ATAN2 (ARCTANGENT)//
2 20H SUBSET REF. - 15.3)
CBB** ********************** BBCHED0B **********************************
C**** WRITE DETAIL REPORT HEADERS
C****
WRITE (I02,90004)
WRITE (I02,90004)
WRITE (I02,90013)
WRITE (I02,90014)
WRITE (I02,90015) IVTOTL
CBE** ********************** BBCHED0B **********************************
C*****
WRITE(NUVI,19501)
C*****
19501 FORMAT(/ 8X, 12HTEST OF ATAN)
C*****
CT001* TEST 1 TEST LARGE VALUES TO TEST SINGULARITY
IVTNUM = 1
BVS = 500.0
AVS = ATAN(BVS)
IF (AVS - 0.15687E+01) 20010, 10010, 40010
40010 IF (AVS - 0.15689E+01) 10010, 10010, 20010
10010 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0011
20010 IVFAIL = IVFAIL + 1
RVCORR = 1.56879632946156
WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR
0011 CONTINUE
CT002* TEST 2 TEST LARGE VALUES TO TEST SINGULARITY
IVTNUM = 2
AVS = ATAN(-1000.0)
IF (AVS + 0.15699E+01) 20020, 10020, 40020
40020 IF (AVS + 0.15697E+01) 10020, 10020, 20020
10020 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0021
20020 IVFAIL = IVFAIL + 1
RVCORR = -1.56979632712823
WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR
0021 CONTINUE
CT003* TEST 3 AN EXPRESSION PRESENTED TO ATAN
IVTNUM = 3
AVS = ATAN(100.0 / 100.0)
IF (AVS - 0.78535E+00) 20030, 10030, 40030
40030 IF (AVS - 0.78544E+00) 10030, 10030, 20030
10030 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0031
20030 IVFAIL = IVFAIL + 1
RVCORR = 0.78539816339745
WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR
0031 CONTINUE
CT004* TEST 4 A VARIABLE PRESENTED TO ATAN
IVTNUM = 4
BVS = -SQRT(3.0)
AVS = ATAN(BVS)
IF (AVS + 0.10473E+01) 20040, 10040, 40040
40040 IF (AVS + 0.10471E+01) 10040, 10040, 20040
10040 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0041
20040 IVFAIL = IVFAIL + 1
RVCORR = -1.04719755119660
WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR
0041 CONTINUE
CT005* TEST 5 AN ARGUMENT OF LOW MAGNITUDE
IVTNUM = 5
AVS = ATAN(1.0E-16)
IF (AVS - 0.99995E-16) 20050, 10050, 40050
40050 IF (AVS - 0.10001E-15) 10050, 10050, 20050
10050 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0051
20050 IVFAIL = IVFAIL + 1
RVCORR = 1.00000000000000E-16
WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR
0051 CONTINUE
CT006* TEST 6 AN ARGUMENT OF HIGH MAGNITUDE
IVTNUM = 6
AVS = ATAN(-2.0E+34)
IF (AVS + 0.15709E+01) 20060, 10060, 40060
40060 IF (AVS + 0.15707E+01) 10060, 10060, 20060
10060 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0061
20060 IVFAIL = IVFAIL + 1
RVCORR = -1.57079632679490
WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR
0061 CONTINUE
C*****
WRITE(NUVI,19508)
19508 FORMAT(/ 08X, 13HTEST OF ATAN2)
CT007* TEST 7 TEST ATAN2 FOR (0,POSITIVE)
IVTNUM = 7
BVS = 10.0 / 10.0
CVS = 0.0
AVS = ATAN2(CVS, BVS)
IF (AVS + 0.50000E-04) 20070, 10070, 40070
40070 IF (AVS - 0.50000E-04) 10070, 10070, 20070
10070 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0071
20070 IVFAIL = IVFAIL + 1
RVCORR = 0.00000000000000
WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR
0071 CONTINUE
CT008* TEST 8 TEST ATAN2 FOR (0, NEGATIVE)
IVTNUM = 8
BVS = 0.0
CVS = -25.0 / 2.0
AVS = ATAN2(BVS, CVS)
IF (AVS - 0.31414E+01) 20080, 10080, 40080
40080 IF (AVS - 0.31418E+01) 10080, 10080, 20080
10080 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0081
20080 IVFAIL = IVFAIL + 1
RVCORR = 3.14159265358979
WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR
0081 CONTINUE
CT009* TEST 9 AN EXPRESSION PRESENTED TO ATAN2
IVTNUM = 9
BVS = 1.0
CVS = BVS + BVS
AVS = ATAN2(BVS * 2.0, CVS)
IF (AVS - 0.78535E+00) 20090, 10090, 40090
40090 IF (AVS - 0.78544E+00) 10090, 10090, 20090
10090 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0091
20090 IVFAIL = IVFAIL + 1
RVCORR = 0.78539816339745
WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR
0091 CONTINUE
CT010* TEST 10 TEST ATAN2(X,Y) FOR X NEAR ZERO
IVTNUM = 10
BVS = ASIN(0.6)
CVS = ACOS(0.8)
AVS = ATAN2(BVS, CVS)
IF (AVS - 0.78535E+00) 20100, 10100, 40100
40100 IF (AVS - 0.78544E+00) 10100, 10100, 20100
10100 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0101
20100 IVFAIL = IVFAIL + 1
RVCORR = 0.78539816339745
WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR
0101 CONTINUE
CT011* TEST 11 WHERE ATAN2(X,Y) IS ZERO FOR Y
IVTNUM = 11
AVS = ATAN2(1.2, 0.0)
IF (AVS - 0.15707E+01) 20110, 10110, 40110
40110 IF (AVS - 0.15709E+01) 10110, 10110, 20110
10110 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0111
20110 IVFAIL = IVFAIL + 1
RVCORR = 1.57079632679490
WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR
0111 CONTINUE
CT012* TEST 12 WHERE ATAN2(X,Y) IS ZERO FOR Y
IVTNUM = 12
BVS = -2.5
CVS = 0.0
AVS = ATAN2(BVS, CVS)
IF (AVS + 0.15709E+01) 20120, 10120, 40120
40120 IF (AVS + 0.15707E+01) 10120, 10120, 20120
10120 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0121
20120 IVFAIL = IVFAIL + 1
RVCORR = -1.57079632679490
WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR
0121 CONTINUE
CT013* TEST 13 COMPARISON OF ATAN WITH ATAN2
IVTNUM = 13
AVS = (ATAN(SQRT(3.0) / 3.0) * 2.0)
1 + ATAN2(-SQRT(3.0) / 2.0, 1.0 / 2.0)
IF (AVS + 0.50000E-04) 20130, 10130, 40130
40130 IF (AVS - 0.50000E-04) 10130, 10130, 20130
10130 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0131
20130 IVFAIL = IVFAIL + 1
RVCORR = 0.00000000000000
WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR
0131 CONTINUE
C*****
CBB** ********************** BBCSUM0 **********************************
C**** WRITE OUT TEST SUMMARY
C****
IVTOTN = IVPASS + IVFAIL + IVDELE + IVINSP
WRITE (I02, 90004)
WRITE (I02, 90014)
WRITE (I02, 90004)
WRITE (I02, 90020) IVPASS
WRITE (I02, 90022) IVFAIL
WRITE (I02, 90024) IVDELE
WRITE (I02, 90026) IVINSP
WRITE (I02, 90028) IVTOTN, IVTOTL
CBE** ********************** BBCSUM0 **********************************
CBB** ********************** BBCFOOT0 **********************************
C**** WRITE OUT REPORT FOOTINGS
C****
WRITE (I02,90016) ZPROG, ZPROG
WRITE (I02,90018) ZPROJ, ZNAME, ZTAPE, ZTAPED
WRITE (I02,90019)
CBE** ********************** BBCFOOT0 **********************************
CBB** ********************** BBCFMT0A **********************************
C**** FORMATS FOR TEST DETAIL LINES
C****
80000 FORMAT (1H ,2X,I3,4X,7HDELETED,32X,A31)
80002 FORMAT (1H ,2X,I3,4X,7H PASS ,32X,A31)
80004 FORMAT (1H ,2X,I3,4X,7HINSPECT,32X,A31)
80008 FORMAT (1H ,2X,I3,4X,7H FAIL ,32X,A31)
80010 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,15X,10HCOMPUTED= ,
1I6,/,1H ,15X,10HCORRECT= ,I6)
80012 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
1E12.5,/,1H ,16X,10HCORRECT= ,E12.5)
80018 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
1A21,/,1H ,16X,10HCORRECT= ,A21)
80020 FORMAT (1H ,16X,10HCOMPUTED= ,A21,1X,A31)
80022 FORMAT (1H ,16X,10HCORRECT= ,A21,1X,A31)
80024 FORMAT (1H ,16X,10HCOMPUTED= ,I6,16X,A31)
80026 FORMAT (1H ,16X,10HCORRECT= ,I6,16X,A31)
80028 FORMAT (1H ,16X,10HCOMPUTED= ,E12.5,10X,A31)
80030 FORMAT (1H ,16X,10HCORRECT= ,E12.5,10X,A31)
80050 FORMAT (1H ,48X,A31)
CBE** ********************** BBCFMT0A **********************************
CBB** ********************** BBCFMT0B **********************************
C**** FORMAT STATEMENTS FOR PAGE HEADERS
C****
90002 FORMAT (1H1)
90004 FORMAT (1H )
90006 FORMAT (1H ,20X,31HFEDERAL SOFTWARE TESTING CENTER)
90007 FORMAT (1H ,19X,34HFORTRAN COMPILER VALIDATION SYSTEM)
90008 FORMAT (1H ,21X,A13,A17)
90009 FORMAT (1H ,/,2H *,A5,6HBEGIN*,12X,15HTEST RESULTS - ,A5,/)
90010 FORMAT (1H ,8X,16HTEST DATE*TIME= ,A17,15H - COMPILER= ,A20)
90013 FORMAT (1H ,8H TEST ,10HPASS/FAIL ,6X,17HDISPLAYED RESULTS,
1 7X,7HREMARKS,24X)
90014 FORMAT (1H ,46H----------------------------------------------,
1 33H---------------------------------)
90015 FORMAT (1H ,48X,17HTHIS PROGRAM HAS ,I3,6H TESTS,/)
C****
C**** FORMAT STATEMENTS FOR REPORT FOOTINGS
C****
90016 FORMAT (1H ,/,2H *,A5,4HEND*,14X,14HEND OF TEST - ,A5,/)
90018 FORMAT (1H ,A13,13X,A20,7H * ,A10,1H/,
1 A13)
90019 FORMAT (1H ,26HFOR OFFICIAL USE ONLY ,35X,15HCOPYRIGHT 1982)
C****
C**** FORMAT STATEMENTS FOR RUN SUMMARY
C****
90020 FORMAT (1H ,21X,I5,13H TESTS PASSED)
90022 FORMAT (1H ,21X,I5,13H TESTS FAILED)
90024 FORMAT (1H ,21X,I5,14H TESTS DELETED)
90026 FORMAT (1H ,21X,I5,25H TESTS REQUIRE INSPECTION)
90028 FORMAT (1H ,21X,I5,4H OF ,I3,15H TESTS EXECUTED)
CBE** ********************** BBCFMT0B **********************************
C*****
C***** END OF TEST SEGMENT 195
STOP
END
*END-OF,FM376
FM377.f 481036325 170 2 100666 14894 `
*HEADER,FORTR,FM377
*FILES1,FORTR,FM377,X
C***********************************************************************
C***** FORTRAN 77
C***** FM377
C***** XSINH - (197)
C*****
C***********************************************************************
C***** GENERAL PURPOSE SUBSET REF
C***** TEST INTRINSIC FUNCTION SINH, COSH 15.3
C***** TABLE 5
C*****
CBB** ********************** BBCCOMNT **********************************
C****
C**** 1978 FORTRAN COMPILER VALIDATION SYSTEM
C**** VERSION 2.0
C****
C****
C**** SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO
C**** GENERAL SERVICES ADMINISTRATION
C**** FEDERAL SOFTWARE TESTING CENTER
C**** 5203 LEESBURG PIKE, SUITE 1100
C**** FALLS CHURCH, VA. 22041
C****
C**** (703) 756-6153
C****
CBE** ********************** BBCCOMNT **********************************
CBB** ********************** BBCINITA **********************************
C**** SPECIFICATION STATEMENTS
C****
CHARACTER ZVERS*13, ZVERSD*17, ZDATE*17, ZPROG*5, ZCOMPL*20,
1 ZNAME*20, ZTAPE*10, ZPROJ*13, REMRKS*31, ZTAPED*13
CBE** ********************** BBCINITA **********************************
CBB** ********************** BBCINITB **********************************
C**** INITIALIZE SECTION
DATA ZVERS, ZVERSD, ZDATE
1 /'VERSION 2.0 ', '82/08/02*18.33.46', '*NO DATE*TIME'/
DATA ZCOMPL, ZNAME, ZTAPE
1 /'*NONE SPECIFIED*', '*NO COMPANY NAME*', '*NO TAPE*'/
DATA ZPROJ, ZTAPED, ZPROG
1 /'*NO PROJECT*', '*NO TAPE DATE', 'XXXXX'/
DATA REMRKS /' '/
C**** THE FOLLOWING 9 COMMENT LINES (CZ01, CZ02, ...) CAN BE REPLACED
C**** FOR IDENTIFYING THE TEST ENVIRONMENT
C****
CZ01 ZVERS = 'VERSION OF THE COMPILER VALIDATION SYSTEM'
CZ02 ZVERSD = 'CREATION DATE/TIME OF THE COMPILER VALIDATION SYSTEM'
CZ03 ZPROG = 'PROGRAM NAME'
CZ04 ZDATE = 'DATE OF TEST'
CZ05 ZCOMPL = 'COMPILER IDENTIFICATION'
CZ06 ZPROJ = 'PROJECT NUMBER/IDENTIFICATION'
CZ07 ZNAME = 'NAME OF USER'
CZ08 ZTAPE = 'TAPE OWNER/ID'
CZ09 ZTAPED = 'DATE TAPE COPIED'
C
IVPASS = 0
IVFAIL = 0
IVDELE = 0
IVINSP = 0
IVTOTL = 0
IVTOTN = 0
ICZERO = 0
C
C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER.
I01 = 05
C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER.
I02 = 06
C
CX010 REPLACED BY FEXEC X-010 CONTROL CARD (CARD-READER UNIT NUMBER).
C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5
CX011 REPLACED BY FEXEC X-011 CONTROL CARD. CX011 IS FOR SYSTEMS
C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX010.
C
CX020 REPLACED BY FEXEC X-020 CONTROL CARD (PRINTER UNIT NUMBER).
C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02= 6
CX021 REPLACED BY FEXEC X-021 CONTROL CARD. CX021 IS FOR SYSTEMS
C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX020.
C
CBE** ********************** BBCINITB **********************************
NUVI = I02
IVTOTL = 15
ZPROG = 'FM377'
CBB** ********************** BBCHED0A **********************************
C****
C**** WRITE REPORT TITLE
C****
WRITE (I02, 90002)
WRITE (I02, 90006)
WRITE (I02, 90007)
WRITE (I02, 90008) ZVERS, ZVERSD
WRITE (I02, 90009) ZPROG, ZPROG
WRITE (I02, 90010) ZDATE, ZCOMPL
CBE** ********************** BBCHED0A **********************************
C*****
C***** HEADER FOR SEGMENT 197
WRITE(NUVI,19700)
19700 FORMAT(1H , / 35H XSINH - (197) INTRINSIC FUNCTIONS//
1 41H SINH, COSH (HYPERBOLIC SINE, COSINE)//
2 20H SUBSET REF. - 15.3)
CBB** ********************** BBCHED0B **********************************
C**** WRITE DETAIL REPORT HEADERS
C****
WRITE (I02,90004)
WRITE (I02,90004)
WRITE (I02,90013)
WRITE (I02,90014)
WRITE (I02,90015) IVTOTL
CBE** ********************** BBCHED0B **********************************
C*****
WRITE(NUVI,19701)
19701 FORMAT(/ 8X, 12HTEST OF SINH)
C*****
CT001* TEST 1 TEST AT ZERO (0.0)
IVTNUM = 1
BVS = 0.0
AVS = SINH(BVS)
IF (AVS + 0.50000E-04) 20010, 10010, 40010
40010 IF (AVS - 0.50000E-04) 10010, 10010, 20010
10010 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0011
20010 IVFAIL = IVFAIL + 1
RVCORR = 0.00000000000000
WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR
0011 CONTINUE
CT002* TEST 2 TEST ARGUMENTS CLOSE TO 1.0
IVTNUM = 2
AVS = SINH(15.0 / 16.0)
IF (AVS - 0.10809E+01) 20020, 10020, 40020
40020 IF (AVS - 0.10811E+01) 10020, 10020, 20020
10020 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0021
20020 IVFAIL = IVFAIL + 1
RVCORR = 1.08099191569306
WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR
0021 CONTINUE
CT003* TEST 3 TEST AT 1.0
IVTNUM = 3
BVS = 1.0
AVS = SINH(BVS)
IF (AVS - 0.11751E+01) 20030, 10030, 40030
40030 IF (AVS - 0.11753E+01) 10030, 10030, 20030
10030 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0031
20030 IVFAIL = IVFAIL + 1
RVCORR = 1.17520119364380
WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR
0031 CONTINUE
CT004* TEST 4 TEST ARGUMENTS CLOSE TO 1.0
IVTNUM = 4
AVS = SINH(33.0 / 32.0)
IF (AVS - 0.12239E+01) 20040, 10040, 40040
40040 IF (AVS - 0.12241E+01) 10040, 10040, 20040
10040 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0041
20040 IVFAIL = IVFAIL + 1
RVCORR = 1.22400418778664
WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR
0041 CONTINUE
CT005* TEST 5 TEST AT 2.0
IVTNUM = 5
BVS = 2.0
AVS = SINH(BVS)
IF (AVS - 0.36266E+01) 20050, 10050, 40050
40050 IF (AVS - 0.36271E+01) 10050, 10050, 20050
10050 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0051
20050 IVFAIL = IVFAIL + 1
RVCORR = 3.62686040784702
WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR
0051 CONTINUE
CT006* TEST 6 A NEGATIVE ARGUMENT
IVTNUM = 6
AVS = SINH(-2.0)
IF (AVS + 0.36271E+01) 20060, 10060, 40060
40060 IF (AVS + 0.36266E+01) 10060, 10060, 20060
10060 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0061
20060 IVFAIL = IVFAIL + 1
RVCORR = -3.62686040784702
WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR
0061 CONTINUE
CT007* TEST 7 AN ARGUMENT OF LOW MAGNITUDE
IVTNUM = 7
AVS = SINH(1.0E-34)
IF (AVS - 0.99995E-34) 20070, 10070, 40070
40070 IF (AVS - 0.10001E-33) 10070, 10070, 20070
10070 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0071
20070 IVFAIL = IVFAIL + 1
RVCORR = 1.00000000000000E-34
WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR
0071 CONTINUE
C*****
WRITE (NUVI, 90002)
WRITE (NUVI, 90013)
WRITE (NUVI, 90014)
C*****
WRITE(NUVI,19709)
19709 FORMAT(/ 8X, 12HTEST OF COSH)
C*****
CT008* TEST 8 ZERO (0.0)
IVTNUM = 8
BVS = 0.0
AVS = COSH(BVS)
IF (AVS - 0.99995E+00) 20080, 10080, 40080
40080 IF (AVS - 0.10001E+01) 10080, 10080, 20080
10080 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0081
20080 IVFAIL = IVFAIL + 1
RVCORR = 1.00000000000000
WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR
0081 CONTINUE
CT009* TEST 9 VALUES CLOSE TO 1.0
IVTNUM = 9
AVS = COSH(15.0 / 16.0)
IF (AVS - 0.14725E+01) 20090, 10090, 40090
40090 IF (AVS - 0.14727E+01) 10090, 10090, 20090
10090 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0091
20090 IVFAIL = IVFAIL + 1
RVCORR = 1.47259754236986
WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR
0091 CONTINUE
CT010* TEST 10 TEST AT 1.0
IVTNUM = 10
BVS = 1.0
AVS = COSH(BVS)
IF (AVS - 0.15430E+01) 20100, 10100, 40100
40100 IF (AVS - 0.15432E+01) 10100, 10100, 20100
10100 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0101
20100 IVFAIL = IVFAIL + 1
RVCORR = 1.54308063481524
WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR
0101 CONTINUE
CT011* TEST 11 TEST ARGUMENTS CLOSE TO 1.0
IVTNUM = 11
AVS = COSH(33.0 / 32.0)
IF (AVS - 0.15804E+01) 20110, 10110, 40110
40110 IF (AVS - 0.15807E+01) 10110, 10110, 20110
10110 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0111
20110 IVFAIL = IVFAIL + 1
RVCORR = 1.58056516845059
WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR
0111 CONTINUE
CT012* TEST 12 TEST AT 2.0
IVTNUM = 12
BVS = 2.0
AVS = COSH(BVS)
IF (AVS - 0.37620E+01) 20120, 10120, 40120
40120 IF (AVS - 0.37624E+01) 10120, 10120, 20120
10120 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0121
20120 IVFAIL = IVFAIL + 1
RVCORR = 3.76219569108363
WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR
0121 CONTINUE
CT013* TEST 13 A NEGATIVE ARGUMENT
IVTNUM = 13
AVS = COSH(-2.0)
IF (AVS - 0.37620E+01) 20130, 10130, 40130
40130 IF (AVS - 0.37624E+01) 10130, 10130, 20130
10130 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0131
20130 IVFAIL = IVFAIL + 1
RVCORR = 3.76219569108363
WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR
0131 CONTINUE
CT014* TEST 14 AN ARGUMENT OF LOW MAGNITUDE
IVTNUM = 14
AVS = COSH(-1.0E-34)
IF (AVS - 0.99995E+00) 20140, 10140, 40140
40140 IF (AVS - 0.10001E+01) 10140, 10140, 20140
10140 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0141
20140 IVFAIL = IVFAIL + 1
RVCORR = 1.00000000000000E+00
WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR
0141 CONTINUE
CT015* TEST 15 POSITIVE VALUES SUPPLIED AS ARGUMENTS
C***** TO BOTH FUNCTIONS IN AN EXPRESSION
IVTNUM = 15
AVS = SINH(3.25) + COSH(3.25)
IF (AVS - 0.25789E+02) 20150, 10150, 40150
40150 IF (AVS - 0.25792E+02) 10150, 10150, 20150
10150 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0151
20150 IVFAIL = IVFAIL + 1
RVCORR = 25.79033991719306
WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR
0151 CONTINUE
C*****
CBB** ********************** BBCSUM0 **********************************
C**** WRITE OUT TEST SUMMARY
C****
IVTOTN = IVPASS + IVFAIL + IVDELE + IVINSP
WRITE (I02, 90004)
WRITE (I02, 90014)
WRITE (I02, 90004)
WRITE (I02, 90020) IVPASS
WRITE (I02, 90022) IVFAIL
WRITE (I02, 90024) IVDELE
WRITE (I02, 90026) IVINSP
WRITE (I02, 90028) IVTOTN, IVTOTL
CBE** ********************** BBCSUM0 **********************************
CBB** ********************** BBCFOOT0 **********************************
C**** WRITE OUT REPORT FOOTINGS
C****
WRITE (I02,90016) ZPROG, ZPROG
WRITE (I02,90018) ZPROJ, ZNAME, ZTAPE, ZTAPED
WRITE (I02,90019)
CBE** ********************** BBCFOOT0 **********************************
CBB** ********************** BBCFMT0A **********************************
C**** FORMATS FOR TEST DETAIL LINES
C****
80000 FORMAT (1H ,2X,I3,4X,7HDELETED,32X,A31)
80002 FORMAT (1H ,2X,I3,4X,7H PASS ,32X,A31)
80004 FORMAT (1H ,2X,I3,4X,7HINSPECT,32X,A31)
80008 FORMAT (1H ,2X,I3,4X,7H FAIL ,32X,A31)
80010 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,15X,10HCOMPUTED= ,
1I6,/,1H ,15X,10HCORRECT= ,I6)
80012 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
1E12.5,/,1H ,16X,10HCORRECT= ,E12.5)
80018 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
1A21,/,1H ,16X,10HCORRECT= ,A21)
80020 FORMAT (1H ,16X,10HCOMPUTED= ,A21,1X,A31)
80022 FORMAT (1H ,16X,10HCORRECT= ,A21,1X,A31)
80024 FORMAT (1H ,16X,10HCOMPUTED= ,I6,16X,A31)
80026 FORMAT (1H ,16X,10HCORRECT= ,I6,16X,A31)
80028 FORMAT (1H ,16X,10HCOMPUTED= ,E12.5,10X,A31)
80030 FORMAT (1H ,16X,10HCORRECT= ,E12.5,10X,A31)
80050 FORMAT (1H ,48X,A31)
CBE** ********************** BBCFMT0A **********************************
CBB** ********************** BBCFMT0B **********************************
C**** FORMAT STATEMENTS FOR PAGE HEADERS
C****
90002 FORMAT (1H1)
90004 FORMAT (1H )
90006 FORMAT (1H ,20X,31HFEDERAL SOFTWARE TESTING CENTER)
90007 FORMAT (1H ,19X,34HFORTRAN COMPILER VALIDATION SYSTEM)
90008 FORMAT (1H ,21X,A13,A17)
90009 FORMAT (1H ,/,2H *,A5,6HBEGIN*,12X,15HTEST RESULTS - ,A5,/)
90010 FORMAT (1H ,8X,16HTEST DATE*TIME= ,A17,15H - COMPILER= ,A20)
90013 FORMAT (1H ,8H TEST ,10HPASS/FAIL ,6X,17HDISPLAYED RESULTS,
1 7X,7HREMARKS,24X)
90014 FORMAT (1H ,46H----------------------------------------------,
1 33H---------------------------------)
90015 FORMAT (1H ,48X,17HTHIS PROGRAM HAS ,I3,6H TESTS,/)
C****
C**** FORMAT STATEMENTS FOR REPORT FOOTINGS
C****
90016 FORMAT (1H ,/,2H *,A5,4HEND*,14X,14HEND OF TEST - ,A5,/)
90018 FORMAT (1H ,A13,13X,A20,7H * ,A10,1H/,
1 A13)
90019 FORMAT (1H ,26HFOR OFFICIAL USE ONLY ,35X,15HCOPYRIGHT 1982)
C****
C**** FORMAT STATEMENTS FOR RUN SUMMARY
C****
90020 FORMAT (1H ,21X,I5,13H TESTS PASSED)
90022 FORMAT (1H ,21X,I5,13H TESTS FAILED)
90024 FORMAT (1H ,21X,I5,14H TESTS DELETED)
90026 FORMAT (1H ,21X,I5,25H TESTS REQUIRE INSPECTION)
90028 FORMAT (1H ,21X,I5,4H OF ,I3,15H TESTS EXECUTED)
CBE** ********************** BBCFMT0B **********************************
C*****
C***** END OF TEST SEGMENT 197
STOP
END
*END-OF,FM377
FM378.f 481036328 170 2 100666 11768 `
*HEADER,FORTR,FM378
*FILES1,FORTR,FM378,X
C***********************************************************************
C***** FORTRAN 77
C***** FM378
C***** XTANH - (199)
C*****
C***********************************************************************
C***** GENERAL PURPOSE SUBSET REF
C***** TEST INTRINSIC FUNCTION TANH 15.3
C***** TABLE 5
C*****
CBB** ********************** BBCCOMNT **********************************
C****
C**** 1978 FORTRAN COMPILER VALIDATION SYSTEM
C**** VERSION 2.0
C****
C****
C**** SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO
C**** GENERAL SERVICES ADMINISTRATION
C**** FEDERAL SOFTWARE TESTING CENTER
C**** 5203 LEESBURG PIKE, SUITE 1100
C**** FALLS CHURCH, VA. 22041
C****
C**** (703) 756-6153
C****
CBE** ********************** BBCCOMNT **********************************
CBB** ********************** BBCINITA **********************************
C**** SPECIFICATION STATEMENTS
C****
CHARACTER ZVERS*13, ZVERSD*17, ZDATE*17, ZPROG*5, ZCOMPL*20,
1 ZNAME*20, ZTAPE*10, ZPROJ*13, REMRKS*31, ZTAPED*13
CBE** ********************** BBCINITA **********************************
CBB** ********************** BBCINITB **********************************
C**** INITIALIZE SECTION
DATA ZVERS, ZVERSD, ZDATE
1 /'VERSION 2.0 ', '82/08/02*18.33.46', '*NO DATE*TIME'/
DATA ZCOMPL, ZNAME, ZTAPE
1 /'*NONE SPECIFIED*', '*NO COMPANY NAME*', '*NO TAPE*'/
DATA ZPROJ, ZTAPED, ZPROG
1 /'*NO PROJECT*', '*NO TAPE DATE', 'XXXXX'/
DATA REMRKS /' '/
C**** THE FOLLOWING 9 COMMENT LINES (CZ01, CZ02, ...) CAN BE REPLACED
C**** FOR IDENTIFYING THE TEST ENVIRONMENT
C****
CZ01 ZVERS = 'VERSION OF THE COMPILER VALIDATION SYSTEM'
CZ02 ZVERSD = 'CREATION DATE/TIME OF THE COMPILER VALIDATION SYSTEM'
CZ03 ZPROG = 'PROGRAM NAME'
CZ04 ZDATE = 'DATE OF TEST'
CZ05 ZCOMPL = 'COMPILER IDENTIFICATION'
CZ06 ZPROJ = 'PROJECT NUMBER/IDENTIFICATION'
CZ07 ZNAME = 'NAME OF USER'
CZ08 ZTAPE = 'TAPE OWNER/ID'
CZ09 ZTAPED = 'DATE TAPE COPIED'
C
IVPASS = 0
IVFAIL = 0
IVDELE = 0
IVINSP = 0
IVTOTL = 0
IVTOTN = 0
ICZERO = 0
C
C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER.
I01 = 05
C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER.
I02 = 06
C
CX010 REPLACED BY FEXEC X-010 CONTROL CARD (CARD-READER UNIT NUMBER).
C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5
CX011 REPLACED BY FEXEC X-011 CONTROL CARD. CX011 IS FOR SYSTEMS
C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX010.
C
CX020 REPLACED BY FEXEC X-020 CONTROL CARD (PRINTER UNIT NUMBER).
C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02= 6
CX021 REPLACED BY FEXEC X-021 CONTROL CARD. CX021 IS FOR SYSTEMS
C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX020.
C
CBE** ********************** BBCINITB **********************************
NUVI = I02
IVTOTL = 9
ZPROG = 'FM378'
CBB** ********************** BBCHED0A **********************************
C****
C**** WRITE REPORT TITLE
C****
WRITE (I02, 90002)
WRITE (I02, 90006)
WRITE (I02, 90007)
WRITE (I02, 90008) ZVERS, ZVERSD
WRITE (I02, 90009) ZPROG, ZPROG
WRITE (I02, 90010) ZDATE, ZCOMPL
CBE** ********************** BBCHED0A **********************************
C*****
C***** HEADER FOR SEGMENT 199
WRITE(NUVI,19900)
19900 FORMAT(1H , / 35H XTANH - (199) INTRINSIC FUNCTIONS//
1 28H TANH (HYPERBOLIC TANGENT)//
2 20H SUBSET REF. - 15.3)
CBB** ********************** BBCHED0B **********************************
C**** WRITE DETAIL REPORT HEADERS
C****
WRITE (I02,90004)
WRITE (I02,90004)
WRITE (I02,90013)
WRITE (I02,90014)
WRITE (I02,90015) IVTOTL
CBE** ********************** BBCHED0B **********************************
C*****
CT001* TEST 1 TEST AT ZERO (0.0)
IVTNUM = 1
BVS = 0.0
AVS = TANH(BVS)
IF (AVS + 0.50000E-04) 20010, 10010, 40010
40010 IF (AVS - 0.50000E-04) 10010, 10010, 20010
10010 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0011
20010 IVFAIL = IVFAIL + 1
RVCORR = 0.00000000000000
WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR
0011 CONTINUE
CT002* TEST 2 A NEGATIVE ARGUMENT
IVTNUM = 2
AVS = TANH(-2.5)
IF (AVS + 0.98667E+00) 20020, 10020, 40020
40020 IF (AVS + 0.98656E+00) 10020, 10020, 20020
10020 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0021
20020 IVFAIL = IVFAIL + 1
RVCORR = -0.98661429815143
WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR
0021 CONTINUE
CT003* TEST 3 A VARIABLE SUPPLIED AS AN ARGUMENT
IVTNUM = 3
BVS = 4.75
AVS = TANH(BVS)
IF (AVS - 0.99980E+00) 20030, 10030, 40030
40030 IF (AVS - 0.99990E+00) 10030, 10030, 20030
10030 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0031
20030 IVFAIL = IVFAIL + 1
RVCORR = 0.99985030754498
WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR
0031 CONTINUE
CT004* TEST 4 A POSITIVE REAL NUMBER SUPPLIED AS AN ARGUMENT
IVTNUM = 4
AVS = TANH(15.125)
IF (AVS - 0.99995E+00) 20040, 10040, 40040
40040 IF (AVS - 0.10001E+01) 10040, 10040, 20040
10040 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0041
20040 IVFAIL = IVFAIL + 1
RVCORR = 0.99999999999985
WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR
0041 CONTINUE
CT005* TEST 5 TEST WITH LARGE VALUES
IVTNUM = 5
BVS = 10.0 ** 2
AVS = TANH(BVS)
IF (AVS - 0.99995E+00) 20050, 10050, 40050
40050 IF (AVS - 0.10001E+01) 10050, 10050, 20050
10050 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0051
20050 IVFAIL = IVFAIL + 1
RVCORR = 1.00000000000000
WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR
0051 CONTINUE
CT006* TEST 6 TEST WITH LARGE VALUES
IVTNUM = 6
BVS = -100.0 * 10.0
AVS = TANH(BVS)
IF (AVS + 0.10001E+01) 20060, 10060, 40060
40060 IF (AVS + 0.99995E+00) 10060, 10060, 20060
10060 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0061
20060 IVFAIL = IVFAIL + 1
RVCORR = -1.00000000000000
WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR
0061 CONTINUE
CT007* TEST 7 AN ARGUMENT OF HIGH MAGNITUDE
IVTNUM = 7
BVS = 3.0E+36
AVS = TANH(BVS)
IF (AVS - 0.99995E+00) 20070, 10070, 40070
40070 IF (AVS - 0.10001E+01) 10070, 10070, 20070
10070 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0071
20070 IVFAIL = IVFAIL + 1
RVCORR = 1.00000000000000
WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR
0071 CONTINUE
CT008* TEST 8 AN ARGUMENT OF LOW MAGNITUDE
IVTNUM = 8
BVS = -1.0E-15
AVS = TANH(BVS)
IF (AVS + 0.10001E-14) 20080, 10080, 40080
40080 IF (AVS + 0.99995E-15) 10080, 10080, 20080
10080 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0081
20080 IVFAIL = IVFAIL + 1
RVCORR = -1.00000000000000E-15
WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR
0081 CONTINUE
CT009* TEST 9 THE FUNCTION APPLIED TWICE
IVTNUM = 9
AVS = TANH(0.5) * TANH(0.75)
IF (AVS - 0.29349E+00) 20090, 10090, 40090
40090 IF (AVS - 0.29353E+00) 10090, 10090, 20090
10090 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0091
20090 IVFAIL = IVFAIL + 1
RVCORR = 0.293513228313886
WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR
0091 CONTINUE
C*****
CBB** ********************** BBCSUM0 **********************************
C**** WRITE OUT TEST SUMMARY
C****
IVTOTN = IVPASS + IVFAIL + IVDELE + IVINSP
WRITE (I02, 90004)
WRITE (I02, 90014)
WRITE (I02, 90004)
WRITE (I02, 90020) IVPASS
WRITE (I02, 90022) IVFAIL
WRITE (I02, 90024) IVDELE
WRITE (I02, 90026) IVINSP
WRITE (I02, 90028) IVTOTN, IVTOTL
CBE** ********************** BBCSUM0 **********************************
CBB** ********************** BBCFOOT0 **********************************
C**** WRITE OUT REPORT FOOTINGS
C****
WRITE (I02,90016) ZPROG, ZPROG
WRITE (I02,90018) ZPROJ, ZNAME, ZTAPE, ZTAPED
WRITE (I02,90019)
CBE** ********************** BBCFOOT0 **********************************
CBB** ********************** BBCFMT0A **********************************
C**** FORMATS FOR TEST DETAIL LINES
C****
80000 FORMAT (1H ,2X,I3,4X,7HDELETED,32X,A31)
80002 FORMAT (1H ,2X,I3,4X,7H PASS ,32X,A31)
80004 FORMAT (1H ,2X,I3,4X,7HINSPECT,32X,A31)
80008 FORMAT (1H ,2X,I3,4X,7H FAIL ,32X,A31)
80010 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,15X,10HCOMPUTED= ,
1I6,/,1H ,15X,10HCORRECT= ,I6)
80012 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
1E12.5,/,1H ,16X,10HCORRECT= ,E12.5)
80018 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
1A21,/,1H ,16X,10HCORRECT= ,A21)
80020 FORMAT (1H ,16X,10HCOMPUTED= ,A21,1X,A31)
80022 FORMAT (1H ,16X,10HCORRECT= ,A21,1X,A31)
80024 FORMAT (1H ,16X,10HCOMPUTED= ,I6,16X,A31)
80026 FORMAT (1H ,16X,10HCORRECT= ,I6,16X,A31)
80028 FORMAT (1H ,16X,10HCOMPUTED= ,E12.5,10X,A31)
80030 FORMAT (1H ,16X,10HCORRECT= ,E12.5,10X,A31)
80050 FORMAT (1H ,48X,A31)
CBE** ********************** BBCFMT0A **********************************
CBB** ********************** BBCFMT0B **********************************
C**** FORMAT STATEMENTS FOR PAGE HEADERS
C****
90002 FORMAT (1H1)
90004 FORMAT (1H )
90006 FORMAT (1H ,20X,31HFEDERAL SOFTWARE TESTING CENTER)
90007 FORMAT (1H ,19X,34HFORTRAN COMPILER VALIDATION SYSTEM)
90008 FORMAT (1H ,21X,A13,A17)
90009 FORMAT (1H ,/,2H *,A5,6HBEGIN*,12X,15HTEST RESULTS - ,A5,/)
90010 FORMAT (1H ,8X,16HTEST DATE*TIME= ,A17,15H - COMPILER= ,A20)
90013 FORMAT (1H ,8H TEST ,10HPASS/FAIL ,6X,17HDISPLAYED RESULTS,
1 7X,7HREMARKS,24X)
90014 FORMAT (1H ,46H----------------------------------------------,
1 33H---------------------------------)
90015 FORMAT (1H ,48X,17HTHIS PROGRAM HAS ,I3,6H TESTS,/)
C****
C**** FORMAT STATEMENTS FOR REPORT FOOTINGS
C****
90016 FORMAT (1H ,/,2H *,A5,4HEND*,14X,14HEND OF TEST - ,A5,/)
90018 FORMAT (1H ,A13,13X,A20,7H * ,A10,1H/,
1 A13)
90019 FORMAT (1H ,26HFOR OFFICIAL USE ONLY ,35X,15HCOPYRIGHT 1982)
C****
C**** FORMAT STATEMENTS FOR RUN SUMMARY
C****
90020 FORMAT (1H ,21X,I5,13H TESTS PASSED)
90022 FORMAT (1H ,21X,I5,13H TESTS FAILED)
90024 FORMAT (1H ,21X,I5,14H TESTS DELETED)
90026 FORMAT (1H ,21X,I5,25H TESTS REQUIRE INSPECTION)
90028 FORMAT (1H ,21X,I5,4H OF ,I3,15H TESTS EXECUTED)
CBE** ********************** BBCFMT0B **********************************
C*****
C***** END OF TEST SEGMENT 199
STOP
END
*END-OF,FM378
FM379.f 481036332 170 2 100666 12704 `
*HEADER,FORTR,FM379
*FILES1,FORTR,FM379,X
C***********************************************************************
C***** FORTRAN 77
C***** FM379
C***** XRFOR - (201)
C*****
C***********************************************************************
C***** GENERAL PURPOSE SUBSET REF
C***** TEST TRIGONOMETRIC FORMULAE 15.3
C***** TABLE 5
C*****
CBB** ********************** BBCCOMNT **********************************
C****
C**** 1978 FORTRAN COMPILER VALIDATION SYSTEM
C**** VERSION 2.0
C****
C****
C**** SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO
C**** GENERAL SERVICES ADMINISTRATION
C**** FEDERAL SOFTWARE TESTING CENTER
C**** 5203 LEESBURG PIKE, SUITE 1100
C**** FALLS CHURCH, VA. 22041
C****
C**** (703) 756-6153
C****
CBE** ********************** BBCCOMNT **********************************
CBB** ********************** BBCINITA **********************************
C**** SPECIFICATION STATEMENTS
C****
CHARACTER ZVERS*13, ZVERSD*17, ZDATE*17, ZPROG*5, ZCOMPL*20,
1 ZNAME*20, ZTAPE*10, ZPROJ*13, REMRKS*31, ZTAPED*13
CBE** ********************** BBCINITA **********************************
CBB** ********************** BBCINITB **********************************
C**** INITIALIZE SECTION
DATA ZVERS, ZVERSD, ZDATE
1 /'VERSION 2.0 ', '82/08/02*18.33.46', '*NO DATE*TIME'/
DATA ZCOMPL, ZNAME, ZTAPE
1 /'*NONE SPECIFIED*', '*NO COMPANY NAME*', '*NO TAPE*'/
DATA ZPROJ, ZTAPED, ZPROG
1 /'*NO PROJECT*', '*NO TAPE DATE', 'XXXXX'/
DATA REMRKS /' '/
C**** THE FOLLOWING 9 COMMENT LINES (CZ01, CZ02, ...) CAN BE REPLACED
C**** FOR IDENTIFYING THE TEST ENVIRONMENT
C****
CZ01 ZVERS = 'VERSION OF THE COMPILER VALIDATION SYSTEM'
CZ02 ZVERSD = 'CREATION DATE/TIME OF THE COMPILER VALIDATION SYSTEM'
CZ03 ZPROG = 'PROGRAM NAME'
CZ04 ZDATE = 'DATE OF TEST'
CZ05 ZCOMPL = 'COMPILER IDENTIFICATION'
CZ06 ZPROJ = 'PROJECT NUMBER/IDENTIFICATION'
CZ07 ZNAME = 'NAME OF USER'
CZ08 ZTAPE = 'TAPE OWNER/ID'
CZ09 ZTAPED = 'DATE TAPE COPIED'
C
IVPASS = 0
IVFAIL = 0
IVDELE = 0
IVINSP = 0
IVTOTL = 0
IVTOTN = 0
ICZERO = 0
C
C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER.
I01 = 05
C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER.
I02 = 06
C
CX010 REPLACED BY FEXEC X-010 CONTROL CARD (CARD-READER UNIT NUMBER).
C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5
CX011 REPLACED BY FEXEC X-011 CONTROL CARD. CX011 IS FOR SYSTEMS
C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX010.
C
CX020 REPLACED BY FEXEC X-020 CONTROL CARD (PRINTER UNIT NUMBER).
C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02= 6
CX021 REPLACED BY FEXEC X-021 CONTROL CARD. CX021 IS FOR SYSTEMS
C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX020.
C
CBE** ********************** BBCINITB **********************************
NUVI = I02
IVTOTL = 10
ZPROG = 'FM379'
CBB** ********************** BBCHED0A **********************************
C****
C**** WRITE REPORT TITLE
C****
WRITE (I02, 90002)
WRITE (I02, 90006)
WRITE (I02, 90007)
WRITE (I02, 90008) ZVERS, ZVERSD
WRITE (I02, 90009) ZPROG, ZPROG
WRITE (I02, 90010) ZDATE, ZCOMPL
CBE** ********************** BBCHED0A **********************************
C*****
C***** HEADER FOR SEGMENT 201
WRITE(NUVI,20101)
20101 FORMAT(1H , / 35H XRFOR - (201) INTRINSIC FUNCTIONS//
1 24H TRIGONOMETRIC FORMULAE//
2 20H SUBSET REF. - 15.3)
CBB** ********************** BBCHED0B **********************************
C**** WRITE DETAIL REPORT HEADERS
C****
WRITE (I02,90004)
WRITE (I02,90004)
WRITE (I02,90013)
WRITE (I02,90014)
WRITE (I02,90015) IVTOTL
CBE** ********************** BBCHED0B **********************************
C*****
PIVS = 3.1415926535897932384626434
C*****
CT001* TEST 1 LN(EXP(X)) = 1
IVTNUM = 1
BVS = 17.5
AVS = ALOG(EXP(1.75)) - BVS / 10.0
IF (AVS + 0.50000E-04) 20010, 10010, 40010
40010 IF (AVS - 0.50000E-04) 10010, 10010, 20010
10010 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0011
20010 IVFAIL = IVFAIL + 1
RVCORR = 0.0000
WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR
0011 CONTINUE
CT002* TEST 2 SIN**2 + COS**2 = 1
IVTNUM = 2
BVS = 10.0 / 4.0
CVS = SIN(BVS) ** 2
DVS = COS(BVS) ** 2
AVS = CVS + DVS - 1.0
IF (AVS + 0.50000E-04) 20020, 10020, 40020
40020 IF (AVS - 0.50000E-04) 10020, 10020, 20020
10020 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0021
20020 IVFAIL = IVFAIL + 1
RVCORR = 0.0000
WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR
0021 CONTINUE
CT003* TEST 3 SIN(2X) = 2*SIN(X)*COS(X)
IVTNUM = 3
BVS = 8.5
CVS = BVS * (-0.5)
AVS = (SIN(-4.25) * COS(CVS)) * 2.0 - SIN(-8.5)
IF (AVS + 0.50000E-04) 20030, 10030, 40030
40030 IF (AVS - 0.50000E-04) 10030, 10030, 20030
10030 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0031
20030 IVFAIL = IVFAIL + 1
RVCORR = 0.0000
WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR
0031 CONTINUE
CT004* TEST 4 ARCSIN(X) = ARCCOS(1-X**2)
IVTNUM = 4
AVS = ASIN(-0.875) + ACOS(SQRT(1.0 - (0.875) ** 2))
IF (AVS + 0.50000E-04) 20040, 10040, 40040
40040 IF (AVS - 0.50000E-04) 10040, 10040, 20040
10040 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0041
20040 IVFAIL = IVFAIL + 1
RVCORR = 0.0000
WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR
0041 CONTINUE
CT005* TEST 5 TAN(X)**2 - 1 = -COS(2X)/COS(X)**2
IVTNUM = 5
BVS = 7.0
AVS = COS(1.75) / COS(BVS / 8.0) ** 2 + TAN(0.875) ** 2 -
1 1
IF (AVS + 0.50000E-04) 20050, 10050, 40050
40050 IF (AVS - 0.50000E-04) 10050, 10050, 20050
10050 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0051
20050 IVFAIL = IVFAIL + 1
RVCORR = 0.0000
WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR
0051 CONTINUE
CT006* TEST 6 ATAN(X/Y) = ATAN2(X,Y), Y > 0
IVTNUM = 6
BVS = 12.0
CVS = ATAN2(BVS / 4.0, BVS / 3.0)
AVS = CVS - ATAN(0.75)
IF (AVS + 0.50000E-04) 20060, 10060, 40060
40060 IF (AVS - 0.50000E-04) 10060, 10060, 20060
10060 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0061
20060 IVFAIL = IVFAIL + 1
RVCORR = 0.0000
WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR
0061 CONTINUE
CT007* TEST 7 SQRT(X)**2 = X
IVTNUM = 7
AVS = SQRT(9.125) ** 2 - 9.125
IF (AVS + 0.50000E-04) 20070, 10070, 40070
40070 IF (AVS - 0.50000E-04) 10070, 10070, 20070
10070 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0071
20070 IVFAIL = IVFAIL + 1
RVCORR = 0.0000
WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR
0071 CONTINUE
CT008* TEST 8 LN(X) = LN(10) * LOG10(X)
IVTNUM = 8
BVS = 62.5 / 1000.0
AVS = ALOG10(BVS) * ALOG(10.0) - ALOG(0.0625)
IF (AVS + 0.50000E-04) 20080, 10080, 40080
40080 IF (AVS - 0.50000E-04) 10080, 10080, 20080
10080 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0081
20080 IVFAIL = IVFAIL + 1
RVCORR = 0.0000
WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR
0081 CONTINUE
CT009* TEST 9 COSH**2 - SINH**2 = 1
IVTNUM = 9
BVS = 0.125
CVS = SINH(2.125)
DVS = COSH(2.0 + BVS)
AVS = DVS ** 2 - CVS ** 2 - COSH(0.0)
IF (AVS + 0.50000E-04) 20090, 10090, 40090
40090 IF (AVS - 0.50000E-04) 10090, 10090, 20090
10090 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0091
20090 IVFAIL = IVFAIL + 1
RVCORR = 0.0000
WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR
0091 CONTINUE
CT010* TEST 10 TANH(X) = 1 - 2/(EXP(2X)+1)
IVTNUM = 10
BVS = 5.0
CVS = 2.0
DVS = ALOG10(BVS * CVS) - SQRT(4.0) /
1 (EXP(2.0 * (BVS - CVS)) + COS(0.0))
AVS = DVS - TANH(3.0)
IF (AVS + 0.50000E-04) 20100, 10100, 40100
40100 IF (AVS - 0.50000E-04) 10100, 10100, 20100
10100 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0101
20100 IVFAIL = IVFAIL + 1
RVCORR = 0.0000
WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR
0101 CONTINUE
C*****
CBB** ********************** BBCSUM0 **********************************
C**** WRITE OUT TEST SUMMARY
C****
IVTOTN = IVPASS + IVFAIL + IVDELE + IVINSP
WRITE (I02, 90004)
WRITE (I02, 90014)
WRITE (I02, 90004)
WRITE (I02, 90020) IVPASS
WRITE (I02, 90022) IVFAIL
WRITE (I02, 90024) IVDELE
WRITE (I02, 90026) IVINSP
WRITE (I02, 90028) IVTOTN, IVTOTL
CBE** ********************** BBCSUM0 **********************************
CBB** ********************** BBCFOOT0 **********************************
C**** WRITE OUT REPORT FOOTINGS
C****
WRITE (I02,90016) ZPROG, ZPROG
WRITE (I02,90018) ZPROJ, ZNAME, ZTAPE, ZTAPED
WRITE (I02,90019)
CBE** ********************** BBCFOOT0 **********************************
CBB** ********************** BBCFMT0A **********************************
C**** FORMATS FOR TEST DETAIL LINES
C****
80000 FORMAT (1H ,2X,I3,4X,7HDELETED,32X,A31)
80002 FORMAT (1H ,2X,I3,4X,7H PASS ,32X,A31)
80004 FORMAT (1H ,2X,I3,4X,7HINSPECT,32X,A31)
80008 FORMAT (1H ,2X,I3,4X,7H FAIL ,32X,A31)
80010 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,15X,10HCOMPUTED= ,
1I6,/,1H ,15X,10HCORRECT= ,I6)
80012 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
1E12.5,/,1H ,16X,10HCORRECT= ,E12.5)
80018 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
1A21,/,1H ,16X,10HCORRECT= ,A21)
80020 FORMAT (1H ,16X,10HCOMPUTED= ,A21,1X,A31)
80022 FORMAT (1H ,16X,10HCORRECT= ,A21,1X,A31)
80024 FORMAT (1H ,16X,10HCOMPUTED= ,I6,16X,A31)
80026 FORMAT (1H ,16X,10HCORRECT= ,I6,16X,A31)
80028 FORMAT (1H ,16X,10HCOMPUTED= ,E12.5,10X,A31)
80030 FORMAT (1H ,16X,10HCORRECT= ,E12.5,10X,A31)
80050 FORMAT (1H ,48X,A31)
CBE** ********************** BBCFMT0A **********************************
CBB** ********************** BBCFMT0B **********************************
C**** FORMAT STATEMENTS FOR PAGE HEADERS
C****
90002 FORMAT (1H1)
90004 FORMAT (1H )
90006 FORMAT (1H ,20X,31HFEDERAL SOFTWARE TESTING CENTER)
90007 FORMAT (1H ,19X,34HFORTRAN COMPILER VALIDATION SYSTEM)
90008 FORMAT (1H ,21X,A13,A17)
90009 FORMAT (1H ,/,2H *,A5,6HBEGIN*,12X,15HTEST RESULTS - ,A5,/)
90010 FORMAT (1H ,8X,16HTEST DATE*TIME= ,A17,15H - COMPILER= ,A20)
90013 FORMAT (1H ,8H TEST ,10HPASS/FAIL ,6X,17HDISPLAYED RESULTS,
1 7X,7HREMARKS,24X)
90014 FORMAT (1H ,46H----------------------------------------------,
1 33H---------------------------------)
90015 FORMAT (1H ,48X,17HTHIS PROGRAM HAS ,I3,6H TESTS,/)
C****
C**** FORMAT STATEMENTS FOR REPORT FOOTINGS
C****
90016 FORMAT (1H ,/,2H *,A5,4HEND*,14X,14HEND OF TEST - ,A5,/)
90018 FORMAT (1H ,A13,13X,A20,7H * ,A10,1H/,
1 A13)
90019 FORMAT (1H ,26HFOR OFFICIAL USE ONLY ,35X,15HCOPYRIGHT 1982)
C****
C**** FORMAT STATEMENTS FOR RUN SUMMARY
C****
90020 FORMAT (1H ,21X,I5,13H TESTS PASSED)
90022 FORMAT (1H ,21X,I5,13H TESTS FAILED)
90024 FORMAT (1H ,21X,I5,14H TESTS DELETED)
90026 FORMAT (1H ,21X,I5,25H TESTS REQUIRE INSPECTION)
90028 FORMAT (1H ,21X,I5,4H OF ,I3,15H TESTS EXECUTED)
CBE** ********************** BBCFMT0B **********************************
C*****
C***** END OF TEST SEGMENT 201
STOP
END
*END-OF,FM379
FM401.f 481036337 170 2 100666 35213 `
*HEADER,FORTR,FM401
*FILES1,FORTR,FM401,X
PROGRAM FM401
C
C
C THIS ROUTINE TESTS FOR PROPER EDITING OF LOGICAL DATA BY
C THE L EDIT DESCRIPTOR OF THE FORMAT SPECIFICATION. THE L EDIT
C DESCRIPTOR IS FIRST TESTED FOR PROPER EDITING ON OUTPUT BY
C DIRECTING THE EDITED RESULT TO A PRINT FILE. THE RESULTS MUST
C BE VISUALLY CHECKED FOR CORRECTNESS BY EXAMINING THE EXECUTION
C REPORT PRODUCED BY THIS ROUTINE. NEXT A NONPRINTER FILE WHICH
C IS CONNECTED FOR SEQUENTIAL ACCESS IS CREATED WITH LOGICAL DATA
C FIELDS AND THEN REPOSITIONED TO THE FIRST RECORD IN THE FILE.
C THE FILE IS THEN READ USING THE SAME EDIT DESCRIPTORS AS WERE
C USED TO CREATE THE FILE AND THE INTERNAL DATA REPRESENTATION AS A
C RESULT OF READING THE LOGICAL DATA IS CHECKED.
C THE FOLLOWING L EDITING TESTS ARE MADE TO SEE THAT
C
C (1) THE VALUE T OR F IS PRODUCED ON OUTPUT WHEN THE INTERNAL
C DATUM IS TRUE AND FALSE RESPECTIVELY,
C (2) THE VALUE OF THE INPUT LIST ITEM IS TRUE OR FALSE
C WHEN THE INPUT FIELD IS T AND F RESPECTIVELY,
C (3) THE VALUES .T, .F, T, F, .TRUE., .FALSE., .T, AND
C .F ARE ACCEPTABLE FORMS FOR INPUT DATA FIELDS
C (4) THE INPUT VALUES T OR F MAY BE FOLLOWED BY
C ADDITIONAL CHARACTERS IN THE FIELD,
C (5) THE REPEATABLE EDIT DESCRIPTOR FOR L EDITING FUNCTIONS
C CORRECTLY,
C (6) THE FIELDS CONTAINING LOGICAL DATA CAN BE WRITTEN
C USING ONE L EDIT DESCRIPTOR AND READ USING A DIFFERENT
C FORM OF THE L EDIT DESCRIPTOR.
C
C REFERENCES -
C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN,
C X3.9-1978
C
C SECTION 4.7, LOGICAL TYPE
C SECTION 13.1.1, FORMAT STATEMENT
C SECTION 13.5.10, L EDITING
C
C
C
C ******************************************************************
C A COMPILER VALIDATION SYSTEM FOR THE FORTRAN LANGUAGE
C BASED ON SPECIFICATIONS AS DEFINED IN AMERICAN STANDARD FORTRAN
C X3.9-1978, HAS BEEN DEVELOPED BY THE DEPARTMENT OF THE NAVY. THE
C FORTRAN COMPILER VALIDATION SYSTEM (FCVS) CONSISTS OF AUDIT
C ROUTINES, THEIR RELATED DATA, AND AN EXECUTIVE SYSTEM. EACH AUDIT
C ROUTINE IS A FORTRAN PROGRAM OR SUBPROGRAM WHICH INCLUDES TESTS
C OF SPECIFIC LANGUAGE ELEMENTS AND SUPPORTING PROCEDURES INDICATING
C THE RESULT OF EXECUTING THESE TESTS.
C
C THIS PARTICULAR PROGRAM OR SUBPROGRAM CONTAINS ONLY FEATURES
C FOUND IN THE SUBSET LEVEL OF THE STANDARD.
C
C SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO
C DEPARTMENT OF THE NAVY
C FEDERAL COBOL COMPILER TESTING SERVICE
C WASHINGTON, D.C. 20376
C
C ******************************************************************
C
C
IMPLICIT LOGICAL (L)
IMPLICIT CHARACTER*14 (C)
C
DIMENSION LAON15(5), LAON12(2)
DIMENSION IDUMP(132)
C
C
C
C INITIALIZATION SECTION.
C
C INITIALIZE CONSTANTS
C ********************
C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER
I01 = 5
C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER
I02 = 6
C SYSTEM ENVIRONMENT SECTION
C
CX010 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-010 CONTROL CARD.
C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5
C (UNIT NUMBER FOR CARD READER).
CX011 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-011 CONTROL CARD
C THE CX011 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL
C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX010 ABOVE.
C
CX020 THIS CARD IS PEPLACED BY CONTENTS OF FEXEC X-020 CONTROL CARD.
C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02 = 6
C (UNIT NUMBER FOR PRINTER).
CX021 THIS CARD IS PEPLACED BY CONTENTS OF FEXEC X-021 CONTROL CARD.
C THE CX021 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL
C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX020 ABOVE.
C
IVPASS = 0
IVFAIL = 0
IVDELE = 0
ICZERO = 0
C
C WRITE OUT PAGE HEADERS
C
WRITE (I02,90002)
WRITE (I02,90006)
WRITE (I02,90008)
WRITE (I02,90004)
WRITE (I02,90010)
WRITE (I02,90004)
WRITE (I02,90016)
WRITE (I02,90001)
WRITE (I02,90004)
WRITE (I02,90012)
WRITE (I02,90014)
WRITE (I02,90004)
C
C
C
C TEST 001 THROUGH 007 TESTS THE L EDIT DESCRIPTOR FOR PROPER
C EDITING OF LOGICAL DATUM ON OUTPUT. TO VALIDATE THESE TESTS
C THE EDITED DATUM IS SENT TO A PRINT FILE AND THEREFORE MUST BE
C VISUALLY CHECKED FOR CORRECTNESS. ON OUTPUT THE EDITED FIELD
C CONSISTS OF W-1 (W IS NUMBER OF POSITIONS IN THE FIELD) BLANKS
C FOLLOWED BY A T OR F AS THE VALUE OF THE DATUM IS TRUE OR FALSE
C RESPECTIVELY. SEE SECTION 13.5.10 L EDITING.
C
C
80052 FORMAT (1H ,4X,48HTESTS 001 THROUGH 007 MUST BE VISUALLY VERIFIED.
1)
80054 FORMAT (1H ,56HIMMEDIATELY FOLLOWING THIS NARRATIVE IS A REFERENCE
1 LINE)
80056 FORMAT (1H ,52HOF THE FORM '123456 ...'. THE REFERENCE LINE IS T
1O)
80058 FORMAT (1H ,49HAID IN THE VISUAL VERIFICATION OF THE TESTS. FOR)
80062 FORMAT (1H ,50HTHE OUTPUT TO BE CORRECT THE DATA VALUES DISPLAYED)
80064 FORMAT (1H ,54HIN THE COMPUTED COLUMN MUST MATCH THAT IN THE CORRE
1CT )
80066 FORMAT (1H ,44HCOLUMN IN BOTH VALUE AND CHARACTER POSITION.)
80072 FORMAT (1H ,26HREFERENCE LINE - ,10H1234567890,5X,10H1234
1567890)
WRITE (I02,80052)
WRITE (I02,80054)
WRITE (I02,80056)
WRITE (I02,80058)
WRITE (I02,80062)
WRITE (I02,80064)
WRITE (I02,80066)
WRITE (I02,90004)
WRITE (I02,80072)
C
C **** FCVS PROGRAM 401 - TEST 001 ****
C
C TEST 001 TESTS FOR PROPER EDITING OF THE L EDIT DESCRIPTOR
C ON OUTPUT WHERE THE FIELD IS 1 POSITION IN LENGTH, THE
C VALUE OF THE DATUM IS TRUE AND THE OUTPUT LIST ITEM IS A
C VARIABLE.
C
IVTNUM = 001
IF (ICZERO) 30010, 0010, 30010
0010 CONTINUE
LCON01 = .TRUE.
0012 FORMAT (1H ,4X,I5,26X,L1,14X,1HT)
WRITE (I02, 0012) IVTNUM, LCON01
GO TO 0021
30010 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
0021 CONTINUE
C
C **** FCVS PROGRAM 401 - TEST 002 ****
C
C TEST 002 IS SIMILAR TO TEST 001 EXCEPT THAT THE OUTPUT LIST
C ITEM IS AN ARRAY ELEMENT.
C
IVTNUM = 002
IF (ICZERO) 30020, 0020, 30020
0020 CONTINUE
LAON12(2) = .TRUE.
0022 FORMAT (1H ,4X,I5,26X,L1,14X,1HT)
WRITE (I02, 0022) IVTNUM, LAON12(2)
GO TO 0031
30020 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
0031 CONTINUE
C
C **** FCVS PROGRAM 401 - TEST 003 ****
C
C TEST 003 TESTS TO SEE THAT ON OUTPUT 9 BLANKS PRECEDE THE VALUE
C T WHERE THE L EDIT DESCRIPTOR INDICATES THAT THE FIELD OCCUPIES
C 10 POSITIONS. THE VALUE OF THE INTERNAL DATUM IS TRUE.
C
IVTNUM = 003
IF (ICZERO) 30030, 0030, 30030
0030 CONTINUE
LCON01 = .TRUE.
0032 FORMAT (1H ,4X,I5,17X,L10,5X,10H T)
WRITE (I02, 0032) IVTNUM, LCON01
GO TO 0041
30030 IVDELE = IVDELE + 1
WRITE (I02, 80000) IVTNUM
0041 CONTINUE
C
C **** FCVS PROGRAM 401 - TEST 004 ****
C
C TEST 004 TESTS TO SEE THAT THE VALUE F IS PRODUCED ON OUTPUT
C WHEN THE VALUE OF THE INTERNAL DATUM IS FALSE AND THE L EDITING
C FIELD IS 1 POSITION IN LENGTH.
C
IVTNUM = 004
IF (ICZERO) 30040, 0040, 30040
0040 CONTINUE
LCON02 = .FALSE.
0042 FORMAT (1H ,4X,I5,26X,L1,14X,1HF)
WRITE (I02, 0042) IVTNUM, LCON02
GO TO 0051
30040 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
0051 CONTINUE
C
C **** FCVS PROGRAM 401 - TEST 005 ****
C
C TEST 005 VERIFIES THAT ON OUTPUT 9 BLANKS PRECEDE THE VALUE F
C WHERE THE L EDIT DESCRIPTOR IS L10 (FIELD OCCUPIES 10 POSITIONS).
C THE VALUE OF THE INTERNAL DATUM IS FALSE.
C
IVTNUM = 005
IF (ICZERO) 30050, 0050, 30050
0050 CONTINUE
LCON02 = .FALSE.
0052 FORMAT (1H ,4X,I5,17X,L10,5X,10H F)
WRITE (I02, 0052) IVTNUM, LCON02
GO TO 0061
30050 IVDELE = IVDELE + 1
WRITE (I02, 80000) IVTNUM
0061 CONTINUE
C
C **** FCVS PROGRAM 401 - TEST 006 ****
C
C TEST 006 TESTS THE OPTIONAL REPEAT SPECIFICATION OF THE L
C EDIT DESCRIPTOR WHERE THE FIELD OCCUPIES 1 POSITION (EDIT
C DESCRIPTOR IS 5L1).
C
IVTNUM = 006
IF (ICZERO) 30060, 0060, 30060
0060 CONTINUE
LCON01 = .TRUE.
LCON02 = .FALSE.
LCON03 = .FALSE.
LAON12(1) = .FALSE.
LAON12(2) = .TRUE.
0062 FORMAT (1H ,4X,I5,17X,5H ,5L1,5X,10H TFFFT)
WRITE (I02, 0062) IVTNUM, LCON01, LCON02, LCON03, LAON12(1),
1LAON12(2)
GO TO 0071
30060 IVDELE = IVDELE + 1
WRITE (I02, 80000) IVTNUM
0071 CONTINUE
C
C *** FCVS PROGRAM 401 - TEST 007 ****
C
C TEST 007 TESTS THE OPTIONAL REPEAT SPECIFICATION OF THE L
C EDIT DESCRIPTOR WHERE THE FIELD OCCUPIES 3 POSITIONS (EDIT
C DESCRIPTOR IS 3L3).
C
IVTNUM = 007
IF (ICZERO) 30070, 0070, 30070
0070 CONTINUE
LCON01 = .TRUE.
LCON02 = .FALSE.
LAON12(2) = .TRUE.
0072 FORMAT (1H ,4X,I5,17X,1H ,3L3,5X,10H T F T)
WRITE (I02, 0072) IVTNUM, LCON01, LCON02, LAON12(2)
GO TO 0081
30070 IVDELE = IVDELE + 1
WRITE (I02, 80000) IVTNUM
0081 CONTINUE
C
C THE FOLLOWING BLOCK OF SOURCE CODE BEGINNING WITH COMMENT LINE
C **** CREATE-FILE SECTION AND ENDING WITH THE COMMENT LINE
C **** END-OF-CREATE-FILE SECTION BUILDS A FILE WHICH IS USED IN
C TESTING THE L EDIT DESCRIPTOR. THE FILE PROPERTIES ARE
C
C FILE IDENTIFIER - I08 (X-NUMBER 08)
C RECORD SIZE - 80 CHARACTERS
C ACCESS METHOD - SEQUENTIAL
C RECORD TYPE - FORMATTED
C DESIGNATED DEVICE - DISK
C TYPE OF DATA - LOGICAL (L FORMAT)
C RECORDS IN FILE - 141
C
C THE FIRST 20 POSITIONS OF EACH RECORD IN THE FILE UNIQUELY
C IDENTIFY THAT RECORD. THE REMAINING POSITONS OF THE RECORD
C CONTAIN DATA WHICH IS USED IN TESTING THE L EDIT DESCRIPTOR.
C A DESCRIPTION OF EACH FIELD OF THE 20-CHARACTER PREAMBLE FOLLOWS.
C
C VARIABLE NAME IN PROGRAM CHARACTER POSITIONS
C ----------------------- -------------------
C
C IPROG (ROUTINE NAME) - 1 THRU 3
C IFILE (LOGICAL/ X-NUMBER) - 4 THRU 5
C ITOTR (RECORDS IN FILE) - 6 THRU 9
C IRLGN (CHARACTERS IN RECORD) - 10 THRU 12
C IRECN (RECORD NUMBER) - 13 THRU 16
C IEOF (9999 IF LAST RECORD) - 17 THRU 20
C
C DEFAULT ASSIGNMENT FOR FILE IS I08 = 07
I08 = 07
CX080 THIS CARD IS REPLACED BY THE CONTENTS OF CARD X-080
CX081 THIS CARD IS REPLACED BY THE CONTENTS OF CARD X-081
IPROG = 401
IFILE = I08
ITOTR = 141
IRLGN = 80
IRECN = 0
IEOF = 0
C
C THERE ARE 10 SETS OF 14 RECORDS PER SET PLUS ONE
C TRAILER RECORD FOR A TOTAL OF 141 DATA RECORDS IN THE FILE.
C ALTHOUGH ONLY 12 RECORDS ARE USED IN TESTING, THE FILE IS MADE
C LARGER TO PRECLUDE THE FILE FROM BEING TOTALY STORED IN MEMORY
C DURING EXECUTION OF THIS ROUTINE.
C
C
C
C **** CREATE-FILE SECTION
LCON01 = .TRUE.
LCON02 = .FALSE.
70001 FORMAT (I3,I2,I4,I3,2I4,58X,1HT,1HF)
70002 FORMAT (I3,I2,I4,I3,2I4,40X,10H T,10H F)
70003 FORMAT (I3,I2,I4,I3,2I4,47X,6H.TRUE.,7H.FALSE.)
70004 FORMAT (I3,I2,I4,I3,2I4,56X,2H.T,2H.F)
70005 FORMAT (I3,I2,I4,I3,2I4,48X,6H .T,6H .F)
70006 FORMAT (I3,I2,I4,I3,2I4,38X,15HTHIS IS ALLOWED,7HFINALLY)
70007 FORMAT (I3,I2,I4,I3,2I4,48X,6HTRUE ,6HFALSE )
70008 FORMAT (I3,I2,I4,I3,2I4,40X,10H .TIME. ,10H .FIELD. )
70009 FORMAT (I3,I2,I4,I3,2I4,07X,53HTHIS IS VERY LARGE FIELD FOR INPUT
1OF LOGICAL VALUES.)
70010 FORMAT (I3,I2,I4,I3,2I4,55X,5HTFTFT)
70011 FORMAT (I3,I2,I4,I3,2I4,44X,16H T T F F)
70012 FORMAT (I3,I2,I4,I3,2I4,55X,L5)
70013 FORMAT (I3,I2,I4,I3,2I4,55X,4X,L1)
70014 FORMAT (I3,I2,I4,I3,2I4,59X,1H )
DO 4012 I=1,10
IRECN = IRECN + 1
WRITE (I08, 70001) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF
IRECN = IRECN + 1
WRITE (I08, 70002) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF
IRECN = IRECN + 1
WRITE (I08, 70003) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF
IRECN = IRECN + 1
WRITE (I08, 70004) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF
IRECN = IRECN + 1
WRITE (I08, 70005) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF
IRECN = IRECN + 1
WRITE (I08, 70006) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF
IRECN = IRECN + 1
WRITE (I08, 70007) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF
IRECN = IRECN + 1
WRITE (I08, 70008) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF
IRECN = IRECN + 1
WRITE (I08, 70009) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF
IRECN = IRECN + 1
WRITE (I08, 70010) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF
IRECN = IRECN + 1
WRITE (I08, 70011) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF
IRECN = IRECN + 1
WRITE (I08, 70012) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF, LCON01
IRECN = IRECN + 1
WRITE (I08, 70012) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF, LCON02
IRECN = IRECN + 1
WRITE (I08, 70013) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF, LCON01
4012 CONTINUE
IRECN = IRECN + 1
IEOF = 9999
WRITE (I08, 70014) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF
ENDFILE I08
REWIND I08
WRITE (I02, 90004)
70015 FORMAT (53H FILE I08 HAS BEEN CREATED AND CONTAINS 141 RECORDS)
70016 FORMAT (1H ,38HINCORRECT NUMBER OF RECORDS IN FILE - , I4 , 8H RE
1CORDS)
70017 FORMAT (1H ,49HWRITTEN BUT 141 RECORDS SHOULD HAVE BEEN WRITTEN.)
IF (IRECN - 141) 4013, 4014, 4013
4013 WRITE (I02, 70016) IRECN
WRITE (I02, 70017)
GO TO 4015
4014 WRITE (I02, 70015)
WRITE (I02, 90004)
4015 CONTINUE
C
C **** END-OF-CREATE-FILE SECTION
C
C
C
C TEST 8 AND 9 VERIFY THAT ON INPUT THE VALUE T AND F IS TRUE
C AND FALSE RESPECTIVELY. THE FIELD IS ONE POSITION IN LENGTH AND
C USES THE EDIT DESCRIPTOR L1.
C
C
LVON01 = .FALSE.
LVON02 = .TRUE.
0082 FORMAT (78X,L1,L1)
READ (I08, 0082) LVON01, LVON02
C THE ABOVE READ AND ASSOCIATED FORMAT STATEMENT IS FOR TESTS 8
C AND 9
C
C
C **** FCVS PROGRAM 401 - TEST 008 ****
C
C
C TEST 8 TESTS THE FIELD VALUE T FOR A TRUE CONDITION.
C
C
IVTNUM = 8
IF (ICZERO) 30080, 0080, 30080
0080 CONTINUE
IVCOMP = 0
IF (LVON01) IVCOMP = 1
IVCORR = 1
40080 IF (IVCOMP - 1) 20080, 10080, 20080
30080 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10080, 0091, 20080
10080 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0091
20080 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0091 CONTINUE
C
C **** FCVS PROGRAM 401 - TEST 009 ****
C
C
C TEST 9 TESTS THE VALUE F FOR A FALSE CONDITION
C
C
IVTNUM = 9
IF (ICZERO) 30090, 0090, 30090
0090 CONTINUE
IVCOMP = 1
IF (.NOT. LVON02) IVCOMP = 0
IVCORR = 0
40090 IF (IVCOMP - 0) 20090, 10090, 20090
30090 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10090, 0101, 20090
10090 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0101
20090 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0101 CONTINUE
C
C
C THE INPUT FIELD MAY CONSIST OF OPTIONAL BLANKS FOLLOWED BY T OR
C F. TEST 10 AND 11 VERIFY THAT THE VALUE T OR F PRECEDED BY BLANKS
C ON INPUT IS TRUE OR FALSE RESPECTIVELY. THE EDIT DESCRIPTOR BEING
C TESTED IS L10 (INPUT FIELD HAS 10 POSITIONS).
C
C
LVON01 = .FALSE.
LVON02 = .TRUE.
0102 FORMAT (60X,L10,L10)
READ (I08, 0102) LVON01, LVON02
C THE ABOVE READ AND ASSOCIATED FORMAT STATEMENT IS FOR TESTS 10
C AND 11
C
C **** FCVS PROGRAM 401 - TEST 010 ****
C
C
C TEST 10 TESTS A FIELD OF BLANKS FOLLOWED BY A T FOR A TRUE
C CONDITION.
C
C
IVTNUM = 10
IF (ICZERO) 30100, 0100, 30100
0100 CONTINUE
IVCOMP = 0
IF (LVON01) IVCOMP = 1
IVCORR = 1
40100 IF (IVCOMP - 1) 20100, 10100, 20100
30100 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10100, 0111, 20100
10100 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0111
20100 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0111 CONTINUE
C
C **** FCVS PROGRAM 401 - TEST 011 ****
C
C
C TEST 11 TESTS A FIELD OF BLANKS FOLLOWED BY A F FOR A FALSE
C CONDITION
C
C
IVTNUM = 11
IF (ICZERO) 30110, 0110, 30110
0110 CONTINUE
IVCOMP = 1
IF (.NOT. LVON02) IVCOMP = 0
IVCORR = 0
40110 IF (IVCOMP - 0) 20110, 10110, 20110
30110 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10110, 0121, 20110
10110 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0121
20110 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0121 CONTINUE
C
C
C TESTS 12 AND 13 VERIFY THAT THE FIELD CONTENTS .TRUE . OR
C .FALSE. ARE ACCEPTABLE INPUT FORMS AND THE VALUE OF THE INTERNAL
C DATUM IS TRUE OR FALSE RESPECTIVELY.
C
C
LVON01 = .FALSE.
LVON02 = .TRUE.
0122 FORMAT (67X,L6,L7)
READ (I08, 0122) LVON01, LVON02
C THE ABOVE READ AND ASSOCIATED FORMAT STATEMENT IS FOR TESTS 12
C AND 13
C
C **** FCVS PROGRAM 401 - TEST 012 ****
C
C
C TEST 12 TESTS THE INPUT FIELD CONTENTS .TRUE. FOR A TRUE
C CONDITION.
C
C
IVTNUM = 12
IF (ICZERO) 30120, 0120, 30120
0120 CONTINUE
IVCOMP = 0
IF (LVON01) IVCOMP = 1
IVCORR = 1
40120 IF (IVCOMP - 1) 20120, 10120, 20120
30120 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10120, 0131, 20120
10120 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0131
20120 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0131 CONTINUE
C
C **** FCVS PROGRAM 401 - TEST 013 ****
C
C
C TEST 13 TESTS THE INPUT FIELD CONTENTS .FALSE. FOR A FALSE
C CONDITION.
C
C
IVTNUM = 13
IF (ICZERO) 30130, 0130, 30130
0130 CONTINUE
IVCOMP = 1
IF (.NOT. LVON02) IVCOMP = 0
IVCORR = 0
40130 IF (IVCOMP - 0) 20130, 10130, 20130
30130 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10130, 0141, 20130
10130 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0141
20130 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0141 CONTINUE
C
C
C TESTS 14 AND 15 VERIFY THAT VALUE .T OR .F ARE ACCEPTABLE INPUT
C FORMS AND THAT THE VALUE OF THE INTERNAL DATUM IS TRUE OR FALSE
C RESPECTIVELY.
C
C
LVON01 = .FALSE.
LVON02 = .TRUE.
0142 FORMAT (76X,L2,L2)
READ (I08, 0142) LVON01, LVON02
C THE ABOVE READ STATEMENT AND ASSOCIATED FORMAT IS FOR TESTS
C 14 AND 15
C
C
C **** FCVS PROGRAM 401 - TEST 014 ****
C
C TEST 14 TESTS THE INPUT FIELD CONTENTS .T FOR A TRUE CONDITION
C
C
IVTNUM = 14
IF (ICZERO) 30140, 0140, 30140
0140 CONTINUE
IVCOMP = 0
IF (LVON01) IVCOMP = 1
IVCORR = 1
40140 IF (IVCOMP - 1) 20140, 10140, 20140
30140 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10140, 0151, 20140
10140 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0151
20140 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0151 CONTINUE
C
C **** FCVS PROGRAM 401 - TEST 015 ****
C
C
C TEST 15 TESTS THE INPUT FIELD CONTENTS .F FOR A FALSE CONDITION
C
C
IVTNUM = 15
IF (ICZERO) 30150, 0150, 30150
0150 CONTINUE
IVCOMP = 1
IF (.NOT. LVON02) IVCOMP = 0
IVCORR = 0
40150 IF (IVCOMP - 0) 20150, 10150, 20150
30150 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10150, 0161, 20150
10150 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0161
20150 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0161 CONTINUE
C
C
C TEST 16 AND 17 VERIFY THAT VALUE .T OR .F PRECEDED BY BLANKS
C ARE ACCEPTABLE INPUT FORMS AND THE VALUE OF THE INTERNAL DATA
C AS A RESULT OF THE READ ARE TRUE AND FALSE RESPECTIVELY.
C
C
LVON01 = .FALSE.
LVON02 = .TRUE.
0162 FORMAT (68X,L6,L6)
READ (I08, 0162) LVON01, LVON02
C THE ABOVE READ AND ASSOCIATED FORMAT STATEMENT ARE FOR TESTS
C 16 AND 17.
C
C
C **** FCVS PROGRAM 401 - TEST 016 ****
C
C TEST 16 TESTS THE INPUT FIELD CONTENTS .T PRECEDED BY 4 BLANKS
C FOR A TRUE CONDITION.
C
C
IVTNUM = 16
IF (ICZERO) 30160, 0160, 30160
0160 CONTINUE
IVCOMP = 0
IF (LVON01) IVCOMP = 1
IVCORR = 1
40160 IF (IVCOMP - 1) 20160, 10160, 20160
30160 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10160, 0171, 20160
10160 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0171
20160 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0171 CONTINUE
C
C **** FCVS PROGRAM 401 - TEST 017 ****
C
C
C TEST 17 TESTS THE INPUT FIELD CONTENTS .F PRECEDED BY 4 BLANKS
C FOR A FALSE CONDITION.
C
C
IVTNUM = 17
IF (ICZERO) 30170, 0170, 30170
0170 CONTINUE
IVCOMP = 1
IF (.NOT. LVON02) IVCOMP = 0
IVCORR = 0
40170 IF (IVCOMP - 0) 20170, 10170, 20170
30170 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10170, 0181, 20170
10170 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0181
20170 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0181 CONTINUE
C
C
C THE INPUT FIELD MAY HAVE T OR F FOLLOWED BY ADDITIONAL
C CHARACTERS IN THE FIELD. TESTS 18 THROUGH 24 VERIFY THAT T OR F
C FOLLOWED BY ADDITIONAL CHARACTERS ARE ACCEPTABLE INPUT FORMS AND
C THE VALUE OF THE LOGICAL ENTITIES AS A RESULT OF THE READ ARE TRUE
C AND FALSE RESPECTIVELY.
C
C
LVON01 = .FALSE.
LVON02 = .TRUE.
0182 FORMAT (58X,L15,L7)
READ (I08, 0182) LVON01, LVON02
C THE ABOVE READ AND ASSOCIATED FORMAT STATEMENT ARE FOR TESTS
C 18 AND 19.
C
C **** FCVS PROGRAM 401 - TEST 018 ****
C
C
C TEST 18 TESTS THE INPUT FIELD CONTENTS OF 'THIS IS ALLOWED'
C FOR A TRUE CONDITION.
C
C
IVTNUM = 18
IF (ICZERO) 30180, 0180, 30180
0180 CONTINUE
IVCOMP = 0
IF (LVON01) IVCOMP = 1
IVCORR = 1
40180 IF (IVCOMP - 1) 20180, 10180, 20180
30180 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10180, 0191, 20180
10180 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0191
20180 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0191 CONTINUE
C
C **** FCVS PROGRAM 401 - TEST 019 ****
C
C
C TEST 19 TEST THE INPUT FIELD CONTENTS 'FINALLY' FOR A
C FALSE CONDITION.
C
C
IVTNUM = 19
IF (ICZERO) 30190, 0190, 30190
0190 CONTINUE
IVCOMP = 1
IF (.NOT. LVON02) IVCOMP = 0
IVCORR = 0
40190 IF (IVCOMP - 0) 20190, 10190, 20190
30190 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10190, 0201, 20190
10190 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0201
20190 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0201 CONTINUE
C
C **** FCVS PROGRAM 401 - TEST 020 ****
C
C
IVTNUM = 20
IF (ICZERO) 30200, 0200, 30200
0200 CONTINUE
LVON01 = .FALSE.
LVON02 = .TRUE.
0202 FORMAT (68X,L6,L6)
READ (I08, 0202) LVON01, LVON02
C THE ABOVE READ AND ASSOCIATED FORMAT STATEMENTS ARE FOR TESTS
C 20 AND 21.
C
C TEST 20 TESTS THE INPUT FIELD CONTENTS OF 'TRUE ' (T FOLLOWED
C BY CHARACTERS WHICH INCLUDE SPACES) FOR A TRUE CONDITION.
C
IVCOMP = 0
IF (LVON01) IVCOMP = 1
IVCORR = 1
40200 IF (IVCOMP - 1) 20200, 10200, 20200
30200 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10200, 0211, 20200
10200 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0211
20200 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0211 CONTINUE
C
C **** FCVS PROGRAM 401 - TEST 021 ****
C
C
C TEST 21 TESTS THE INPUT FIELD CONTENTS OF 'FALSE '
C (F FOLLOWED BY CHARACTERS WHICH INCLUDE SPACES) FOR A FALSE
C CONDITION.
C
C
IVTNUM = 21
IF (ICZERO) 30210, 0210, 30210
0210 CONTINUE
IVCOMP = 1
IF (.NOT. LVON02) IVCOMP = 0
IVCORR = 0
40210 IF (IVCOMP - 0) 20210, 10210, 20210
30210 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10210, 0221, 20210
10210 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0221
20210 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0221 CONTINUE
C
C **** FCVS PROGRAM 401 - TEST 022 ****
C
C
C
IVTNUM = 22
IF (ICZERO) 30220, 0220, 30220
0220 CONTINUE
LVON01 = .FALSE.
LVON02 = .TRUE.
0222 FORMAT (60X,L10,L10)
READ (I08, 0222) LVON01, LVON02
C THE ABOVE READ AND ASSOCIATED FORMAT STATEMENT ARE FOR TESTS
C 22 AND 23.
C
C TEST 22 TESTS THE INPUT FIELD CONTENTS OF ' .TIME. ' (.T
C FOLLOWED BY CHARACTERS WHICH INCLUDE SPACES AND PERIODS) FOR A
C TRUE CONDITION.
C
IVCOMP = 0
IF (LVON01) IVCOMP = 1
IVCORR = 1
40220 IF (IVCOMP - 1) 20220, 10220, 20220
30220 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10220, 0231, 20220
10220 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0231
20220 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0231 CONTINUE
C
C **** FCVS PROGRAM 401 - TEST 023 ****
C
C
C TEST 23 TESTS THE INPUT FIELD CONTENTS OF ' .FIELD. ' (.F
C FOLLOWED BY CHARACTERS WHICH INCLUDE SPACES AND PERIODS) FOR A
C FALSE CONDITION.
C
C
IVTNUM = 23
IF (ICZERO) 30230, 0230, 30230
0230 CONTINUE
IVCOMP = 1
IF (.NOT. LVON02) IVCOMP = 0
IVCORR = 0
40230 IF (IVCOMP - 0) 20230, 10230, 20230
30230 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10230, 0241, 20230
10230 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0241
20230 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0241 CONTINUE
C
C **** FCVS PROGRAM 401 - TEST 024 ****
C
C
C
IVTNUM = 24
IF (ICZERO) 30240, 0240, 30240
0240 CONTINUE
LVON01 = .FALSE.
0242 FORMAT (27X,L53)
READ (I08, 0242) LVON01
C
C TEST 24 TESTS USE OF A LARGE INPUT FIELD WITH THE CONTENTS
C 'THIS IS A VERY LARGE FIELD FOR INPUT OF LOGICAL VALUES. '. THE
C EDIT DESCRIPTOR IS L53 AND THE VALUE OF THE INTERNAL DATUM AS A
C RESULT OF THE READ SHOULD GIVE A TRUE CONDITION.
C
IVCOMP = 0
IF (LVON01) IVCOMP = 1
IVCORR = 1
40240 IF (IVCOMP - 1) 20240, 10240, 20240
30240 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10240, 0251, 20240
10240 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0251
20240 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0251 CONTINUE
C
C **** FCVS PROGRAM 401 - TEST 025 ****
C
C
C TEST 25 TESTS USE OF THE OPTIONAL REPEAT SPECIFICATION WITH
C THE L EDIT DESCRIPTOR. THE INPUT FIELD IS 1 POSITION IN LENGTH.
C
C
IVTNUM = 25
IF (ICZERO) 30250, 0250, 30250
0250 CONTINUE
LAON15(1) = .FALSE.
LAON15(2) = .TRUE.
LAON15(3) = .FALSE.
LAON15(4) = .TRUE.
LAON15(5) = .FALSE.
0252 FORMAT (75X,5L1)
READ (I08, 0252) (LAON15(I), I = 1, 5)
IVCOMP = 1
IVCORR = 2310
IF (LAON15(1)) IVCOMP = IVCOMP * 2
IF (.NOT. LAON15(2)) IVCOMP = IVCOMP * 3
IF (LAON15(3)) IVCOMP = IVCOMP * 5
IF (.NOT. LAON15(4)) IVCOMP = IVCOMP * 7
IF (LAON15(5)) IVCOMP = IVCOMP * 11
40250 IF (IVCOMP - 2310) 20250, 10250, 20250
30250 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10250, 0261, 20250
10250 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0261
20250 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0261 CONTINUE
C
C **** FCVS PROGRAM 401 - TEST 026 ****
C
C
C TEST 26 IS SIMILAR TO TEST 25 EXCEPT THAT EACH INPUT FIELD
C CONTAINING LOGICAL DATA IS 4 CHARACTERS IN LENGTH. THE EDIT
C DESCRIPTOR IS 4L4.
C
C
IVTNUM = 26
IF (ICZERO) 30260, 0260, 30260
0260 CONTINUE
LAON15(1) = .FALSE.
LAON15(2) = .FALSE.
LAON15(3) = .TRUE.
LAON15(4) = .TRUE.
0262 FORMAT (64X,4L4)
READ (I08, 0262) (LAON15(I), I = 1, 4)
IVCOMP = 1
IVCORR = 210
IF (LAON15 (1)) IVCOMP = IVCOMP * 2
IF (LAON15(2)) IVCOMP = IVCOMP * 3
IF (.NOT. LAON15(3)) IVCOMP = IVCOMP * 5
IF (.NOT. LAON15(4)) IVCOMP = IVCOMP * 7
40260 IF (IVCOMP - 210) 20260, 10260, 20260
30260 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10260, 0271, 20260
10260 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0271
20260 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0271 CONTINUE
C
C
C THE PURPOSE OF TESTS 27 THROUGH 29 IS TO VERIFY THAT RECORDS
C CAN BE WRITTEN USING ONE EDIT DESCRIPTOR FORM AND READ USING
C ANOTHER FORM.
C
C
C
C **** FCVS PROGRAM 401 - TEST 027 ****
C
C
C TEST 27 READS A RECORD WITH THE EDIT DESCRIPTORS 4X,L1. THE
C RECORD WAS WRITTEN USING THE DESCRIPTOR L5. THE VALUE OF THE
C LOGICAL ENTITIES AS A RESULT OF THE READ SHOULD BE TRUE.
C
C
IVTNUM = 27
IF (ICZERO) 30270, 0270, 30270
0270 CONTINUE
LVON01 = .FALSE.
0272 FORMAT (55X,20X,4X,L1)
READ (I08, 0272) LVON01
IVCOMP = 0
IVCORR = 1
IF (LVON01) IVCOMP = 1
40270 IF (IVCOMP - 1) 20270, 10270, 20270
30270 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10270, 0281, 20270
10270 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0281
20270 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0281 CONTINUE
C
C **** FCVS PROGRAM 401 - TEST 028 ****
C
C TEST 28 READS A RECORD WITH THE EDIT DESCRIPTOR 4X,L1. THE
C RECORD WAS WRITTEN USING THE EDIT DESCRIPTOR L5. THIS TEST IS
C SIMILAR TO TEST 27 EXCEPT THE VALUE OF THE LOGICAL ENTITIES AS A
C RESULT OF THE READ SHOULD BE FALSE.
C
C
IVTNUM = 28
IF (ICZERO) 30280, 0280, 30280
0280 CONTINUE
LVON02 = .TRUE.
0282 FORMAT (55X,20X,4X,L1)
READ (I08, 0282) LVON02
IVCOMP = 1
IVCORR = 0
IF (.NOT. LVON02) IVCOMP = 0
40280 IF (IVCOMP - 0) 20280, 10280, 20280
30280 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10280, 0291, 20280
10280 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0291
20280 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0291 CONTINUE
C
C **** FCVS PROGRAM 401 - TEST 029 ****
C
C
C TEST 29 READS A RECORD WITH THE EDIT DESCRIPTOR L5. THE
C RECORD WAS WRITTEN USING THE EDIT DESCRIPTORS 4X,L1. THE VALUE
C OF INTERNAL DATUM AS A RESULT OF THE READ SHOULD BE TRUE.
C
C
IVTNUM = 29
IF (ICZERO) 30290, 0290, 30290
0290 CONTINUE
LVON01 = .FALSE.
0292 FORMAT (55X,20X,L5)
READ (I08, 0292) LVON01
IVCOMP = 0
IVCORR = 1
IF (LVON01) IVCOMP = 1
40290 IF (IVCOMP - 1) 20290, 10290, 20290
30290 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10290, 0301, 20290
10290 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0301
20290 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0301 CONTINUE
C
C
C
C THE FOLLOWING SOURCE CODE BRACKETED BY THE COMMENT LINES
C ***** BEGIN-FILE-DUMP SECTION AND ***** END-FILE-DUMP SECTION
C MAY OR MAY NOT APPEAR AS COMMENTS IN THE SOURCE PROGRAM.
C THIS CODE IS OPTIONAL AND BY DEFAULT IT IS AUTOMATICALLY COMMENTED
C OUT BY THE EXECUTIVE ROUTINE. A DUMP OF THE FILE USED BY THIS
C ROUTINE IS PROVIDED BY USING THE *OPT1 EXECUTIVE ROUTINE CONTROL
C CARD. IF THE OPTIONAL CODE IS SELECTED THE ROUTINE WILL DUMP
C THE CONTENTS OF THE FILE TO THE PRINT FILE FOLLOWING THE TEST
C REPORT AND BEFORE THE TEST REPORT SUMMARY.
C
C ***** BEGIN-FILE-DUMP SECTION *****
C
C
CDB**
C REWIND I08
C ITOTR = 141
C IRNUM = 1
C ILUN = I08
C7701 FORMAT (I3,I2,I4,I3,2I4,60A1)
C7702 FORMAT (1H ,I3,I2,I4,I3,2I4,60A1)
C7703 FORMAT (10X,5HFILE ,I2,5H HAS ,I3,13H RECORDS - OK)
C7704 FORMAT (10X,5HFILE ,I2,5H HAS ,I3,27H RECORDS - THERE SHOULD BE ,
C 1I3,9H RECORDS.)
C DO 7771 IRNUM = 1, ITOTR
C READ (ILUN, 7701) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF,
C 1 (IDUMP(ICH), ICH = 1,60)
C WRITE (I02, 7702) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF,
C 1 (IDUMP(ICH), ICH = 1,60)
C IF (IEOF .EQ. 9999) GO TO 7772
C7771 CONTINUE
C GO TO 7775
C7772 IF (IRNUM - ITOTR) 7774, 7773, 7775
C7773 WRITE (I02, 7703) ILUN, IRNUM
C GO TO 7779
C7774 WRITE (I02, 7704) ILUN, IRNUM, ITOTR
C GO TO 7779
C7775 DO 7776 I = 1,20
C READ (ILUN, 7701) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF,
C 1 (IDUMP(ICH), ICH = 1,60)
C WRITE (I02, 7702) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF,
C 1 (IDUMP(ICH), ICH = 1,60)
C IRNUM = IRNUM + 1
C IF (IEOF .EQ. 9999) GO TO 7777
C7776 CONTINUE
C7777 WRITE (I02 , 7704) ILUN, IRNUM, ITOTR
C7779 CONTINUE
CDE** * END-FILE-DUMP SECTION *
C TEST 029 IS THE LAST TEST IN THIS PROGRAM. THE ROUTINE SHOULD
C HAVE MADE 29 EXPLICIT TESTS AND PROCESSED ONE FILE CONNECTED FOR
C SEQUENTIAL ACCESS
C
C
C
C WRITE OUT TEST SUMMARY
C
WRITE (I02,90004)
WRITE (I02,90014)
WRITE (I02,90004)
WRITE (I02,90000)
WRITE (I02,90004)
WRITE (I02,90020) IVFAIL
WRITE (I02,90022) IVPASS
WRITE (I02,90024) IVDELE
STOP
90001 FORMAT (1H ,24X,5HFM401)
90000 FORMAT (1H ,20X,20HEND OF PROGRAM FM401)
C
C FORMATS FOR TEST DETAIL LINES
C
80000 FORMAT (1H ,4X,I5,6X,7HDELETED)
80002 FORMAT (1H ,4X,I5,7X,4HPASS)
80010 FORMAT (1H ,4X,I5,7X,4HFAIL,10X,I6,9X,I6)
80012 FORMAT (1H ,4X,I5,7X,4HFAIL,4X,E12.5,3X,E12.5)
80018 FORMAT (1H ,4X,I5,7X,4HFAIL,2X,A14,1X,A14)
C
C FORMAT STATEMENTS FOR PAGE HEADERS
C
90002 FORMAT (1H1)
90004 FORMAT (1H )
90006 FORMAT (1H ,10X,34HFORTRAN COMPILER VALIDATION SYSTEM)
90008 FORMAT (1H ,21X,11HVERSION 1.0)
90010 FORMAT (1H ,8X,38HFOR OFFICIAL USE ONLY - COPYRIGHT 1978)
90012 FORMAT (1H ,5X,4HTEST,5X,9HPASS/FAIL,5X,8HCOMPUTED,8X,7HCORRECT)
90014 FORMAT (1H ,5X,46H----------------------------------------------)
90016 FORMAT (1H ,18X,17HSUBSET LEVEL TEST)
C
C FORMAT STATEMENTS FOR RUN SUMMARY
C
90020 FORMAT (1H ,19X,I5,13H TESTS FAILED)
90022 FORMAT (1H ,19X,I5,13H TESTS PASSED)
90024 FORMAT (1H ,19X,I5,14H TESTS DELETED)
END
*END-OF,FM401
FM402.f 481036344 170 2 100666 41474 `
*HEADER,FORTR,FM402
*FILES1,FORTR,FM402,X
PROGRAM FM402
C
C
C
C THIS ROUTINE TESTS THE A(W) (W IS SIZE OF FIELD IN CHARACTERS)
C EDIT DESCRIPTOR OF THE FORMAT SPECIFICATION BOTH WITH AND WITHOUT
C THE OPTIONAL W. THE A EDIT DESCRIPTOR IS USED WITH AN INPUT/
C OUTPUT LIST ITEM OF TYPE CHARACTER. IF A FIELD WIDTH W IS SPECI-
C FIED WITH THE A EDIT DESCRIPTOR THE FIELD CONSISTS OF W CHARAC-
C TERS. IF A FIELD WIDTH W IS NOT SPECIFIED WITH THE A EDIT DES-
C CRIPTOR, THE NUMBER OF CHARACTERS IN THE FIELD IS THE LENGTH OF
C THE CHARACTER INPUT/OUTPUT LIST ITEM. THIS ROUTINE FIRST
C TESTS FOR PROPER EDITING OF CHARACTER DATA ON OUTPUT BY DIRECTING
C THE EDITED RESULT TO A PRINT FILE. RESULTS OF THIS SET OF
C TESTS MUST BE VISUALLY CHECKED FOR CORRECTNESS. NEXT AN EXTERNAL
C FILE CONNECTED FOR SEQUENTIAL ACCESS IS CREATED WITH CHARACTER
C DATA. FINALLY THE FILE IS REWOUND AND READ WITH THE A(W) EDIT
C DESCRIPTOR AND CHECKED FOR PROPER EDITING ON INPUT.
C
C THIS ROUTINE TESTS FOR PROPER EDITING BY
C
C (1) THE A EDIT DESCRIPTOR WITHOUT THE OPTIONAL W ON BOTH INPUT
C AND OUTPUT,
C
C (2) THE AW EDIT DESCRIPTOR WHEN THE LENGTH OF THE INPUT/OUTPUT
C LIST ITEM IS LESS THAN THE WIDTH W,
C
C (3) THE AW EDIT DESCRIPTOR WHEN THE LENGTH OF THE INPUT/OUTPUT
C LIST ITEM IS BOTH EQUAL TO AND GREATER THAN THE WIDTH W,
C
C (4) THE A EDIT DESCRIPTOR WHEN USED WITH THE OPTIONAL REPEAT
C SPECIFICATION.
C
C REFERENCES -
C
C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN,
C X3.9-1978
C
C SECTION 3.1, FORTRAN CHARACTER SET
C SECTION 4.8, CHARACTER TYPE
C SECTION 8.4.2, CHARACTER TYPE-STATEMENT
C SECTION 10.4, CHARACTER ASSIGNMENT STATEMENT
C SECTION 13.5.11, A EDITING
C
C
C
C
C ******************************************************************
C A COMPILER VALIDATION SYSTEM FOR THE FORTRAN LANGUAGE
C BASED ON SPECIFICATIONS AS DEFINED IN AMERICAN STANDARD FORTRAN
C X3.9-1978, HAS BEEN DEVELOPED BY THE DEPARTMENT OF THE NAVY. THE
C FORTRAN COMPILER VALIDATION SYSTEM (FCVS) CONSISTS OF AUDIT
C ROUTINES, THEIR RELATED DATA, AND AN EXECUTIVE SYSTEM. EACH AUDIT
C ROUTINE IS A FORTRAN PROGRAM OR SUBPROGRAM WHICH INCLUDES TESTS
C OF SPECIFIC LANGUAGE ELEMENTS AND SUPPORTING PROCEDURES INDICATING
C THE RESULT OF EXECUTING THESE TESTS.
C
C THIS PARTICULAR PROGRAM OR SUBPROGRAM CONTAINS ONLY FEATURES
C FOUND IN THE SUBSET LEVEL OF THE STANDARD.
C
C SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO
C DEPARTMENT OF THE NAVY
C FEDERAL COBOL COMPILER TESTING SERVICE
C WASHINGTON, D.C. 20376
C
C ******************************************************************
C
C
IMPLICIT LOGICAL (L)
IMPLICIT CHARACTER*14 (C)
C
DIMENSION IDUMP (80)
DIMENSION CATN11(46), CATN12(5), CATN31(2,3,2), CATN14(46)
CHARACTER CATN11*1, CVTN11*1, CATN12*5, CATN31*1
CHARACTER CVTN12*10, CVTN13*2, CATN14*1, CCTN15*50, CVTN15*50
CHARACTER CVTN01*1
DATA CATN14 /46*' '/
DATA CCTN15 /'ABCDEFG HIJKLMN OPQRSTUVWXYZ 0123456789'/
DATA CATN11 / '0', '1', '2', '3', '4', '5', '6', '7', '8', '9',
1'=', '+', '-','*', '/', '(', ')', ',', '.', '''','A', 'B', 'C',
2'D', 'E', 'F','G', 'H', 'I', 'J', 'K', 'L', 'M', 'N', 'O', 'P',
3'Q', 'R', 'S','T', 'U', 'V', 'W', 'X', 'Y', 'Z'/
DATA CATN12 /'ABMYZ', '01589', '=+-()','A5+Z.' ,'1''A,4'/
C
C
C
C INITIALIZATION SECTION.
C
C INITIALIZE CONSTANTS
C ********************
C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER
I01 = 5
C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER
I02 = 6
C SYSTEM ENVIRONMENT SECTION
C
CX010 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-010 CONTROL CARD.
C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5
C (UNIT NUMBER FOR CARD READER).
CX011 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-011 CONTROL CARD
C THE CX011 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL
C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX010 ABOVE.
C
CX020 THIS CARD IS PEPLACED BY CONTENTS OF FEXEC X-020 CONTROL CARD.
C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02 = 6
C (UNIT NUMBER FOR PRINTER).
CX021 THIS CARD IS PEPLACED BY CONTENTS OF FEXEC X-021 CONTROL CARD.
C THE CX021 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL
C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX020 ABOVE.
C
IVPASS = 0
IVFAIL = 0
IVDELE = 0
ICZERO = 0
C
C WRITE OUT PAGE HEADERS
C
WRITE (I02,90002)
WRITE (I02,90006)
WRITE (I02,90008)
WRITE (I02,90004)
WRITE (I02,90010)
WRITE (I02,90004)
WRITE (I02,90016)
WRITE (I02,90001)
WRITE (I02,90004)
WRITE (I02,90012)
WRITE (I02,90014)
WRITE (I02,90004)
C
C
C
C TEST 001 THROUGH 014 TESTS THE EDIT DESCRIPTOR FOR PROPER
C EDITING OF CHARACTER DATA ON OUTPUT. TO VALIDATE THESE TESTS
C THE EDITED DATA IS SENT TO A PRINT FILE AND THEREFORE MUST BE
C VISUALLY CHECKED FOR CORRECTNESS. ON OUTPUT THE EDITED FIELD
C SIZE IS AW WHERE W IS NUMBER OF POSITIONS IN THE FIELD OR
C IS THE SIZE OF THE OUTPUT DATUM ITEM. SEE SECTION 13.5.11 A
C EDITING
C
C
80052 FORMAT (1H ,4X,48HTESTS 001 THROUGH 014 MUST BE VISUALLY VERIFIED.
1)
80054 FORMAT (1H ,56HIMMEDIATELY FOLLOWING THIS NARRATIVE IS A REFERENCE
1 LINE)
80056 FORMAT (1H ,52HOF THE FORM '123456 ...'. THE REFERENCE LINE IS T
1O)
80058 FORMAT (1H ,49HAID IN THE VISUAL VERIFICATION OF THE TESTS. FOR)
80062 FORMAT (1H ,50HTHE OUTPUT TO BE CORRECT THE DATA VALUES DISPLAYED
1)
80064 FORMAT (1H ,54HIN THE COMPUTED COLUMN MUST MATCH THAT IN THE CORRE
1CT )
80066 FORMAT (1H ,44HCOLUMN IN BOTH VALUE AND CHARACTER POSITION.)
80072 FORMAT (1H ,26HREFERENCE LINE - ,10H1234567890,5X,10H1234
1567890)
WRITE (I02,80052)
WRITE (I02,80054)
WRITE (I02,80056)
WRITE (I02,80058)
WRITE (I02,80062)
WRITE (I02,80064)
WRITE (I02,80066)
WRITE (I02,90004)
WRITE (I02,80072)
C
C **** FCVS PROGRAM 402 - TEST 001 ****
C
C TEST 001 TESTS FOR PROPER EDITING OF THE A EDIT DESCRIPTOR
C ON OUTPUT WHERE THE FIELD IS 1 POSITION IN LENGTH, THE
C VALUE OF THE DATUM IS LETTERS AND THE OUTPUT LIST ITEM IS A
C VARIABLE.
C
IVTNUM = 001
IF (ICZERO) 30010, 0010, 30010
0010 CONTINUE
CVTN01 = 'A'
0012 FORMAT (1H ,4X,I5,26X,A,14X,1HA)
WRITE (I02, 0012) IVTNUM, CVTN01
GO TO 0021
30010 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
0021 CONTINUE
C
C **** FCVS PROGRAM 402 - TEST 002 ****
C
C TEST 002 IS SIMILAR TO TEST 001 EXCEPT THAT THE OUTPUT LIST
C ITEM IS AN ARRAY ELEMENT.
C
IVTNUM = 002
IF (ICZERO) 30020, 0020, 30020
0020 CONTINUE
CATN31 (1,2,1) = 'Z'
0022 FORMAT (1H ,4X,I5,26X,A,14X,1HZ)
WRITE (I02, 0022) IVTNUM, CATN31 (1,2,1)
GO TO 0031
30020 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
0031 CONTINUE
C
C *** FCVS PROGRAM 402 - TEST 003 ****
C
C TEST 003 VERIFIES THAT THE A EDIT DESCRIPTOR (WITHOUT THE
C W OPTION) CAN PROPERLY EDIT SPECIAL CHARACTERS ON OUTPUT. THE
C SPECIAL CHARACTER / (SLASH) IS USED FOR THIS TEST AND IS STORED
C IN AN OUTPUT LIST ITEM 1 POSITION IN LENGTH.
C
IVTNUM = 003
IF (ICZERO) 30030, 0030, 30030
0030 CONTINUE
CVTN11 = '/'
0032 FORMAT (1H ,4X,I5,26X,A,14X,1H/)
WRITE (I02, 0032) IVTNUM, CVTN11
GO TO 0041
30030 IVDELE = IVDELE + 1
WRITE (I02, 80000) IVTNUM
0041 CONTINUE
C
C *** FCVS PROGRAM 402 - TEST 004 ***
C
C TEST 004 IS SIMILAR TO TEST 003 EXCEPT THAT THE DATA BEING
C EDITED IS NUMERIC.
C
IVTNUM = 004
IF (ICZERO) 30040, 0040, 30040
0040 CONTINUE
CVTN11 = '9'
0042 FORMAT (1H ,4X,I5,26X,A,14X,1H9)
WRITE (I02, 0042) IVTNUM, CVTN11
GO TO 0051
30040 IVDELE = IVDELE + 1
WRITE (I02, 80000) IVTNUM
0051 CONTINUE
C
C *** FCVS PROGRAM 402 - TEST 005 ***
C
C TEST 005 IS SIMILAR TO TEST 003 EXCEPT THAT IT USES THE SPECIAL
C CHARACTER QUOTE.
C
IVTNUM = 005
IF (ICZERO) 30050, 0050, 30050
0050 CONTINUE
CVTN11 = ''''
0052 FORMAT (1H ,4X,I5,26X,A,14X,1H')
WRITE (I02, 0052) IVTNUM, CVTN11
GO TO 0061
30050 IVDELE = IVDELE + 1
WRITE (I02, 80000) IVTNUM
C
C
C TESTS 006 THROUGH TEST 011 TESTS THE A EDIT DESCRIPTOR
C WITHOUT THE FIELD WIDTH SPECIFICATION (W OPTION) WHERE THE SIZE
C OF THE OUTPUT DATA ITEM IS 05 CHARACTERS IN LENGTH.
C
C
0061 CONTINUE
C
C **** FCVS PROGRAM 402 - TEST 006 ****
C
C TEST 006 TESTS USE OF THE A EDIT DESCRIPTOR WITH LETTERS
C
IVTNUM = 006
IF (ICZERO) 30060, 0060, 30060
0060 CONTINUE
CATN12(1) = 'ABMYZ'
0062 FORMAT(1H ,4X,I5,17X,5H ,A,5X,10H ABMYZ)
WRITE (I02, 0062) IVTNUM, CATN12(1)
GO TO 0071
30060 IVDELE = IVDELE + 1
WRITE (I02, 80000) IVTNUM
0071 CONTINUE
C
C **** FCVS PROGRAM 402 - TEST 007 ****
C
C TEST 007 TESTS USE OF THE A EDIT DESCRIPTOR WITH DIGITS
C
IVTNUM = 007
IF (ICZERO) 30070, 0070, 30070
0070 CONTINUE
CATN12(2) = '01589'
0072 FORMAT(1H ,4X,I5,17X,5H ,A,5X,10H 01589)
WRITE (I02, 0072) IVTNUM, CATN12(2)
GO TO 0081
30070 IVDELE = IVDELE + 1
WRITE (I02, 80000) IVTNUM
0081 CONTINUE
C
C **** FCVS PROGRAM 402 - TEST 008 ****
C
C TEST 008 TESTS USE OF THE A EDIT DESCRIPTOR WITH SPECIAL
C CHARACTERS.
C
IVTNUM = 008
IF (ICZERO) 30080, 0080, 30080
0080 CONTINUE
CATN12(3) = '=+-()'
0082 FORMAT(1H ,4X,I5,17X,5H ,A,5X,10H =+-())
WRITE (I02, 0082) IVTNUM, CATN12(3)
GO TO 0091
30080 IVDELE = IVDELE + 1
WRITE (I02, 80000) IVTNUM
0091 CONTINUE
C
C **** FCVS PROGRAM FM402 - TEST 009 ****
C
C TEST 009 TESTS USE OF THE A EDIT DESCRIPTOR WITH A MIX
C OF LETTERS, DIGITS AND SPECIAL CHARACTERS
C
IVTNUM = 009
IF (ICZERO) 30090, 0090, 30090
0090 CONTINUE
CATN12(4) = 'A5+.Z'
0092 FORMAT(1H ,4X,I5,17X,5H ,A,5X,10H A5+.Z)
WRITE (I02, 0092) IVTNUM, CATN12(4)
GO TO 0101
30090 IVDELE = IVDELE + 1
WRITE (I02, 80000) IVTNUM
0101 CONTINUE
C
C **** FCVS PROGRAM FM402 - TEST 010 ****
C
C TEST 010 TESTS USE OF THE A EDIT DESCRIPTOR WITH A MIX
C OF LETTERS, DIGITS AND SPECIAL CHARACTERS INCLUDING APOSTROPES
C
IVTNUM = 010
IF (ICZERO) 30100, 0100, 30100
0100 CONTINUE
CATN12(5) = '1''A,4'
0102 FORMAT(1H ,4X,I5,17X,5H ,A,5X,10H 1'A,4)
WRITE (I02, 0102) IVTNUM, CATN12(5)
GO TO 0111
30100 IVDELE = IVDELE + 1
WRITE (I02, 80000) IVTNUM
C
0111 CONTINUE
C **** FCVS PROGRAM FM402 - TEST 11 ****
C
C TEST 011 USES THE A EDIT DESCRIPTOR (WITHOUT THE OPTIONAL
C FIELD WIDTH SPECIFIED) WITH THE OPTIONAL REPEAT SPECIFICATION.
C EACH OUTPUT LIST ITEM WILL BE ONE CHARACTER IN LENGTH.
C
IVTNUM = 011
IF (ICZERO) 30110, 0110, 30110
0110 CONTINUE
0112 FORMAT (1H ,4X,I5,17X,10A,5X,10H059=+PQUVY)
WRITE (I02, 0112) IVTNUM, CATN11(1), CATN11(6), CATN11(10),
1CATN11(11), CATN11(12), CATN11(36), CATN11(37), CATN11(41),
2CATN11(42), CATN11(45)
GO TO 0121
30110 IVDELE = IVDELE + 1
WRITE (I02, 80000) IVTNUM
0121 CONTINUE
C
C **** FCVS PROGRAM FM402 - TEST 12 ****
C
C TEST 012 IS SIMILAR TO 011 IN THAT THE A DESCRIPTOR IS USED
C WITH THE OPTIONAL REPEAT SPECIFICATION E. G., 3A HOWEVER, EACH
C OUTPUT LIST ITEM HAS A DIFFERENT NUMBER OF CHARACTERS IN THE ITEM
C E. G., THE FIRST I/O LIST ITEM HAS 5 CHARACTERS, THE SECOND
C ITEM HAS 2 CHARACTERS AND THE THIRD ITEM HAS 1 CHARACTER.
C
IVTNUM = 012
IF (ICZERO) 30120, 0120, 30120
0120 CONTINUE
CVTN13 = 'YZ'
CVTN11 = ')'
CATN12(2) = '(12AB'
0122 FORMAT (1H ,4X,I5,17X,1H*,3A,1H*,5X,10H*(12ABYZ)*)
WRITE (I02, 0122) IVTNUM, CATN12(2), CVTN13, CVTN11
GO TO 0131
30120 IVDELE = IVDELE + 1
WRITE (I02, 80000) IVTNUM
0131 CONTINUE
C
C **** FCVS PROGRAM FM402 - TEST 13 ***
C
C TEST 013 TESTS FOR PROPER EDITING OF THE A EDIT DESCRIPTOR
C (WITH THE FIELD WIDTH SPECIFIED) WHEN THE OUTPUT LIST ITEM
C HAS FEWER CHARACTERS THAN SPECIFIED BY THE EDIT DESCRIPTOR. THE
C OUTPUT FIELD SHOULD CONSISTS OF BLANKS FOLLOWED BY CHARACTERS
C FROM THE INTERNAL REPRESENTATION.
C
IVTNUM = 013
IF (ICZERO) 30130, 0130, 30130
0130 CONTINUE
CATN12(1) = 'ABMYZ'
0132 FORMAT (1H ,4X,I5,17X,A10,5X,10H ABMYZ)
WRITE (I02, 0132) IVTNUM, CATN12(1)
GO TO 0141
30130 IVDELE = IVDELE + 1
WRITE (I02, 80000) IVTNUM
0141 CONTINUE
C
C **** FCVS PROGRAM FM402 - TEST 14 ****
C
C TEST 014 TESTS FOR PROPER EDITING OF THE A EDIT DESCRIPTOR
C (WITH THE FIELD WIDTH SPECIFIED) WHEN THE OUTPUT LIST ITEM
C IS GREATER THAN THAT SPECIFIED BY THE EDIT DESCRIPTOR. THE OUTPUT
C FIELD SHOULD CONSIST OF THE LEFTMOST CHARACTERS FROM THE INTERNAL
C REPRESENTATION.
C
IVTNUM = 014
IF (ICZERO) 30140, 0140, 30140
0140 CONTINUE
CVTN12 = '12345ABCDE'
0142 FORMAT (1H ,4X,I5,17X,5H ,A5,5X,10H 12345)
WRITE (I02, 0142) IVTNUM, CVTN12
GO TO 0151
30140 IVDELE = IVDELE + 1
WRITE (I02, 80000) IVTNUM
0151 CONTINUE
C
C THE FOLLOWING BLOCK OF SOURCE CODE BEGINNING WITH COMMENT LINE
C **** CREATE-FILE SECTION AND ENDING WITH THE COMMENT LINE
C **** END-OF-CREATE-FILE SECTION BUILDS A FILE WHICH IS USED IN
C TESTING THE A EDIT DESCRIPTOR. THE FILE PROPERTIES ARE:
C
C FILE IDENTIFIER - I09 (X-NUMBER 09)
C RECORD SIZE - 80 CHARACTERS
C ACCESS METHOD - SEQUENTIAL
C RECORD TYPE - FORMATTED
C DESIGNATED DEVICE - DISK
C TYPE OF DATA - CHARACTER (A FORMAT)
C RECORDS IN FILE - 143 PLUS THE ENDFILE RECORD
C
C THE FIRST 20 POSITIONS OF EACH RECORD IN THE FILE UNIQUELY
C IDENTIFIES THAT RECORD. THE REMAINING POSITONS OF THE RECORD
C CONTAIN DATA WHICH IS USED IN TESTING THE A EDIT DESCRIPTOR.
C A DESCRIPTION OF EACH FIELD OF THE 20-CHARACTER PREAMBLE FOLLOWS.
C
C VARIABLE NAME IN PROGRAM CHARACTER POSITIONS
C -------- ---- -- ------- --------- ---------
C
C IPROG (ROUTINE NAME) - 1 THRU 3
C IFILE (LOGICAL/ X-NUMBER) - 4 THRU 5
C ITOTR (RECORDS IN FILE) - 6 THRU 9
C IRLGN (CHARACTERS IN RECORD) - 10 THRU 12
C IRECN (RECORD NUMBER) - 13 THRU 16
C IEOF (9999 IF LAST RECORD) - 17 THRU 20
C
C DEFAULT ASSIGNMENT FOR FILE IS I09 = 07
I09 = 07
CX090 THIS CARD IS REPLACED BY THE CONTENTS OF CARD X-090
CX091 THIS CARD IS REPLACED BY THE CONTENTS OF CARD X-091
IPROG = 402
IFILE = I09
ITOTR = 143
IRLGN = 80
IRECN = 0
IEOF = 0
C
C
C ***** CREATE-FILE SECTION *****
C
C
C **** FCVS PROGRAM 402 - TEST 015 ****
C
C
C TEST 15 WRITES RECORDS USING THE A EDIT DESCRIPTOR WITHOUT THE
C OPTIONAL FIELD WIDTH SPECIFICATION. EACH CHARACTER OF THE
C FORTRAN SET IS WRITTEN WITH AN A EDIT DESCRIPTOR FROM
C THE INTERNAL REPRESENTATION WHICH IS ONE CHARACTER IN LENGTH.
C TEN DIFFERENT CHARACTERS ARE WRITTEN IN EACH RECORD UNTIL THE
C FULL CHARACTER SET IS EXHAUSTED. THIS SEQUENCE IS REPEATED UNTIL
C 50 RECORDS HAVE BEEN WRITTEN (5 RECORDS PER SET AND 10 SETS).
C THE RECORDS ARE WRITTEN TO A MASS STORAGE FILE.
C
C
IVTNUM = 15
IF (ICZERO) 30150, 0150, 30150
0150 CONTINUE
70003 FORMAT (I3,I2,I4,I3,2I4,50X,10A)
70004 FORMAT (I3,I2,I4,I3,2I4,54X,6A)
IRECN = 0
DO 4023 I=1,10
IRECN = IRECN + 1
WRITE (I09, 70003) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF,
1 (CATN11 (J), J = 1,10)
C CHARACTERS 0 THROUGH 9 ARE CONTAINED IN THIS RECORD
IRECN = IRECN + 1
WRITE (I09, 70003) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF,
1 (CATN11(J), J = 11,20)
C CHARACTERS =,+,-,*,/,(,),,,. AND ' ARE IN THIS RECORD.
IRECN = IRECN + 1
WRITE (I09, 70003) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF,
1 (CATN11(J), J = 21,30)
C CHARACTERS A THROUGH J ARE IN THIS RECORD
IRECN = IRECN + 1
WRITE (I09, 70003) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF,
1 (CATN11(J), J = 31,40)
C CHARACTERS K THROUGH T ARE IN THIS RECORD
IRECN = IRECN + 1
WRITE (I09, 70004) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF,
1 (CATN11(J), J = 41,46)
C CHARACTERS U THROUGH Z ARE IN THIS RECORD
4023 CONTINUE
IVCOMP = IRECN
IVCORR = 050
IVON01 = 50
40150 IF (IVON01 - IRECN ) 20150, 10150, 20150
C VALUE IN IVCOMP IS THE NUMBER OF RECORDS WRITTEN
30150 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10150, 0161, 20150
10150 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0161
20150 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0161 CONTINUE
C
C **** FCVS PROGRAM 402 - TEST 016 ****
C
C
C TEST 16 IS THE SAME AS TEST 15 EXCEPT THAT THE 50 RECORDS
C WRITTEN USE THE A EDIT DESCRIPTOR WITH THE OPTIONAL FIELD WIDTH
C SPECIFIED.
C
C
IVTNUM = 16
IF (ICZERO) 30160, 0160, 30160
0160 CONTINUE
70005 FORMAT (I3,I2,I4,I3,2I4,50X,10A1)
70006 FORMAT (I3,I2,I4,I3,2I4,54X,6A1)
IRECN = 50
DO 4024 I=1,10
IRECN = IRECN + 1
WRITE (I09, 70005) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF,
1 (CATN11(J), J = 1,10)
C CHARACTERS 0 THROUGH 9 ARE CONTAINED IN THIS RECORD
IRECN = IRECN + 1
WRITE (I09, 70005) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF,
1 (CATN11(J), J = 11,20)
C CHARACTERS =,+,-,*,/,(,),,,. AND ' ARE IN THIS RECORD
IRECN = IRECN + 1
WRITE (I09, 70005) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF,
1 (CATN11(J), J = 21,30)
C CHARACTERS A THROUGH J ARE IN THIS RECORD
IRECN = IRECN + 1
WRITE (I09, 70005) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF,
1 (CATN11(J), J = 31,40)
C CHARACTERS K THROUGH T ARE IN THIS RECORD
IRECN = IRECN + 1
WRITE (I09, 70006) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF,
1 (CATN11(J), J = 41,46)
C CHARACTERS U THROUGH Z ARE IN THIS RECORD
4024 CONTINUE
IVCOMP = IRECN - 50
IVCORR = 50
IVON01 = 100
40160 IF (IVON01 - IRECN) 20160, 10160, 20160
30160 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10160, 0171, 20160
10160 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0171
20160 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0171 CONTINUE
C
C **** FCVS PROGRAM 402 - TEST 017 ****
C
C
C TEST 17 WRITES 40 RECORDS CONTAINING CHARACTER DATA WHICH IS
C USED FOR LATER TESTS. THE FILE SHOULD CONTAIN 140 RECORDS
C FOLLOWING EXECUTION OF THIS TEST.
C
C
IVTNUM = 17
IF (ICZERO) 30170, 0170, 30170
0170 CONTINUE
70007 FORMAT (I3,I2,I4,I3,2I4,60HABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789
1 )
70008 FORMAT (I3,I2,I4,I3,2I4,60H=+-*/(),'.ABMYZ01589=+-()A5+Z.1'A,4
1 )
IRECN = 100
DO 4025 I = 1,20
IRECN = IRECN + 1
WRITE (I09, 70007) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF
C CHARACTERS 0 THROUGH 9 AND A THROUGH Z ARE IN THIS RECORD
IRECN = IRECN + 1
WRITE (I09, 70008) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF
C SPECIAL CHARACTERS ARE IN THIS RECORD
4025 CONTINUE
IVCOMP = IRECN - 100
IVCORR = 40
IVON01 = 140
40170 IF (IVON01 - IRECN) 20170, 10170, 20170
30170 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10170, 0181, 20170
10170 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0181
20170 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0181 CONTINUE
C
C **** FCVS PROGRAM 402 - TEST 018 ****
C
C
C TEST 18 WRITES A RECORD WHICH CONTAINS A LONG FIELD (50 CHAR-
C ACTERS) USING AN A EDIT DESCRIPTOR WITHOUT THE OPTIONAL FIELD
C WIDTH SPECIFICATION.
C
C
IVTNUM = 18
IF (ICZERO) 30180, 0180, 30180
0180 CONTINUE
IRECN = 141
70009 FORMAT (I3,I2,I4,I3,2I4,10X,A)
WRITE (I09, 70009) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF, CCTN15
IVCOMP = IRECN - 140
IVCORR = 1
IVON01 = 141
40180 IF (IVON01 - IRECN) 20180, 10180, 20180
30180 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10180, 0191, 20180
10180 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0191
20180 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0191 CONTINUE
C
C **** FCVS PROGRAM 402 - TEST 019 ****
C
C
C TEST 19 WRITES A LONG FIELD (50 CHARACTERS)
C USING AN A EDIT DESCRIPTOR WITH THE OPTIONAL FIELD WIDTH
C SPECIFICATION.
C
C
IVTNUM = 19
IF (ICZERO) 30190, 0190, 30190
0190 CONTINUE
IRECN = 142
70010 FORMAT (I3,I2,I4,I3,2I4,10X,A50)
WRITE (I09, 70010) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF, CCTN15
IVCOMP = IRECN - 141
IVCORR = 1
IVON01 = 142
40190 IF (IVON01 - IRECN) 20190, 10190, 20190
30190 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10190, 0201, 20190
10190 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0201
20190 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0201 CONTINUE
C
C **** FCVS PROGRAM 402 - TEST 020 ****
C
C
IVTNUM = 20
IF (ICZERO) 30200, 0200, 30200
0200 CONTINUE
IRECN = IRECN + 1
IEOF = 9999
70011 FORMAT (I3,I2,I4,I3,2I4,59X,1H )
WRITE (I09, 70011) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF
ENDFILE I09
REWIND I09
WRITE (I02, 90004)
70012 FORMAT (53H FILE I09 HAS BEEN CREATED AND CONTAINS 143 RECORDS)
70013 FORMAT (39H INCORRECT NUMBER OF RECORDS IN FILE - , I5 ,08H RECO
1RDS)
70014 FORMAT (50H WRITTEN BUT 143 RECORDS SHOULD HAVE BEEN WRITTEN.)
IF (IRECN - 143) 4020, 4021, 4020
4020 WRITE (I02, 70013) IRECN
WRITE (I02, 70014)
GO TO 4022
4021 WRITE (I02, 70012)
WRITE (I02, 90004)
C
C **** END-OF-CREATE-FILE SECTION ****
C
4022 CONTINUE
C
C TESTS 20 THROUGH 24 READ 5 OF THE FIRST 50 RECORDS USING THE
C A EDIT DESCRIPTOR WITHOUT THE OPTIONAL FIELD WIDTH SPECIFICATION.
C EACH CHARACTER IS CHECKED FOR PROPER EDITING. THE FIELDS ARE
C WRITTEN AND READ WITH THE SAME A EDIT DESCRIPTOR FORM. THE
C RESULTING NUMBER FROM EACH TEST IN IVCOMP AND IVCORR IS
C THE NUMBER OF CORRECT CHARACTERS FOUND AS A RESULT OF THE READ.
C
C
C TEST 20 READS AND CHECKS THE CHARACTERS 0 THROUGH 9. THE
C VALUE RESULTING FROM THE TEST IN IVCOMP AND IVCORR REFLECTS THE
C NUMBER OF CORRECT CHARACTERS FOUND AS A RESULT OF THE READ.
C
IVCOMP = 0
IVCORR = 10
0202 FORMAT (70X,10A)
READ (I09, 0202) (CATN14(J), J = 1,10)
DO 0203 I=1,10
IF (CATN14(I) .EQ. CATN11(I)) IVCOMP = IVCOMP + 1
0203 CONTINUE
40200 IF (IVCOMP - 10) 20200, 10200, 20200
30200 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10200, 0211, 20200
10200 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0211
20200 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0211 CONTINUE
C
C **** FCVS PROGRAM 402 - TEST 021 ****
C
C
C TEST 21 READS AND CHECKS THE CHARACTERS =,+,-,*,/,(,),,,., AND
C '. THE NUMBER RESULTING FROM THE TEST IN IVCOMP AND IVCORR
C REFLECTS THE NUMBER OF CORRECT CHARACTERS FOUND AS A RESULT OF
C THE READ.
C
C
IVTNUM = 21
IF (ICZERO) 30210, 0210, 30210
0210 CONTINUE
IVCOMP = 0
IVCORR = 10
0212 FORMAT (70X,10A)
READ (I09, 0212) (CATN14(J), J = 11,20)
DO 0213 I = 11,20
IF (CATN14(I) .EQ. CATN11(I)) IVCOMP = IVCOMP + 1
0213 CONTINUE
40210 IF (IVCOMP - 10) 20210, 10210, 20210
30210 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10210, 0221, 20210
10210 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0221
20210 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0221 CONTINUE
C
C **** FCVS PROGRAM 402 - TEST 022 ****
C
C
C TEST 22 READS AND CHECKS THE CHARACTERS A THROUGH J.
C
C
IVTNUM = 22
IF (ICZERO) 30220, 0220, 30220
0220 CONTINUE
IVCOMP = 0
IVCORR = 10
0222 FORMAT (70X,10A)
READ (I09, 0222) (CATN14(J), J = 21,30)
DO 0223 I = 21,30
IF (CATN14(I) .EQ. CATN11(I)) IVCOMP = IVCOMP + 1
0223 CONTINUE
40220 IF (IVCOMP - 10) 20220, 10220, 20220
30220 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10220, 0231, 20220
10220 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0231
20220 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0231 CONTINUE
C
C **** FCVS PROGRAM 402 - TEST 023 ****
C
C
C TEST 23 READS AND CHECKS THE CHARACTERS K THROUGH T.
C
C
IVTNUM = 23
IF (ICZERO) 30230, 0230, 30230
0230 CONTINUE
IVCOMP = 0
IVCORR = 10
0232 FORMAT (70X,10A)
READ (I09, 0232) (CATN14(J), J = 31,40)
DO 0233 I = 31,40
IF (CATN14(I) .EQ. CATN11(I)) IVCOMP = IVCOMP + 1
0233 CONTINUE
40230 IF (IVCOMP - 10) 20230, 10230, 20230
30230 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10230, 0241, 20230
10230 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0241
20230 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0241 CONTINUE
C
C **** FCVS PROGRAM 402 - TEST 024 ****
C
C
C TEST 24 READS AND CHECKS THE CHARACTERS U THROUGH Z.
C
C
IVTNUM = 24
IF (ICZERO) 30240, 0240, 30240
0240 CONTINUE
IVCOMP = 0
IVCORR = 06
0242 FORMAT (74X,6A)
READ (I09, 0242) (CATN14(J), J = 41,46)
DO 0243 I = 41,46
IF (CATN14(I) .EQ. CATN11(I)) IVCOMP = IVCOMP + 1
0243 CONTINUE
40240 IF (IVCOMP - 6) 20240, 10240, 20240
30240 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10240, 0251, 20240
10240 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0251
20240 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0251 CONTINUE
C
C
C TESTS 25 THROUGH 29 READ RECORD NUMBERS 56 THROUGH 60 USING
C THE A EDIT DESCRIPTOR WITH THE OPTIONAL FIELD WIDTH SPECIFIED.
C EACH FIELD IS 1 CHARACTER IN LENGTH AND IS CHECKED FOR PROPER
C EDITING. THE FIELDS ARE WRITTEN AND READ WITH THE SAME EDIT
C DESCRIPTOR. THE NUMBER RESULTING FROM EACH TEST IN IVCOMP AND
C IVCORR IS THE THE NUMBER OF CORRECT CHARACTERS FOUND AS A RESULT
C OF THE READ.
C
C
70020 FORMAT (12X,2I4,59X,A1)
REWIND I09
DO 4026 I = 1, 150
READ (I09, 70020, END = 4027) IRECN, IEOF
IF (IRECN .EQ. 55) GO TO 4027
4026 CONTINUE
4027 IF (IRECN - 55) 4028, 4029, 4028
C
C THE CODE IMMEDIATELY PRECEDING POSITIONS THE FILE TO RECORD
C NUMBER 55 FOR TESTS 25 THROUGH 29.
C
70021 FORMAT (64H THE INITIAL RECORD FOR TESTS 25 THROUGH 29 COULD NOT
1BE FOUND,)
70022 FORMAT (49H THEREFORE TESTS 25 THROUGH 29 ARE DELETED.)
4028 WRITE (I02, 70021)
WRITE (I02, 70022)
GO TO 301
4029 CONTINUE
DO 4030 I = 1,46
CATN14(I) = ' '
4030 CONTINUE
C
C THE ABOVE DO LOOP INITIALIZES THE ARRAY CATN14 TO BLANKS.
C
C
C **** FCVS PROGRAM 402 - TEST 025 ****
C
C
C TEST 25 READS AND CHECKS THE CHARACTERS 0 THROUGH 9.
C
C
IVTNUM = 25
IF (ICZERO) 30250, 0250, 30250
0250 CONTINUE
IVCOMP = 0
IVCORR = 10
0252 FORMAT (70X,10A1)
READ (I09, 0252) (CATN14(J), J = 1, 10)
DO 0253 I = 1,10
IF (CATN14(I) .EQ. CATN11(I)) IVCOMP = IVCOMP + 1
0253 CONTINUE
40250 IF (IVCOMP - 10) 20250, 10250, 20250
30250 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10250, 0261, 20250
10250 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0261
20250 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0261 CONTINUE
C
C **** FCVS PROGRAM 402 - TEST 026 ****
C
C
C TEST 26 READS AND CHECKS THE CHARACTERS =,+,-,*,/,(,),,,., AND
C '.
C
C
IVTNUM = 26
IF (ICZERO) 30260, 0260, 30260
0260 CONTINUE
IVCOMP = 0
IVCORR = 10
0262 FORMAT (70X,10A1)
READ (I09, 0262) (CATN14(J), J = 11, 20)
DO 0263 I = 11,20
IF (CATN14(I) .EQ. CATN11(I)) IVCOMP = IVCOMP + 1
0263 CONTINUE
40260 IF (IVCOMP -10) 20260, 10260, 20260
30260 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10260, 0271, 20260
10260 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0271
20260 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0271 CONTINUE
C
C **** FCVS PROGRAM 402 - TEST 027 ****
C
C
C TEST 27 READS AND CHECKS THE CHARACTERS A THROUGH J.
C
C
IVTNUM = 27
IF (ICZERO) 30270, 0270, 30270
0270 CONTINUE
IVCOMP = 0
IVCORR = 10
0272 FORMAT (70X,10A1)
READ (I09, 0272) (CATN14(J), J = 21,30)
DO 0273 I = 21,30
IF (CATN14(I) .EQ. CATN11(I)) IVCOMP = IVCOMP + 1
0273 CONTINUE
40270 IF (IVCOMP - 10) 20270, 10270, 20270
30270 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10270, 0281, 20270
10270 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0281
20270 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0281 CONTINUE
C
C **** FCVS PROGRAM 402 - TEST 028 ****
C
C
C TEST 28 READS AND CHECKS THE CHARACTERS K THROUGH T.
C
C
IVTNUM = 28
IF (ICZERO) 30280, 0280, 30280
0280 CONTINUE
IVCOMP = 0
IVCORR = 10
0282 FORMAT (70X,10A1)
READ (I09, 0282) (CATN14(J), J = 31,40)
DO 0283 I = 31, 40
IF (CATN14(I) .EQ. CATN11(I)) IVCOMP = IVCOMP + 1
0283 CONTINUE
40280 IF (IVCOMP - 10) 20280, 10280, 20280
30280 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10280, 0291, 20280
10280 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0291
20280 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0291 CONTINUE
C
C **** FCVS PROGRAM 402 - TEST 029 ****
C
C
C TEST 29 READS AND CHECKS THE CHARACTERS U THROUGH Z.
C
C
IVTNUM = 29
IF (ICZERO) 30290, 0290, 30290
0290 CONTINUE
IVCOMP = 0
IVCORR = 6
0292 FORMAT (74X,6A1)
READ (I09, 0292) (CATN14(J), J = 41,46)
DO 0293 I = 41,46
IF (CATN14(I) .EQ. CATN11(I)) IVCOMP = IVCOMP + 1
0293 CONTINUE
40290 IF (IVCOMP - 6) 20290, 10290, 20290
30290 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10290, 0301, 20290
10290 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0301
20290 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0301 CONTINUE
C
C
C TESTS 30 THROUGH 32 READ RECORD NUMBERS 101 THROUGH 103. THESE
C TESTS TEST FOR PROPER EDITING ON INPUT WHERE THE INPUT FIELD
C AND THE INPUT LIST ITEM ARE OF DIFFERENT SIZES.
C
C
70031 FORMAT (12X,2I4,59X,A1)
REWIND I09
DO 4031 I = 1,150
READ (I09, 70031, END = 4032) IRECN, IEOF
IF (IRECN .EQ. 100) GO TO 4032
4031 CONTINUE
4032 IF (IRECN - 100) 4033, 4034, 4033
70032 FORMAT (64H THE START RECORD FOR TESTS 30 THROUGH 32 COULD NOT
1BE FOUND,)
70033 FORMAT (49H THEREFORE TESTS 30 THROUGH 32 ARE DELETED.)
4033 WRITE (I02, 70032)
WRITE (I02, 70033)
GO TO 331
4034 CONTINUE
C
C **** FCVS PROGRAM 402 - TEST 030 ****
C
C
C TEST 30 TESTS THE A EDIT DESCRIPTOR WITH THE OPTIONAL REPEAT
C SPECIFICATION. THE A EDIT DESCRIPTOR DOES NOT HAVE THE OPTIONAL
C FIELD WIDTH SPECIFICATION AND THE INPUT LIST ITEMS VARY IN SIZE
C FROM 1 TO 10 CHARACTERS. RECORD NUMBER 101 IS READ AND WAS
C CREATED IN TEST 17 WITH THE FORMAT STATEMENT
C
C FORMAT (I3,I2,I4,I3,2I4,60HABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789
C 1 )
C
C
IVTNUM = 30
IF (ICZERO) 30300, 0300, 30300
0300 CONTINUE
IVCOMP = 1
IVCORR = 210
CATN14(1) = ' '
CVTN13 = ' '
CATN12(3) = ' '
CVTN12 = ' '
0302 FORMAT (20X,4A,42X,A1)
READ (I09, 0302, END = 0303) CATN14(1), CVTN13, CATN12(3), CVTN12
0303 IF (CATN14(1) .EQ. 'A') IVCOMP = IVCOMP * 2
IF (CVTN13 .EQ. 'BC') IVCOMP = IVCOMP * 3
IF (CATN12(3) .EQ. 'DEFGH') IVCOMP = IVCOMP * 5
IF (CVTN12 .EQ. 'IJKLMNOPQR') IVCOMP = IVCOMP * 7
40300 IF (IVCOMP - 210) 20300, 10300, 20300
30300 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10300, 0311, 20300
10300 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0311
20300 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0311 CONTINUE
C
C **** FCVS PROGRAM 402 - TEST 031 ****
C
C
C TEST 31 TESTS FOR PROPER EDITING OF THE A EDIT DESCRIPTOR WHEN
C THE SPECIFIED WIDTH OF THE DESCRIPTOR IS LESS THAN THE INTERNAL
C REPRESENTATION OF THE INPUT LIST ITEM. THE CHARACTERS SHOULD
C APPEAR LEFT-JUSTIFIED WITH TRAILING BLANKS IN THE INTERNAL
C REPRESENTATION. RECORD NUMBER 102 IS READ AND WAS CREATED
C IN TEST 17 WITH THE FORMAT STATEMENT
C
C FORMAT (I3,I2,I4,I3,2I4,60H=+-*/(),'.ABMYZ01589=+-()A5+Z.1'A,4
C 1 )
C
C
C
IVTNUM = 31
IF (ICZERO) 30310, 0310, 30310
0310 CONTINUE
CVTN12 = '9999999999'
IVCOMP = 0
IVCORR = 1
0312 FORMAT (20X,10X,A5,40X)
READ (I09, 0312, END = 0313) CVTN12
0313 IF (CVTN12 .EQ. 'ABMYZ ') IVCOMP = 1
40310 IF (IVCOMP - 1) 20310, 10310, 20310
30310 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10310, 0321, 20310
10310 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0321
20310 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0321 CONTINUE
C
C **** FCVS PROGRAM 402 - TEST 032 ****
C
C
C TEST 32 TESTS FOR PROPER EDITING OF THE A EDIT
C DESCRIPTOR WHEN THE WIDTH OF THE DESCRIPTOR IS GREATER THAN THE
C INTERNAL REPRESENTATION OF THE INPUT LIST ITEM. THE RIGHTMOST
C CHARACTERS SHOULD BE TAKEN FROM THE INPUT FIELD. RECORD NUMBER
C 103 IS EXPECTED TO BE READ. THE RECORD WAS CREATED IN TEST 17
C WITH THE FORMAT STATEMENT
C
C FORMAT (I3,I2,I4,I3,2I4,60HABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789
C 1 )
C
C
C
IVTNUM = 32
IF (ICZERO) 30320, 0320, 30320
0320 CONTINUE
CATN12 (5) = 'AAAAA'
IVCOMP = 0
IVCORR = 1
0322 FORMAT (20X,10X,A10,35X)
READ (I09, 0322, END = 0323) CATN12 (5)
0323 IF (CATN12(5) .EQ. 'PQRST') IVCOMP = 1
40320 IF (IVCOMP - 1) 20320, 10320, 20320
30320 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10320, 0331, 20320
10320 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0331
20320 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0331 CONTINUE
C
C
C TESTS 33 AND 34 READ A LONG INPUT FIELD (50 CHARACTERS) AND
C CHECK RESULTING INTERNAL REPRESENTATION. THE RECORD IS READ
C WITH THE SAME A EDIT DESCRIPTOR AS WAS USED TO WRITE THE RECORD.
C
C
70034 FORMAT (12X,2I4,60X)
REWIND I09
DO 4035 I = 1,150
READ (I09, 70034, END = 4036) IRECN, IEOF
IF (IRECN .EQ. 140) GO TO 4036
4035 CONTINUE
4036 IF (IRECN - 140) 4037, 4038, 4037
C THE ABOVE CODE POSITIONS THE FILE TO RECORD NUMBER 140 FOR
C TESTS 33 AND 34.
C
70035 FORMAT (61H THE START RECORD FOR TESTS 33 AND 34 COULD NOT BE
1FOUND,)
70036 FORMAT (45H THEREFORE TESTS 33 AND 34 ARE DELETED.)
4037 WRITE (I02, 70035)
WRITE (I02, 70036)
GO TO 351
4038 CONTINUE
C
C **** FCVS PROGRAM 402 - TEST 033 ****
C
C
C TEST 33 READS A LONG FIELD WITH THE WIDTH SPECIFIED ON THE A
C EDIT DESCRIPTOR. RECORD NUMBER 141 IS READ. THE RECORD WAS
C CREATED IN TEST 18 AND CONTAINS FIELD DATA OF
C
C 'ABCDEFG HIJKLMN OPQRSTUVWXYZ 0123456789'
C
C WITHOUT THE SURROUNDING APOSTROPHES.
C
C
C
IVTNUM = 33
IF (ICZERO) 30330, 0330, 30330
0330 CONTINUE
CVTN15 = ' '
IVCOMP = 0
IVCORR = 1
0332 FORMAT (20X,10X,A50)
READ (I09, 0332) CVTN15
IF (CVTN15 .EQ. 'ABCDEFG HIJKLMN OPQRSTUVWXYZ 012345678
19') IVCOMP = 1
40330 IF (IVCOMP -1 ) 20330, 10330, 20330
30330 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10330, 0341, 20330
10330 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0341
20330 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0341 CONTINUE
C
C **** FCVS PROGRAM 402 - TEST 034 ****
C
C
C TEST 34 READS A LONG FIELD USING THE A EDIT DESCRIPTOR
C WITHOUT THE OPTIONAL WIDTH SPECIFIED. RECORD NUMBER 142 IS READ.
C THE RECORD WAS CREATED IN TEST 19 AND CONTAINS THE FIELD DATA
C
C 'ABCDEFG HIJKLMN OPQRSTUVWXYZ 0123456789'
C
C WITHOUT THE SURROUNDING APOSTROPHES.
C
C
IVTNUM = 34
IF (ICZERO) 30340, 0340, 30340
0340 CONTINUE
CVTN15 = ' '
IVCOMP = 0
IVCORR = 1
0342 FORMAT (20X,10X,A)
READ (I09, 0342) CVTN15
IF (CVTN15 .EQ. 'ABCDEFG HIJKLMN OPQRSTUVWXYZ 012345678
19') IVCOMP = 1
40340 IF (IVCOMP - 1) 20340, 10340, 20340
30340 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10340, 0351, 20340
10340 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0351
20340 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0351 CONTINUE
C
C
C
C THE FOLLOWING SOURCE CODE BRACKETED BY THE COMMENT LINES
C ***** BEGIN-FILE-DUMP SECTION AND ***** END-FILE-DUMP SECTION
C MAY OR MAY NOT APPEAR AS COMMENTS IN THE SOURCE PROGRAM.
C THIS CODE IS OPTIONAL AND BY DEFAULT IT IS AUTOMATICALLY COMMENTED
C OUT BY THE EXECUTIVE ROUTINE. A DUMP OF THE FILE USED BY THIS
C ROUTINE IS PROVIDED BY USING THE *OPT1 EXECUTIVE ROUTINE CONTROL
C CARD. IF THE OPTIONAL CODE IS SELECTED THE ROUTINE WILL DUMP
C THE CONTENTS OF THE FILE TO THE PRINT FILE FOLLOWING THE TEST
C REPORT AND BEFORE THE TEST REPORT SUMMARY.
C
CDB** BEGIN FILE DUMP CODE
C REWIND I09
C IRNUM = 1
C IRLGN = 80
C ILUN = I09
C7701 FORMAT (I3,I2,I4,I3,2I4,60A1)
C7702 FORMAT (1H ,I3,I2,I4,I3,2I4,60A1)
C7703 FORMAT (10X,5HFILE ,I2,5H HAS ,I3,13H RECORDS - OK)
C7704 FORMAT (10X,5HFILE ,I2,5H HAS ,I3,27H RECORDS - THERE SHOULD BE ,
C 1I3,9H RECORDS.)
C DO 7771 IRNUM = 1, ITOTR
C READ (ILUN, 7701) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF,
C 1 (IDUMP(ICH), ICH = 1,60)
C WRITE (I02, 7702) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF,
C 1 (IDUMP(ICH), ICH = 1,60)
C IF (IEOF .EQ. 9999) GO TO 7772
C7771 CONTINUE
C GO TO 7775
C7772 IF (IRNUM - ITOTR) 7774, 7773, 7775
C7773 WRITE (I02, 7703) ILUN, IRNUM
C GO TO 7779
C7774 WRITE (I02, 7704) ILUN, IRNUM, ITOTR
C GO TO 7779
C7775 DO 7776 I = 1,20
C READ (ILUN, 7701) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF,
C 1 (IDUMP(ICH), ICH = 1,60)
C WRITE (I02, 7702) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF,
C 1 (IDUMP(ICH), ICH = 1,60)
C IRNUM = IRNUM + 1
C IF (IEOF .EQ. 9999) GO TO 7777
C7776 CONTINUE
C7777 WRITE (I02, 7704) ILUN, IRNUM, ITOTR
C7779 CONTINUE
CDE** END OF DUMP CODE
C
C THERE SHOULD BE 34 TESTS IN THIS ROUTINE
C
C
C
C
C WRITE OUT TEST SUMMARY
C
WRITE (I02,90004)
WRITE (I02,90014)
WRITE (I02,90004)
WRITE (I02,90000)
WRITE (I02,90004)
WRITE (I02,90020) IVFAIL
WRITE (I02,90022) IVPASS
WRITE (I02,90024) IVDELE
STOP
90001 FORMAT (1H ,24X,5HFM402)
90000 FORMAT (1H ,20X,20HEND OF PROGRAM FM402)
C
C FORMATS FOR TEST DETAIL LINES
C
80000 FORMAT (1H ,4X,I5,6X,7HDELETED)
80002 FORMAT (1H ,4X,I5,7X,4HPASS)
80010 FORMAT (1H ,4X,I5,7X,4HFAIL,10X,I6,9X,I6)
80012 FORMAT (1H ,4X,I5,7X,4HFAIL,4X,E12.5,3X,E12.5)
80018 FORMAT (1H ,4X,I5,7X,4HFAIL,2X,A14,1X,A14)
C
C FORMAT STATEMENTS FOR PAGE HEADERS
C
90002 FORMAT (1H1)
90004 FORMAT (1H )
90006 FORMAT (1H ,10X,34HFORTRAN COMPILER VALIDATION SYSTEM)
90008 FORMAT (1H ,21X,11HVERSION 1.0)
90010 FORMAT (1H ,8X,38HFOR OFFICIAL USE ONLY - COPYRIGHT 1978)
90012 FORMAT (1H ,5X,4HTEST,5X,9HPASS/FAIL,5X,8HCOMPUTED,8X,7HCORRECT)
90014 FORMAT (1H ,5X,46H----------------------------------------------)
90016 FORMAT (1H ,18X,17HSUBSET LEVEL TEST)
C
C FORMAT STATEMENTS FOR RUN SUMMARY
C
90020 FORMAT (1H ,19X,I5,13H TESTS FAILED)
90022 FORMAT (1H ,19X,I5,13H TESTS PASSED)
90024 FORMAT (1H ,19X,I5,14H TESTS DELETED)
END
*END-OF,FM402
FM403.f 481036351 170 2 100666 39580 `
*HEADER,FORTR,FM403
*FILES1,FORTR,FM403,XX
C***********************************************************************
C***** FORTRAN 77
C***** FM403 FMTRW - (020)
C*****
C***********************************************************************
C***** GENERAL PURPOSE SUBSET REFS
C***** TO TEST SIMPLE FORMAT AND FORMATTED DATA 12.9.5.2
C***** TRANSFER STATEMENTS IN EXTERNAL SEQUENTIAL I/O SO 13.1.1
C***** THAT THESE FEATURES MAY BE USED IN OTHER TEST 12.8.1
C***** PROGRAM SEGMENTS FOR INTEGER, REAL, AND LOGICAL
C***** DATA TYPES.
C***** RESTRICTIONS OBSERVED 12.8.2
C***** * ALL FORMAT STATEMENTS ARE LABELED 13.1.1
C***** * H DESCRIPTOR ARE NEVER REPEATED 13.2.1
C***** * FOR W.D DESCRIPTORS, D IS ALWAYS SPECIFIED AND
C***** W IS EQUAL TO OR GREATER THAN D
C***** * FIELD WIDTH IS NEVER ZERO 13.2.1
C***** * IF AN I/O LIST SPECIFIES AT LEAST ONE LIST ITEM 13.3
C***** AT LEAST ONE REPEATABLE EDIT DESCRIPTOR MUST EXIST
C***** IN THE FORMAT SPECIFICATION
C***** * ITEMS IN I/O LIST CORRESPOND TO EDIT DESCRIPTORS 13.3
C***** * NEGATIVE OUTPUT VALUES ARE SIGNED 13.5.9
C***** * FIELD WIDTH NEVER EXCEEDED BY OUTPUT 13.5.9
C***** * FOR I EDITING, EXTERNAL INPUT FIELDS ARE 13.5.9.1
C***** INTEGER CONSTANTS
C***** GENERAL COMMENTS
C***** PLUS SIGNS FOR INPUT FIELDS ARE USUALLY OMITTED 13.5.9
C***** FORMATTED WRITES WITHOUT AN I/O LIST (FORMAT 13.5.2
C***** STATEMENTS TEST H AND X DESCRIPTORS AND SLASH 13.5.3
C***** RECORD DIVIDERS) 13.5.4
C*****
CBB** ********************** BBCCOMNT **********************************
C****
C**** 1978 FORTRAN COMPILER VALIDATION SYSTEM
C**** VERSION 2.0
C****
C****
C**** SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO
C**** GENERAL SERVICES ADMINISTRATION
C**** FEDERAL SOFTWARE TESTING CENTER
C**** 5203 LEESBURG PIKE, SUITE 1100
C**** FALLS CHURCH, VA. 22041
C****
C**** (703) 756-6153
C****
CBE** ********************** BBCCOMNT **********************************
C INPUT DATA TO THIS SEGMENT CONSISTS OF 27 CARD IMAGES IN COL. 1 - 80
COL. 1----------------------------------------------------------61
CARD 1 999
CARD 2 555554444
CARD 3 666 777777 8
CARD 4 333333111112222222255555444444444444
CARD 5 7.7123456.7
CARD 6 8.889.9997.123456
CARD 7 5.44446.5555533.133.133.133.1444.1
CARD 8 5555.15555.1 66666.166666.1 44.22
CARD 9 2.12.12.12.12.1666.3334.3334.3334.333
CARD 10 -0.1E+01+0.22E-01 0.333E+02 0.4444E+03-0.55555E-03+0.666666E+
COL. 62------------77
CARD 10 00+0.9876543E+12
COL. 1----------------------------------------------------------61
CARD 11 TABC
CARD 12 FDEFFGHIT*+T1F/).TRUE..FALSE.
CARD 13 -9.9-9.9-9.9-9.9
CARD 14 9999999999
CARD 15 .9.9.9.9.9.9.9.9.9.9.9.9.9.9.9.9.9.9.9.9.9.9.9.9.9.9.9
CARD 16 TFTFTFTFTF
CARD 17 99999999
CARD 18 9999999999999999TFFT9.99.99.99.99.9
CARD 19 T F T F
CARD 20 3334444.555550
CARD 21 9876.5498.7654E2 9876.54 987.654 86.4786E286.4786
CARD 22 9.8765698.7654E2 9876.54 987.654 86.4786E286.4786
CARD 23 122333544888611222
CARD 24 455666233444966111
CARD 25 788999377555899777
CARD 26 11112 334 559 880 11
CARD 27 6 778 995 441 222 00
C*****
C***** S P E C I F I C A T I O N S SEGMENT 020
C*****
DIMENSION EP1S(33),CMA1S(5),IAC1I(5),IAC2I(2,7),MCA1I(5)
REAL A1S(5),A2S(2,2),A3S(3,3,3),AC1S(25),AC2S(5,6)
INTEGER I2I(2,2),I3I(2,2,2),MCA3I(2,3,3)
LOGICAL MCA1B(7),A1B(2),A2B(2,2),A3B(2,2,2),AVB,CVB,DVB ,MCBVB
C*****
CBB** ********************** BBCINITA **********************************
C**** SPECIFICATION STATEMENTS
C****
CHARACTER ZVERS*13, ZVERSD*17, ZDATE*17, ZPROG*5, ZCOMPL*20,
1 ZNAME*20, ZTAPE*10, ZPROJ*13, REMRKS*31, ZTAPED*13
CBE** ********************** BBCINITA **********************************
CBB** ********************** BBCINITB **********************************
C**** INITIALIZE SECTION
DATA ZVERS, ZVERSD, ZDATE
1 /'VERSION 2.0 ', '82/08/02*18.33.46', '*NO DATE*TIME'/
DATA ZCOMPL, ZNAME, ZTAPE
1 /'*NONE SPECIFIED*', '*NO COMPANY NAME*', '*NO TAPE*'/
DATA ZPROJ, ZTAPED, ZPROG
1 /'*NO PROJECT*', '*NO TAPE DATE', 'XXXXX'/
DATA REMRKS /' '/
C**** THE FOLLOWING 9 COMMENT LINES (CZ01, CZ02, ...) CAN BE REPLACED
C**** FOR IDENTIFYING THE TEST ENVIRONMENT
C****
CZ01 ZVERS = 'VERSION OF THE COMPILER VALIDATION SYSTEM'
CZ02 ZVERSD = 'CREATION DATE/TIME OF THE COMPILER VALIDATION SYSTEM'
CZ03 ZPROG = 'PROGRAM NAME'
CZ04 ZDATE = 'DATE OF TEST'
CZ05 ZCOMPL = 'COMPILER IDENTIFICATION'
CZ06 ZPROJ = 'PROJECT NUMBER/IDENTIFICATION'
CZ07 ZNAME = 'NAME OF USER'
CZ08 ZTAPE = 'TAPE OWNER/ID'
CZ09 ZTAPED = 'DATE TAPE COPIED'
C
IVPASS = 0
IVFAIL = 0
IVDELE = 0
IVINSP = 0
IVTOTL = 0
IVTOTN = 0
ICZERO = 0
C
C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER.
I01 = 05
C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER.
I02 = 06
C
CX010 REPLACED BY FEXEC X-010 CONTROL CARD (CARD-READER UNIT NUMBER).
C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5
CX011 REPLACED BY FEXEC X-011 CONTROL CARD. CX011 IS FOR SYSTEMS
C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX010.
C
CX020 REPLACED BY FEXEC X-020 CONTROL CARD (PRINTER UNIT NUMBER).
C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02= 6
CX021 REPLACED BY FEXEC X-021 CONTROL CARD. CX021 IS FOR SYSTEMS
C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX020.
C
CBE** ********************** BBCINITB **********************************
C***** I N P U T - O U T P U T ASSIGNMENT STATEMENTS
IRVI = I01
NUVI = I02
IVTOTL = 59
ZPROG = 'FM403'
CBB** ********************** BBCHED0A **********************************
C****
C**** WRITE REPORT TITLE
C****
WRITE (I02, 90002)
WRITE (I02, 90006)
WRITE (I02, 90007)
WRITE (I02, 90008) ZVERS, ZVERSD
WRITE (I02, 90009) ZPROG, ZPROG
WRITE (I02, 90010) ZDATE, ZCOMPL
CBE** ********************** BBCHED0A **********************************
C***** HEADER FORMAT STATEMENT
2000 FORMAT ( // 2X,37HFMTRW - (020) FORMATTED DATA TRANSFER//2X,
141HSUBSET REFS - 12.9.5.2 13.3 13.5.9 )
WRITE (NUVI,2000)
CBB** ********************** BBCHED0B **********************************
C**** WRITE DETAIL REPORT HEADERS
C****
WRITE (I02,90004)
WRITE (I02,90004)
WRITE (I02,90013)
WRITE (I02,90014)
WRITE (I02,90015) IVTOTL
CBE** ********************** BBCHED0B **********************************
CT001* TEST 1 - FORMAT WITH DIGITS 0-9 IN H FIELDS
IVTNUM = 1
REMRKS = '2 COMPUTED LINES EXPECTED'
WRITE (I02,80004) IVTNUM, REMRKS
WRITE (I02,80020)
WRITE (I02,70010)
70010 FORMAT (25X,22H 10101010101010101010,9H999999999,8H88888888/27X,
17H7777777,6H666666,5H55555,4H4444,3H333,2H22,1H1)
IVINSP = IVINSP + 1
WRITE (I02,70011)
70011 FORMAT(1H ,16X,10HCORRECT: ,22X,29HCORRESPONDING LINE MUST MATCH)
WRITE (I02,70012)
70012 FORMAT (25X,' 1010101010101010101099999999988888888',
1 /25X,' 7777777666666555554444333221 ')
CT002* TEST 2 - FORMAT CONTAINING ALL LETTERS (A-Z) IN H FIELDS AND
C***** A VARIABLE NUMBER OF BLANKS IN H AND X FIELDS
IVTNUM = 2
REMRKS = '9 COMPUTED LINES EXPECTED'
WRITE (I02,80004) IVTNUM, REMRKS
WRITE (I02,80020)
WRITE (I02,70020)
70020 FORMAT(27X,3HAAA,5X,5H ,3HBBB,10X,3HCCC/28X,3HDDD,9X,3HEEE
1,9H ,3HFFF/29X,3HGGG,8X,3HHHH,8H ,3HIII/27X,3H
2,3HJJJ,7H ,3HKKK,7X,3HLLL/31X,3HMMM,6X,3HNNN,6H ,3HOOO/
3 32X,3HPPP,5H ,3HQQQ,5X,3HRRR/33X,3HSSS,4X,3HTTT,4H ,3HUUU/
4 27X,1
53H VVV ,3HWWW,3X,3HXXX/37X,3HYYY,3X,3HZZZ)
IVINSP = IVINSP + 1
WRITE (I02,70011)
WRITE (I02,70021)
70021 FORMAT (27X,'AAA BBB CCC',
1 /27X,' DDD EEE FFF ',
2 /27X,' GGG HHH III ',
3 /27X,' JJJ KKK LLL ',
4 /27X,' MMM NNN OOO ',
5 /27X,' PPP QQQ RRR ',
6 /27X,' SSS TTT UUU ',
7 /27X,' VVV WWW XXX ',
8 /27X,' YYY ZZZ ')
CT003* TEST 3 - FORMAT CONTAINING H FIELD WITH ALL POSSIBLE
C***** SPECIAL CHARACTERS
IVTNUM = 3
WRITE (I02,80004) IVTNUM
WRITE (I02,80020)
WRITE (I02,70030)
70030 FORMAT (25X,21H = + - * / ( ) , . ')
IVINSP = IVINSP + 1
WRITE (I02,80022)
WRITE (I02,70031)
70031 FORMAT (25X, ' = + - * / ( ) , . ''')
C***** FORMAT TO TEST VERTICAL SPACING
C***** 12.9.5.2.3
CT004* TEST 4 - FORMAT STATEMENT ENDING WITH ONE SLASH DESCRIPTOR
IVTNUM = 4
REMRKS = 'SLASH DESCRIPTOR'
WRITE (I02,80004) IVTNUM, REMRKS
WRITE (I02,70040)
70040 FORMAT(15X, 30H FORMAT(14H SKIP 1 LINE
1 /) /)
IVINSP = IVINSP + 1
WRITE (I02,70041)
70041 FORMAT(17X,34HONE BLANK LINE SHOULD APPEAR ABOVE)
C ADVANCE TO TOP-OF-PAGE AND WRITE HEADERS
WRITE (I02,90002)
WRITE (I02,90013)
WRITE (I02,90014)
CT005* TEST 5 - FORMAT STATEMENT ENDING WITH TWO SLASH DESCRIPTORS
IVTNUM = 5
WRITE (I02,80004) IVTNUM
WRITE (I02,70050)
70050 FORMAT(15X,32H FORMAT(15H SKIP 2 LINES //) //)
IVINSP = IVINSP + 1
WRITE (I02,70051)
70051 FORMAT(17X,35HTWO BLANK LINES SHOULD APPEAR ABOVE)
CT006* TEST 6 - FORMAT STATEMENT ENDING WITH THREE SLASH DESCRIPTORS
IVTNUM = 6
WRITE (I02,80004) IVTNUM
WRITE (I02,70060)
70060 FORMAT(15X,33H FORMAT(16H SKIP 3 LINES ///) ///)
IVINSP = IVINSP + 1
WRITE (I02,70061)
70061 FORMAT(17X,37HTHREE BLANK LINES SHOULD APPEAR ABOVE)
CT007* TEST 7 - FORMAT STATEMENT CONTAINING IMBEDDED SLASH DESCRIPTORS
IVTNUM = 7
REMRKS = 'IMBEDDED SLASHES'
WRITE (I02,80004) IVTNUM, REMRKS
WRITE (I02,70070)
70070 FORMAT( 17X,32H1 BLANK LINE SHOULD APPEAR BELOW //
1 17X,33H2 BLANK LINES SHOULD APPEAR BELOW///
2 17X,33H3 BLANK LINES SHOULD APPEAR BELOW/ 3(/),
3 17X,33H0 BLANK LINES SHOULD APPEAR BELOW/
4 17X,33HEND IMBEDDED SLASHES TEST )
IVINSP = IVINSP + 1
CT008* TEST 8 - FORMS CONTROL USING '0' FOR DOUBLE SPACING
IVTNUM = 8
REMRKS = 'DOUBLE SPACE'
WRITE (I02,80004) IVTNUM, REMRKS
WRITE (I02,70080)
70080 FORMAT( 17X,33H1 BLANK LINE SHOULD APPEAR BELOW / 1H0,
1 17X,33HEND DOUBLE SPACE TEST )
IVINSP = IVINSP + 1
CT009* TEST 9 - FORMS CONTROL USING '+' FOR OVERPRINTING
IVTNUM = 9
REMRKS = 'OVERPRINT'
WRITE (I02,80004) IVTNUM, REMRKS
WRITE (I02,70090)
70090 FORMAT(/17X,27H!FIRST PRINT LINE! OVER,/1H+,
1 17X,50H P R I N T !SECOND PRINT LINE!)
IVINSP = IVINSP + 1
CT010* TEST 10 - FORMS CONTROL USING '1' FOR PAGE EJECTION
IVTNUM = 10
REMRKS = 'PAGE ADVANCE'
WRITE (I02,80004) IVTNUM, REMRKS
WRITE (I02,70100)
70100 FORMAT(/17X,41HTHIS SHOULD BE THE LAST LINE ON THIS PAGE/,
157H1 NEW PAGE: END OF VERTICAL SPACING TESTS)
IVINSP = IVINSP + 1
C WRITE PAGE HEADERS
WRITE (I02,90004)
WRITE (I02,90013)
WRITE (I02,90014)
C***** FORMATTED DATA TRANSFER I/O STATEMENTS WITH INTEGER 12.8.1
C***** VARIABLES AND ARRAY ELEMENTS IN AN I/O LIST. (THE 12.8.2
C***** NUMBER OF ITEMS IN THE LIST IS VARIABLE.) SOME 13.2.1
C***** FORMAT STATEMENTS CONTAIN REPEATED FIELDS.
C***** FORMATS CONTAIN I EDIT DESCRIPTORS. 13.5.9.1
C***** FIELD WIDTHS ARE FROM 1 TO 5 DIGITS. 13.3
C***** INPUT CARD 1
2009 FORMAT (2X,I3)
READ (IRVI,2009) JACVI
C***** INPUT CARD 2
2010 FORMAT (1X,I5,1X,I4)
READ (IRVI,2010) KBCVI, IAC1I(1)
C***** INPUT CARD 3
2011 FORMAT (2X,I3,2X,3I2,2X,I1)
READ (IRVI,2011) IAC2I(1,2), LCCVI, IAC1I(5), IHDVI, MCA3I(1,2,3)
C***** INPUT CARD 4
2012 FORMAT (2X,2(I3),1(I5), 4I2 ,5I1,3 I4 )
READ (IRVI,2012) MDCVI, IAC2I(2,2), IAC1I(4), NECVI, IAC1I(3),
1 IAC2I(2,3), IAC2I(2,1), MRRVI, IGDVI, KGVI, IEDVI, IAC2I(1,1)
2 ,IAC1I(2), IAC2I(2,7), MCA3I(2,1,3)
CT011* TEST 11 - I CONVERSION
IVTNUM = 11
WRITE (I02,80004) IVTNUM
WRITE (I02,80020)
WRITE (I02,70110) JACVI
70110 FORMAT (25X,I5)
IVINSP = IVINSP + 1
WRITE (I02,80022)
WRITE (I02,70111)
70111 FORMAT (25X,5H 999)
CT012* TEST 12 - I CONVERSION
IVTNUM = 12
WRITE (I02,80004) IVTNUM
WRITE (I02,80020)
WRITE (I02,70120) KBCVI, IAC1I(1)
70120 FORMAT (26X,I5,1X,I4)
IVINSP = IVINSP + 1
WRITE (I02,80022)
WRITE (I02,70121)
70121 FORMAT (26X,10H 5555 4444)
CT013* TEST 13 - I CONVERSION
IVTNUM = 13
WRITE (I02,80004) IVTNUM
WRITE (I02,80020)
WRITE (I02,70130) IAC2I(1,2),LCCVI, IAC1I(5), IHDVI, MCA3I(1,2,3)
70130 FORMAT (27X,I3,2X,3I2,2X,I1)
IVINSP = IVINSP + 1
WRITE (I02,80022)
WRITE (I02,70131)
70131 FORMAT (27X,14H666 777777 8)
CT014* TEST 14 - I CONVERSION
IVTNUM = 14
WRITE (I02,80004) IVTNUM
WRITE (I02,80020)
WRITE (I02,70140)
WRITE (I02,70140) MDCVI, IAC2I(2,2), IAC1I(4), NECVI, IAC1I(3),
1 IAC2I(2,3), IAC2I(2,1), MRRVI, IGDVI, KGVI, IEDVI, IAC2I(1,1)
2 ,IAC1I(2), IAC2I(2,7), MCA3I(2,1,3)
70140 FORMAT (27X,2(I3),1(I5), 4I2 ,5I1,3 I4 )
IVINSP = IVINSP + 1
WRITE (I02,80022)
WRITE (I02,70141)
70141 FORMAT (27X,36H333333111112222222255555444444444444)
C***** FORMATTED DATA TRANSFER I/O STATEMENTS WITH REAL 12.8.1
C***** VARIABLES AND ARRAY ELEMENTS IN AN I/O LIST.(THE 12.8.2
C***** NUMBER OF ITEMS IN THE LIST IS VARIABLE.) ONLY F 13.5.9.2
C***** EDIT DESCRIPTORS ARE USED IN THE FORMAT 13.5.9.2.1
C***** STATEMENTS. SOME F EDIT DESCRIPTORS ARE REPEATED. 13.3
C***** FIELD WIDTH ALWAYS CONTAINS 1 POSITION FOR DECIMAL PT.
C***** FIELD WIDTH IS FROM 1 TO 7 DIGITS. PLACEMENT OF
C***** DECIMAL POINT IS VARIABLE. SOME F FIELDS ARE
C***** REPEATED
C***** INPUT CARD 5
2018 FORMAT (2X,F3.1,F8.1)
READ (IRVI,2018) ACVS, CMAVS
C***** INPUT CARD 6
2019 FORMAT(2X,F4.2,F5.3,F8.6)
READ (IRVI,2019) A1S(2), BCVS, CMBVS
C***** INPUT CARD 7
2020 FORMAT (2X,F6.4,F7.5,4F4.1,F5.1)
READ (IRVI,2020) HHCVS, CMCVS, GGCVS, FFCVS, A1S(1), AC1S(25),
1 AC2S(4,1)
C***** INPUT CARD 8
2021 FORMAT (2X,2(F6.1),2X,2F7.1 ,2X,F5.2)
READ (IRVI,2021) AC1S(18), AC1S(7), AC2S(4,4) , AC1S(8), AC1S(10)
C***** INPUT CARD 9
2022 FORMAT (2X,5(F3.1),F7.3,3F5.3 )
READ (IRVI,2022) AC2S(3,3) , AC2S(5,1), CCVS, AC1S(12), DCVS,
1 AC1S(13), AC1S(5), A3S(1,1,2), AC2S(3,5)
CT015* TEST 15 - F CONVERSION
IVTNUM = 15
WRITE (I02,80004) IVTNUM
WRITE (I02,80020)
WRITE (I02,70150) ACVS, CMAVS
70150 FORMAT (27X,F3.1,F8.1)
IVINSP = IVINSP + 1
WRITE (I02,80022)
WRITE (I02,70151)
70151 FORMAT (27X,11H7.7123456.7)
CT016* TEST 16 - F CONVERSION
IVTNUM = 16
WRITE (I02,80004) IVTNUM
WRITE (I02,80020)
WRITE (I02,70160) A1S(2), BCVS, CMBVS
70160 FORMAT(27X,F4.2,F5.3,F8.6)
IVINSP = IVINSP + 1
WRITE (I02,80022)
WRITE (I02,70161)
70161 FORMAT (27X,17H8.889.9997.123456)
CT017* TEST 17 - F CONVERSION
IVTNUM = 17
WRITE (I02,80004) IVTNUM
WRITE (I02,80020)
WRITE (I02,70170) HHCVS,CMCVS, GGCVS, FFCVS, A1S(1), AC1S(25)
1 ,AC2S(4,1)
70170 FORMAT (27X,F6.4,F7.5,4F4.1,F5.1)
IVINSP = IVINSP + 1
WRITE (I02,80022)
WRITE (I02,70171)
70171 FORMAT (27X,34H5.44446.5555533.133.133.133.1444.1)
CT018* TEST 18 - F CONVERSION
IVTNUM = 18
WRITE (I02,80004) IVTNUM
WRITE (I02,80020)
WRITE (I02,70180) AC1S(18),AC1S(7), AC2S(4,4) , AC1S(8), AC1S(10)
70180 FORMAT (27X,2(F6.1),2X,2F7.1 ,2X,F5.2)
IVINSP = IVINSP + 1
WRITE (I02,80022)
WRITE (I02,70181)
70181 FORMAT (27X,35H5555.15555.1 66666.166666.1 44.22 )
CT019* TEST 19 - F CONVERSION
IVTNUM = 19
WRITE (I02,80004) IVTNUM
WRITE (I02,80020)
WRITE (I02,70190) AC2S(3,3) , AC2S(5,1), CCVS, AC1S(12), DCVS,
1 AC1S(13), AC1S(5), A3S(1,1,2), AC2S(3,5)
70190 FORMAT (27X,5(F3.1),F7.3,3F5.3 )
IVINSP = IVINSP + 1
WRITE (I02,80022)
WRITE (I02,70191)
70191 FORMAT (27X,37H2.12.12.12.12.1666.3334.3334.3334.333)
C***** FORMATTED DATA TRANSFER I/O STATEMENTS WITH REAL 12.8.1
C***** VARIABLES AND ARRAY ELEMENTS IN AN I/O LIST. 12.8.2
C***** E EDIT DESCRIPTORS ARE USED IN THE FORMAT 13.5.9.2
C***** STATEMENTS. SOME E EDIT DESCRIPTORS ARE REPEATED 13.5.9.2.2
C***** (FIELD WIDTH ALWAYS INCLUDES 6 EXTRA POSITIONS
C***** TO PROVIDE FOR SIGN, DECIMAL POINT AND EXPONENT. 13.5.9
C***** PROVISION IS ALWAYS MADE FOR THE DIGIT ZERO 13.5.9.2.1
C***** BEFORE THE DECIMAL POINT)
C***** THE NUMBER OF DECIMAL PLACES VARIES FROM 1
C***** TO 7 DIGITS.
C***** INPUT CARD 10
2029 FORMAT (E8.1,E9.2,E10.3,E11.4,E12.5,E13.6,E14.7)
READ (IRVI,2029) AVS, BVS, EP1S(5), AC2S(1,5), CVS, AC2S(5,4),
1 A3S(2,1,2)
CT020* TEST 20 - E CONVERSION
IVTNUM = 20
REMRKS = 'LEADING PLUS SIGN/ZERO OPTIONAL'
WRITE (I02,80004) IVTNUM, REMRKS
WRITE (I02,80020)
WRITE (I02,70200) AVS, BVS
70200 FORMAT (27X,E8.1,2X,E9.2)
IVINSP = IVINSP + 1
WRITE (I02,70201)
70201 FORMAT (1H ,16X,10HCORRECT: ,22X,26H2 CORRECT ANSWERS POSSIBLE)
WRITE (I02,70202)
70202 FORMAT (27X,19H-0.1E+01 +0.22E-01/
1 27X,19H-0.1+001 +0.22-001)
C ADVANCE TO TOP-OF-PAGE AND WRITE HEADERS
WRITE (I02,90002)
WRITE (I02,90013)
WRITE (I02,90014)
CT021* TEST 21 - E CONVERSION
IVTNUM = 21
WRITE (I02,80004) IVTNUM, REMRKS
WRITE (I02,80020)
WRITE (I02,70210) EP1S(5), AC2S(1,5)
70210 FORMAT (27X,E10.3,2X,E11.4)
IVINSP = IVINSP + 1
WRITE (I02,70201)
WRITE (I02,70211)
70211 FORMAT (27X,23H+0.333E+02 +0.4444E+03/
1 27X,23H+0.333+002 +0.4444+003)
CT022* TEST 22 - E CONVERSION
IVTNUM = 22
WRITE (I02,80004) IVTNUM, REMRKS
WRITE (I02,80020)
WRITE (I02,70220) CVS, AC2S(5,4)
70220 FORMAT (27X,E12.5,2X,E13.6)
IVINSP = IVINSP + 1
WRITE (I02,70201)
WRITE (I02,70221)
70221 FORMAT (27X,27H-0.55555E-03 +0.666666E+00/
1 27X,27H-0.55555-003 +0.666666+000)
CT023* TEST 23 - E CONVERSION
IVTNUM = 23
WRITE (I02,80004) IVTNUM, REMRKS
WRITE (I02,80020)
WRITE (I02,70230) A3S(2,1,2)
70230 FORMAT (27X,E14.7)
IVINSP = IVINSP + 1
WRITE (I02,70201)
WRITE (I02,70231)
70231 FORMAT (27X,14H+0.9876543E+12/
1 27X,14H+0.9876543+012)
C***** FORMATTED DATA TRANSFER I/O STATEMENTS WITH LOGICAL 12.8.2
C***** VARIABLES AND ARRAY ELEMENTS IN AN I/O LIST 13.5.10
C***** SOME L EDIT DESCRIPTORS ARE REPEATED.
C***** L EDIT DESCRIPTORS ARE USED IN THE FORMAT STATEMENTS 13.2.1
C***** INPUT CARD 11
2033 FORMAT (L4)
READ (IRVI,2033) A2B(2,1)
C***** INPUT CARD 12
2034 FORMAT ( 2L4, L3, L2, L3, L6, L7)
READ (IRVI,2034) MCA1B(1), MCBVB, A2B(1,1), A3B(1,1,1), CVB,
1 DVB, A3B(1,2,1)
CT024* TEST 24 - L CONVERSION
IVTNUM = 24
WRITE (I02,80004) IVTNUM
WRITE (I02,80020)
WRITE (I02,70240) A2B(2,1), MCA1B(1), MCBVB, A2B(1,1), A3B(1,1,1),
1 CVB, DVB, A3B(1,2,1)
70240 FORMAT (24X, 3(L4), L3, L2, L3,
1 2(L1))
IVINSP = IVINSP + 1
WRITE (I02,80022)
WRITE (I02,70241)
70241 FORMAT (27X,19HT F F T T FTF)
C***** FORMATTED DATA TRANSFER STATEMENTS WITH ARRAY 12.8.2
C***** NAMES OF SEVERAL TYPES IN AN I/O LIST. THE 12.9.5.2
C***** NUMBER OF ITEMS IN THE LIST IS VARIABLE. SOME 13.2.1
C***** EDIT DESCRIPTORS ARE REPEATED.
C***** OPTIONAL COMMA BEFORE AND AFTER A SLASH
C***** INPUT CARDS 13, 14
2037 FORMAT(2X,4(F4.1)/5(I2))
READ (IRVI,2037) A2S, MCA1I
C***** INPUT CARDS 15, 16
2038 FORMAT(27(F2.1)/5(L1),5L1)
READ (IRVI,2038) A3S, A1B, A3B
C***** INPUT CARDS 17, 18
2039 FORMAT (2X,2(I2,I2),/,2(2(I2,I2)),2(L1,L1),2(F3.1,F3.1),F3.1)
READ (IRVI,2039) I2I, I3I, A2B, CMA1S
CT025* TEST 25 THRU 28 - UNSUBSCRIPTED ARRAY NAME IN I/O LISTS
WRITE (I02,70250) A2S, MCA1I, A3S, A1B
70250 FORMAT (17H 25 INSPECT/1H ,16X,10HCOMPUTED: /27X,4(F4.1)/
11H ,16X,10HCORRECT: /27X,16H-9.9-9.9-9.9-9.9/17H 26 INSPECT
2/1H ,16X,10HCOMPUTED: /27X,5(I2)/1H ,16X,10HCORRECT: /27X,
310H9999999999/17H 27 INSPECT,32X,23HLEADING PLUS SIGN/ZERO ,
48HOPTIONAL/1H ,16X,10HCOMPUTED: ,22X,25H3 COMPUTED LINES EXPECTED
5/27X,3(3(F4.1))/27X,2(2(F4.1,F4.1)),F4.1/27X,9F4.1/1H ,16X,
610HCORRECT: ,22X,29HEACH RESULT LINE SHOULD EQUAL/
7 27X,36H 0.9 0.9 0.9 0.9 0.9 0.9 0.9 0.9 0.9/
8 17H 28 INSPECT/1H ,16X,10HCOMPUTED: /27X,2L1/
9 1H ,16X,10HCORRECT: /27X,2HTF)
IVINSP = IVINSP + 4
C ADVANCE TO TOP-OF-PAGE AND WRITE HEADERS
WRITE (I02,90002)
WRITE (I02,90013)
WRITE (I02,90014)
CT029* TEST 29 THRU 33 - UNSUBSCRIPTED ARRAY NAMES IN I/O LISTS
WRITE (I02,70290) A3B, I2I, I3I, A2B, CMA1S
70290 FORMAT (17H 29 INSPECT/1H ,16X,10HCOMPUTED: /27X,8(L1)/1H ,
116X,10HCORRECT: /27X,8HTFTFTFTF/17H 30 INSPECT/1H ,16X,
210HCOMPUTED: /27X,4(I2)/1H ,16X,10HCORRECT: /27X,8H99999999/
317H 31 INSPECT/1H ,16X,10HCOMPUTED: /27X,8(I2)/1H ,16X,
410HCORRECT: /27X,16H9999999999999999/17H 32 INSPECT/1H ,
516X,10HCOMPUTED: /27X,4(L1)/1H ,16X,10HCORRECT: /27X,4HTFFT/
617H 33 INSPECT/1H ,16X,10HCOMPUTED: /27X,5(F3.1)/
7 1H ,16X,10HCORRECT: ,/,
8 27X,15H9.99.99.99.99.9)
IVINSP = IVINSP + 5
CT034* TEST 34 - FORMATTED DATA TRANSFER STATEMENT TO TEST 13.5.10
C***** THAT OPTIONAL BLANKS MAY PRECEDE A LOGICAL INPUT FIELD
C***** INPUT CARD 19
70340 FORMAT ( L6, L4, L10, L5)
READ (IRVI,70340) AVB, MCA1B(2), A2B(1,2), A3B(2,1,2)
IVTNUM = 34
REMRKS = 'LEADING BLANKS ARE REQUIRED'
WRITE (I02,80004) IVTNUM, REMRKS
WRITE (I02,80020)
WRITE (I02,70341) AVB, MCA1B(2), A2B(1,2), A3B(2,1,2)
70341 FORMAT (27X,L6, L4, L10, L5)
IVINSP = IVINSP + 1
WRITE (I02,80022)
WRITE (I02,70342)
70342 FORMAT (27X,25H T F T F)
CT035* TEST 35
C***** FORMATTED DATA TRANSFER TO TEST F EDIT DESCRIPTORS 13.5.9.2.1
C***** WHERE D IS EQUAL TO ZERO
C***** INPUT CARD 20
70350 FORMAT (2X, F3.0, F5.0, F5.5, F1.0)
READ (IRVI,70350) AVS, BVS, CVS, DVS
IVTNUM = 35
WRITE (I02,80004) IVTNUM
WRITE (I02,80020)
WRITE (I02,70351) AVS, BVS
70351 FORMAT (27X,F4.0,4X,F5.0)
IVINSP = IVINSP + 1
WRITE (I02,80022)
WRITE (I02,70352)
70352 FORMAT (27X,4H333.,4X,5H4444.)
CT036* TEST 36
C***** FORMATTED DATA TRANSFER TO TEST F EDIT DESCRIPTORS 13.5.9.2.1
C***** WHERE W EQUALS D+1 AND WHERE D IS EQUAL TO ZERO 13.2.1
IVTNUM = 36
WRITE (I02,80004) IVTNUM
WRITE (I02,80020)
WRITE (I02,70360) CVS, DVS
70360 FORMAT (27X,F6.5,2X,F2.0)
IVINSP = IVINSP + 1
WRITE (I02,80022)
WRITE (I02,70361)
70361 FORMAT (27X,10H.55555 0.)
CT037* TEST 37
C***** FORMATTED WRITES TO TEST THAT LEADING BLANKS 13.5.9
C***** ARE INSERTED IN THE OUTPUT FIELD WHEN THE OUTPUT
C***** PRODUCED IS SMALLER THAN THE FIELD WIDTH FOR THE
C***** I EDIT DESCRIPTORS
IVTNUM = 37
WRITE (I02,80004) IVTNUM, REMRKS
WRITE (I02,80020)
WRITE (I02,70370) MCA3I(1,2,3)
70370 FORMAT (27X,I3)
IVINSP = IVINSP + 1
WRITE (I02,80022)
WRITE (I02,70371)
70371 FORMAT (27X,3H 8)
CT038* TEST 38
C***** FORMATTED WRITES TO TEST THAT LEADING BLANKS 13.5.9
C***** ARE INSERTED IN THE OUTPUT FIELD WHEN THE OUTPUT
C***** PRODUCED IS SMALLER THAN THE FIELD WIDTH FOR THE
C***** I EDIT DESCRIPTORS
IVTNUM = 38
WRITE (I02,80004) IVTNUM, REMRKS
WRITE (I02,80020)
WRITE (I02,70380) IAC1I(3)
70380 FORMAT (27X,I4)
IVINSP = IVINSP + 1
WRITE (I02,80022)
WRITE (I02,70381)
70381 FORMAT (27X,4H 22)
CT039* TEST 39
C***** FORMATTED WRITES TO TEST THAT LEADING BLANKS 13.5.9
C***** ARE INSERTED IN THE OUTPUT FIELD WHEN THE OUTPUT
C***** PRODUCED IS SMALLER THAN THE FIELD WIDTH FOR THE
C***** I EDIT DESCRIPTORS
IVTNUM = 39
WRITE (I02,80004) IVTNUM, REMRKS
WRITE (I02,80020)
WRITE (I02,70390) NECVI
70390 FORMAT (27X,I5)
IVINSP = IVINSP + 1
WRITE (I02,80022)
WRITE (I02,70391)
70391 FORMAT (27X,5H 22)
C ADVANCE TO TOP-OF-PAGE AND WRITE HEADERS
WRITE (I02,90002)
WRITE (I02,90013)
WRITE (I02,90014)
CT040* TEST 40
C***** FORMATTED WRITES TO TEST THAT LEADING BLANKS 13.5.9
C***** ARE INSERTED IN THE OUTPUT FIELD WHEN THE OUTPUT
C***** PRODUCED IS SMALLER THAN THE FIELD WIDTH FOR THE
C***** I EDIT DESCRIPTORS
IVTNUM = 40
WRITE (I02,80004) IVTNUM, REMRKS
WRITE (I02,80020)
WRITE (I02,70400) IAC1I(3)
70400 FORMAT (27X,I6)
IVINSP = IVINSP + 1
WRITE (I02,80022)
WRITE (I02,70401)
70401 FORMAT (27X,6H 22)
CT041* TEST 41
C***** FORMATTED WRITES TO TEST THAT LEADING BLANKS 13.5.9
C***** ARE INSERTED IN THE OUTPUT FIELD WHEN THE OUTPUT
C***** PRODUCED IS SMALLER THAN THE FIELD WIDTH FOR THE
C***** I EDIT DESCRIPTORS
IVTNUM = 41
WRITE (I02,80004) IVTNUM, REMRKS
WRITE (I02,80020)
WRITE (I02,70410) IAC2I(2,3)
70410 FORMAT (27X,I7)
IVINSP = IVINSP + 1
WRITE (I02,80022)
WRITE (I02,70411)
70411 FORMAT (27X,7H 22)
CT042* TEST 42
C***** FORMATTED WRITES TO TEST THAT LEADING BLANKS 13.5.9
C***** ARE INSERTED IN THE OUTPUT FIELD WHEN THE OUTPUT
C***** PRODUCED IS SMALLER THAN THE FIELD WIDTH FOR THE
C***** F EDIT DESCRIPTORS
IVTNUM = 42
WRITE (I02,80004) IVTNUM, REMRKS
WRITE (I02,80020)
WRITE (I02,70420) ACVS
70420 FORMAT (27X,F5.1)
IVINSP = IVINSP + 1
WRITE (I02,80022)
WRITE (I02,70421)
70421 FORMAT (27X,5H 7.7)
CT043* TEST 43
CT043* TEST 43 - FORMATTED WRITES TO TEST THAT LEADING BLANKS 13.5.9
C***** ARE INSERTED IN THE OUTPUT FIELD WHEN THE OUTPUT
C***** PRODUCED IS SMALLER THAN THE FIELD WIDTH FOR THE
C***** F EDIT DESCRIPTORS
IVTNUM = 43
WRITE (I02,80004) IVTNUM, REMRKS
WRITE (I02,80020)
WRITE (I02,70430) A1S(2)
70430 FORMAT (27X,F7.2)
IVINSP = IVINSP + 1
WRITE (I02,80022)
WRITE (I02,70431)
70431 FORMAT (27X,7H 8.88)
CT044* TEST 44 - FORMATTED WRITES TO TEST THAT LEADING BLANKS 13.5.9
C***** ARE INSERTED IN THE OUTPUT FIELD WHEN THE OUTPUT
C***** PRODUCED IS SMALLER THAN THE FIELD WIDTH FOR THE
C***** F EDIT DESCRIPTORS
IVTNUM = 44
WRITE (I02,80004) IVTNUM, REMRKS
WRITE (I02,80020)
WRITE (I02,70440) BCVS
70440 FORMAT (27X,F9.3)
IVINSP = IVINSP + 1
WRITE (I02,80022)
WRITE (I02,70441)
70441 FORMAT (27X,9H 9.999)
CT045* TEST 45
C***** FORMATTED WRITES TO TEST THAT LEADING BLANKS 13.5.9
C***** ARE INSERTED IN THE OUTPUT FIELD WHEN THE OUTPUT
C***** PRODUCED IS SMALLER THAN THE FIELD WIDTH FOR THE
C***** F EDIT DESCRIPTORS
IVTNUM = 45
WRITE (I02,80004) IVTNUM, REMRKS
WRITE (I02,80020)
WRITE (I02,70450) HHCVS
70450 FORMAT (27X,F11.4)
IVINSP = IVINSP + 1
WRITE (I02,80022)
WRITE (I02,70451)
70451 FORMAT (27X,11H 5.4444)
CT046* TEST 46
C***** FORMATTED WRITES TO TEST THAT LEADING BLANKS 13.5.9
C***** ARE INSERTED IN THE OUTPUT FIELD WHEN THE OUTPUT
C***** PRODUCED IS SMALLER THAN THE FIELD WIDTH FOR THE
C***** F EDIT DESCRIPTORS
IVTNUM = 46
WRITE (I02,80004) IVTNUM, REMRKS
WRITE (I02,80020)
WRITE (I02,70460) CMCVS
70460 FORMAT (27X,F13.5)
IVINSP = IVINSP + 1
WRITE (I02,80022)
WRITE (I02,70461)
70461 FORMAT (27X,13H 6.55555)
CT047* TEST 47
C***** FORMATTED WRITES TO TEST THAT LEADING BLANKS 13.5.9
C***** ARE INSERTED IN THE OUTPUT FIELD WHEN THE OUTPUT
C***** PRODUCED IS SMALLER THAN THE FIELD WIDTH FOR THE
C***** F EDIT DESCRIPTORS
IVTNUM = 47
WRITE (I02,80004) IVTNUM, REMRKS
WRITE (I02,80020)
WRITE (I02,70470) CMBVS
70470 FORMAT (27X,F15.6)
IVINSP = IVINSP + 1
WRITE (I02,80022)
WRITE (I02,70471)
70471 FORMAT (27X,15H 7.123456)
CT048* TEST 48
C***** FORMATTED WRITES TO TEST THAT LEADING BLANKS 13.5.9
C***** ARE INSERTED IN THE OUTPUT FIELD WHEN THE OUTPUT
C***** PRODUCED IS SMALLER THAN THE FIELD WIDTH FOR THE
C***** E EDIT DESCRIPTORS
IVTNUM = 48
WRITE (I02,80004) IVTNUM, REMRKS
WRITE (I02,80020)
WRITE (I02,70480) DCVS
70480 FORMAT (27X,E10.2)
IVINSP = IVINSP + 1
WRITE (I02,70201)
WRITE (I02,70481)
70481 FORMAT (27X,10H 0.21E+01/
1 27X,10H 0.21+001)
CT049* TEST 49
C***** FORMATTED WRITES TO TEST THAT LEADING BLANKS 13.5.9
C***** ARE INSERTED IN THE OUTPUT FIELD WHEN THE OUTPUT
C***** PRODUCED IS SMALLER THAN THE FIELD WIDTH FOR THE
C***** E EDIT DESCRIPTORS
IVTNUM = 49
WRITE (I02,80004) IVTNUM, REMRKS
WRITE (I02,80020)
WRITE (I02,70490) AC1S(25)
70490 FORMAT (27X,E12.3)
IVINSP = IVINSP + 1
WRITE (I02,70201)
WRITE (I02,70491)
70491 FORMAT (27X,12H 0.331E+02/
1 27X,12H 0.331+002)
C ADVANCE TO TOP-OF-PAGE AND WRITE HEADERS
WRITE (I02,90002)
WRITE (I02,90013)
WRITE (I02,90014)
CT050* TEST 50
C***** FORMATTED WRITES TO TEST THAT LEADING BLANKS 13.5.9
C***** ARE INSERTED IN THE OUTPUT FIELD WHEN THE OUTPUT
C***** PRODUCED IS SMALLER THAN THE FIELD WIDTH FOR THE
C***** E EDIT DESCRIPTORS
IVTNUM = 50
WRITE (I02,80004) IVTNUM, REMRKS
WRITE (I02,80020)
WRITE (I02,70500) AC2S(4,1)
70500 FORMAT (27X,E14.4)
IVINSP = IVINSP + 1
WRITE (I02,70201)
WRITE (I02,70501)
70501 FORMAT (27X,14H 0.4441E+03/
1 27X,14H 0.4441+003)
CT051* TEST 51
C***** FORMATTED WRITES TO TEST THAT LEADING BLANKS 13.5.9
C***** ARE INSERTED IN THE OUTPUT FIELD WHEN THE OUTPUT
C***** PRODUCED IS SMALLER THAN THE FIELD WIDTH FOR THE
C***** E EDIT DESCRIPTORS
IVTNUM = 51
WRITE (I02,80004) IVTNUM, REMRKS
WRITE (I02,80020)
WRITE (I02,70510) AC1S(7)
70510 FORMAT (27X,E16.5)
IVINSP = IVINSP + 1
WRITE (I02,70201)
WRITE (I02,70511)
70511 FORMAT (27X,16H 0.55551E+04/
1 27X,16H 0.55551+004)
CT052* TEST 52
C***** FORMATTED WRITES TO TEST THAT LEADING BLANKS 13.5.9
C***** ARE INSERTED IN THE OUTPUT FIELD WHEN THE OUTPUT
C***** PRODUCED IS SMALLER THAN THE FIELD WIDTH FOR THE
C***** E EDIT DESCRIPTORS
IVTNUM = 52
WRITE (I02,80004) IVTNUM, REMRKS
WRITE (I02,80020)
WRITE (I02,70520) AC1S(8)
70520 FORMAT (27X,E18.6)
IVINSP = IVINSP + 1
WRITE (I02,70201)
WRITE (I02,70521)
70521 FORMAT (27X,18H 0.666661E+05/
1 27X,18H 0.666661+005)
CT053* TEST 53
C***** FORMATTED WRITES TO TEST THAT LEADING BLANKS 13.5.9
C***** ARE INSERTED IN THE OUTPUT FIELD WHEN THE OUTPUT
C***** PRODUCED IS SMALLER THAN THE FIELD WIDTH FOR THE
C***** E EDIT DESCRIPTORS
IVTNUM = 53
WRITE (I02,80004) IVTNUM, REMRKS
WRITE (I02,80020)
WRITE (I02,70530) CMAVS
70530 FORMAT (27X,E20.7)
IVINSP = IVINSP + 1
WRITE (I02,70201)
WRITE (I02,70531)
70531 FORMAT (27X,20H 0.1234567E+06/
1 27X,20H 0.1234567+006)
CT054* TEST 54
C***** SCALE FACTOR APPLIED TO F AND E EDIT DESCRIPTORS
C***** ON READ, BUT NOT ON WRITE
C***** INPUT CARD 21
2050 FORMAT(2PF8.3,-2PE9.4,F9.4,0PF9.4,9X,-2PE9.4,F9.4)
READ(IRVI,2050)EP1S(16),EP1S(17),EP1S(18), EP1S(19),
1 EP1S(20),EP1S(22)
IVTNUM = 54
WRITE (I02,80004) IVTNUM, REMRKS
WRITE (I02,80020)
WRITE (I02,70540) EP1S(16),EP1S(17),EP1S(18)
70540 FORMAT (27X,F12.4, E12.4, F12.2)
IVINSP = IVINSP + 1
WRITE (I02,70201)
WRITE (I02,70541)
70541 FORMAT (27X,36H 98.7654 0.9877E+04 987654.00/
1 27X,36H 0.9877+004 )
CT055* TEST 55
C***** SCALE FACTOR APPLIED TO F AND E EDIT DESCRIPTORS
C***** ON READ, BUT NOT ON WRITE
IVTNUM = 55
WRITE (I02,80004) IVTNUM, REMRKS
WRITE (I02,80020)
WRITE (I02,70550) EP1S(19),EP1S(20),EP1S(22)
70550 FORMAT( 27X,F12.3, E12.4,F12.3 )
IVINSP = IVINSP + 1
WRITE (I02,70201)
WRITE (I02,70551)
70551 FORMAT (27X,36H 987.654 0.8648E+04 8647.860/
1 27X,36H 0.8648+004 )
CT056* TEST 56
C***** SCALE FACTOR APPLIED TO F AND E EDIT DESCRIPTORS
C***** ON WRITE, BUT, NOT ON READ
C***** INPUT CARD 22
2053 FORMAT(F8.2,E9.4,F9.2,F9.3,9X,E9.4,F9.4)
READ(IRVI,2053) AC1S(1),AC1S(2),AC1S(3),AC1S(4),
1 AC1S(20),AC1S(23)
IVTNUM = 56
WRITE (I02,80004) IVTNUM, REMRKS
WRITE (I02,80020)
WRITE (I02,70560) AC1S(1),AC1S(2),AC1S(3)
70560 FORMAT (27X,2PF12.2, -2PE12.4,F12.4)
IVINSP = IVINSP + 1
WRITE (I02,70201)
WRITE (I02,70561)
70561 FORMAT (27X,36H 987.66 0.0099E+06 98.7654/
1 27X,36H 0.0099+006 )
CT057* TEST 57 - SCALE FACTOR APPLIED TO F AND E EDIT DESCRIPTORS
C***** ON WRITE, BUT, NOT ON READ
IVTNUM = 57
WRITE (I02,80004) IVTNUM, REMRKS
WRITE (I02,80020)
WRITE (I02,70570) AC1S(4), AC1S(20),AC1S(23)
70570 FORMAT (27X,1PE12.2, -2PE12.4, 2PF12.2 )
IVINSP = IVINSP + 1
WRITE (I02,70201)
WRITE (I02,70571)
70571 FORMAT (27X,36H 9.88E+02 0.0086E+06 8647.86/
1 27X,36H 9.88+002 0.0086+006 )
CT058* TEST 58 - I/O FORMAT RESCAN
C***** INPUT CARDS 23, 24, 25
2055 FORMAT( I1,I2,I3)
READ(IRVI,2055) I2I,IAC1I
IVTNUM = 58
REMRKS = '3 COMPUTED LINES EXPECTED'
WRITE (I02,80004) IVTNUM, REMRKS
WRITE (I02,80020)
WRITE(I02,70580) I2I(1,1),I2I(2,1),I2I(1,2),I2I(2,2),IAC1I
70580 FORMAT (27X,I4,I5,I6)
IVINSP = IVINSP + 1
WRITE (I02,70011)
WRITE (I02,70581)
70581 FORMAT (27X,15H 1 22 333/
1 27X,15H 4 55 666/
2 27X,15H 7 88 999)
C ADVANCE TO TOP-OF-PAGE AND WRITE HEADERS
WRITE (I02,90002)
WRITE (I02,90013)
WRITE (I02,90014)
C***** INPUT CARDS 26, 27
2058 FORMAT(I4, 2(I1,1X,I2))
READ( IRVI,2058) I2I, IAC1I
CT059* TEST 59 - I/O FORMAT RESCAN
IVTNUM = 59
REMRKS = '2 COMPUTED LINES EXPECTED'
WRITE (I02,80004) IVTNUM, REMRKS
WRITE (I02,80020)
WRITE( I02,70590) I2I(2,1),I2I(2,2),IAC1I(2),IAC1I(4)
70590 FORMAT (27X,I4,3H **,1(27X,I4,3H '',(I4,3H (()))
IVINSP = IVINSP + 1
WRITE (I02,70011)
WRITE (I02,70591)
70591 FORMAT(27X,7H 2 **,30X,11H4 '' 6 ((,/
1 27X,7H 8 '')
CBB** ********************** BBCSUM0 **********************************
C**** WRITE OUT TEST SUMMARY
C****
IVTOTN = IVPASS + IVFAIL + IVDELE + IVINSP
WRITE (I02, 90004)
WRITE (I02, 90014)
WRITE (I02, 90004)
WRITE (I02, 90020) IVPASS
WRITE (I02, 90022) IVFAIL
WRITE (I02, 90024) IVDELE
WRITE (I02, 90026) IVINSP
WRITE (I02, 90028) IVTOTN, IVTOTL
CBE** ********************** BBCSUM0 **********************************
CBB** ********************** BBCFOOT0 **********************************
C**** WRITE OUT REPORT FOOTINGS
C****
WRITE (I02,90016) ZPROG, ZPROG
WRITE (I02,90018) ZPROJ, ZNAME, ZTAPE, ZTAPED
WRITE (I02,90019)
CBE** ********************** BBCFOOT0 **********************************
CBB** ********************** BBCFMT0A **********************************
C**** FORMATS FOR TEST DETAIL LINES
C****
80000 FORMAT (1H ,2X,I3,4X,7HDELETED,32X,A31)
80002 FORMAT (1H ,2X,I3,4X,7H PASS ,32X,A31)
80004 FORMAT (1H ,2X,I3,4X,7HINSPECT,32X,A31)
80008 FORMAT (1H ,2X,I3,4X,7H FAIL ,32X,A31)
80010 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,15X,10HCOMPUTED= ,
1I6,/,1H ,15X,10HCORRECT= ,I6)
80012 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
1E12.5,/,1H ,16X,10HCORRECT= ,E12.5)
80018 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
1A21,/,1H ,16X,10HCORRECT= ,A21)
80020 FORMAT (1H ,16X,10HCOMPUTED= ,A21,1X,A31)
80022 FORMAT (1H ,16X,10HCORRECT= ,A21,1X,A31)
80024 FORMAT (1H ,16X,10HCOMPUTED= ,I6,16X,A31)
80026 FORMAT (1H ,16X,10HCORRECT= ,I6,16X,A31)
80028 FORMAT (1H ,16X,10HCOMPUTED= ,E12.5,10X,A31)
80030 FORMAT (1H ,16X,10HCORRECT= ,E12.5,10X,A31)
80050 FORMAT (1H ,48X,A31)
CBE** ********************** BBCFMT0A **********************************
CBB** ********************** BBCFMT0B **********************************
C**** FORMAT STATEMENTS FOR PAGE HEADERS
C****
90002 FORMAT (1H1)
90004 FORMAT (1H )
90006 FORMAT (1H ,20X,31HFEDERAL SOFTWARE TESTING CENTER)
90007 FORMAT (1H ,19X,34HFORTRAN COMPILER VALIDATION SYSTEM)
90008 FORMAT (1H ,21X,A13,A17)
90009 FORMAT (1H ,/,2H *,A5,6HBEGIN*,12X,15HTEST RESULTS - ,A5,/)
90010 FORMAT (1H ,8X,16HTEST DATE*TIME= ,A17,15H - COMPILER= ,A20)
90013 FORMAT (1H ,8H TEST ,10HPASS/FAIL ,6X,17HDISPLAYED RESULTS,
1 7X,7HREMARKS,24X)
90014 FORMAT (1H ,46H----------------------------------------------,
1 33H---------------------------------)
90015 FORMAT (1H ,48X,17HTHIS PROGRAM HAS ,I3,6H TESTS,/)
C****
C**** FORMAT STATEMENTS FOR REPORT FOOTINGS
C****
90016 FORMAT (1H ,/,2H *,A5,4HEND*,14X,14HEND OF TEST - ,A5,/)
90018 FORMAT (1H ,A13,13X,A20,7H * ,A10,1H/,
1 A13)
90019 FORMAT (1H ,26HFOR OFFICIAL USE ONLY ,35X,15HCOPYRIGHT 1982)
C****
C**** FORMAT STATEMENTS FOR RUN SUMMARY
C****
90020 FORMAT (1H ,21X,I5,13H TESTS PASSED)
90022 FORMAT (1H ,21X,I5,13H TESTS FAILED)
90024 FORMAT (1H ,21X,I5,14H TESTS DELETED)
90026 FORMAT (1H ,21X,I5,25H TESTS REQUIRE INSPECTION)
90028 FORMAT (1H ,21X,I5,4H OF ,I3,15H TESTS EXECUTED)
CBE** ********************** BBCFMT0B **********************************
C*****
C***** END OF TEST SEGMENT 020
STOP
END
*END-OF,FM403
FM404.f 481036355 170 2 100666 13208 `
*HEADER,FORTR,FM404
*FILES1,FORTR,FM404,XX
C***********************************************************************
C***** FORTRAN 77
C***** FM404 AFMTS - (022)
C*****
C***********************************************************************
C***** GENERAL PURPOSE SUBSET REFS
C***** TO TEST SIMPLE FORMAT AND FORMATTED DATA 12.9.5.2
C***** TRANSFER STATEMENTS IN EXTERNAL SEQUENTIAL I/O SO 13.1.1
C***** THAT THESE FEATURES MAY BE USED IN OTHER TEST 12.8.1
C***** PROGRAM SEGMENTS FOR CHARACTER DATA TYPES. 4.8
C*****
C***** RESTRICTIONS OBSERVED
C***** * ALL FORMAT STATEMENTS ARE LABELED 12.8.2
C***** * H AND X DESCRIPTORS ARE NEVER REPEATED 13.1.1
C***** * FIELD WIDTH IS NEVER ZERO 13.5.11
C***** * IF AN I/O LIST SPECIFIES AT LEAST ONE LIST ITEM 13.3
C***** AT LEAST ONE REPEATABLE EDIT DESCRIPTOR MUST EXIST
C***** IN THE FORMAT SPECIFICATION.
C***** * ITEMS IN I/O LIST CORRESPOND TO FORMAT DESCRIPTORS 13.3
C*****
CBB** ********************** BBCCOMNT **********************************
C****
C**** 1978 FORTRAN COMPILER VALIDATION SYSTEM
C**** VERSION 2.0
C****
C****
C**** SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO
C**** GENERAL SERVICES ADMINISTRATION
C**** FEDERAL SOFTWARE TESTING CENTER
C**** 5203 LEESBURG PIKE, SUITE 1100
C**** FALLS CHURCH, VA. 22041
C****
C**** (703) 756-6153
C****
CBE** ********************** BBCCOMNT **********************************
C*****
C INPUT DATA TO THIS SEG. CONSISTS OF 6 DATA CARD IMAGES IN COLS. 1 - 55
COL. 1--------------------------------------------47
CARD 1 QRSTMNOPIJKLYZ127890ABCD3456EFGHUVWX/(),.' =+-*
CARD 2 AABABCABCDABCDEABCDEFWXYZWXYZWXYZWXYZWXYZWXYZ
CARD 3 112123123412345123456
CARD 4 GGGGHHHHIIIIJJJJ
CARD 5 ----LLLL
CARD 6 ....NNNN
C*****
C***** S P E C I F I C A T I O N S SEGMENT 022
C*****
CHARACTER*1 A1VK
CHARACTER*2 A2VK
CHARACTER*3 A3VK
CHARACTER*4 A4VK, A41K(6), A43K(2,2,3)
CHARACTER*5 A5VK
CHARACTER*6 A6VK
C*****
CBB** ********************** BBCINITA **********************************
C**** SPECIFICATION STATEMENTS
C****
CHARACTER ZVERS*13, ZVERSD*17, ZDATE*17, ZPROG*5, ZCOMPL*20,
1 ZNAME*20, ZTAPE*10, ZPROJ*13, REMRKS*31, ZTAPED*13
CBE** ********************** BBCINITA **********************************
CBB** ********************** BBCINITB **********************************
C**** INITIALIZE SECTION
DATA ZVERS, ZVERSD, ZDATE
1 /'VERSION 2.0 ', '82/08/02*18.33.46', '*NO DATE*TIME'/
DATA ZCOMPL, ZNAME, ZTAPE
1 /'*NONE SPECIFIED*', '*NO COMPANY NAME*', '*NO TAPE*'/
DATA ZPROJ, ZTAPED, ZPROG
1 /'*NO PROJECT*', '*NO TAPE DATE', 'XXXXX'/
DATA REMRKS /' '/
C**** THE FOLLOWING 9 COMMENT LINES (CZ01, CZ02, ...) CAN BE REPLACED
C**** FOR IDENTIFYING THE TEST ENVIRONMENT
C****
CZ01 ZVERS = 'VERSION OF THE COMPILER VALIDATION SYSTEM'
CZ02 ZVERSD = 'CREATION DATE/TIME OF THE COMPILER VALIDATION SYSTEM'
CZ03 ZPROG = 'PROGRAM NAME'
CZ04 ZDATE = 'DATE OF TEST'
CZ05 ZCOMPL = 'COMPILER IDENTIFICATION'
CZ06 ZPROJ = 'PROJECT NUMBER/IDENTIFICATION'
CZ07 ZNAME = 'NAME OF USER'
CZ08 ZTAPE = 'TAPE OWNER/ID'
CZ09 ZTAPED = 'DATE TAPE COPIED'
C
IVPASS = 0
IVFAIL = 0
IVDELE = 0
IVINSP = 0
IVTOTL = 0
IVTOTN = 0
ICZERO = 0
C
C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER.
I01 = 05
C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER.
I02 = 06
C
CX010 REPLACED BY FEXEC X-010 CONTROL CARD (CARD-READER UNIT NUMBER).
C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5
CX011 REPLACED BY FEXEC X-011 CONTROL CARD. CX011 IS FOR SYSTEMS
C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX010.
C
CX020 REPLACED BY FEXEC X-020 CONTROL CARD (PRINTER UNIT NUMBER).
C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02= 6
CX021 REPLACED BY FEXEC X-021 CONTROL CARD. CX021 IS FOR SYSTEMS
C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX020.
C
CBE** ********************** BBCINITB **********************************
IRVI = I01
NUVI = I02
IVTOTL = 5
ZPROG = 'FM404'
CBB** ********************** BBCHED0A **********************************
C****
C**** WRITE REPORT TITLE
C****
WRITE (I02, 90002)
WRITE (I02, 90006)
WRITE (I02, 90007)
WRITE (I02, 90008) ZVERS, ZVERSD
WRITE (I02, 90009) ZPROG, ZPROG
WRITE (I02, 90010) ZDATE, ZCOMPL
CBE** ********************** BBCHED0A **********************************
C*****
C***** HEADER FOR SEGMENT 22
WRITE (NUVI,02200)
02200 FORMAT(1H , /1X,38H AFMTS - (022) FORMATTED DATA TRANSFER//
1 1X,19H USING A-CONVERSION//1X,
2 38H SUBSET REFS - 12.9.5.2 13.3 13.5.11)
CBB** ********************** BBCHED0B **********************************
C**** WRITE DETAIL REPORT HEADERS
C****
WRITE (I02,90004)
WRITE (I02,90004)
WRITE (I02,90013)
WRITE (I02,90014)
WRITE (I02,90015) IVTOTL
CBE** ********************** BBCHED0B **********************************
C*****
C***** TESTS THAT ALL FORTRAN (SUBSET) CHARACTERS MAY BE READ. 3.1
C*****
C***** INPUT CARD 1
READ(IRVI, 02201) A43K(1,1,1), A43K(1,1,2), A43K(1,1,3),
1 A43K(1,2,1), A43K(1,2,2), A43K(1,2,3), A43K(2,1,1),
2 A43K(2,1,2), A43K(2,1,3), A6VK, A5VK
02201 FORMAT(9A4, A6, A5)
CT001* TEST 1
IVTNUM = 1
REMRKS = '2 COMPUTED LINES EXPECTED'
WRITE (NUVI, 80004) IVTNUM, REMRKS
WRITE (NUVI, 80020)
WRITE(NUVI, 70010) A43K(1,2,3), A43K(2,1,2), A43K(1,1,3),
1 A43K(1,1,2), A43K(1,1,1), A43K(2,1,3), A43K(1,2,1),
2 A43K(2,1,1), A43K(1,2,2), A5VK, A6VK
70010 FORMAT(26X,9A4/25X,A5,A6)
IVINSP = IVINSP + 1
WRITE (NUVI, 70011)
70011 FORMAT(1H ,16X,10HCORRECT: ,22X,32HCORRESPONDING LINE(S) MUST M
1ATCH)
WRITE (NUVI, 70012)
70012 FORMAT(26X, 36HABCDEFGHIJKLMNOPQRSTUVWXYZ1234567890/
1 26X,10H=+-*/(),.')
C*****
C***** AW CONVERSION IS USED IN THE FORMAT STATEMENTS. 3.5.11
C***** SOME FORMAT DESCRIPTORS ARE REPEATED.
C***** THE FOLLOWING THREE CASES ARE USED FOR BOTH INPUT AND OUTPUT.
C***** INPUT FIELD WIDTH = CHARACTER VARIABLE LENGTH
C***** INPUT FIELD WIDTH < CHARACTER VARIABLE LENGTH
C***** INPUT FIELD WIDTH > CHARACTER VARIABLE LENGTH
C*****
C***** INPUT CARD 2
READ(IRVI, 02203) A41K(1), A41K(2), A41K(3), A41K(4), A41K(5),
1 A41K(6), A1VK, A2VK, A3VK, A4VK, A5VK, A6VK
02203 FORMAT(A1, A2, 1A3, A4, A5, 1(A6), A4, 2A4, 3(A4))
CT002* TEST 2
IVTNUM = 2
REMRKS = '2 COMPUTED LINES EXPECTED'
WRITE (NUVI, 80004) IVTNUM, REMRKS
WRITE (NUVI, 80020)
WRITE(NUVI, 70020) A41K(1), A41K(2), A41K(3), A41K(4), A41K(5),
1 A41K(6), A6VK, A5VK, A4VK, A3VK, A2VK, A1VK
70020 FORMAT(26X,A4,A4,4A4/26X,A6,A5,A4,A3,A2,A1)
IVINSP = IVINSP + 1
WRITE (NUVI, 70011)
WRITE (NUVI, 70022)
70022 FORMAT(26X,24HA AB ABC ABCDBCDECDEF/
1 26X,21HWXYZ WXYZ WXYZXYZYZZ)
C*****
CT003* TEST 3
IVTNUM = 3
REMRKS = '2 COMPUTED LINES EXPECTED'
WRITE (NUVI, 80004) IVTNUM, REMRKS
WRITE (NUVI, 80020)
WRITE(NUVI, 70030) A41K(1), A41K(2), A41K(3), A41K(4), A41K(5),
1 A41K(6), A1VK, A2VK, A3VK, A4VK, A5VK, A6VK
70030 FORMAT(26X,A1,A2,A3,A4,A5,A6/23X,4(A4),A4,A4)
IVINSP = IVINSP + 1
WRITE (NUVI, 70011)
WRITE (NUVI, 70032)
70032 FORMAT(26X,21HAABABCABCD BCDE CDEF/
1 26X,21HZ YZ XYZWXYZWXYZWXYZ)
C*****
C***** A CONVERSION IS USED IN THE FORMAT STATEMENTS. 3.5.11
C***** SOME FORMAT DESCRIPTORS ARE REPEATED.
C***** READ WITH A-EDIT DESCRIPTOR, A STRING, FOLLOWED BY ANOTHER
C***** FIELD TO SHOW THAT THE POINTER PICKS UP THE NEXT FIELD
C***** FOLLOWING THE COUNT OF THE LENGTH OF THE DECLARED VARIABLE.
C*****
C***** INPUT CARD 3
READ(IRVI, 02206) A1VK, A2VK, A3VK, A4VK, A5VK, A6VK
02206 FORMAT(A, 2A, 3(A))
CT004* TEST 4
IVTNUM = 4
WRITE (NUVI, 80004) IVTNUM
WRITE (NUVI, 80020)
WRITE(NUVI, 70040) A1VK, A2VK, A3VK, A4VK, A5VK, A6VK
70040 FORMAT(26X,6A)
IVINSP = IVINSP + 1
WRITE (NUVI, 80022)
WRITE (NUVI, 70042)
70042 FORMAT(26X,21H112123123412345123456)
C*****
C***** TEST THAT A SLASH ON INPUT CAUSES THE UNPROCESSED CHARACTERS
C***** TO BE SKIPPED. 13.5.4
C***** ALSO TEST THAT AN APOSTROPHE MAY BE USED INSTEAD OF AN 13.5.1
C***** H-EDIT DESCRIPTOR. 13.5.2
C*****
C***** INPUT CARD 4
READ(IRVI, 02208) A41K(2), A41K(1), A41K(4), A41K(3)
02208 FORMAT(4A4)
C***** INPUT CARDS 5-6
READ(IRVI, 02209) A41K(2), A41K(4), A41K(3)
02209 FORMAT(A4 / 2A4)
CT005* TEST 5
IVTNUM = 5
REMRKS = '2 IDENTICAL COMPUTED LINES '
WRITE (NUVI, 80004) IVTNUM, REMRKS
REMRKS = 'EXPECTED '
WRITE (NUVI, 80050) REMRKS
WRITE (NUVI, 80020)
WRITE(NUVI, 70050) A41K(2), A41K(1), A41K(4), A41K(3)
70050 FORMAT(26X,'----HHHH....NNNN'/26X,3(A4),A4)
IVINSP = IVINSP + 1
WRITE (NUVI, 70011)
WRITE (NUVI, 70052)
70052 FORMAT (26X,16H----HHHH....NNNN)
C*****
CBB** ********************** BBCSUM0 **********************************
C**** WRITE OUT TEST SUMMARY
C****
IVTOTN = IVPASS + IVFAIL + IVDELE + IVINSP
WRITE (I02, 90004)
WRITE (I02, 90014)
WRITE (I02, 90004)
WRITE (I02, 90020) IVPASS
WRITE (I02, 90022) IVFAIL
WRITE (I02, 90024) IVDELE
WRITE (I02, 90026) IVINSP
WRITE (I02, 90028) IVTOTN, IVTOTL
CBE** ********************** BBCSUM0 **********************************
CBB** ********************** BBCFOOT0 **********************************
C**** WRITE OUT REPORT FOOTINGS
C****
WRITE (I02,90016) ZPROG, ZPROG
WRITE (I02,90018) ZPROJ, ZNAME, ZTAPE, ZTAPED
WRITE (I02,90019)
CBE** ********************** BBCFOOT0 **********************************
CBB** ********************** BBCFMT0A **********************************
C**** FORMATS FOR TEST DETAIL LINES
C****
80000 FORMAT (1H ,2X,I3,4X,7HDELETED,32X,A31)
80002 FORMAT (1H ,2X,I3,4X,7H PASS ,32X,A31)
80004 FORMAT (1H ,2X,I3,4X,7HINSPECT,32X,A31)
80008 FORMAT (1H ,2X,I3,4X,7H FAIL ,32X,A31)
80010 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,15X,10HCOMPUTED= ,
1I6,/,1H ,15X,10HCORRECT= ,I6)
80012 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
1E12.5,/,1H ,16X,10HCORRECT= ,E12.5)
80018 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
1A21,/,1H ,16X,10HCORRECT= ,A21)
80020 FORMAT (1H ,16X,10HCOMPUTED= ,A21,1X,A31)
80022 FORMAT (1H ,16X,10HCORRECT= ,A21,1X,A31)
80024 FORMAT (1H ,16X,10HCOMPUTED= ,I6,16X,A31)
80026 FORMAT (1H ,16X,10HCORRECT= ,I6,16X,A31)
80028 FORMAT (1H ,16X,10HCOMPUTED= ,E12.5,10X,A31)
80030 FORMAT (1H ,16X,10HCORRECT= ,E12.5,10X,A31)
80050 FORMAT (1H ,48X,A31)
CBE** ********************** BBCFMT0A **********************************
CBB** ********************** BBCFMT0B **********************************
C**** FORMAT STATEMENTS FOR PAGE HEADERS
C****
90002 FORMAT (1H1)
90004 FORMAT (1H )
90006 FORMAT (1H ,20X,31HFEDERAL SOFTWARE TESTING CENTER)
90007 FORMAT (1H ,19X,34HFORTRAN COMPILER VALIDATION SYSTEM)
90008 FORMAT (1H ,21X,A13,A17)
90009 FORMAT (1H ,/,2H *,A5,6HBEGIN*,12X,15HTEST RESULTS - ,A5,/)
90010 FORMAT (1H ,8X,16HTEST DATE*TIME= ,A17,15H - COMPILER= ,A20)
90013 FORMAT (1H ,8H TEST ,10HPASS/FAIL ,6X,17HDISPLAYED RESULTS,
1 7X,7HREMARKS,24X)
90014 FORMAT (1H ,46H----------------------------------------------,
1 33H---------------------------------)
90015 FORMAT (1H ,48X,17HTHIS PROGRAM HAS ,I3,6H TESTS,/)
C****
C**** FORMAT STATEMENTS FOR REPORT FOOTINGS
C****
90016 FORMAT (1H ,/,2H *,A5,4HEND*,14X,14HEND OF TEST - ,A5,/)
90018 FORMAT (1H ,A13,13X,A20,7H * ,A10,1H/,
1 A13)
90019 FORMAT (1H ,26HFOR OFFICIAL USE ONLY ,35X,15HCOPYRIGHT 1982)
C****
C**** FORMAT STATEMENTS FOR RUN SUMMARY
C****
90020 FORMAT (1H ,21X,I5,13H TESTS PASSED)
90022 FORMAT (1H ,21X,I5,13H TESTS FAILED)
90024 FORMAT (1H ,21X,I5,14H TESTS DELETED)
90026 FORMAT (1H ,21X,I5,25H TESTS REQUIRE INSPECTION)
90028 FORMAT (1H ,21X,I5,4H OF ,I3,15H TESTS EXECUTED)
CBE** ********************** BBCFMT0B **********************************
C*****
C***** END OF TEST SEGMENT 022
STOP
END
*END-OF,FM404
FM405.f 481036359 170 2 100666 17867 `
*HEADER,FORTR,FM405
*FILES1,FORTR,FM405,X
C***********************************************************************
C***** FORTRAN 77
C***** FM405
C***** INTER1 - (390)
C*****
C***********************************************************************
C***** TESTING OF INTERNAL FILES - SUBSET REF
C***** USING READ 12.2.5
C*****
CBB** ********************** BBCCOMNT **********************************
C****
C**** 1978 FORTRAN COMPILER VALIDATION SYSTEM
C**** VERSION 2.0
C****
C****
C**** SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO
C**** GENERAL SERVICES ADMINISTRATION
C**** FEDERAL SOFTWARE TESTING CENTER
C**** 5203 LEESBURG PIKE, SUITE 1100
C**** FALLS CHURCH, VA. 22041
C****
C**** (703) 756-6153
C****
CBE** ********************** BBCCOMNT **********************************
C*****
C***** S P E C I F I C A T I O N S SEGMENT 390
C*****
LOGICAL AVB, BVB, CVB
CHARACTER A1VK*1, A4VK*4, B1VK*1, B4VK*4, A38VK*38, B381K(4)*38
CHARACTER A5VK*5, A8VK*8, B5VK*5, B8VK*8
CBB** ********************** BBCINITA **********************************
C**** SPECIFICATION STATEMENTS
C****
CHARACTER ZVERS*13, ZVERSD*17, ZDATE*17, ZPROG*5, ZCOMPL*20,
1 ZNAME*20, ZTAPE*10, ZPROJ*13, REMRKS*31, ZTAPED*13
CBE** ********************** BBCINITA **********************************
CBB** ********************** BBCINITB **********************************
C**** INITIALIZE SECTION
DATA ZVERS, ZVERSD, ZDATE
1 /'VERSION 2.0 ', '82/08/02*18.33.46', '*NO DATE*TIME'/
DATA ZCOMPL, ZNAME, ZTAPE
1 /'*NONE SPECIFIED*', '*NO COMPANY NAME*', '*NO TAPE*'/
DATA ZPROJ, ZTAPED, ZPROG
1 /'*NO PROJECT*', '*NO TAPE DATE', 'XXXXX'/
DATA REMRKS /' '/
C**** THE FOLLOWING 9 COMMENT LINES (CZ01, CZ02, ...) CAN BE REPLACED
C**** FOR IDENTIFYING THE TEST ENVIRONMENT
C****
CZ01 ZVERS = 'VERSION OF THE COMPILER VALIDATION SYSTEM'
CZ02 ZVERSD = 'CREATION DATE/TIME OF THE COMPILER VALIDATION SYSTEM'
CZ03 ZPROG = 'PROGRAM NAME'
CZ04 ZDATE = 'DATE OF TEST'
CZ05 ZCOMPL = 'COMPILER IDENTIFICATION'
CZ06 ZPROJ = 'PROJECT NUMBER/IDENTIFICATION'
CZ07 ZNAME = 'NAME OF USER'
CZ08 ZTAPE = 'TAPE OWNER/ID'
CZ09 ZTAPED = 'DATE TAPE COPIED'
C
IVPASS = 0
IVFAIL = 0
IVDELE = 0
IVINSP = 0
IVTOTL = 0
IVTOTN = 0
ICZERO = 0
C
C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER.
I01 = 05
C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER.
I02 = 06
C
CX010 REPLACED BY FEXEC X-010 CONTROL CARD (CARD-READER UNIT NUMBER).
C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5
CX011 REPLACED BY FEXEC X-011 CONTROL CARD. CX011 IS FOR SYSTEMS
C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX010.
C
CX020 REPLACED BY FEXEC X-020 CONTROL CARD (PRINTER UNIT NUMBER).
C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02= 6
CX021 REPLACED BY FEXEC X-021 CONTROL CARD. CX021 IS FOR SYSTEMS
C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX020.
C
CBE** ********************** BBCINITB **********************************
C*****
EVS = 0.001
C*****
NUVI = I02
IVTOTL=15
ZPROG='FM405'
CBB** ********************** BBCHED0A **********************************
C****
C**** WRITE REPORT TITLE
C****
WRITE (I02, 90002)
WRITE (I02, 90006)
WRITE (I02, 90007)
WRITE (I02, 90008) ZVERS, ZVERSD
WRITE (I02, 90009) ZPROG, ZPROG
WRITE (I02, 90010) ZDATE, ZCOMPL
CBE** ********************** BBCHED0A **********************************
C*****
A38VK = '2.1 TEST 3 23.45E2 .TRUE. F '
B381K(1) = ' 23 23.345 T ENDS '
B381K(2) = ' 23.456 F 98 YOURS PROGRAMS '
B381K(3) = ' 13.1234 13.1234E0 1312.34 '
B381K(4) = ' 5.2345 56 5.2345 T TRUE 5.2345'
C*****
C***** HEADER FOR SEGMENT 390
C*****
WRITE(NUVI,39000)
39000 FORMAT(/2X,44H INTER1 - (390) INTERNAL FILES -- USING READ
1 //21H SUBSET REF. - 12.2.5)
CBB** ********************** BBCHED0B **********************************
C**** WRITE DETAIL REPORT HEADERS
C****
WRITE (I02,90004)
WRITE (I02,90004)
WRITE (I02,90013)
WRITE (I02,90014)
WRITE (I02,90015) IVTOTL
CBE** ********************** BBCHED0B **********************************
C******
C*************************************************************
CT001* TEST 1 CHARACTER VARIABLE, INTEGER
IVTNUM=1
READ(A38VK,39001) IVI
39001 FORMAT(8X,I2)
KVI = 3
IVCOMP=0
IF (IVI .EQ. KVI) IVCOMP=1
IF (IVCOMP-1) 20010,10010,20010
10010 IVPASS=IVPASS + 1
WRITE (NUVI,80002) IVTNUM
GO TO 0011
20010 IVFAIL=IVFAIL+1
WRITE (NUVI,80008) IVTNUM
WRITE (NUVI,80024) IVI
WRITE (NUVI,80026) KVI
0011 CONTINUE
C*****
CT002* TEST 2 REAL, FW.D
IVTNUM=2
READ(A38VK,39004) AVS
39004 FORMAT(F3.1)
BVS = 2.1
IVCOMP=0
IF (AVS .LT. BVS + EVS .AND. AVS .GT. BVS - EVS) IVCOMP=1
IF (IVCOMP-1) 20020,10020,20020
10020 IVPASS=IVPASS + 1
WRITE(NUVI,80002)IVTNUM
GO TO 0021
20020 IVFAIL=IVFAIL+1
WRITE(NUVI,80008) IVTNUM
WRITE (NUVI,80028) AVS
WRITE (NUVI,80030) BVS
0021 CONTINUE
CT003* TEST 3 REAL, EW.D
IVTNUM=3
READ(A38VK,39006) AVS
39006 FORMAT(11X,E7.2)
BVS = 23.45E2
IVCOMP=0
IF (AVS .LT. BVS + EVS .AND. AVS .GT. BVS - EVS) IVCOMP=1
IF (IVCOMP-1) 20030,10030,20030
10030 IVPASS=IVPASS + 1
WRITE(NUVI,80002)IVTNUM
GO TO 0031
20030 IVFAIL=IVFAIL + 1
WRITE(NUVI,80008)IVTNUM
WRITE (NUVI,80028) AVS
WRITE (NUVI,80030) BVS
0031 CONTINUE
CT004* TEST 4 SAME REAL, EW.DEN
IVTNUM=4
IVCOMP=0
READ(A38VK,39008) CVS
39008 FORMAT(10X,E8.2E2)
IF (CVS .LT. BVS + EVS .AND. CVS .GT. BVS - EVS) IVCOMP=1
IF (IVCOMP-1) 20040,10040,20040
10040 IVPASS=IVPASS+1
WRITE(NUVI,80002) IVTNUM
GO TO 0041
20040 IVFAIL=IVFAIL + 1
WRITE(NUVI,80008)IVTNUM
WRITE (NUVI,80028) CVS
WRITE (NUVI,80030) BVS
0041 CONTINUE
CT005* TEST 5 LOGICAL, WITH PERIODS
IVTNUM=5
READ(A38VK,39010) AVB
39010 FORMAT(19X,L6)
IVCOMP=0
IF (AVB) IVCOMP=1
IF (IVCOMP-1) 20050,10050,20050
10050 IVPASS=IVPASS+1
WRITE (NUVI,80002) IVTNUM
GO TO 0051
20050 IVFAIL=IVFAIL + 1
WRITE (NUVI,80008) IVTNUM
70050 FORMAT (1H ,16X,10HCOMPUTED: ,L1,
1 /17X,10HCORRECT: ,1HT)
WRITE (NUVI,70050) AVB
0051 CONTINUE
CT006* TEST 6 LOGICAL, WITHOUT PERIODS
IVTNUM=6
READ(A38VK,39012) CVB
39012 FORMAT(25X,L3)
IVCOMP=0
IF (.NOT. CVB) IVCOMP=1
IF (IVCOMP-1) 20060,10060,20060
10060 IVPASS=IVPASS+1
WRITE (NUVI,80002) IVTNUM
GO TO 0061
20060 IVFAIL=IVFAIL+1
WRITE (NUVI,80008) IVTNUM
70060 FORMAT (1H ,16X,10HCOMPUTED: ,L1)
WRITE (NUVI,70060) CVB
70061 FORMAT (1H ,16X,10HCORRECT: ,1HF)
WRITE (NUVI,70061)
0061 CONTINUE
CT007* TEST 7 CHARACTER, A
IVTNUM=7
READ(A38VK,39014) A1VK
39014 FORMAT(9X,A1)
B1VK = '3'
IVCOMP=0
IF (A1VK .EQ. B1VK) IVCOMP=1
IF (IVCOMP-1) 20070,10070,20070
10070 IVPASS=IVPASS+1
WRITE (NUVI,80002) IVTNUM
GO TO 0071
20070 IVFAIL=IVFAIL+1
WRITE (NUVI,80008) IVTNUM
WRITE (NUVI,80020) A1VK
WRITE (NUVI,80022) B1VK
0071 CONTINUE
CT008* TEST 8 CHARACTER, AW
IVTNUM=8
READ(A38VK,39016) A4VK
39016 FORMAT(4X,A4)
B4VK = 'TEST'
IVCOMP=0
IF (A4VK .EQ. B4VK) IVCOMP=1
IF (IVCOMP-1) 20080,10080,20080
10080 IVPASS=IVPASS+1
WRITE (NUVI,80002) IVTNUM
GO TO 0081
20080 IVFAIL=IVFAIL + 1
WRITE (NUVI,80008) IVTNUM
WRITE (NUVI,80020) A4VK
WRITE (NUVI,80022) B4VK
0081 CONTINUE
CT009* TEST 9 CHARACTER, EXTRA BLANKS
IVTNUM = 9
READ(A38VK,39018) A4VK
39018 FORMAT(11X,A7)
B4VK = '45E2'
IVCOMP=0
IF (A4VK .EQ. B4VK) IVCOMP=1
IF (IVCOMP-1) 20090,10090,20090
10090 IVPASS=IVPASS+1
WRITE (NUVI,80002) IVTNUM
GO TO 0091
20090 IVFAIL=IVFAIL+1
WRITE (NUVI,80008) IVTNUM
WRITE (NUVI,80020) A4VK
WRITE (NUVI,80022) B4VK
0091 CONTINUE
CT010* TEST 10 CHARACTER, NO PADDING
IVTNUM = 10
READ(A38VK,39020) A4VK
39020 FORMAT(A3)
IVCOMP=0
B4VK = '2.1 '
IF (A4VK .EQ. B4VK) IVCOMP=1
IF (IVCOMP-1) 20100,10100,20100
10100 IVPASS=IVPASS+1
WRITE (NUVI,80002) IVTNUM
GO TO 0101
20100 IVFAIL=IVFAIL + 1
WRITE (NUVI,80008) IVTNUM
WRITE (NUVI,80020) A4VK
WRITE (NUVI,80022) B4VK
0101 CONTINUE
CT011* TEST 11 CHECK TO SEE IF SECOND VARIABLE
C***** START READING JUST AFTER FIRST VARIABLE
IVTNUM = 11
READ(A38VK,39022) A4VK, A1VK
39022 FORMAT(1X,A,A)
B4VK = '.1 T'
B1VK = 'E'
IVCOMP=0
IF (A4VK .EQ. B4VK .AND. A1VK .EQ. B1VK) IVCOMP=1
IF (IVCOMP-1) 20110,10110,20110
10110 IVPASS=IVPASS+1
WRITE (NUVI,80002) IVTNUM
GO TO 0111
20110 IVFAIL=IVFAIL + 1
WRITE (NUVI,80008) IVTNUM
WRITE (NUVI,80020) A4VK,A1VK
WRITE (NUVI,80022) B4VK,B1VK
0111 CONTINUE
CT012* TEST 12 MIXED TYPES, ARRAY ELEMENT
IVTNUM = 12
READ(B381K(1),39024) IVI, AVS, AVB, A4VK
39024 FORMAT(I5,1X,F8.3,1X,L5,1X,A4)
KVI = 23
BVS = 23.345
B4VK = 'ENDS'
IF (IVI .EQ. KVI .AND.
1 AVS .LT. BVS + EVS .AND. AVS .GT. BVS - EVS .AND.
2 AVB .AND.
3 A4VK .EQ. B4VK) GOTO 39026
IVFAIL=IVFAIL + 1
70120 FORMAT (1H ,2X,I3,4X,7H FAIL ,16HMIXED DATA TYPES,16X,
1 28HCOMPLEX IF - SEE SOURCE CODE)
WRITE(NUVI,70120)IVTNUM
70121 FORMAT (1H ,16X,10HCOMPUTED: ,I5,2X,F10.5,2X,L1,2X,A4)
WRITE (NUVI,70121) IVI,AVS,AVB,A4VK
70122 FORMAT (1H ,16X,10HCORRECT: ,
1 5H 23,2X,10H 23.34500,2X,1HT,2X,4HENDS)
WRITE (NUVI,70122)
GOTO 39027
39026 IVPASS=IVPASS+1
WRITE(NUVI,80002) IVTNUM
39027 CONTINUE
CT013* TEST 13 MIXED TYPES, ARRAY ELEMENT
C***** WITH RUN TIME EXPRESSION AS SUBSCRIPT
IVTNUM = 13
KVI = 1
READ(B381K(KVI*2),39028) AVS, AVB, IVI, A5VK, A8VK
39028 FORMAT(F7.3,1X,L5,1X,I5,1X,A5,1X,A8)
BVS = 23.456
KVI = 98
B5VK = 'YOURS'
B8VK = 'PROGRAMS'
IF (AVS .LT. BVS + EVS .AND. AVS .GT. BVS - EVS .AND.
1 .NOT. AVB .AND.
2 IVI .EQ. KVI .AND.
3 A5VK .EQ. B5VK .AND.
4 A8VK .EQ. B8VK) GOTO 39030
IVFAIL=IVFAIL+1
70130 FORMAT (1H ,2X,I3,4X,7H FAIL ,16HMIXED DATA TYPES,16X,
1 28HCOMPLEX IF - SEE SOURCE CODE)
WRITE (NUVI,70130) IVTNUM
70131 FORMAT (1H ,16X,10HCOMPUTED: ,
1 F7.3,2X,L1,2X,I5,2X,A5,2X,A8)
WRITE (NUVI,70131) AVS,AVB,IVI,A5VK,A8VK
70132 FORMAT (1H ,16X,10HCORRECT: ,
1 7H 23.456,2X,1HF,2X,5H 98,2X,5HYOURS,2X,8HPROGRAMS)
WRITE (NUVI,70132)
GOTO 39031
39030 IVPASS=IVPASS + 1
WRITE(NUVI,80002) IVTNUM
39031 CONTINUE
CT014* TEST 14 MIXED TYPES, ALSO BN AND BZ
C*****
IVTNUM = 14
READ(B381K(4),39032) AVS, IVI, BVS, AVB, A4VK, CVS
39032 FORMAT(F9.4,1X,I4,1X,BN,F9.4,1X,L1,1X,A4,1X,BZ,F6.4)
DVS = 5.2345
KVI = 56
BVB = .TRUE.
B4VK = 'TRUE'
IF (AVS .LT. DVS + EVS .AND. AVS .GT. DVS - EVS .AND.
1 IVI .EQ. KVI .AND.
2 BVS .LT. DVS + EVS .AND. BVS .GT. DVS - EVS .AND.
3 AVB .AND.
4 A4VK .EQ. B4VK .AND.
5 CVS .LT. DVS + EVS .AND. CVS .GT. DVS - EVS) GOTO 39034
IVFAIL=IVFAIL + 1
70140 FORMAT (1H ,2X,I3,4X,7H FAIL ,16HMIXED DATA TYPES,16X,
1 28HCOMPLEX IF - SEE SOURCE CODE)
WRITE(NUVI,70140) IVTNUM
70141 FORMAT (1H ,16X,10HCOMPUTED: ,
1 F9.4,2X,I4,2X,F9.4,2X,L1,2X,A4,2X,F9.4)
WRITE (NUVI,70141) AVS,IVI,BVS,AVB,A4VK,CVS
70142 FORMAT (1H ,16X,10HCORRECT: ,
2 9H 5.2345,2X,4H 56,2X,9H 5.2345,2X,1HT,2X,4HTRUE,
3 2X,9H 5.2345)
WRITE (NUVI,70142)
GOTO 39035
39034 IVPASS=IVPASS+1
WRITE(NUVI,80002) IVTNUM
39035 CONTINUE
CT015* TEST 15 REAL VARIABLES WITH SCALING FACTOR
IVTNUM = 15
READ(B381K(3),39036) AVS, BVS, CVS
39036 FORMAT(F9.5, 1X, E9.3, 1X, 2PF7.4)
DVS = 13.1234
IF (AVS .LT. DVS + EVS .AND. AVS .GT. DVS - EVS .AND.
1 BVS .LT. DVS + EVS .AND. BVS .GT. DVS - EVS .AND.
2 CVS .LT. DVS + EVS .AND. CVS .GT. DVS - EVS) GOTO 39038
IVFAIL=IVFAIL + 1
70150 FORMAT (1H ,2X,I3,4X,7H FAIL ,16HREAL DATA TYPES,16X,
1 28HCOMPLEX IF - SEE SOURCE CODE)
WRITE(NUVI,70150) IVTNUM
70151 FORMAT (1H ,16X,10HCOMPUTED: ,F9.4,2X,F9.3,2X,F7.4)
WRITE (NUVI,70151) AVS,BVS,CVS
70152 FORMAT (1H ,16X,10HCORRECT: ,
1 9H 13.1234,2X,9H 13.123,2X,7H13.1234)
WRITE (NUVI,70152)
GOTO 39039
39038 IVPASS=IVPASS+1
WRITE(NUVI,80002) IVTNUM
39039 CONTINUE
C*****
C***** END OF TEST SEGMENT 390
CBB** ********************** BBCSUM0 **********************************
C**** WRITE OUT TEST SUMMARY
C****
IVTOTN = IVPASS + IVFAIL + IVDELE + IVINSP
WRITE (I02, 90004)
WRITE (I02, 90014)
WRITE (I02, 90004)
WRITE (I02, 90020) IVPASS
WRITE (I02, 90022) IVFAIL
WRITE (I02, 90024) IVDELE
WRITE (I02, 90026) IVINSP
WRITE (I02, 90028) IVTOTN, IVTOTL
CBE** ********************** BBCSUM0 **********************************
CBB** ********************** BBCFOOT0 **********************************
C**** WRITE OUT REPORT FOOTINGS
C****
WRITE (I02,90016) ZPROG, ZPROG
WRITE (I02,90018) ZPROJ, ZNAME, ZTAPE, ZTAPED
WRITE (I02,90019)
CBE** ********************** BBCFOOT0 **********************************
CBB** ********************** BBCFMT0A **********************************
C**** FORMATS FOR TEST DETAIL LINES
C****
80000 FORMAT (1H ,2X,I3,4X,7HDELETED,32X,A31)
80002 FORMAT (1H ,2X,I3,4X,7H PASS ,32X,A31)
80004 FORMAT (1H ,2X,I3,4X,7HINSPECT,32X,A31)
80008 FORMAT (1H ,2X,I3,4X,7H FAIL ,32X,A31)
80010 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,15X,10HCOMPUTED= ,
1I6,/,1H ,15X,10HCORRECT= ,I6)
80012 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
1E12.5,/,1H ,16X,10HCORRECT= ,E12.5)
80018 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
1A21,/,1H ,16X,10HCORRECT= ,A21)
80020 FORMAT (1H ,16X,10HCOMPUTED= ,A21,1X,A31)
80022 FORMAT (1H ,16X,10HCORRECT= ,A21,1X,A31)
80024 FORMAT (1H ,16X,10HCOMPUTED= ,I6,16X,A31)
80026 FORMAT (1H ,16X,10HCORRECT= ,I6,16X,A31)
80028 FORMAT (1H ,16X,10HCOMPUTED= ,E12.5,10X,A31)
80030 FORMAT (1H ,16X,10HCORRECT= ,E12.5,10X,A31)
80050 FORMAT (1H ,48X,A31)
CBE** ********************** BBCFMT0A **********************************
CBB** ********************** BBCFMT0B **********************************
C**** FORMAT STATEMENTS FOR PAGE HEADERS
C****
90002 FORMAT (1H1)
90004 FORMAT (1H )
90006 FORMAT (1H ,20X,31HFEDERAL SOFTWARE TESTING CENTER)
90007 FORMAT (1H ,19X,34HFORTRAN COMPILER VALIDATION SYSTEM)
90008 FORMAT (1H ,21X,A13,A17)
90009 FORMAT (1H ,/,2H *,A5,6HBEGIN*,12X,15HTEST RESULTS - ,A5,/)
90010 FORMAT (1H ,8X,16HTEST DATE*TIME= ,A17,15H - COMPILER= ,A20)
90013 FORMAT (1H ,8H TEST ,10HPASS/FAIL ,6X,17HDISPLAYED RESULTS,
1 7X,7HREMARKS,24X)
90014 FORMAT (1H ,46H----------------------------------------------,
1 33H---------------------------------)
90015 FORMAT (1H ,48X,17HTHIS PROGRAM HAS ,I3,6H TESTS,/)
C****
C**** FORMAT STATEMENTS FOR REPORT FOOTINGS
C****
90016 FORMAT (1H ,/,2H *,A5,4HEND*,14X,14HEND OF TEST - ,A5,/)
90018 FORMAT (1H ,A13,13X,A20,7H * ,A10,1H/,
1 A13)
90019 FORMAT (1H ,26HFOR OFFICIAL USE ONLY ,35X,15HCOPYRIGHT 1982)
C****
C**** FORMAT STATEMENTS FOR RUN SUMMARY
C****
90020 FORMAT (1H ,21X,I5,13H TESTS PASSED)
90022 FORMAT (1H ,21X,I5,13H TESTS FAILED)
90024 FORMAT (1H ,21X,I5,14H TESTS DELETED)
90026 FORMAT (1H ,21X,I5,25H TESTS REQUIRE INSPECTION)
90028 FORMAT (1H ,21X,I5,4H OF ,I3,15H TESTS EXECUTED)
CBE** ********************** BBCFMT0B **********************************
STOP
END
*END-OF,FM405
FM406.f 481036363 170 2 100666 18358 `
*HEADER,FORTR,FM406
*FILES1,FORTR,FM406,X
C***********************************************************************
C***** FORTRAN 77
C***** FM406
C***** INTER2 - (391)
C*****
C***********************************************************************
C***** TESTING OF INTERNAL FILES - SUBSET REF
C***** USING WRITE 12.2.5
C*****
CBB** ********************** BBCCOMNT **********************************
C****
C**** 1978 FORTRAN COMPILER VALIDATION SYSTEM
C**** VERSION 2.0
C****
C****
C**** SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO
C**** GENERAL SERVICES ADMINISTRATION
C**** FEDERAL SOFTWARE TESTING CENTER
C**** 5203 LEESBURG PIKE, SUITE 1100
C**** FALLS CHURCH, VA. 22041
C****
C**** (703) 756-6153
C****
CBE** ********************** BBCCOMNT **********************************
C*****
C***** S P E C I F I C A T I O N S SEGMENT 391
C*****
LOGICAL AVB
CHARACTER A4VK*4, A5VK*5, A10VK*10, A38VK*38
CHARACTER CVCORR*38, AVCORR(8)*38
C*****
CBB** ********************** BBCINITA **********************************
C**** SPECIFICATION STATEMENTS
C****
CHARACTER ZVERS*13, ZVERSD*17, ZDATE*17, ZPROG*5, ZCOMPL*20,
1 ZNAME*20, ZTAPE*10, ZPROJ*13, REMRKS*31, ZTAPED*13
CBE** ********************** BBCINITA **********************************
CBB** ********************** BBCINITB **********************************
C**** INITIALIZE SECTION
DATA ZVERS, ZVERSD, ZDATE
1 /'VERSION 2.0 ', '82/08/02*18.33.46', '*NO DATE*TIME'/
DATA ZCOMPL, ZNAME, ZTAPE
1 /'*NONE SPECIFIED*', '*NO COMPANY NAME*', '*NO TAPE*'/
DATA ZPROJ, ZTAPED, ZPROG
1 /'*NO PROJECT*', '*NO TAPE DATE', 'XXXXX'/
DATA REMRKS /' '/
C**** THE FOLLOWING 9 COMMENT LINES (CZ01, CZ02, ...) CAN BE REPLACED
C**** FOR IDENTIFYING THE TEST ENVIRONMENT
C****
CZ01 ZVERS = 'VERSION OF THE COMPILER VALIDATION SYSTEM'
CZ02 ZVERSD = 'CREATION DATE/TIME OF THE COMPILER VALIDATION SYSTEM'
CZ03 ZPROG = 'PROGRAM NAME'
CZ04 ZDATE = 'DATE OF TEST'
CZ05 ZCOMPL = 'COMPILER IDENTIFICATION'
CZ06 ZPROJ = 'PROJECT NUMBER/IDENTIFICATION'
CZ07 ZNAME = 'NAME OF USER'
CZ08 ZTAPE = 'TAPE OWNER/ID'
CZ09 ZTAPED = 'DATE TAPE COPIED'
C
IVPASS = 0
IVFAIL = 0
IVDELE = 0
IVINSP = 0
IVTOTL = 0
IVTOTN = 0
ICZERO = 0
C
C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER.
I01 = 05
C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER.
I02 = 06
C
CX010 REPLACED BY FEXEC X-010 CONTROL CARD (CARD-READER UNIT NUMBER).
C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5
CX011 REPLACED BY FEXEC X-011 CONTROL CARD. CX011 IS FOR SYSTEMS
C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX010.
C
CX020 REPLACED BY FEXEC X-020 CONTROL CARD (PRINTER UNIT NUMBER).
C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02= 6
CX021 REPLACED BY FEXEC X-021 CONTROL CARD. CX021 IS FOR SYSTEMS
C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX020.
C
CBE** ********************** BBCINITB **********************************
NUVI = I02
IVTOTL = 12
ZPROG = 'FM406'
CBB** ********************** BBCHED0A **********************************
C****
C**** WRITE REPORT TITLE
C****
WRITE (I02, 90002)
WRITE (I02, 90006)
WRITE (I02, 90007)
WRITE (I02, 90008) ZVERS, ZVERSD
WRITE (I02, 90009) ZPROG, ZPROG
WRITE (I02, 90010) ZDATE, ZCOMPL
CBE** ********************** BBCHED0A **********************************
C*****
C*****
C***** HEADER FOR SEGMENT 391
C*****
WRITE(NUVI,39100)
39100 FORMAT(1H ,/ 45H INTER2 - (391) INTERNAL FILES -- USING WRITE
1 //21H SUBSET REF. - 12.2.5)
CBB** ********************** BBCHED0B **********************************
C**** WRITE DETAIL REPORT HEADERS
C****
WRITE (I02,90004)
WRITE (I02,90004)
WRITE (I02,90013)
WRITE (I02,90014)
WRITE (I02,90015) IVTOTL
CBE** ********************** BBCHED0B **********************************
WRITE (NUVI, 39199)
39199 FORMAT (1H ,48X,31HNOTE 1: OPTIONAL LEADING ZERO /
1 1H ,48X,31H MAY BE BLANK FOR ABSOLUTE /
2 1H ,48X,31H VALUE < 1 /
3 1H ,48X,31HNOTE 2: LEADING PLUS SIGN IS /
4 1H ,48X,31H OPTIONAL /
5 1H ,48X,31HNOTE 3: E EXPONENT MAY BE E+ /
6 1H ,48X,31H OR +0 BEFORE VALUE )
CT001* TEST 1 CHARACTER VARIABLE, INTEGER
IVTNUM = 1
A10VK = 'XXXXXXXXXX'
KVI = 3
WRITE(A10VK,39101) KVI
39101 FORMAT(I2)
IVCOMP = 0
AVCORR(1) = ' 3 '
AVCORR(2) = '+3 '
DO 40011 I = 1, 2
IF (A10VK.EQ.AVCORR(I)) IVCOMP = 1
IF (IVCOMP - 1) 40011, 10010, 40011
40011 CONTINUE
GO TO 20010
10010 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0011
20010 IVFAIL = IVFAIL + 1
CVCORR = ' 3 '
REMRKS = 'COMPUTED VALUE NOT CONSISTENT'
WRITE (NUVI, 80008) IVTNUM, REMRKS
REMRKS = 'WITH PERMISSIBLE OPTIONS ABOVE'
WRITE (NUVI, 80050) REMRKS
WRITE (NUVI, 80020) A10VK
WRITE (NUVI, 80022) CVCORR
0011 CONTINUE
CT002* TEST 2 REAL, FW.D
IVTNUM = 2
A10VK = 'XXXXXXXXXX'
AVS = 2.1
WRITE(A10VK,39103) AVS
39103 FORMAT(F3.1)
IVCOMP = 0
IF (A10VK.EQ.'2.1 ') IVCOMP = 1
IF (IVCOMP - 1) 20020, 10020, 20020
10020 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0021
20020 IVFAIL = IVFAIL + 1
CVCORR = '2.1 '
WRITE (NUVI, 80018) IVTNUM, A10VK, CVCORR
0021 CONTINUE
CT003* TEST 3 CHECK FOR MISSING SIGN
IVTNUM = 3
A10VK = 'XXXXXXXXXX'
AVS = -0.0001
WRITE(A10VK,39104) AVS
39104 FORMAT(F4.1)
IVCOMP = 0
AVCORR(1) = ' 0.0 '
AVCORR(2) = ' .0 '
AVCORR(3) = '+0.0 '
AVCORR(4) = ' +.0 '
DO 40031 I = 1, 4
IF (A10VK.EQ.AVCORR(I)) IVCOMP = 1
IF (IVCOMP - 1) 40031, 10030, 40031
40031 CONTINUE
GO TO 20030
10030 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0031
20030 IVFAIL = IVFAIL + 1
CVCORR = ' 0.0 '
REMRKS = 'COMPUTED VALUE NOT CONSISTENT'
WRITE (NUVI, 80008) IVTNUM, REMRKS
REMRKS = 'WITH PERMISSIBLE OPTIONS ABOVE'
WRITE (NUVI, 80050) REMRKS
WRITE (NUVI, 80020) A10VK
WRITE (NUVI, 80022) CVCORR
0031 CONTINUE
CT004* TEST 4 CONVERSION ERROR
IVTNUM = 4
A10VK = 'XXXXXXXXXX'
AVS = 231.75
WRITE(A10VK,39105) AVS
39105 FORMAT(F4.2)
IVCOMP = 0
IF (A10VK.EQ.'**** ') IVCOMP = 1
IF (IVCOMP - 1) 20040, 10040, 20040
10040 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0041
20040 IVFAIL = IVFAIL + 1
CVCORR = '**** '
WRITE (NUVI, 80018) IVTNUM, A10VK, CVCORR
0041 CONTINUE
CT005* TEST 5 REAL, EW.D
IVTNUM = 5
A10VK = 'XXXXXXXXXX'
AVS = 23.45E2
WRITE(A10VK,39106) AVS
39106 FORMAT(1X,E9.4)
IVCOMP = 0
AVCORR(1) = ' .2345E+04'
AVCORR(2) = ' .2345+004'
DO 40051 I = 1, 2
IF (A10VK.EQ.AVCORR(I)) IVCOMP = 1
IF (IVCOMP - 1) 40051, 10050, 40051
40051 CONTINUE
GO TO 20050
10050 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0051
20050 IVFAIL = IVFAIL + 1
CVCORR = ' .2345E+04'
REMRKS = 'COMPUTED VALUE NOT CONSISTENT'
WRITE (NUVI, 80008) IVTNUM, REMRKS
REMRKS = 'WITH PERMISSIBLE OPTIONS ABOVE'
WRITE (NUVI, 80050) REMRKS
WRITE (NUVI, 80020) A10VK
WRITE (NUVI, 80022) CVCORR
0051 CONTINUE
CT006* TEST 6 REAL, EW.DEN
IVTNUM = 6
A10VK = 'XXXXXXXXXX'
WRITE(A10VK,39107) AVS
39107 FORMAT(1X,E8.4E1)
IVCOMP = 0
AVCORR(1) = ' .2345E+4 '
AVCORR(2) = ' .2345+04 '
DO 40061 I = 1, 2
IF (A10VK.EQ.AVCORR(I)) IVCOMP = 1
IF (IVCOMP - 1) 40061, 10060, 40061
40061 CONTINUE
GO TO 20060
10060 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0061
20060 IVFAIL = IVFAIL + 1
CVCORR = ' .2345E+4 '
REMRKS = 'COMPUTED VALUE NOT CONSISTENT'
WRITE (NUVI, 80008) IVTNUM, REMRKS
REMRKS = 'WITH PERMISSIBLE OPTIONS ABOVE'
WRITE (NUVI, 80050) REMRKS
WRITE (NUVI, 80020) A10VK
WRITE (NUVI, 80022) CVCORR
0061 CONTINUE
CT007* TEST 7 LOGICAL
IVTNUM = 7
A10VK = 'XXXXXXXXXX'
AVB = .TRUE.
WRITE(A10VK,39108) AVB
39108 FORMAT(L6)
IVCOMP = 0
IF (A10VK.EQ.' T ') IVCOMP = 1
IF (IVCOMP - 1) 20070, 10070, 20070
10070 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0071
20070 IVFAIL = IVFAIL + 1
CVCORR = ' T '
WRITE (NUVI, 80018) IVTNUM, A10VK, CVCORR
0071 CONTINUE
CT008* TEST 8 CHARACTER, AW
IVTNUM = 8
A10VK = 'XXXXXXXXXX'
A4VK = 'TEST'
WRITE(A10VK,39109) A4VK
39109 FORMAT(A4)
IVCOMP = 0
IF (A10VK.EQ.'TEST ') IVCOMP = 1
IF (IVCOMP - 1) 20080, 10080, 20080
10080 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0081
20080 IVFAIL = IVFAIL + 1
CVCORR = 'TEST '
WRITE (NUVI, 80018) IVTNUM, A10VK, CVCORR
0081 CONTINUE
CT009* TEST 9 BLANK RECORD
IVTNUM = 9
A10VK = 'XXXXXXXXXX'
WRITE(A10VK,39110)
39110 FORMAT()
IVCOMP = 0
IF (A10VK.EQ.' ') IVCOMP = 1
IF (IVCOMP - 1) 20090, 10090, 20090
10090 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0091
20090 IVFAIL = IVFAIL + 1
CVCORR = ' '
WRITE (NUVI, 80018) IVTNUM, A10VK, CVCORR
0091 CONTINUE
CT010* TEST 10 MIXED TYPES
IVTNUM = 10
A38VK = 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX'
KVI = 23
AVS = 23.345
AVB = .TRUE.
A4VK = 'ENDS'
WRITE(A38VK,39111) KVI, AVS, AVB, A4VK
39111 FORMAT(I5,1X,F8.3,1X,L5,1X,A4)
IVCOMP = 0
AVCORR(1) = ' 23 23.345 T ENDS '
AVCORR(2) = ' +23 +23.345 T ENDS '
AVCORR(3) = ' 23 +23.345 T ENDS '
AVCORR(4) = ' +23 23.345 T ENDS '
DO 40101 I = 1, 4
IF (A38VK.EQ.AVCORR(I)) IVCOMP = 1
IF (IVCOMP - 1) 40101, 10100, 40101
40101 CONTINUE
GO TO 20100
10100 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0101
20100 IVFAIL = IVFAIL + 1
CVCORR = ' 23 23.345 T ENDS '
REMRKS = 'COMPUTED VALUE NOT CONSISTENT'
WRITE (NUVI, 80008) IVTNUM, REMRKS
REMRKS = 'WITH PERMISSIBLE OPTIONS ABOVE'
WRITE (NUVI, 80050) REMRKS
WRITE (NUVI, 80020) A38VK
WRITE (NUVI, 80022) CVCORR
0101 CONTINUE
CT011* TEST 11 MIXED TYPES, WITH
C***** CHARACTER AND HOLLERITH STRINGS
IVTNUM = 11
A38VK = 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX'
AVS = 23.456
AVB = .FALSE.
KVI = 98
A5VK = 'YOURS'
WRITE(A38VK,39112) AVS, AVB, KVI, A5VK
39112 FORMAT(F7.3,1X,L5,1X,I5,1X,A5,1X,'PROGRAMS',1X,3HONE)
IVCOMP = 0
AVCORR(1) = ' 23.456 F 98 YOURS PROGRAMS ONE'
AVCORR(2) = '+23.456 F +98 YOURS PROGRAMS ONE'
AVCORR(3) = ' 23.456 F +98 YOURS PROGRAMS ONE'
AVCORR(4) = '+23.456 F 98 YOURS PROGRAMS ONE'
DO 40111 I = 1, 4
IF (A38VK.EQ.AVCORR(I)) IVCOMP = 1
IF (IVCOMP - 1) 40111, 10110, 40111
40111 CONTINUE
GO TO 20110
10110 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0111
20110 IVFAIL = IVFAIL + 1
CVCORR = ' 23.456 F 98 YOURS PROGRAMS ONE'
REMRKS = 'COMPUTED VALUE NOT CONSISTENT'
WRITE (NUVI, 80008) IVTNUM, REMRKS
REMRKS = 'WITH PERMISSIBLE OPTIONS ABOVE'
WRITE (NUVI, 80050) REMRKS
WRITE (NUVI, 80020) A38VK
WRITE (NUVI, 80022) CVCORR
0111 CONTINUE
CT012* TEST 12 MIXED TYPES, WITH EXPRESSION
IVTNUM = 12
A38VK = 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX'
AVS = 5.2345
BVS = 1.2345
AVB = .TRUE.
WRITE(A38VK,39113) AVS, 5, BVS*2, AVB, 'TWO'
39113 FORMAT(F9.4,1X,I4,1X,3HBVS,1X,F9.4,1X,L1,1X,A3)
IVCOMP = 0
AVCORR(1) = ' 5.2345 5 BVS 2.4690 T TWO '
AVCORR(2) = ' 5.2345 5 BVS +2.4690 T TWO '
AVCORR(3) = ' 5.2345 +5 BVS 2.4690 T TWO '
AVCORR(4) = ' 5.2345 +5 BVS +2.4690 T TWO '
AVCORR(5) = ' +5.2345 5 BVS 2.4690 T TWO '
AVCORR(6) = ' +5.2345 5 BVS +2.4690 T TWO '
AVCORR(7) = ' +5.2345 +5 BVS 2.4690 T TWO '
AVCORR(8) = ' +5.2345 +5 BVS +2.4690 T TWO '
DO 40121 I = 1, 8
IF (A38VK.EQ.AVCORR(I)) IVCOMP = 1
IF (IVCOMP - 1) 40121, 10120, 40121
40121 CONTINUE
GO TO 20120
10120 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0121
20120 IVFAIL = IVFAIL + 1
CVCORR = ' 5.2345 5 BVS 2.4690 T TWO '
REMRKS = 'COMPUTED VALUE NOT CONSISTENT'
WRITE (NUVI, 80008) IVTNUM, REMRKS
REMRKS = 'WITH PERMISSIBLE OPTIONS ABOVE'
WRITE (NUVI, 80050) REMRKS
WRITE (NUVI, 80020) A38VK
WRITE (NUVI, 80022) CVCORR
0121 CONTINUE
C*****
CBB** ********************** BBCSUM0 **********************************
C**** WRITE OUT TEST SUMMARY
C****
IVTOTN = IVPASS + IVFAIL + IVDELE + IVINSP
WRITE (I02, 90004)
WRITE (I02, 90014)
WRITE (I02, 90004)
WRITE (I02, 90020) IVPASS
WRITE (I02, 90022) IVFAIL
WRITE (I02, 90024) IVDELE
WRITE (I02, 90026) IVINSP
WRITE (I02, 90028) IVTOTN, IVTOTL
CBE** ********************** BBCSUM0 **********************************
CBB** ********************** BBCFOOT0 **********************************
C**** WRITE OUT REPORT FOOTINGS
C****
WRITE (I02,90016) ZPROG, ZPROG
WRITE (I02,90018) ZPROJ, ZNAME, ZTAPE, ZTAPED
WRITE (I02,90019)
CBE** ********************** BBCFOOT0 **********************************
CBB** ********************** BBCFMT0A **********************************
C**** FORMATS FOR TEST DETAIL LINES
C****
80000 FORMAT (1H ,2X,I3,4X,7HDELETED,32X,A31)
80002 FORMAT (1H ,2X,I3,4X,7H PASS ,32X,A31)
80004 FORMAT (1H ,2X,I3,4X,7HINSPECT,32X,A31)
80008 FORMAT (1H ,2X,I3,4X,7H FAIL ,32X,A31)
80010 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,15X,10HCOMPUTED= ,
1I6,/,1H ,15X,10HCORRECT= ,I6)
80012 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
1E12.5,/,1H ,16X,10HCORRECT= ,E12.5)
80018 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
1A21,/,1H ,16X,10HCORRECT= ,A21)
80020 FORMAT (1H ,16X,10HCOMPUTED= ,A21,1X,A31)
80022 FORMAT (1H ,16X,10HCORRECT= ,A21,1X,A31)
80024 FORMAT (1H ,16X,10HCOMPUTED= ,I6,16X,A31)
80026 FORMAT (1H ,16X,10HCORRECT= ,I6,16X,A31)
80028 FORMAT (1H ,16X,10HCOMPUTED= ,E12.5,10X,A31)
80030 FORMAT (1H ,16X,10HCORRECT= ,E12.5,10X,A31)
80050 FORMAT (1H ,48X,A31)
CBE** ********************** BBCFMT0A **********************************
CBB** ********************** BBCFMT0B **********************************
C**** FORMAT STATEMENTS FOR PAGE HEADERS
C****
90002 FORMAT (1H1)
90004 FORMAT (1H )
90006 FORMAT (1H ,20X,31HFEDERAL SOFTWARE TESTING CENTER)
90007 FORMAT (1H ,19X,34HFORTRAN COMPILER VALIDATION SYSTEM)
90008 FORMAT (1H ,21X,A13,A17)
90009 FORMAT (1H ,/,2H *,A5,6HBEGIN*,12X,15HTEST RESULTS - ,A5,/)
90010 FORMAT (1H ,8X,16HTEST DATE*TIME= ,A17,15H - COMPILER= ,A20)
90013 FORMAT (1H ,8H TEST ,10HPASS/FAIL ,6X,17HDISPLAYED RESULTS,
1 7X,7HREMARKS,24X)
90014 FORMAT (1H ,46H----------------------------------------------,
1 33H---------------------------------)
90015 FORMAT (1H ,48X,17HTHIS PROGRAM HAS ,I3,6H TESTS,/)
C****
C**** FORMAT STATEMENTS FOR REPORT FOOTINGS
C****
90016 FORMAT (1H ,/,2H *,A5,4HEND*,14X,14HEND OF TEST - ,A5,/)
90018 FORMAT (1H ,A13,13X,A20,7H * ,A10,1H/,
1 A13)
90019 FORMAT (1H ,26HFOR OFFICIAL USE ONLY ,35X,15HCOPYRIGHT 1982)
C****
C**** FORMAT STATEMENTS FOR RUN SUMMARY
C****
90020 FORMAT (1H ,21X,I5,13H TESTS PASSED)
90022 FORMAT (1H ,21X,I5,13H TESTS FAILED)
90024 FORMAT (1H ,21X,I5,14H TESTS DELETED)
90026 FORMAT (1H ,21X,I5,25H TESTS REQUIRE INSPECTION)
90028 FORMAT (1H ,21X,I5,4H OF ,I3,15H TESTS EXECUTED)
CBE** ********************** BBCFMT0B **********************************
C*****
C***** END OF TEST SEGMENT 391
STOP
END
*END-OF,FM406
FM407.f 481036367 170 2 100666 15881 `
*HEADER,FORTR,FM407
*FILES1,FORTR,FM407
C***********************************************************************
C***** FORTRAN 77
C***** FM407
C***** DIRAF1 - (410)
C***** THIS PROGRAM CALLS SUBROUTINE SN408
C***********************************************************************
C***** TESTING OF DIRECT ACCESS FILES SUBSET REF
C***** UNFORMATED RECORDS ONLY 12.10.1
C*****
C*****
CBB** ********************** BBCCOMNT **********************************
C****
C**** 1978 FORTRAN COMPILER VALIDATION SYSTEM
C**** VERSION 2.0
C****
C****
C**** SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO
C**** GENERAL SERVICES ADMINISTRATION
C**** FEDERAL SOFTWARE TESTING CENTER
C**** 5203 LEESBURG PIKE, SUITE 1100
C**** FALLS CHURCH, VA. 22041
C****
C**** (703) 756-6153
C****
CBE** ********************** BBCCOMNT **********************************
C*****
C***** S P E C I F I C A T I O N S SEGMENT 410
DIMENSION L1I(10), K1I(10), M1I(10), F1S(10), G1S(10)
CHARACTER*4 A4VK, B4VK, A41K(10), B41K(10)
LOGICAL AVB, BVB, C1B(10), D1B(10)
C***** BELOW CHARACTER STATEMENT ESTABLISHES THE FILE NAME VARIABLES.
CBB** ********************** BBCINITA **********************************
C**** SPECIFICATION STATEMENTS
C****
CHARACTER ZVERS*13, ZVERSD*17, ZDATE*17, ZPROG*5, ZCOMPL*20,
1 ZNAME*20, ZTAPE*10, ZPROJ*13, REMRKS*31, ZTAPED*13
CBE** ********************** BBCINITA **********************************
CBB** ********************** BBCINITB **********************************
C**** INITIALIZE SECTION
DATA ZVERS, ZVERSD, ZDATE
1 /'VERSION 2.0 ', '82/08/02*18.33.46', '*NO DATE*TIME'/
DATA ZCOMPL, ZNAME, ZTAPE
1 /'*NONE SPECIFIED*', '*NO COMPANY NAME*', '*NO TAPE*'/
DATA ZPROJ, ZTAPED, ZPROG
1 /'*NO PROJECT*', '*NO TAPE DATE', 'XXXXX'/
DATA REMRKS /' '/
C**** THE FOLLOWING 9 COMMENT LINES (CZ01, CZ02, ...) CAN BE REPLACED
C**** FOR IDENTIFYING THE TEST ENVIRONMENT
C****
CZ01 ZVERS = 'VERSION OF THE COMPILER VALIDATION SYSTEM'
CZ02 ZVERSD = 'CREATION DATE/TIME OF THE COMPILER VALIDATION SYSTEM'
CZ03 ZPROG = 'PROGRAM NAME'
CZ04 ZDATE = 'DATE OF TEST'
CZ05 ZCOMPL = 'COMPILER IDENTIFICATION'
CZ06 ZPROJ = 'PROJECT NUMBER/IDENTIFICATION'
CZ07 ZNAME = 'NAME OF USER'
CZ08 ZTAPE = 'TAPE OWNER/ID'
CZ09 ZTAPED = 'DATE TAPE COPIED'
C
IVPASS = 0
IVFAIL = 0
IVDELE = 0
IVINSP = 0
IVTOTL = 0
IVTOTN = 0
ICZERO = 0
C
C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER.
I01 = 05
C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER.
I02 = 06
C
CX010 REPLACED BY FEXEC X-010 CONTROL CARD (CARD-READER UNIT NUMBER).
C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5
CX011 REPLACED BY FEXEC X-011 CONTROL CARD. CX011 IS FOR SYSTEMS
C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX010.
C
CX020 REPLACED BY FEXEC X-020 CONTROL CARD (PRINTER UNIT NUMBER).
C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02= 6
CX021 REPLACED BY FEXEC X-021 CONTROL CARD. CX021 IS FOR SYSTEMS
C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX020.
C
CBE** ********************** BBCINITB **********************************
C*****
C***** THE FOLLOWING STATEMENT MUST BE CHANGED IF
C***** THE UNIT GIVEN IS NOT CAPABLE OF BEING OPENED AS A
C***** DIRECT, UNFORMATTED FILE.
C*****
C I10 CONTAINS THE UNIT NUMBER FOR A DIRECT, UNFORMATTED FILE.
I10 = 24
CX100 REPLACED BY FEXEC X-100 CONTROL CARD (DIR. FILE UNIT NUMBER).
C SPECIFYING I10 = NN OVERRIDES THE DEFAULT I10 = 24.
C*****
C***** THE FOLLOWING STATEMENT MUST BE CHANGED IF THE NAME
C***** GIVEN IS NOT A VALID FILE SPECIFIER FOR A DIRECT,
C***** UNFORMATTED FILE.
C*****
C*****
NUVI = I02
IVTOTL = 4
ZPROG = 'FM407'
CBB** ********************** BBCHED0A **********************************
C****
C**** WRITE REPORT TITLE
C****
WRITE (I02, 90002)
WRITE (I02, 90006)
WRITE (I02, 90007)
WRITE (I02, 90008) ZVERS, ZVERSD
WRITE (I02, 90009) ZPROG, ZPROG
WRITE (I02, 90010) ZDATE, ZCOMPL
CBE** ********************** BBCHED0A **********************************
C***** FILE NUMBER ASSIGNMENT
IUVI = I10
C*****
C***** HEADER FOR SEGMENT 410
WRITE(NUVI,41000)
41000 FORMAT(1H ,/ 46H DIRAF1 - (410) DIRECT ACCESS UNFORMATTED FILE//
1 22H SUBSET REF. - 12.10.1)
CBB** ********************** BBCHED0B **********************************
C**** WRITE DETAIL REPORT HEADERS
C****
WRITE (I02,90004)
WRITE (I02,90004)
WRITE (I02,90013)
WRITE (I02,90014)
WRITE (I02,90015) IVTOTL
CBE** ********************** BBCHED0B **********************************
C*****
WRITE (NUVI, 41099)
41099 FORMAT (1H ,48X,31HEACH TEST READS 10 RECORDS AND /
1 1H ,48X,31HEACH RECORD IS CHECKED, I.E., /
2 1H ,48X,31HTHERE ARE 10 SUBTESTS MADE FOR /
3 1H ,48X,31HEACH TEST )
C*****
CALL SN408(L1I,K1I,M1I,F1S,G1S,C1B,D1B,A41K,B41K)
C*****
OPEN(IUVI, ACCESS='DIRECT',RECL=132)
C***** WRITE 10 RECORDS IN SEQUENCE, REC = 1 TO 10
DO 41001 IVI = 1, 10
AVS = F1S (IVI)
A4VK = A41K (IVI)
AVB = C1B (IVI)
WRITE(IUVI, REC= IVI) IVI, AVS, A4VK, AVB
41001 CONTINUE
CT001* TEST 1 READ RECORDS 1 TO 10 IN SEQUENCE
IVTNUM = 1
IVCOMP = 0
DO 41002 IVI = 1, 10
READ(IUVI, REC = IVI) KVI, BVS, B4VK, BVB
IF (IVI .NE. KVI) GOTO 20010
IF (B4VK .NE. A41K(IVI)) GOTO 20010
IF ((BVB .AND. .NOT. C1B(IVI)) .OR.
1 (.NOT. BVB .AND. C1B(IVI))) GOTO 20010
IF (BVS .NE. F1S(IVI)) GO TO 20010
GO TO 41002
20010 IVCOMP = IVCOMP + 1
IF (IVCOMP .LE. 1) IVFAIL = IVFAIL + 1
WRITE (NUVI, 70010) IVTNUM, IVI
WRITE (NUVI, 70020) KVI, BVS, B4VK, BVB, IVI, F1S(IVI),
1 A41K(IVI), C1B(IVI)
70010 FORMAT (1H ,2X,I3,4X,13H FAIL ON REC ,I2)
70020 FORMAT (1H ,16X,10HCOMPUTED: ,I2,1X,F5.2,1X,A4,1X,L1/
1 1H ,16X,10HCORRECT: ,I2,1X,F5.2,1X,A4,1X,L1)
41002 CONTINUE
IF (IVCOMP - 0) 0011, 10010, 0011
10010 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
0011 CONTINUE
CT002* TEST 2 READ RECORDS NOT IN SEQUENCE OF RECORD NUMBER
IVTNUM = 2
IVCOMP = 0
DO 41013 IVI = 1, 10
JVI = L1I(IVI)
READ(IUVI, REC = JVI) KVI, BVS, B4VK, BVB
IF (KVI .NE. JVI) GOTO 20020
IF (B4VK .NE. A41K(JVI)) GOTO 20020
IF ((BVB .AND. .NOT. C1B(JVI)) .OR.
1 (.NOT. BVB .AND. C1B(JVI))) GOTO 20020
IF (BVS .NE. F1S(JVI)) GOTO 20020
GO TO 41013
20020 IVCOMP = IVCOMP + 1
IF (IVCOMP .LE. 1) IVFAIL = IVFAIL + 1
WRITE (NUVI, 70010) IVTNUM, JVI
WRITE (NUVI, 70020) KVI, BVS, B4VK, BVB, JVI, F1S(JVI),
1 A41K(JVI), C1B(JVI)
41013 CONTINUE
IF (IVCOMP - 0) 0021, 10020, 0021
10020 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
0021 CONTINUE
C***** WRITE RECORDS NOT IN SEQUENCE OF RECORD NUMBER
41014 DO 41015 IVI = 1, 10
JVI = K1I (IVI)
AVS = G1S (JVI)
A4VK = B41K (JVI)
AVB = D1B (JVI)
WRITE(IUVI, REC= JVI) AVB, A4VK, JVI, AVS
41015 CONTINUE
CT003* TEST 3 READ RECORDS IN SEQUENCE OF RECORD NUMBER
IVTNUM = 3
IVCOMP = 0
DO 41016 IVI = 1, 10
READ(IUVI, REC = IVI) BVB, B4VK, JVI, BVS
IF (JVI .NE. IVI) GOTO 20030
IF (B4VK .NE. B41K(IVI)) GOTO 20030
IF ((BVB .AND. .NOT. D1B(IVI)) .OR.
1 (.NOT. BVB .AND. D1B(IVI))) GOTO 20030
IF (BVS .NE. G1S(JVI)) GOTO 20030
GO TO 41016
20030 IVCOMP = IVCOMP + 1
IF (IVCOMP .LE. 1) IVFAIL = IVFAIL + 1
WRITE (NUVI, 70010) IVTNUM, IVI
WRITE (NUVI, 70020) JVI, BVS, B4VK, BVB, IVI, G1S(IVI),
1 B41K(IVI), D1B(IVI)
41016 CONTINUE
IF (IVCOMP -0) 0031, 10030, 0031
10030 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
0031 CONTINUE
CT004* TEST 4 READ RECORDS IN A DIFFERENT ORDER SEQUENCE
IVTNUM = 4
IVCOMP = 0
DO 41018 IVI = 1, 10
JVI = M1I(IVI)
READ(IUVI, REC = JVI) BVB, B4VK, KVI, BVS
IF (KVI .NE. JVI) GOTO 20040
IF (B4VK .NE. B41K(JVI)) GOTO 20040
IF ((BVB .AND. .NOT. D1B(JVI)) .OR.
1 (.NOT. BVB .AND. D1B(JVI))) GOTO 20040
IF (BVS .NE. G1S(JVI)) GOTO 20040
GO TO 41018
20040 IVCOMP = IVCOMP + 1
IF (IVCOMP .LE. 1) IVFAIL = IVFAIL + 1
WRITE (NUVI, 70010) IVTNUM, JVI
WRITE (NUVI, 70020) KVI, BVS, B4VK, BVB, JVI, G1S(JVI),
1 B41K(JVI), D1B(JVI)
41018 CONTINUE
IF (IVCOMP - 0) 0041, 10040, 0041
10040 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
0041 CONTINUE
C*****
C THE FOLLOWING SOURCE CODE BRACKETED BY THE COMMENT LINES
C ***** BEGIN-FILE-DUMP SECTION ***** AND ***** END-FILE-DUMP
C SECTION ***** IS USED TO DUMP THE DATA FILE USED BY THIS
C ROUTINE. THIS CODE IS OPTIONAL CODE AND IS ONLY USED IF THERE
C IS A NEED TO PRINT THE CONTENT OF THE RECORDS FOR THE FILE.
C THE CODE CAN BE SELECTED BY THE EXECUTIVE ROUTINE TO BE INCLUDED
C IN THE COMPILED PROGRAM FOR EXECUTION BY USING THE *OPT1
C EXECUTIVE ROUTINE CONTROL CARD. IF THE *OPT1 CONTROL CARD IS
C NOT SPECIFIED THE DEFAULT WILL BE TO AUTOMATICALLY CHANGE
C THIS CODE TO PROGRAM COMMENTS. IF THIS CODE IS SELECTED THE
C ROUTINE WILL DUMP THE CONTENTS OF THE FILE TO THE PRINTER FILE
C FOLLOWING THE TEST REPORT AND BEFORE THE TEST REPORT SUMMARY.
C
CDB** *** BEGIN-FILE-DUMP SECTION ***
C ITOTR = 10
C ILUN = I10
C IRLGN = 132
C IRNUM = 1
C7701 FORMAT (132A1)
C7702 FORMAT (1X,132A1)
C DO 7771 IRNUM = 1, ITOTR
C READ (ILUN, REC = IRNUM) (IDUMP(ICH), ICH = 1, IRLGN)
C WRITE (I02,7702) (IDUMP(ICH), ICH = 1, IRLGN)
C7771 CONTINUE
C7772 CONTINUE
CDE** *** END-FILE-DUMP SECTION ***
C****
CBB** ********************** BBCSUM0 **********************************
C**** WRITE OUT TEST SUMMARY
C****
IVTOTN = IVPASS + IVFAIL + IVDELE + IVINSP
WRITE (I02, 90004)
WRITE (I02, 90014)
WRITE (I02, 90004)
WRITE (I02, 90020) IVPASS
WRITE (I02, 90022) IVFAIL
WRITE (I02, 90024) IVDELE
WRITE (I02, 90026) IVINSP
WRITE (I02, 90028) IVTOTN, IVTOTL
CBE** ********************** BBCSUM0 **********************************
CBB** ********************** BBCFOOT0 **********************************
C**** WRITE OUT REPORT FOOTINGS
C****
WRITE (I02,90016) ZPROG, ZPROG
WRITE (I02,90018) ZPROJ, ZNAME, ZTAPE, ZTAPED
WRITE (I02,90019)
CBE** ********************** BBCFOOT0 **********************************
CBB** ********************** BBCFMT0A **********************************
C**** FORMATS FOR TEST DETAIL LINES
C****
80000 FORMAT (1H ,2X,I3,4X,7HDELETED,32X,A31)
80002 FORMAT (1H ,2X,I3,4X,7H PASS ,32X,A31)
80004 FORMAT (1H ,2X,I3,4X,7HINSPECT,32X,A31)
80008 FORMAT (1H ,2X,I3,4X,7H FAIL ,32X,A31)
80010 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,15X,10HCOMPUTED= ,
1I6,/,1H ,15X,10HCORRECT= ,I6)
80012 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
1E12.5,/,1H ,16X,10HCORRECT= ,E12.5)
80018 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
1A21,/,1H ,16X,10HCORRECT= ,A21)
80020 FORMAT (1H ,16X,10HCOMPUTED= ,A21,1X,A31)
80022 FORMAT (1H ,16X,10HCORRECT= ,A21,1X,A31)
80024 FORMAT (1H ,16X,10HCOMPUTED= ,I6,16X,A31)
80026 FORMAT (1H ,16X,10HCORRECT= ,I6,16X,A31)
80028 FORMAT (1H ,16X,10HCOMPUTED= ,E12.5,10X,A31)
80030 FORMAT (1H ,16X,10HCORRECT= ,E12.5,10X,A31)
80050 FORMAT (1H ,48X,A31)
CBE** ********************** BBCFMT0A **********************************
CBB** ********************** BBCFMT0B **********************************
C**** FORMAT STATEMENTS FOR PAGE HEADERS
C****
90002 FORMAT (1H1)
90004 FORMAT (1H )
90006 FORMAT (1H ,20X,31HFEDERAL SOFTWARE TESTING CENTER)
90007 FORMAT (1H ,19X,34HFORTRAN COMPILER VALIDATION SYSTEM)
90008 FORMAT (1H ,21X,A13,A17)
90009 FORMAT (1H ,/,2H *,A5,6HBEGIN*,12X,15HTEST RESULTS - ,A5,/)
90010 FORMAT (1H ,8X,16HTEST DATE*TIME= ,A17,15H - COMPILER= ,A20)
90013 FORMAT (1H ,8H TEST ,10HPASS/FAIL ,6X,17HDISPLAYED RESULTS,
1 7X,7HREMARKS,24X)
90014 FORMAT (1H ,46H----------------------------------------------,
1 33H---------------------------------)
90015 FORMAT (1H ,48X,17HTHIS PROGRAM HAS ,I3,6H TESTS,/)
C****
C**** FORMAT STATEMENTS FOR REPORT FOOTINGS
C****
90016 FORMAT (1H ,/,2H *,A5,4HEND*,14X,14HEND OF TEST - ,A5,/)
90018 FORMAT (1H ,A13,13X,A20,7H * ,A10,1H/,
1 A13)
90019 FORMAT (1H ,26HFOR OFFICIAL USE ONLY ,35X,15HCOPYRIGHT 1982)
C****
C**** FORMAT STATEMENTS FOR RUN SUMMARY
C****
90020 FORMAT (1H ,21X,I5,13H TESTS PASSED)
90022 FORMAT (1H ,21X,I5,13H TESTS FAILED)
90024 FORMAT (1H ,21X,I5,14H TESTS DELETED)
90026 FORMAT (1H ,21X,I5,25H TESTS REQUIRE INSPECTION)
90028 FORMAT (1H ,21X,I5,4H OF ,I3,15H TESTS EXECUTED)
CBE** ********************** BBCFMT0B **********************************
C*****
C***** END OF TEST SEGMENT 410
STOP
END
*HEADER,FORTR,FM407,SUBRTN,FM408
C**********************************************************************
C***** FORTRAN 77
C***** FM408
C***** SN408 DAQ - (805)
C***** THIS SUBROUTINE IS CALLED BY FM407
C**********************************************************************
SUBROUTINE SN408(LW1I, KW1I, MW1I, FW1S, GW1S, CW1B, DW1B,
1 A4W1K, B4W1K)
C*****
C***** SUBROUTINE USED WITH SEGMENT FM408 TO SUPPLY VALUES
C***** TO ARRAYS THRU THE DUMMY ARGUMENT LIST
C*****
DIMENSION LT1I(10),LW1I(10),KT1I(10),KW1I(10),MT1I(10),MW1I(10)
REAL FT1S(10),FW1S(10),GT1S(10),GW1S(10)
LOGICAL CT1B(10),CW1B(10),DT1B(10),DW1B(10)
CHARACTER*4 A4T1K(10),A4W1K(10),B4T1K(10),B4W1K(10)
C*****
DATA LT1I /2, 4, 1, 3, 10, 8, 9, 6, 7 ,5/
DATA KT1I /9, 10, 1, 3, 2, 5, 8, 4, 7, 6/
DATA MT1I /10, 1, 3, 4, 7, 6, 8, 5, 2, 9/
DATA FT1S /1.0, 2.0, 3.0, 4.0, 5.0, 6.5, 7.1, 8.2, 9.9, 10.0/
DATA GT1S /2.34, 2.3,1.9, 2.3, 9.9, 1.1, 8.8, 7.6, 2.3, 10.1/
DATA A4T1K / 'AAAA', 'BBBB', 'CCCC', 'DDDD', 'EDFG', 'JLKD'
1 , 'CDFE', 'LKJH', 'JHGF', 'LLLL'/
DATA B4T1K / 'HDFK', 'LKJH', 'ASDF', 'LKJH', 'XMNC', 'ALXM'
1 , 'IEOW', 'IERU', 'DJNC', 'DJAL'/
DATA CT1B /.TRUE., .FALSE., .TRUE., .TRUE., .TRUE., .FALSE.,
1 .FALSE., .TRUE., .TRUE., .FALSE./
DATA DT1B /.FALSE., .FALSE., .FALSE., .TRUE., .FALSE., .FALSE.,
1 .TRUE., .TRUE., .FALSE., .TRUE./
C*****
DO 1 IVI = 1, 10
LW1I(IVI) = LT1I(IVI)
KW1I(IVI) = KT1I(IVI)
MW1I(IVI) = MT1I(IVI)
FW1S(IVI) = FT1S(IVI)
GW1S(IVI) = GT1S(IVI)
CW1B(IVI) = CT1B(IVI)
DW1B(IVI) = DT1B(IVI)
A4W1K(IVI) = A4T1K(IVI)
B4W1K(IVI) = B4T1K(IVI)
1 CONTINUE
C*****
RETURN
END
*END-OF,FM407
FM411.f 481036373 170 2 100666 46813 `
*HEADER,FORTR,FM411
*FILES1,FORTR,FM411,X
PROGRAM FM411
C
C
C
C THIS ROUTINE TESTS FOR PROPER PROCESSING OF UNFORMATTED RECORDS
C WITH A FILE CONNECTED FOR SEQUENTIAL ACCESS. UNFORMATTED RECORDS
C MAY BE READ OR WRITTEN ONLY BY UNFORMATTED INPUT/OUTPUT STATE-
C MENTS. THIS ROUTINE TESTS SEVERAL SYNTACTICAL VARIATIONS OF THE
C UNFORMATTED READ AND WRITE STATEMENTS AS WELL AS THE FILE
C POSITIONING STATEMENTS BACKSPACE, ENDFILE AND REWIND. IN
C ADDITION UNFORMATTED RECORDS MAY HAVE BOTH CHARACTER AND
C NONCHARACTER DATA. THIS DATA IS TRANSFERRED WITHOUT EDITING
C BETWEEN THE CURRENT RECORD AND ENTITIES SPECIFIED BY THE INPUT/
C OUTPUT LIST ITEMS. THIS ROUTINE BOTH READS AND WRITES
C RECORDS CONTAINING DATA OF LOGICAL, REAL AND INTEGER TYPE WITH
C I/O LIST ITEMS REPRESENTED AS VARIABLE NAMES, ARRAY ELEMENT
C NAMES AND ARRAY NAMES. THIS ROUTINE DOES NOT TEST DATA OF TYPE
C CHARACTER.
C ROUTINE FM413 TESTS USE OF UNFORMATTED RECORDS WITH A FILE
C CONNECTED FOR DIRECT ACCESS.
C
C THIS ROUTINE TESTS
C
C (1) THE STATEMENT CONSTRUCTS
C
C A. WRITE (U) VARIABLE-NAME,...
C B. WRITE (U) ARRAY-ELEMENT-NAME,...
C C. WRITE (U) ARRAY-NAME,...
C D. WRITE (U) - NO OUTPUT LIST
C E. WRITE (U) IMPLIED-DO-LIST
C F. READ (U) VARIABLE-NAME,...
C G. READ (U) ARRAY-ELEMENT-NAME,...
C H. READ (U) ARRAY-NAME,...
C I. READ (U,END=S) - NO INPUT LIST
C J. READ (U,END=S) VARIABLE-NAME
C K. READ (U) IMPLIED-DO-LIST
C
C (2) USE OF A READ STATEMENT WHERE THE NUMBER OF VALUES
C IN THE INPUT LIST IS LESS THAN OR EQUAL TO THE
C NUMBER OF VALUES IN THE RECORD.
C
C (3) USE OF THE BACKSPACE, REWIND AND ENDFILE STATEMENT
C ON A FILE CONTAINING UNFORMATTED RECORDS.
C
C (4) USE OF A REWIND STATEMENT ON A FILE THAT IS CONNECTED
C BUT DOES NOT EXIST.
C
C (5) USE OF AN ENDFILE STATEMENT TO CREATE A FILE THAT
C DOES NOT EXIST
C
C REFERENCES -
C
C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN,
C X3.9-1977
C
C SECTION 4.1, DATA TYPES
C SECTION 12.1.2, UNFORMATTED RECORDS
C SECTION 12.2.1, FILE EXISTENCE
C SECTION 12.2.4, FILE ACCESS
C SECTION 12.2.4.1, SEQUENTIAL ACCESS
C SECTION 12.3.3, UNIT SPECIFIER AND IDENTIFIER
C SECTION 12.7.2, END-OF-FILE SPECIFIER
C SECTION 12.8, READ, WRITE AND PRINT STATEMENTS
C SECTION 12.8.1, CONTROL INFORMATION LIST
C SECTION 12.8.2, INPUT/OUTPUT LIST
C SECTION 12.8.2.1, INPUT LIST ITEMS
C SECTION 12.8.2.2, OUTPUT LIST ITEMS
C SECTION 12.8.2.3, IMPLIED-DO LIST
C SECTION 12.9.5.1, UNFORMATTED DATA TRANSFER
C SECTION 12.10.4, FILE POSITIONING STATEMENTS
C SECTION 12.10.4.1 BACKSPACE STATEMENT
C SECTION 12.10.4.2, ENDFILE STATEMENT
C SECTION 12.10.4.3, REWIND STATEMENT
C
C
C
C ******************************************************************
C A COMPILER VALIDATION SYSTEM FOR THE FORTRAN LANGUAGE
C BASED ON SPECIFICATIONS AS DEFINED IN AMERICAN STANDARD FORTRAN
C X3.9-1978, HAS BEEN DEVELOPED BY THE DEPARTMENT OF THE NAVY. THE
C FORTRAN COMPILER VALIDATION SYSTEM (FCVS) CONSISTS OF AUDIT
C ROUTINES, THEIR RELATED DATA, AND AN EXECUTIVE SYSTEM. EACH AUDIT
C ROUTINE IS A FORTRAN PROGRAM OR SUBPROGRAM WHICH INCLUDES TESTS
C OF SPECIFIC LANGUAGE ELEMENTS AND SUPPORTING PROCEDURES INDICATING
C THE RESULT OF EXECUTING THESE TESTS.
C
C THIS PARTICULAR PROGRAM OR SUBPROGRAM CONTAINS ONLY FEATURES
C FOUND IN THE SUBSET LEVEL OF THE STANDARD.
C
C SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO
C DEPARTMENT OF THE NAVY
C FEDERAL COBOL COMPILER TESTING SERVICE
C WASHINGTON, D.C. 20376
C
C ******************************************************************
C
C
IMPLICIT LOGICAL (L)
IMPLICIT CHARACTER*14 (C)
C
LOGICAL LAON11, LAON21, LAON31, LCONT1, LCONF2, LVONT1, LVONF2
LOGICAL LAON12, LAON22, LAON32, LCONT3, LCONF4, LVONT3, LVONF4
LOGICAL LCONT5, LCONF6, LCONT7, LCONF8, LVONT5, LVONF6, LVONT7
LOGICAL LVONF8
DIMENSION IDUMP(80)
DIMENSION IAON11(8), IAON21(2,4), IAON31(2,2,2)
DIMENSION IAON12(8), IAON22(2,4), IAON32(2,2,2)
DIMENSION RAON11(8), RAON21(2,4), RAON31(2,2,2)
DIMENSION RAON12(8), RAON22(2,4), RAON32(2,2,2)
DIMENSION LAON11(8), LAON21(2,4), LAON31(2,2,2)
DIMENSION LAON12(8), LAON22(2,4), LAON32(2,2,2)
DATA IAON11 /11, -11, 777, -777, 512, -512, -32767, 32767/
DATA IAON21 /11, -11, 777, -777, 512, -512, -32767, 32767/
DATA IAON31 /11, -11, 777, -777, 512, -512, -32767, 32767/
DATA LAON11 /.TRUE., .FALSE., .TRUE., .FALSE., .TRUE., .FALSE.,
1 .TRUE., .FALSE./
DATA LAON21 /.TRUE., .FALSE., .TRUE., .FALSE., .TRUE., .FALSE.,
1 .TRUE., .FALSE./
DATA LAON31 /.TRUE., .FALSE., .TRUE., .FALSE., .TRUE., .FALSE.,
1 .TRUE., .FALSE./
DATA RAON11 /11., -11., 7.77, -7.77,.512, -.512, -32767., 32767./
DATA RAON21 /11., -11., 7.77, -7.77,.512, -.512, -32767., 32767./
DATA RAON31 /11., -11., 7.77, -7.77,.512, -.512, -32767., 32767./
ICON21 = 11
ICON22 = -11
ICON31 = +777
ICON32 = -777
ICON33 = 512
ICON34 = -512
ICON55 = -32767
ICON56 = 32767
RCON21 = 11.
RCON22 = -11.
RCON31 = +7.77
RCON32 = -7.77
RCON33 = .512
RCON34 = -.512
RCON55 = -32767.
RCON56 = 32767.
LCONT1 = .TRUE.
LCONF2 = .FALSE.
LCONT3 = .TRUE.
LCONF4 = .FALSE.
LCONT5 = .TRUE.
LCONF6 = .FALSE.
LCONT7 = .TRUE.
LCONF8 = .FALSE.
C
C THE FILE USED IN THIS ROUTINE HAS THE FOLLOWING PROPERTIES
C
C FILE IDENTIFIER - I04 (X-NUMBER 04)
C RECORD SIZE - 80
C ACCESS METHOD - SEQUENTIAL
C RECORD TYPE - UNFORMATTED
C DESIGNATED DEVICE - DISK
C TYPE OF DATA - INTEGER, REAL AND LOGICAL
C RECORDS IN FILE - 142 PLUS ENDFILE RECORD
C
C THE FIRST 6 FIELDS OF EACH RECORD IN THE FILE UNIQUELY IDENT-
C IFIES THAT RECORD. THE REMAINING FIELDS OF THE RECORD CONTAIN
C DATA WHICH ARE USED IN TESTING. A DESCRIPTION OF EACH FIELD
C OF THE PREAMBLE FOLLOWS.
C
C VARIABLE NAME IN PROGRAM FIELD NUMBER
C ------------------------ ------------
C
C IPROG (ROUTINE NAME) - 1
C IFILE (LOGICAL/X-NUMBER) - 2
C ITOTR (RECORDS IN FILE) - 3
C IRLGN (LENGTH OF RECORD) - 4
C IRECN (RECORD NUMBER) - 5
C IEOF (9999 IF LAST RECORD) - 6
C
C
C
C
C INITIALIZATION SECTION.
C
C INITIALIZE CONSTANTS
C ********************
C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER
I01 = 5
C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER
I02 = 6
C SYSTEM ENVIRONMENT SECTION
C
CX010 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-010 CONTROL CARD.
C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5
C (UNIT NUMBER FOR CARD READER).
CX011 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-011 CONTROL CARD
C THE CX011 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL
C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX010 ABOVE.
C
CX020 THIS CARD IS PEPLACED BY CONTENTS OF FEXEC X-020 CONTROL CARD.
C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02 = 6
C (UNIT NUMBER FOR PRINTER).
CX021 THIS CARD IS PEPLACED BY CONTENTS OF FEXEC X-021 CONTROL CARD.
C THE CX021 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL
C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX020 ABOVE.
C
IVPASS = 0
IVFAIL = 0
IVDELE = 0
ICZERO = 0
C
C WRITE OUT PAGE HEADERS
C
WRITE (I02,90002)
WRITE (I02,90006)
WRITE (I02,90008)
WRITE (I02,90004)
WRITE (I02,90010)
WRITE (I02,90004)
WRITE (I02,90016)
WRITE (I02,90001)
WRITE (I02,90004)
WRITE (I02,90012)
WRITE (I02,90014)
WRITE (I02,90004)
C
I04 = 8
C I04 CONTAINS THE LOGICAL UNIT NUMBER FOR A SEQUENTIAL ACCESS FILE
CX040 THIS CARD IS REPLACED BY CONTENTS OF X-040 CARD
CX041 THIS CARD IS REPLACED BY CONTENTS OF X-041 CARD
IPROG = 411
IFILE = I04
ITOTR = 142
IRLGN = 80
IRECN = 0
IEOF = 0
C
C **** FCVS PROGRAM 411 - TEST 001 ****
C
C
C TEST 001 USES THE REWIND STATEMENT ON A FILE THAT IS CONNECTED
C BUT DOES NOT EXIST. THERE SHOULD BE NO EFFECT ON THE FILE WHEN
C THIS STATEMENT IS EXECUTED. CONNECTION OF THE FILE TO A UNIT
C IS ASSUMED TO BE DONE BY PRECONNECTION.
C
C SEE SECTION 12.10.4.3, REWIND STATEMENT
C
C
IVTNUM = 1
IF (ICZERO) 30010, 0010, 30010
0010 CONTINUE
IVCORR = 1
IVCOMP = 0
REWIND I04
IVCOMP = 1
40010 IF (IVCOMP - 1) 20010, 10010, 20010
30010 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10010, 0021, 20010
10010 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0021
20010 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0021 CONTINUE
C
C **** FCVS PROGRAM 411 - TEST 002 ****
C
C
C TEST 002 USES THE ENDFILE STATEMENT TO CREATE A FILE THAT IS
C CONNECTED BUT DOES NOT EXIST. NO RECORDS HAVE BEEN WRITTEN TO
C THE FILE BEFORE THE ENDFILE STATEMENT IS EXECUTED. AS IN THE
C PRECEDING TEST, IT IS ASSUMED THAT CONNECTION OF THE FILE TO A
C UNIT IS DONE BY PRECONNECTION.
C
C SEE SECTIONS 12.2.1, FILE EXISTENCE
C 12.10.4.2, ENDFILE STATEMENT
C
C
IVTNUM = 2
IF (ICZERO) 30020, 0020, 30020
0020 CONTINUE
IVCORR = 1
IVCOMP = 0
ENDFILE I04
REWIND I04
READ (I04, END = 0023) IVON01
C
C TO TEST CREATION OF A FILE VIA A ENDFILE STATEMENT THE FILE
C IS REWOUND AND READ. AN END-OF-FILE CONDITION IS EXPECTED TO
C OCCUR ON THE FIRST READ SINCE THE ONLY RECORD WRITTEN TO THE
C FILE WAS THE ENDFILE RECORD.
C
IVCOMP = 0
GO TO 40020
0023 IVCOMP = 1
40020 IF (IVCOMP - 1) 20020, 10020, 20020
30020 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10020, 0031, 20020
10020 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0031
20020 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0031 CONTINUE
C
C
C TESTS 003 THROUGH 019 USE A PRECONNECTED FILE FOR SEQUENTIAL
C ACCESS TO WRITE 141 RECORDS TO THE FILE. THESE TESTS TEST USE OF
C THE ALLOWABLE FORMS OF THE WRITE STATEMENT ON A FILE CONNECTED
C FOR SEQUENTIAL ACCESS. THE WRITE STATEMENT IS USED WITH
C THE I/O LIST ITEM AS A VARIABLE, ARRAY ELEMENT AND AN ARRAY.
C THE PURPOSE OF TESTS 003 THROUGH 019 IS TO CHECK THE COMPILER'S
C ABILITY TO HANDLE THE VARIOUS STATEMENT CONSTRUCTS OF THE
C WRITE STATEMENT. LATER TESTS WITHIN THIS ROUINE READ AND
C CHECK THE RECORDS WHICH ARE CREATED.
C THE VALUE IN IVCORR FOR TESTS 002 THROUGH 013 IS THE RECORD
C NUMBER FOR THE RECORD.
C
C
C
C **** FCVS PROGRAM 411 - TEST 003 ****
C
C
IVTNUM = 3
IF (ICZERO) 30030, 0030, 30030
0030 CONTINUE
REWIND I04
C REPOSITION TO BEGINNING OF FILE
C
C TEST 003 USES A WRITE STATEMENT WHERE THE OUTPUT LIST ITEM
C IS A VARIABLE OF INTEGER TYPE.
C
IRECN = 01
IVCORR = 01
WRITE (I04) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF,
1 ICON21, ICON22, ICON31, ICON32, ICON33, ICON34, ICON55, ICON56
IVCOMP = IRECN
40030 IF (IVCOMP - 01) 20030, 10030, 20030
30030 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10030, 0041, 20030
10030 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0041
20030 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0041 CONTINUE
C
C **** FCVS PROGRAM 411 - TEST 004 ****
C
C
C TEST 004 USES A WRITE STATEMENT WHERE THE OUTPUT LIST ITEM
C IS A VARIABLE OF REAL TYPE.
C
C
IVTNUM = 4
IF (ICZERO) 30040, 0040, 30040
0040 CONTINUE
IRECN = 02
IVCORR = 02
WRITE (I04) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF,
1 RCON21, RCON22, RCON31, RCON32, RCON33, RCON34, RCON55, RCON56
IVCOMP = IRECN
40040 IF (IVCOMP - 02) 20040, 10040, 20040
30040 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10040, 0051, 20040
10040 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0051
20040 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0051 CONTINUE
C
C **** FCVS PROGRAM 411 - TEST 005 ****
C
C
C TEST 005 USES A WRITE STATEMENT WHERE THE OUTPUT LIST ITEM
C IS A VARIABLE OF LOGICAL TYPE.
C
C
IVTNUM = 5
IF (ICZERO) 30050, 0050, 30050
0050 CONTINUE
IRECN = 03
IVCORR = 03
WRITE (I04) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF,
1 LCONT1, LCONF2, LCONT3, LCONF4, LCONT5, LCONF6, LCONT7, LCONF8
IVCOMP = IRECN
40050 IF (IVCOMP - 03) 20050, 10050, 20050
30050 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10050, 0061, 20050
10050 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0061
20050 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0061 CONTINUE
C
C **** FCVS PROGRAM 411 - TEST 006 ****
C
C
C TEST 006 USES A WRITE STATEMENT WHERE THE OUTPUT LIST ITEM
C IS AN ARRAY ELEMENT OF INTEGER TYPE. ONE, TWO AND THREE
C DIMENSION ARRAYS ARE USED.
C
C
IVTNUM = 6
IF (ICZERO) 30060, 0060, 30060
0060 CONTINUE
IRECN = 04
IVCORR = 04
WRITE (I04) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF,
1 IAON11(1), IAON11(2), IAON21(1,2), IAON21(2,2), IAON31(1,1,2),
2 IAON31(2,1,2), IAON11(7), IAON11(8)
IVCOMP = IRECN
40060 IF (IVCOMP - 04) 20060, 10060, 20060
30060 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10060, 0071, 20060
10060 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0071
20060 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0071 CONTINUE
C
C **** FCVS PROGRAM 411 - TEST 007 ****
C
C
C TEST 007 USES A WRITE STATEMENT WHERE THE OUTPUT LIST ITEM
C IS AN ARRAY ELEMENT OF REAL TYPE. ONE, TWO AND THREE
C DIMENSION ARRAYS ARE USED.
C
C
IVTNUM = 7
IF (ICZERO) 30070, 0070, 30070
0070 CONTINUE
IRECN = 05
IVCORR = 05
WRITE (I04) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF,
1 RAON11(1), RAON11(2), RAON21(1,2), RAON21(2,2), RAON31(1,1,2),
2RAON31(2,1,2), RAON11(7), RAON11 (8)
IVCOMP = IRECN
40070 IF (IVCOMP - 05) 20070, 10070, 20070
30070 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10070, 0081, 20070
10070 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0081
20070 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0081 CONTINUE
C
C **** FCVS PROGRAM 411 - TEST 008 ****
C
C
C
IVTNUM = 8
IF (ICZERO) 30080, 0080, 30080
0080 CONTINUE
IRECN = 06
IVCORR = 06
WRITE (I04) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF,
1 LAON11(1), LAON11(2), LAON21(1,2), LAON21(2,2), LAON31(1,1,2),
2 LAON31(2,1,2), LAON11(7), LAON11(8)
IVCOMP = IRECN
40080 IF (IVCOMP - 06) 20080, 10080, 20080
30080 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10080, 0091, 20080
10080 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0091
20080 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0091 CONTINUE
C
C **** FCVS PROGRAM 411 - TEST 009 ****
C
C
C TEST 009 USES A WRITE STATEMENT WHERE THE OUTPUT LIST ITEM
C IS AN ARRAY OF INTEGER TYPE.
C
C
IVTNUM = 9
IF (ICZERO) 30090, 0090, 30090
0090 CONTINUE
IRECN = 07
IVCORR = 07
WRITE (I04) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF,
1 IAON31
IVCOMP = IRECN
40090 IF (IVCOMP - 07) 20090, 10090, 20090
30090 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10090, 0101, 20090
10090 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0101
20090 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0101 CONTINUE
C
C **** FCVS PROGRAM 411 - TEST 010 ****
C
C
C TEST 010 USES A WRITE STATEMENT WHERE THE OUTPUT LIST ITEM
C IS AN ARRAY OF REAL TYPE.
C
C
IVTNUM = 10
IF (ICZERO) 30100, 0100, 30100
0100 CONTINUE
IRECN = 08
IVCORR = 08
WRITE (I04) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF,
1 RAON31
IVCOMP = IRECN
40100 IF (IVCOMP - 08) 20100, 10100, 20100
30100 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10100, 0111, 20100
10100 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0111
20100 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0111 CONTINUE
C
C **** FCVS PROGRAM 411 - TEST 011 ****
C
C
C TEST 011 USES A WRITE STATEMENT WHERE THE OUTPUT LIST ITEM
C IS AN ARRAY OF LOGICAL TYPE.
C
C
IVTNUM = 11
IF (ICZERO) 30110, 0110, 30110
0110 CONTINUE
IRECN = 09
IVCORR = 09
WRITE (I04) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF,
1 LAON31
IVCOMP = IRECN
40110 IF (IVCOMP - 09) 20110, 10110, 20110
30110 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10110, 0121, 20110
10110 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0121
20110 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0121 CONTINUE
C
C **** FCVS PROGRAM 411 - TEST 012 ****
C
C
C TEST 012 USES A WRITE STATEMENT WHERE THE OUTPUT LIST ITEM
C IS AN IMPLIED-DO WITH AN ITEM OF INTEGER TYPE.
C THE FIELD VALUES ARE WRITTEN IN MIXED ORDER VIS-A-VIS THE
C ELEMENT SEQUENCE OF ARRAY IAON31. THE SEQUENCE OF VALUES WRITTEN
C IN THE RECORD ARE 11, 512, 777, -32767, -11, -512, -777, 32767.
C
C
IVTNUM = 12
IF (ICZERO) 30120, 0120, 30120
0120 CONTINUE
IRECN = 10
IVCORR = 10
WRITE (I04) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF,
1 (((IAON31 (J,K,I), I=1,2), K=1,2), J=1,2)
IVCOMP = IRECN
40120 IF (IVCOMP - 10) 20120, 10120, 20120
30120 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10120, 0131, 20120
10120 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0131
20120 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0131 CONTINUE
C
C **** FCVS PROGRAM 411 - TEST 013 ****
C
C
C TEST 013 USES A WRITE STATEMENT WHERE THE OUTPUT LIST ITEM
C IS AN IMPLIED-DO WITH AN ITEM OF REAL TYPE. THE FIELD VALUES
C (IN FIELD POSITION ORDER) WRITTEN IN THE RECORD ARE 11., -11.,
C 7.77, -7.77, .512, -.512, -32767., 32767.
C
C
IVTNUM = 13
IF (ICZERO) 30130, 0130, 30130
0130 CONTINUE
IRECN = 11
IVCORR = 11
WRITE (I04) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF,
1 (((RAON31 (J,K,I), J=1,2), K=1,2), I=1,2)
IVCOMP = IRECN
40130 IF (IVCOMP - 11) 20130, 10130, 20130
30130 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10130, 0141, 20130
10130 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0141
20130 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0141 CONTINUE
C
C **** FCVS PROGRAM 411 - TEST 014 ****
C
C
C TEST 014 USES A WRITE STATEMENT WHERE THE OUTPUT LIST ITEM
C IS AN IMPLIED-DO WITH AN ITEM OF LOGICAL TYPE.
C THE FIELD VALUES ARE WRITTEN IN MIXED ORDER (AN ORDER
C DIFFERENT THAN TEST 012 ABOVE) VIS-A-VIS THE
C ELEMENT SEQUENCE OF ARRAY LAON31. THE SEQUENCE OF VALUES WRITTEN
C IN THE RECORD ARE .TRUE., .TRUE., .FALSE., .FALSE., .TRUE., .TRUE.
C .FALSE, .FALSE.
C
C
IVTNUM = 14
IF (ICZERO) 30140, 0140, 30140
0140 CONTINUE
IRECN = 12
IVCORR = 12
WRITE (I04) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF,
1 (((LAON31 (J,K,I), K=1,2), J=1,2), I=1,2)
IVCOMP = IRECN
40140 IF (IVCOMP - 12) 20140, 10140, 20140
30140 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10140, 0151, 20140
10140 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0151
20140 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0151 CONTINUE
C
C **** FCVS PROGRAM 411 - TEST 015 ****
C
C
C TEST 015 USES A WRITE STATEMENT WITHOUT ANY OUTPUT LIST ITEMS.
C THE OUTPUT LIST ITEMS ARE OPTIONAL.
C ALSO THE LENGTH OF AN UNFORMATTED RECORD MAY BE ZERO.
C
C SEE SECTIONS 12.1.2, UNFORMATTED RECORDS
C 12.8, READ, WRITE AND PRINT STATEMENTS
C
C
IVTNUM = 15
IF (ICZERO) 30150, 0150, 30150
0150 CONTINUE
IRECN = 13
IVCORR = 13
WRITE (I04)
IVCOMP = IRECN
40150 IF (IVCOMP - 13) 20150, 10150, 20150
30150 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10150, 0161, 20150
10150 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0161
20150 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0161 CONTINUE
C
C **** FCVS PROGRAM 411 - TEST 016 ****
C
C
C TEST 016 IS SIMILAR TO THE PREVIOUS TEST EXCEPT THE WRITE
C STATEMENT CONTAINS OUTPUT LIST ITEMS. ONE HUNDRED RECORDS ARE
C WRITTEN.
C
C
IVTNUM = 16
IF (ICZERO) 30160, 0160, 30160
0160 CONTINUE
IRECN = 13
DO 4132 I = 1,100
IRECN = IRECN + 1
WRITE (I04) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF,
1 ICON21, ICON22, ICON31, ICON32, ICON33, ICON34, ICON55, ICON56
4132 CONTINUE
IVCORR = 100
IVCOMP = IRECN - 13
40160 IF (IVCOMP - 100) 20160, 10160, 20160
30160 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10160, 0171, 20160
10160 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0171
20160 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0171 CONTINUE
C
C
C THE NEXT THREE TESTS TEST USE OF THE BACKSPACE AND ENDFILE
C STATEMENTS
C
C
C
C **** FCVS PROGRAM 411 - TEST 017 ****
C
C TEST 017 USES AN ENDFILE STATEMENT TO WRITE AN ENDFILE
C RECORD TO A FILE WITH UNFORMATTED RECORDS. AFTER EXECUTION
C OF THIS STATEMENT THE FILE SHOULD BE POSITION AFTER THE ENDFILE
C RECORD.
C
C
IVTNUM = 17
IF (ICZERO) 30170, 0170, 30170
0170 CONTINUE
IVCORR = 1
IVCOMP = 0
0172 ENDFILE I04
IVCOMP = 1
40170 IF (IVCOMP - 1) 20170, 10170, 20170
C
30170 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10170, 0181, 20170
10170 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0181
20170 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0181 CONTINUE
C
C **** FCVS PROGRAM 411 - TEST 018 ****
C
C
C TEST 018 USES THE BACKSPACE STATEMENT TO REPOSITION THE FILE
C BEFORE THE ENDFILE RECORD.
C
C SEE SECTIONS 12.10.4.1, BACKSPACE STATEMENT
C 12.10.4.2, ENDFILE STATEMENT
C
C
IVTNUM = 18
IF (ICZERO) 30180, 0180, 30180
0180 CONTINUE
IVCORR = 1
IVCOMP = 0
BACKSPACE I04
IVCOMP = 1
40180 IF (IVCOMP - 1) 20180, 10180, 20180
30180 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10180, 0191, 20180
10180 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0191
20180 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0191 CONTINUE
C
C **** FCVS PROGRAM 411 - TEST 019 ****
C
C
C TEST 019 IS A CONTINUATION OF THE ENDFILE AND BACKSPACE TESTS
C (TWO PREVIOUS TESTS). THIS TEST CONTINUES WRITTING RECORDS TO THE
C FILE OVER THE ENDFILE RECORD PREVIOUSLY WRITTEN IN TEST 017.
C TWENTY EIGHT RECORDS ARE WRITTEN TO THE FILE FOLLOWED BY AN
C ENDFILE.
C
C
IVTNUM = 19
IF (ICZERO) 30190, 0190, 30190
0190 CONTINUE
IVCOMP = 0
IRECN = 113
DO 4112 I = 1,28
IRECN = IRECN + 1
WRITE (I04) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF,
1 ICON21, ICON22, ICON31, ICON32, ICON33, ICON34, ICON55, ICON56
IVCOMP = IVCOMP + 1
4112 CONTINUE
IVCORR = 29
IEOF = 9999
IRECN = IRECN + 1
WRITE (I04) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF
IVCOMP = IVCOMP + 1
ENDFILE I04
C
C THERE SHOULD BE A TOTAL OF 142 RECORDS PLUS AN ENDFILE RECORD
C IN THE FILE AFTER EXECUTION OF THIS TEST.
C
40190 IF (IVCOMP - 29) 20190, 10190, 20190
30190 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10190, 0201, 20190
10190 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0201
20190 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0201 CONTINUE
C
C
C THE NEXT SERIES OF TESTS READ AND CHECK THE RECORDS CREATED IN
C TESTS 03 THROUGH 019. EACH OF THE TESTS IN THIS SET IS CHECKING
C TWO THINGS. FIRST, THAT THE READ STATEMENT CONSTRUCT IS ACCEPTED
C BY THE COMPILER AND SECOND THAT THE RECORDS CREATED IN TESTS 003
C THROUGH 019 AND READ IN THESE TESTS CAN GIVE PREDICTIBLE VALUES.
C THE READ STATEMENT IS USED WITH THE I/O LIST ITEMS AS A VARIABLE,
C AN ARRAY ELEMENT AND AN ARRAY.
C
C
C
C **** FCVS PROGRAM 411 - TEST 020 ****
C
C
C TEST 020 USES A READ STATEMENT WHERE THE INPUT LIST ITEM IS A
C VARIABLE OF INTEGER TYPE.
C
C
IVTNUM = 20
IF (ICZERO) 30200, 0200, 30200
0200 CONTINUE
REWIND I04
C REPOSITION THE FILE TO THE FIRST RECORD
IVON22 = 0
IVON56 = 0
IVCORR = 30
IVCOMP = 1
READ (I04) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF,
1 IVON21, IVON22, IVON31, IVON32, IVON33, IVON34, IVON55, IVON56
IF (IRECN .EQ. 01) IVCOMP = IVCOMP * 2
IF (IVON22 .EQ. -11) IVCOMP = IVCOMP * 3
IF (IVON56 .EQ. 32767) IVCOMP = IVCOMP * 5
40200 IF (IVCOMP - 30) 20200, 10200, 20200
30200 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10200, 0211, 20200
10200 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0211
20200 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0211 CONTINUE
C
C **** FCVS PROGRAM 411 - TEST 021 ****
C
C
C TEST 021 USES A READ STATEMENT WHERE THE INPUT LIST ITEM IS A
C VARIABLE OF REAL TYPE.
C
C
IVTNUM = 21
IF (ICZERO) 30210, 0210, 30210
0210 CONTINUE
RVON22 = 0.0
RVON31 = 0.0
IVCORR = 30
IVCOMP = 1
READ (I04) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF,
1 RVON21, RVON22, RVON31, RVON32, RVON33, RVON34, RVON55, RVON56
IF (IRECN .EQ. 02) IVCOMP = IVCOMP * 2
IF (RVON22 .EQ. -11.) IVCOMP = IVCOMP * 3
IF (RVON31 .EQ. 7.77) IVCOMP = IVCOMP * 5
40210 IF (IVCOMP - 30) 20210, 10210, 20210
30210 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10210, 0221, 20210
10210 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0221
20210 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0221 CONTINUE
C
C **** FCVS PROGRAM 411 - TEST 022 ****
C
C
C TEST 022 USES A READ STATEMENT WHERE THE INPUT LIST ITEM IS A
C VARIABLE OF LOGICAL TYPE.
C
C
IVTNUM = 22
IF (ICZERO) 30220, 0220, 30220
0220 CONTINUE
LVONT1 = .FALSE.
LVONF6 = .TRUE.
IVCORR = 30
IVCOMP = 1
READ (I04) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF,
1 LVONT1, LVONF2, LVONT3, LVONF4, LVONT5, LVONF6, LVONT7, LVONF8
IF (IRECN .EQ. 03) IVCOMP = IVCOMP * 2
IF (.NOT. LVONF6) IVCOMP = IVCOMP * 3
IF (LVONT1) IVCOMP = IVCOMP * 5
40220 IF (IVCOMP - 30) 20220, 10220, 20220
30220 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10220, 0231, 20220
10220 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0231
20220 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0231 CONTINUE
C
C **** FCVS PROGRAM 411 - TEST 023 ****
C
C
C TEST 023 USES A READ STATEMENT WHERE THE INPUT LIST ITEM IS A
C ARRAY ELEMENT OF INTEGER TYPE. ONE, TWO, AND THREE
C DIMENSION ARRAYS ARE USED.
C
C
IVTNUM = 23
IF (ICZERO) 30230, 0230, 30230
0230 CONTINUE
IAON12(2) = 0
IAON12(8) = 0
IVCORR = 30
IVCOMP = 1
READ (I04) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF,
1 IAON12(1), IAON12(2), IAON22(1,2), IAON22(2,2), IAON32(1,1,2),
2 IAON32(2,1,2), IAON12(7), IAON12(8)
IF (IRECN .EQ. 04) IVCOMP = IVCOMP * 2
IF (IAON12(2) .EQ. -11) IVCOMP = IVCOMP * 3
IF (IAON12(8) .EQ. 32767) IVCOMP = IVCOMP * 5
C
C THE ABOVE 3 IF STATEMENTS CHECK THE RECORD NUMBER, A NEGATIVE
C FIELD VALUE AND A POSITIVE FIELD VALUE.
C
40230 IF (IVCOMP - 30) 20230, 10230, 20230
30230 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10230, 0241, 20230
10230 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0241
20230 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0241 CONTINUE
C
C **** FCVS PROGRAM 411 - TEST 024 ****
C
C
C TEST 024 USES A READ STATEMENT WHERE THE INPUT LIST ITEM IS A
C ARRAY ELEMENT OF REAL TYPE. ONE, TWO, AND THREE
C DIMENSION ARRAYS ARE USED.
C
C
IVTNUM = 24
IF (ICZERO) 30240, 0240, 30240
0240 CONTINUE
RAON22(2,2) = 0.0
RAON32(1,1,2) = 0.0
IVCORR = 30
IVCOMP = 1
READ (I04) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF,
1 RAON12(1), RAON12(2), RAON22(1,2), RAON22(2,2), RAON32(1,1,2),
2 RAON32(2,1,2), RAON12(7), RAON12(8)
IF (IRECN .EQ. 05) IVCOMP = IVCOMP * 2
IF (RAON22(2,2) .EQ. -7.77) IVCOMP = IVCOMP * 3
IF (RAON32(1,1,2) .EQ. .512 ) IVCOMP = IVCOMP * 5
C
C THE ABOVE 3 IF STATEMENTS CHECK THE RECORD NUMBER, A NEGATIVE
C FIELD VALUE AND A POSITIVE FIELD VALUE.
C
40240 IF (IVCOMP - 30) 20240, 10240, 20240
30240 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10240, 0251, 20240
10240 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0251
20240 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0251 CONTINUE
C
C **** FCVS PROGRAM 411 - TEST 025 ****
C
C
C TEST 025 USES A READ STATEMENT WHERE THE INPUT LIST ITEM IS A
C ARRAY ELEMENT OF LOGICAL TYPE. ONE, TWO, AND THREE
C DIMENSION ARRAYS ARE USED.
C
C
C
IVTNUM = 25
IF (ICZERO) 30250, 0250, 30250
0250 CONTINUE
LAON12(1) = .FALSE.
LAON32(2,1,2) = .TRUE.
IVCORR = 30
IVCOMP = 1
READ (I04) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF,
1 LAON12(1), LAON12(2), LAON22(1,2), LAON22(2,2), LAON32(1,1,2),
2 LAON32(2,1,2), LAON12(7), LAON12(8)
IF (IRECN .EQ. 06) IVCOMP = IVCOMP * 2
IF (LAON12(1)) IVCOMP = IVCOMP * 3
IF (.NOT. LAON32(2,1,2)) IVCOMP = IVCOMP * 5
40250 IF (IVCOMP - 30) 20250, 10250, 20250
30250 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10250, 0261, 20250
10250 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0261
20250 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0261 CONTINUE
C
C **** FCVS PROGRAM 411 - TEST 026 ****
C
C
C TEST 026 USES A READ STATEMENT WHERE THE INPUT LIST ITEM IS A
C ARRAY OF INTEGER TYPE.
C
C
IVTNUM = 26
IF (ICZERO) 30260, 0260, 30260
0260 CONTINUE
IAON32(2,1,1) = 0
IAON32(2,2,2) = 0
IVCORR = 30
IVCOMP = 1
READ (I04) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF,
1 IAON32
IF (IRECN .EQ. 07) IVCOMP = IVCOMP * 2
IF (IAON32(2,1,1) .EQ. -11) IVCOMP = IVCOMP * 3
IF (IAON32(2,2,2) .EQ. 32767) IVCOMP = IVCOMP * 5
C
C THE ABOVE 3 IF STATEMENTS CHECK THE RECORD NUMBER, A NEGATIVE
C FIELD VALUE AND A POSITIVE FIELD VALUE.
C
40260 IF (IVCOMP - 30) 20260, 10260, 20260
30260 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10260, 0271, 20260
10260 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0271
20260 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0271 CONTINUE
C
C **** FCVS PROGRAM 411 - TEST 027 ****
C
C
C TEST 027 USES A READ STATEMENT WHERE THE INPUT LIST ITEM IS A
C ARRAY OF REAL TYPE.
C
C
IVTNUM = 27
IF (ICZERO) 30270, 0270, 30270
0270 CONTINUE
RAON32(2,1,1) = 0.0
RAON32(2,2,2) = 0.0
IVCORR = 30
IVCOMP = 1
READ (I04) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF,
1 RAON32
IF (IRECN .EQ. 08) IVCOMP = IVCOMP * 2
IF (RAON32(2,1,1) .EQ. -11.) IVCOMP = IVCOMP * 3
IF (RAON32(2,2,2) .EQ. 32767.) IVCOMP = IVCOMP * 5
C
C THE ABOVE 3 IF STATEMENTS CHECK THE RECORD NUMBER, A NEGATIVE
C FIELD VALUE AND A POSITIVE FIELD VALUE.
C
40270 IF (IVCOMP - 30) 20270, 10270, 20270
30270 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10270, 0281, 20270
10270 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0281
20270 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0281 CONTINUE
C
C **** FCVS PROGRAM 411 - TEST 028 ****
C
C
C TEST 028 USES A READ STATEMENT WHERE THE INPUT LIST ITEM IS A
C ARRAY OF LOGICAL TYPE.
C
C
IVTNUM = 28
IF (ICZERO) 30280, 0280, 30280
0280 CONTINUE
LAON32(1,1,1) = .FALSE.
LAON32(2,2,2) = .TRUE.
IVCORR = 30
IVCOMP = 1
READ (I04) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF,
1 LAON32
IF (IRECN .EQ. 09) IVCOMP = IVCOMP * 2
IF (LAON32(1,1,1)) IVCOMP = IVCOMP * 3
IF (.NOT. LAON32(2,2,2)) IVCOMP = IVCOMP * 5
40280 IF (IVCOMP - 30) 20280, 10280, 20280
30280 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10280, 0291, 20280
10280 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0291
20280 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0291 CONTINUE
C
C **** FCVS PROGRAM 411 - TEST 029 ****
C
C
C TEST 029 USES A READ STATEMENT WHERE THE INPUT LIST ITEM IS A
C IMPLIED-DO WITH AN ITEM OF INTEGER TYPE. THE STORAGE VALUES IN
C THE ARRAY (BY THE IMPLIED-DO DURING THE READ) SHOULD RESULT IN A
C DIFFERENT STORAGE SEQUENCE IN THE ARRAY THAN FOUND IN THE RECORD
C OF THE FILE. THIS RECORD IS RECORD NUMBER 10 AND WAS CREATED IN
C TEST 012 ABOVE. THE FIELD VALUE, FIELD POSITION, POSITION WITHIN
C ARRAY IAON32 AND SUBSCRIPT VALUE AFTER THE READ IS
C
C VALUE 11 777 512 -32767 -11 -777 -512 32767
C FIELD POS 1 3 2 4 5 7 6 8
C IAON32 1 2 3 4 5 6 7 8
C SUBSCRIPT 1,1,1 2,1,1 1,2,1 2,2,1 1,1,2 2,1,2 1,2,2 2,2,2
C
C
IVTNUM = 29
IF (ICZERO) 30290, 0290, 30290
0290 CONTINUE
IAON32(2,1,1) = 0
IAON32(2,2,1) = 0
IVCORR = 30
IVCOMP = 1
READ (I04) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF,
1 (((IAON32 (J,K,I), K=1,2), J=1,2), I=1,2)
IF (IRECN .EQ. 10) IVCOMP = IVCOMP * 2
IF (IAON32(2,1,1) .EQ. 777) IVCOMP = IVCOMP * 3
IF (IAON32(2,2,1) .EQ. -32767) IVCOMP = IVCOMP * 5
C
C THE ABOVE 3 IF STATEMENTS CHECK THE RECORD NUMBER, A NEGATIVE
C FIELD VALUE AND A POSITIVE FIELD VALUE.
C
40290 IF (IVCOMP - 30) 20290, 10290, 20290
30290 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10290, 0301, 20290
10290 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0301
20290 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0301 CONTINUE
C
C **** FCVS PROGRAM 411 - TEST 030 ****
C
C
C TEST 030 USES A READ STATEMENT WHERE THE INPUT LIST ITEM IS A
C IMPLIED-DO WITH AN ITEM OF REAL TYPE. THE STORAGE VALUES IN
C THE ARRAY (BY THE IMPLIED-DO DURING THE READ) SHOULD RESULT IN A
C SEQUENCE THE SAME AS FOUND IN THE RECORD OF THE FILE. THIS REC-
C ORD IS RECORD NUMBER 011 AND WAS CREATED IN TEST 013 ABOVE.
C THE FIELD VALUE, FIELD POSITION, POSITION WITHIN ARRAY RAON32 AND
C SUBSCRIPT VALUE AFTER THE THE READ IS
C
C VALUE 11. -11. 7.77 -7.77 .512 -.512 -32767. 32767.
C FIELD POS 1 2 3 4 5 6 7 8
C RAON32 1 2 3 4 5 6 7 8
C SUBSCRIPT 1,1,1 2,1,1 1,2,1 2,2,1 1,1,2 2,1,2 1,2,2 2,2,2
C
C
IVTNUM = 30
IF (ICZERO) 30300, 0300, 30300
0300 CONTINUE
RAON32(1,2,1) = 0.0
RAON32(1,2,2) = 0.0
IVCORR = 30
IVCOMP = 1
READ (I04) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF,
1 (((RAON32 (J,K,I), J=1,2), K=1,2), I=1,2)
IF (IRECN .EQ. 11) IVCOMP = IVCOMP * 2
IF (RAON32(1,2,1) .EQ. 7.77) IVCOMP = IVCOMP * 3
IF (RAON32(1,2,2) .EQ. -32767.) IVCOMP = IVCOMP * 5
C
C THE ABOVE 3 IF STATEMENTS CHECK THE RECORD NUMBER, A NEGATIVE
C FIELD VALUE AND A POSITIVE FIELD VALUE.
C
40300 IF (IVCOMP - 30) 20300, 10300, 20300
30300 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10300, 0311, 20300
10300 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0311
20300 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0311 CONTINUE
C
C **** FCVS PROGRAM 411 - TEST 031 ****
C
C
C TEST 031 USES A READ STATEMENT WHERE THE INPUT LIST ITEM IS A
C IMPLIED-DO WITH AN ITEM OF LOGICAL TYPE. THE STORAGE VALUES IN
C THE ARRAY (BY THE IMPLIED-DO DURING THE READ) SHOULD RESULT IN A
C DIFFERENT STORAGE SEQUENCE IN THE ARRAY THAN FOUND IN THE RECORD
C OF THE FILE. THIS RECORD IS RECORD NUMBER 12 AND WAS CREATED IN
C TEST 014 ABOVE. THE FIELD VALUE, FIELD POSITION, POSITION WITHIN
C ARRAY LAON32 AND SUBSCRIPT VALUE AFTER THE READ IS
C
C VALUE T T F F T T F F
C FIELD POS 1 5 3 7 2 6 4 8
C LAON32 1 2 3 4 5 6 7 8
C SUBSCRIPT 1,1,1 2,1,1 1,2,1 2,2,1 1,1,2 2,1,2 1,2,2 2,2,2
C
C
IVTNUM = 31
IF (ICZERO) 30310, 0310, 30310
0310 CONTINUE
LAON32(1,2,1) = .TRUE.
LAON32(2,1,1) = .FALSE.
IVCORR = 30
IVCOMP = 1
READ (I04) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF,
1 (((LAON32 (J,K,I), I=1,2), K=1,2), J=1,2)
IF (IRECN .EQ. 12) IVCOMP = IVCOMP * 2
IF ( .NOT. LAON32(1,2,1)) IVCOMP = IVCOMP * 3
IF (LAON32(2,1,1)) IVCOMP = IVCOMP * 5
40310 IF (IVCOMP - 30) 20310, 10310, 20310
30310 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10310, 0321, 20310
10310 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0321
20310 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0321 CONTINUE
C
C **** FCVS PROGRAM 411 - TEST 032 ****
C
C
C TEST 032 USES A READ STATEMENT WITHOUT ANY INPUT LIST ITEMS
C (INPUT LIST ITEMS ARE OPTIONAL FOR THE READ STATEMENT). THIS
C RECORD WAS WRITTEN IN TEST 15 AND SHOULD BE RECORD NUMBER 13.
C THE PURPOSE OF THIS TEST IS TO SEE THAT THE STATEMENT CONSTRUCT
C IS ACCEPTABLE TO THE COMPILER.
C ALSO THE LENGTH OF AN UNFORMATTED RECORD MAY BE ZERO.
C
C SEE SECTIONS 12.1.2, UNFORMATTED RECORDS
C 12.8, READ, WRITE AND PRINT STATEMENTS
C
C
IVTNUM = 32
IF (ICZERO) 30320, 0320, 30320
0320 CONTINUE
IRECN = 13
IVCORR = 13
READ (I04)
IVCOMP = IRECN
40320 IF (IVCOMP - 13) 20320, 10320, 20320
30320 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10320, 0331, 20320
10320 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0331
20320 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0331 CONTINUE
C
C **** FCVS PROGRAM 411 - TEST 033 ****
C
C
C TEST 033 USES A READ STATEMENT IN WHICH THE NUMBER OF VALUES
C REQUIRED BY THE INPUT LIST IS LESS THAN THE NUMBER OF VALUES IN
C THE RECORD. THIS TEST READS RECORD NUMBER 14 WHICH WAS CREATED
C IN TEST 016.
C
C SEE SECTION 12.9.5.1, UNFORMATED DATA TRANSFER
C
C
IVTNUM = 33
IF (ICZERO) 30330, 0330, 30330
0330 CONTINUE
IVON21 = 0
IVON22 = 0
IVON31 = 0
IVCORR = 0
IVCOMP = 1
READ (I04) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF,
1 IVON21, IVON22, IVON31
IF (IRECN .EQ. 14) IVCOMP = IVCOMP * 2
IF (IVON21 .EQ. 11) IVCOMP = IVCOMP * 3
IF (IVON22 .EQ. -11) IVCOMP = IVCOMP * 5
40330 IF (IVCOMP - 30) 20330, 10330, 20330
30330 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10330, 0341, 20330
10330 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0341
20330 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0341 CONTINUE
C
C
C THE FOLLOWING TWO TESTS USE THE READ STATEMENT WITH THE
C END SPECIFIER.
C
C
C
C **** FCVS PROGRAM 411 - TEST 034 ****
C
C
C TEST 034 USES THE READ STATEMENT WITHOUT ANY I/O LIST ITEMS.
C THE FILE IS READ UNTIL AN END-OF-FILE CONDITION OCCURS.
C
IVTNUM = 34
IF (ICZERO) 30340, 0340, 30340
0340 CONTINUE
REWIND I04
C
IVCOMP = 1
IVON01 = 0
IVCORR = 6
DO 0342 I=1,150
READ (I04, END = 0343)
IVON01 = IVON01 + 1
IF (IVON01 .GT. 150) GO TO 40340
0342 CONTINUE
GO TO 40340
0343 IVCOMP = IVCOMP * 2
IF (IVON01 .EQ. 142) IVCOMP = IVCOMP * 3
40340 IF (IVCOMP - 6) 20340, 10340, 20340
30340 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10340, 0351, 20340
10340 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0351
20340 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0351 CONTINUE
C
C **** FCVS PROGRAM 411 - TEST 035 ****
C
C
C TEST 035 USES THE READ STATEMENT WITH INPUT LIST ITEMS.
C THE FILE IS READ UNTIL AN END-OF-FILE CONDITION OCCURS.
C
C
IVTNUM = 35
IF (ICZERO) 30350, 0350, 30350
0350 CONTINUE
REWIND I04
IVCOMP = 1
IVCORR = 6
IVON01 = 0
IRECCK = 0
DO 0352 I = 1,150
IRECCK = IRECCK + 1
IF (IRECCK .EQ. 13) GO TO 0353
C TEST 015 WROTE A RECORD WITHOUT ANY I/O LIST ITEMS THEREFORE
C THE RECORD IS READ WITHOUT ANY I/O LIST ITEMS.
READ (I04, END = 0354) IPROG, IFILE, ITOTR, IRLGN, IRECN,IEOF
GO TO 0355
0353 READ (I04)
IVON01 = IVON01 + 1
0355 IF (IRECN .EQ. IRECCK) IVON01 = IVON01 + 1
0352 CONTINUE
GO TO 40350
0354 IVCOMP = IVCOMP * 2
IF (IVON01 .EQ. 142) IVCOMP = IVCOMP * 3
40350 IF (IVCOMP - 6) 20350, 10350, 20350
30350 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10350, 0361, 20350
10350 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0361
20350 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0361 CONTINUE
C
C
C THE FOLLOWING SOURCE CODE BRACKETED BY THE COMMENT LINES
C ***** BEGIN-FILE-DUMP SECTION AND ***** END-FILE-DUMP SECTION
C MAY OR MAY NOT APPEAR AS COMMENTS IN THE SOURCE PROGRAM.
C THIS CODE IS OPTIONAL AND BY DEFAULT IT IS AUTOMATICALLY COMMENTED
C OUT BY THE EXECUTIVE ROUTINE. A DUMP OF THE FILE USED BY THIS
C ROUTINE IS PROVIDED BY USING THE *OPT1 EXECUTIVE ROUTINE CONTROL
C CARD. IF THE OPTIONAL CODE IS SELECTED THE ROUTINE WILL DUMP
C THE CONTENTS OF THE FILE TO THE PRINT FILE FOLLOWING THE TEST
C REPORT AND BEFORE THE TEST REPORT SUMMARY.
CDB** BEGIN FILE DUMP CODE
C REWIND I04
C ITOTR = 142
C ILUN = I04
C IRLGN = 80
C IRNUM = 1
C7701 FORMAT (80A1)
C7702 FORMAT (1X,80A1)
C7703 FORMAT (10X,5HFILE ,I2,5H HAS ,I3,13H RECORDS - OK)
C7704 FORMAT (10X,5HFILE ,I2,5H HAS ,I3,27H RECORDS - THERE SHOULD BE ,I
C 13,9H RECORDS.)
C DO 7771 IRNUM = 1, ITOTR
C READ (ILUN, END = 7772) (IDUMP(ICH), ICH = 1, IRLGN)
C WRITE (I02,7702) (IDUMP(ICH), ICH = 1, IRLGN)
C7771 CONTINUE
C7772 CONTINUE
CDE** END OF DUMP CODE
C TEST 035 IS THE LAST TEST IN THIS PROGRAM. THE ROUTINE SHOULD
C HAVE MADE 35 EXPLICIT TESTS AND PROCESSED ONE FILE CONNECTED FOR
C SEQUENTIAL ACCESS
C
C
C
C WRITE OUT TEST SUMMARY
C
WRITE (I02,90004)
WRITE (I02,90014)
WRITE (I02,90004)
WRITE (I02,90000)
WRITE (I02,90004)
WRITE (I02,90020) IVFAIL
WRITE (I02,90022) IVPASS
WRITE (I02,90024) IVDELE
STOP
90001 FORMAT (1H ,24X,5HFM411)
90000 FORMAT (1H ,20X,20HEND OF PROGRAM FM411)
C
C FORMATS FOR TEST DETAIL LINES
C
80000 FORMAT (1H ,4X,I5,6X,7HDELETED)
80002 FORMAT (1H ,4X,I5,7X,4HPASS)
80010 FORMAT (1H ,4X,I5,7X,4HFAIL,10X,I6,9X,I6)
80012 FORMAT (1H ,4X,I5,7X,4HFAIL,4X,E12.5,3X,E12.5)
80018 FORMAT (1H ,4X,I5,7X,4HFAIL,2X,A14,1X,A14)
C
C FORMAT STATEMENTS FOR PAGE HEADERS
C
90002 FORMAT (1H1)
90004 FORMAT (1H )
90006 FORMAT (1H ,10X,34HFORTRAN COMPILER VALIDATION SYSTEM)
90008 FORMAT (1H ,21X,11HVERSION 1.0)
90010 FORMAT (1H ,8X,38HFOR OFFICIAL USE ONLY - COPYRIGHT 1978)
90012 FORMAT (1H ,5X,4HTEST,5X,9HPASS/FAIL,5X,8HCOMPUTED,8X,7HCORRECT)
90014 FORMAT (1H ,5X,46H----------------------------------------------)
90016 FORMAT (1H ,18X,17HSUBSET LEVEL TEST)
C
C FORMAT STATEMENTS FOR RUN SUMMARY
C
90020 FORMAT (1H ,19X,I5,13H TESTS FAILED)
90022 FORMAT (1H ,19X,I5,13H TESTS PASSED)
90024 FORMAT (1H ,19X,I5,14H TESTS DELETED)
END
*END-OF,FM411
FM413.f 481036382 170 2 100666 46339 `
*HEADER,FORTR,FM413
*FILES1,FORTR,FM413,X
PROGRAM FM413
C
C
C
C THIS ROUTINE TESTS FOR PROPER PROCESSING OF UNFORMATTED RECORDS
C IN FILES CONNECTED FOR DIRECT ACCESS. FOR THE SUBSET LANGUAGE A
C FILE CONNECTED FOR DIRECT ACCESS MUST HAVE UNFORMATTED RECORDS
C THIS ROUTINE FIRST TESTS SEVERAL SYNTACTICAL VARIATIONS OF THE
C READ AND WRITE STATEMENTS USED IN CREATING AND ACCESSING
C RECORDS OF THE FILE. THE OPEN STATEMENT IS USED TO CONNECT
C THE FILE TO A UNIT AND ESTABLISH ITS CONNECTION FOR DIRECT
C ACCESS. THE FIRST SERIES OF TESTS CREATE AND ACCESS THE
C RECORDS OF THE FILE IN RECORD NUMBER SEQUENCE AND THE LAST
C SERIES OF TESTS CREATE AND ACCESS RECORDS OF THE FILE IN RANDOM
C ORDER.
C
C UNFORMATTED RECORDS MAY HAVE BOTH CHARACTER AND NONCHARACTER
C DATA AND THIS DATA IS TRANSFERRED WITHOUT EDITING BETWEEN THE
C CURRENT RECORD AND THE ENTITIES SPECIFIED BY THE INPUT/OUTPUT
C LIST. THIS ROUTINE BOTH READS AND WRITES RECORDS CONTAINING
C THE DATA TYPES OF INTEGER ,REAL AND LOGICAL WITH I/O LIST ITEMS
C REPRESENTED AS VARIABLE NAMES, ARRAY ELEMENT NAMES AND ARRAY
C NAMES. THIS ROUTINE DOES NOT TEST DATA OF TYPE CHARACTER.
C
C ROUTINE FM411 TESTS USE OF UNFORMATTED RECORDS
C WITH A FILE CONNECTED FOR SEQUENTIAL ACCESS.
C
C THIS ROUTINE TESTS
C
C (1) THE STATEMENT CONSTRUCTS
C
C A. WRITE (U,REC=RN) VARIABLE-NAME,...
C B. WRITE (U,REC=RN) ARRAY-ELEMENT-NAME,...
C C. WRITE (U,REC=RN) ARRAY-NAME,...
C D. WRITE (U,REC=RN) - NO OUTPUT LIST
C E. WRITE (U,REC=RN) IMPLIED-DO-LIST
C F. READ (U,REC=RN) VARIABLE-NAME,...
C G. READ (U,REC=RN) ARRAY-ELEMENT-NAME,...
C H. READ (U,REC=RN) ARRAY-NAME,...
C I. READ (U,REC=RN) - NO INPUT LIST
C J. READ (U,REC=RN) IMPLIED-DO-LIST
C
C (2) USE OF A READ STATEMENT WHERE THE NUMBER OF VALUES
C IN THE INPUT LIST IS LESS THAN OR EQUAL TO THE
C NUMBER OF VALUES IN THE RECORD.
C (3) USE OF THE STATEMENT
C OPEN (U,ACCESS='DIRECT',RECL=RL)
C FOR CONNECTING A FILE TO THE UNIT.
C
C (4) THAT THE RECORDS OF A DIRECT ACCESS FILE NEED NOT BE
C BE CREATED AND READ IN ORDER OF THEIR RECORD NUMBERS.
C
C (5) THAT THE VALUES OF THE RECORD MAY BE CHANGED WHEN
C THE RECORD IS REWRITTEN.
C REFERENCES -
C
C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN,
C X3.9-1977
C
C SECTION 4.1, DATA TYPES
C SECTION 12.1.2, UNFORMATTED RECORD
C SECTION 12.2.4, FILE ACCESS
C SECTION 12.2.4.2, DIRECT ACCESS
C SECTION 12.3.3, UNIT SPECIFIER AND IDENTIFIER
C SECTION 12.7.2, END-OF-FILE SPECIFIER
C SECTION 12.8, READ, WRITE AND PRINT STATEMENTS
C SECTION 12.8.1, CONTROL INFORMATION LIST
C SECTION 12.8.2, INPUT/OUTPUT LIST
C SECTION 12.8.2.1, INPUT LIST ITEMS
C SECTION 12.8.2.2, OUTPUT LIST ITEMS
C SECTION 12.8.2.3, IMPLIED-DO LIST
C SECTION 12.9.5.1, UNFORMATTED DATA TRANSFER
C SECTION 12.10.1, OPEN STATEMENT
C
C
C
C ******************************************************************
C A COMPILER VALIDATION SYSTEM FOR THE FORTRAN LANGUAGE
C BASED ON SPECIFICATIONS AS DEFINED IN AMERICAN STANDARD FORTRAN
C X3.9-1978, HAS BEEN DEVELOPED BY THE DEPARTMENT OF THE NAVY. THE
C FORTRAN COMPILER VALIDATION SYSTEM (FCVS) CONSISTS OF AUDIT
C ROUTINES, THEIR RELATED DATA, AND AN EXECUTIVE SYSTEM. EACH AUDIT
C ROUTINE IS A FORTRAN PROGRAM OR SUBPROGRAM WHICH INCLUDES TESTS
C OF SPECIFIC LANGUAGE ELEMENTS AND SUPPORTING PROCEDURES INDICATING
C THE RESULT OF EXECUTING THESE TESTS.
C
C THIS PARTICULAR PROGRAM OR SUBPROGRAM CONTAINS ONLY FEATURES
C FOUND IN THE SUBSET LEVEL OF THE STANDARD.
C
C SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO
C DEPARTMENT OF THE NAVY
C FEDERAL COBOL COMPILER TESTING SERVICE
C WASHINGTON, D.C. 20376
C
C ******************************************************************
C
C
IMPLICIT LOGICAL (L)
IMPLICIT CHARACTER*14 (C)
C
LOGICAL LAON11, LAON21, LAON31, LCONT1, LCONF2, LVONT1, LVONF2
LOGICAL LAON12, LAON22, LAON32, LCONT3, LCONF4, LVONT3, LVONF4
LOGICAL LCONT5, LCONF6, LCONT7, LCONF8, LVONT5, LVONF6, LVONT7
LOGICAL LVONF8
DIMENSION IDUMP(80)
DIMENSION IAON11(8), IAON21(2,4), IAON31(2,2,2)
DIMENSION IAON12(8), IAON22(2,4), IAON32(2,2,2)
DIMENSION RAON11(8), RAON21(2,4), RAON31(2,2,2)
DIMENSION RAON12(8), RAON22(2,4), RAON32(2,2,2)
DIMENSION LAON11(8), LAON21(2,4), LAON31(2,2,2)
DIMENSION LAON12(8), LAON22(2,4), LAON32(2,2,2)
DATA IAON11 /11, -11, 777, -777, 512, -512, -32767, 32767/
DATA IAON21 /11, -11, 777, -777, 512, -512, -32767, 32767/
DATA IAON31 /11, -11, 777, -777, 512, -512, -32767, 32767/
DATA LAON11 /.TRUE., .FALSE., .TRUE., .FALSE., .TRUE., .FALSE.,
1 .TRUE., .FALSE./
DATA LAON21 /.TRUE., .FALSE., .TRUE., .FALSE., .TRUE., .FALSE.,
1 .TRUE., .FALSE./
DATA LAON31 /.TRUE., .FALSE., .TRUE., .FALSE., .TRUE., .FALSE.,
1 .TRUE., .FALSE./
DATA RAON11 /11., -11., 7.77, -7.77,.512, -.512, -32767., 32767./
DATA RAON21 /11., -11., 7.77, -7.77,.512, -.512, -32767., 32767./
DATA RAON31 /11., -11., 7.77, -7.77,.512, -.512, -32767., 32767./
ICON21 = 11
ICON22 = -11
ICON31 = +777
ICON32 = -777
ICON33 = 512
ICON34 = -512
ICON55 = -32767
ICON56 = 32767
RCON21 = 11.
RCON22 = -11.
RCON31 = +7.77
RCON32 = -7.77
RCON33 = .512
RCON34 = -.512
RCON55 = -32767.
RCON56 = 32767.
LCONT1 = .TRUE.
LCONF2 = .FALSE.
LCONT3 = .TRUE.
LCONF4 = .FALSE.
LCONT5 = .TRUE.
LCONF6 = .FALSE.
LCONT7 = .TRUE.
LCONF8 = .FALSE.
C
C THE FILE USED IN THIS ROUTINE HAS THE FOLLOWING PROPERTIES
C
C FILE IDENTIFIER - I10 (X-NUMBER 10)
C RECORD SIZE - 80
C ACCESS METHOD - DIRECT
C RECORD TYPE - UNFORMATTED
C DESIGNATED DEVICE - DISK
C TYPE OF DATA - INTEGER, REAL AND LOGICAL
C RECORDS IN FILE - 214
C
C THE FIRST 6 FIELDS OF EACH RECORD IN THE FILE UNIQUELY IDENT-
C IFIES THAT RECORD. THE REMAINING FIELDS OF THE RECORD CONTAIN
C DATA WHICH ARE USED IN TESTING. A DESCRIPTION OF EACH FIELD
C OF THE PREAMBLE FOLLOWS.
C
C VARIABLE NAME IN PROGRAM FIELD NUMBER
C ------------------------ ------------
C
C IPROG (ROUTINE NAME) - 1
C IFILE (LOGICAL/X-NUMBER) - 2
C ITOTR (RECORDS IN FILE) - 3
C IRLGN (LENGTH OF RECORD) - 4
C IRECN (RECORD NUMBER) - 5
C IEOF (9999 IF LAST RECORD) - 6
C
C
C
C
C INITIALIZATION SECTION.
C
C INITIALIZE CONSTANTS
C ********************
C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER
I01 = 5
C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER
I02 = 6
C SYSTEM ENVIRONMENT SECTION
C
CX010 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-010 CONTROL CARD.
C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5
C (UNIT NUMBER FOR CARD READER).
CX011 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-011 CONTROL CARD
C THE CX011 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL
C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX010 ABOVE.
C
CX020 THIS CARD IS PEPLACED BY CONTENTS OF FEXEC X-020 CONTROL CARD.
C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02 = 6
C (UNIT NUMBER FOR PRINTER).
CX021 THIS CARD IS PEPLACED BY CONTENTS OF FEXEC X-021 CONTROL CARD.
C THE CX021 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL
C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX020 ABOVE.
C
IVPASS = 0
IVFAIL = 0
IVDELE = 0
ICZERO = 0
C
C WRITE OUT PAGE HEADERS
C
WRITE (I02,90002)
WRITE (I02,90006)
WRITE (I02,90008)
WRITE (I02,90004)
WRITE (I02,90010)
WRITE (I02,90004)
WRITE (I02,90016)
WRITE (I02,90001)
WRITE (I02,90004)
WRITE (I02,90012)
WRITE (I02,90014)
WRITE (I02,90004)
C
I10 = 9
C I10 CONTAINS THE LOGICAL UNIT NUMBER FOR A DIRECT ACCESS FILE
C WITH UNFORMATTED RECORDS
CX100 THE CARD IS REPLACED BY CONTENTS OF X-100 CARD
CX101 THE CARD IS REPLACED BY CONTENTS OF X-101 CARD
IPROG = 413
IFILE = I10
ITOTR = 214
IRLGN = 80
IRECN = 0
IEOF = 0
C
C
C
C TESTS 001 THROUGH 013 OPEN A FILE CONNECTED FOR DIRECT ACCESS
C AND WRITE 12 RECORDS INTO THE FILE. THESE TESTS TEST USE OF THE
C ALLOWABLE FORMS OF THE OPEN AND WRITE STATEMENTS ON A FILE
C CONNECTED FOR DIRECT ACCESS. THE WRITE STATEMENT IS USED WITH
C THE I/O LIST ITEM AS A VARIABLE, ARRAY ELEMENT AND AN ARRAY.
C THE PURPOSE OF TESTS 001 THROUGH 013 IS TO CHECK THE COMPILER'S
C ABILITY TO HANDLE THE VARIOUS STATEMENT CONSTRUCTS OF THE OPEN
C AND WRITE STATEMENTS. LATER TESTS WITHIN THIS ROUTINE READ
C AND CHECK THE RECORDS WHICH WERE CREATED.
C THE VALUE IN IVCORR FOR TESTS 002 THROUGH 013 IS THE RECORD
C NUMBER USED TO WRITE THE RECORD.
C
C
C
C **** FCVS PROGRAM 413 - TEST 001 ****
C
C
C TEST 001 USES THE OPEN STATEMENT TO CONNECT A FILE FOR DIRECT
C ACCESS. THIS IS THE FIRST ROUTINE TO USE AN OPEN STATEMENT.
C
C
IVTNUM = 1
IF (ICZERO) 30010, 0010, 30010
0010 CONTINUE
IVCORR = 1
IVCOMP = 0
OPEN ( I10, ACCESS = 'DIRECT', RECL = 80 )
IVCOMP = 1
40010 IF (IVCOMP - 1) 20010, 10010, 20010
30010 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10010, 0021, 20010
10010 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0021
20010 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0021 CONTINUE
C
C **** FCVS PROGRAM 413 - TEST 002 ****
C
C
C TEST 002 USES A WRITE STATEMENT WHERE THE OUTPUT LIST ITEM
C IS A VARIABLE OF INTEGER TYPE.
C
C
IVTNUM = 2
IF (ICZERO) 30020, 0020, 30020
0020 CONTINUE
IRECN = 01
IVCORR = 01
WRITE (I10,REC=01) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF,
1 ICON21, ICON22, ICON31, ICON32, ICON33, ICON34, ICON55, ICON56
IVCOMP = IRECN
40020 IF (IVCOMP - 01) 20020, 10020, 20020
30020 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10020, 0031, 20020
10020 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0031
20020 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0031 CONTINUE
C
C **** FCVS PROGRAM 413 - TEST 003 ****
C
C
C TEST 003 USES A WRITE STATEMENT WHERE THE OUTPUT LIST ITEM
C IS A VARIABLE OF REAL TYPE.
C
C
IVTNUM = 3
IF (ICZERO) 30030, 0030, 30030
0030 CONTINUE
IRECN = 02
IVCORR = 02
WRITE (I10,REC=02) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF,
1 RCON21, RCON22, RCON31, RCON32, RCON33, RCON34, RCON55, RCON56
IVCOMP = IRECN
40030 IF (IVCOMP - 02) 20030, 10030, 20030
30030 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10030, 0041, 20030
10030 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0041
20030 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0041 CONTINUE
C
C **** FCVS PROGRAM 413 - TEST 004 ****
C
C
C TEST 004 USES A WRITE STATEMENT WHERE THE OUTPUT LIST ITEM
C IS A VARIABLE OF LOGICAL TYPE.
C
C
IVTNUM = 4
IF (ICZERO) 30040, 0040, 30040
0040 CONTINUE
IRECN = 03
IVCORR = 03
WRITE (I10,REC=03) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF,
1 LCONT1, LCONF2, LCONT3, LCONF4, LCONT5, LCONF6, LCONT7, LCONF8
IVCOMP = IRECN
40040 IF (IVCOMP - 03) 20040, 10040, 20040
30040 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10040, 0051, 20040
10040 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0051
20040 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0051 CONTINUE
C
C **** FCVS PROGRAM 413 - TEST 005 ****
C
C
C TEST 005 USES A WRITE STATEMENT WHERE THE OUTPUT LIST ITEM
C IS AN ARRAY ELEMENT OF INTEGER TYPE. ONE, TWO AND THREE
C DIMENSION ARRAYS ARE USED.
C
C
IVTNUM = 5
IF (ICZERO) 30050, 0050, 30050
0050 CONTINUE
IRECN = 04
IVCORR = 04
WRITE (I10,REC=04) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF,
1 IAON11(1), IAON11(2), IAON21(1,2), IAON21(2,2), IAON31(1,1,2),
2 IAON31(2,1,2), IAON11(7), IAON11(8)
IVCOMP = IRECN
40050 IF (IVCOMP - 04) 20050, 10050, 20050
30050 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10050, 0061, 20050
10050 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0061
20050 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0061 CONTINUE
C
C **** FCVS PROGRAM 413 - TEST 006 ****
C
C
C TEST 006 USES A WRITE STATEMENT WHERE THE OUTPUT LIST ITEM
C IS AN ARRAY ELEMENT OF REAL TYPE. ONE, TWO AND THREE
C DIMENSION ARRAYS ARE USED.
C
C
IVTNUM = 6
IF (ICZERO) 30060, 0060, 30060
0060 CONTINUE
IRECN = 05
IVCORR = 05
WRITE (I10,REC=05) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF,
1 RAON11(1), RAON11(2), RAON21(1,2), RAON21(2,2), RAON31(1,1,2),
2 RAON31(2,1,2), RAON11(7), RAON11(8)
IVCOMP = IRECN
40060 IF (IVCOMP - 05) 20060, 10060, 20060
30060 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10060, 0071, 20060
10060 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0071
20060 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0071 CONTINUE
C
C **** FCVS PROGRAM 413 - TEST 007 ****
C
C
C TEST 007 USES A WRITE STATEMENT WHERE THE OUTPUT LIST ITEM
C IS AN ARRAY ELEMENT OF LOGICAL TYPE. ONE, TWO AND THREE
C DIMENSION ARRAYS ARE USED.
C
C
IVTNUM = 7
IF (ICZERO) 30070, 0070, 30070
0070 CONTINUE
IRECN = 06
IVCORR = 06
WRITE (I10,REC=06) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF,
1 LAON11(1), LAON11(2), LAON21(1,2), LAON21(2,2), LAON31(1,1,2),
2 LAON31(2,1,2), LAON11(7), LAON11(8)
IVCOMP = IRECN
40070 IF (IVCOMP - 06) 20070, 10070, 20070
30070 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10070, 0081, 20070
10070 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0081
20070 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0081 CONTINUE
C
C **** FCVS PROGRAM 413 - TEST 008 ****
C
C
C TEST 008 USES A WRITE STATEMENT WHERE THE OUTPUT LIST ITEM
C IS AN ARRAY OF INTEGER TYPE.
C
C
IVTNUM = 8
IF (ICZERO) 30080, 0080, 30080
0080 CONTINUE
IRECN = 07
IVCORR = 07
WRITE (I10,REC=07) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF,
1 IAON31
IVCOMP = IRECN
40080 IF (IVCOMP - 07) 20080, 10080, 20080
30080 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10080, 0091, 20080
10080 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0091
20080 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0091 CONTINUE
C
C **** FCVS PROGRAM 413 - TEST 009 ****
C
C
C TEST 009 USES A WRITE STATEMENT WHERE THE OUTPUT LIST ITEM
C IS AN ARRAY OF REAL TYPE.
C
C
IVTNUM = 9
IF (ICZERO) 30090, 0090, 30090
0090 CONTINUE
IRECN = 08
IVCORR = 08
WRITE (I10,REC=08) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF,
1 RAON31
IVCOMP = IRECN
40090 IF (IVCOMP - 08) 20090, 10090, 20090
30090 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10090, 0101, 20090
10090 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0101
20090 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0101 CONTINUE
C
C **** FCVS PROGRAM 413 - TEST 010 ****
C
C
C TEST 010 USES A WRITE STATEMENT WHERE THE OUTPUT LIST ITEM
C IS AN ARRAY OF LOGICAL TYPE.
C
C
IVTNUM = 10
IF (ICZERO) 30100, 0100, 30100
0100 CONTINUE
IRECN = 09
IVCORR = 09
WRITE (I10,REC=09) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF,
1 LAON31
IVCOMP = IRECN
40100 IF (IVCOMP - 09) 20100, 10100, 20100
30100 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10100, 0111, 20100
10100 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0111
20100 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0111 CONTINUE
C
C **** FCVS PROGRAM 413 - TEST 011 ****
C
C
C TEST 011 USES A WRITE STATEMENT WHERE THE OUTPUT LIST ITEM
C IS AN IMPLIED-DO WITH AN ITEM OF INTEGER TYPE.
C THE FIELD VALUES ARE WRITTEN IN MIXED ORDER VIS-A-VIS THE
C ELEMENT SEQUENCE OF ARRAY IAON31. THE SEQUENCE OF VALUES WRITTEN
C IN THE RECORD ARE 11, 512, 777, -32767, -11, -512, -777, 32767.
C
C
IVTNUM = 11
IF (ICZERO) 30110, 0110, 30110
0110 CONTINUE
IRECN = 10
IVCORR = 10
WRITE (I10,REC=10) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF,
1 (((IAON31 (J,K,I), I=1,2), K=1,2), J=1,2)
IVCOMP = IRECN
40110 IF (IVCOMP - 10) 20110, 10110, 20110
30110 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10110, 0121, 20110
10110 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0121
20110 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0121 CONTINUE
C
C **** FCVS PROGRAM 413 - TEST 012 ****
C
C
C TEST 012 USES A WRITE STATEMENT WHERE THE OUTPUT LIST ITEM
C IS AN IMPLIED-DO WITH AN ITEM OF REAL TYPE. THE FIELD VALUES
C (IN FIELD POSITION ORDER) WRITTEN IN THE RECORD ARE 11., -11.,
C 7.77, -7.77, .512, -.512, -32767., 32767.
C
C
IVTNUM = 12
IF (ICZERO) 30120, 0120, 30120
0120 CONTINUE
IRECN = 11
IVCORR = 11
WRITE (I10,REC=11) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF,
1 (((RAON31 (J,K,I), J=1,2), K=1,2), I=1,2)
IVCOMP = IRECN
40120 IF (IVCOMP - 11) 20120, 10120, 20120
30120 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10120, 0131, 20120
10120 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0131
20120 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0131 CONTINUE
C
C **** FCVS PROGRAM 413 - TEST 013 ****
C
C
C TEST 013 USES A WRITE STATEMENT WHERE THE OUTPUT LIST ITEM
C IS AN IMPLIED-DO WITH AN ITEM OF LOGICAL TYPE.
C THE FIELD VALUES ARE WRITTEN IN MIXED ORDER VIS-A-VIS THE
C ELEMENT SEQUENCE OF ARRAY LAON31. THE SEQUENCE OF VALUES WRITTEN
C IN THE RECORD ARE .TRUE., .TRUE., .FALSE., .FALSE., .TRUE., .TRUE.
C .FALSE, .FALSE.
C
C
IVTNUM = 13
IF (ICZERO) 30130, 0130, 30130
0130 CONTINUE
IRECN = 12
IVCORR = 12
WRITE (I10,REC=12) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF,
1 (((LAON31 (J,K,I), K=1,2), J=1,2), I=1,2)
IVCOMP = IRECN
40130 IF (IVCOMP - 12) 20130, 10130, 20130
30130 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10130, 0141, 20130
10130 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0141
20130 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0141 CONTINUE
C
C
C TESTS 14 AND 15 TEST THE WRITE WITHOUT OUTPUT LIST ITEMS.
C
C
C
C
C **** FCVS PROGRAM 413 - TEST 014 ****
C
C
C TEST 014 USES A WRITE STATEMENT WITHOUT ANY OUTPUT LIST ITEMS.
C THE OUTPUT LIST ITEMS ARE OPTIONAL AND THIS TEST USES THIS FORM
C TO ESTABLISH A RECORD NUMBER FOR A RECORD IN THE FILE.
C ALSO THE LENGTH OF AN UNFORMATTED RECORD MAY BE ZERO.
C
C SEE SECTIONS 12.1.2, UNFORMATTED RECORDS
C 12.2.4.2 (5) AND (6), DIRECT ACCESS
C 12.8, READ, WRITE AND PRINT STATEMENTS
C
C
IVTNUM = 14
IF (ICZERO) 30140, 0140, 30140
0140 CONTINUE
IRECN = 13
IVCORR = 13
WRITE (I10,REC=13)
IVCOMP = IRECN
40140 IF (IVCOMP - 13) 20140, 10140, 20140
30140 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10140, 0151, 20140
10140 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0151
20140 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0151 CONTINUE
C
C **** FCVS PROGRAM 413 - TEST 015 ****
C
C
C TEST 015 IS SIMILAR TO TEST 014 ABOVE EXCEPT THE RN OF THE
C RECORD SPECIFIER (REC = RN) IS AN INTEGER VARIABLE.
C
C
IVTNUM = 15
IF (ICZERO) 30150, 0150, 30150
0150 CONTINUE
IRECN = 14
IVCORR = 14
IREC = 14
WRITE (I10,REC = IREC)
IVCOMP = IRECN
40150 IF (IVCOMP - 14) 20150, 10150, 20150
30150 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10150, 0161, 20150
10150 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0161
20150 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0161 CONTINUE
C
C
C TESTS 16 AND 17 VERIFY THAT RECORDS MAY BE CREATED IN
C OTHER THAN SEQUENTIAL ORDER. ALSO THAT A VARIABLE MAY BY USED
C AS THE OPERAND OF THE REC SPECIFIER FOR A WRITE STATEMENT.
C
C
C
C **** FCVS PROGRAM 413 - TEST 016 ****
C
C
C TEST 016 TESTS USE OF THE REC SPECIFIER WHERE THE OPERAND
C IS A VARIABLE. THIS TEST IS SIMILAR TO TEST 15 EXCEPT THE WRITE
C STATEMENT CONTAINS OUTPUT LIST ITEMS. ONE HUNDRED RECORDS ARE
C WRITTEN BY INCREMENTING THE VARIABLE BY 2 FOR EACH WRITE. TEST
C 032 READS THE RECORDS WRITTEN BY THIS METHOD.
C
C
IVTNUM = 16
IF (ICZERO) 30160, 0160, 30160
0160 CONTINUE
IRECN = 13
IREC = 13
DO 4132 I = 1,100
IREC = IREC + 2
IRECN = IRECN + 2
WRITE (I10, REC = IREC) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF,
1 ICON21, ICON22, ICON31, ICON32, ICON33, ICON34, ICON55, ICON56
4132 CONTINUE
IVCORR = 100
IVCOMP = IREC - 113
40160 IF (IVCOMP - 100) 20160, 10160, 20160
30160 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10160, 0171, 20160
10160 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0171
20160 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0171 CONTINUE
C
C **** FCVS PROGRAM 413 - TEST 017 ****
C
C
C TEST 17 IS SIMILAR TO TEST 16 EXCEPT THE RECORD IS
C WRITTEN IN REVERSE ORDER OF RECORD NUMBER. ONE HUNDERD RECORDS
C ARE WRITTEN AND THE VARIABLE OF THE REC SPECIFIER IS DECREMENTED
C BY TWO FOR EACH WRITE.
C
C
IVTNUM = 17
IF (ICZERO) 30170, 0170, 30170
0170 CONTINUE
IRECN = 216
IREC = 216
IVCOMP = 0
DO 4133 I=1,100
IREC = IREC - 2
IRECN = IRECN - 2
WRITE (I10, REC = IREC) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF,
1 ICON21, ICON22, ICON31, ICON32, ICON33, ICON34, ICON55, ICON56
IVCOMP = IVCOMP + 1
4133 CONTINUE
IVCORR = 100
40170 IF (IVCOMP - 100) 20170, 10170, 20170
30170 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10170, 0181, 20170
10170 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0181
20170 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0181 CONTINUE
C
C
C TESTS 018 THROUGH 030 READ AND CHECK THE RECORDS CREATED IN
C TESTS 002 THROUGH 014. EACH OF THE TESTS IN THIS SET IS CHECKING
C TWO THINGS. FIRST, THAT THE READ STATEMENT CONSTRUCT IS ACCEPTED
C BY THE COMPILER AND SECOND THAT THE RECORDS CREATED IN TESTS 002
C THROUGH 013 AND READ IN THESE TESTS CAN GIVE PREDICTIBLE VALUES.
C THE READ STATEMENT IS USED WITH THE I/O LIST ITEM AS A VARIABLE,
C AN ARRAY ELEMENT AND AN ARRAY.
C
C
C
C **** FCVS PROGRAM 413 - TEST 018 ****
C
C
C TEST 018 USES A READ STATEMENT WHERE THE INPUT LIST ITEM IS A
C VARIABLE OF INTEGER TYPE.
C
C
IVTNUM = 18
IF (ICZERO) 30180, 0180, 30180
0180 CONTINUE
IVON22 = 0
IVON56 = 0
IVCORR = 30
IVCOMP = 1
READ (I10, REC = 01) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF,
1 IVON21, IVON22, IVON31, IVON32, IVON33, IVON34, IVON55, IVON56
IF (IRECN .EQ. 01) IVCOMP = IVCOMP * 2
IF (IVON22 .EQ. -11) IVCOMP = IVCOMP * 3
IF (IVON56 .EQ. 32767) IVCOMP = IVCOMP * 5
40180 IF (IVCOMP - 30) 20180, 10180, 20180
30180 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10180, 0191, 20180
10180 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0191
20180 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0191 CONTINUE
C
C **** FCVS PROGRAM 413 - TEST 019 ****
C
C
C TEST 019 USES A READ STATEMENT WHERE THE INPUT LIST ITEM IS A
C VARIABLE OF REAL TYPE.
C
C
IVTNUM = 19
IF (ICZERO) 30190, 0190, 30190
0190 CONTINUE
RVON22 = 0.0
RVON31 = 0.0
IVCORR = 30
IVCOMP = 1
READ (I10, REC = 02) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF,
1 RVON21, RVON22, RVON31, RVON32, RVON33, RVON34, RVON55, RVON56
IF (IRECN .EQ. 02) IVCOMP = IVCOMP * 2
IF (RVON22 .EQ. -11.) IVCOMP = IVCOMP * 3
IF (RVON31 .EQ. 7.77) IVCOMP = IVCOMP * 5
40190 IF (IVCOMP - 30) 20190, 10190, 20190
30190 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10190, 0201, 20190
10190 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0201
20190 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0201 CONTINUE
C
C **** FCVS PROGRAM 413 - TEST 020 ****
C
C
C TEST 020 USES A READ STATEMENT WHERE THE INPUT LIST ITEM IS A
C VARIABLE OF LOGICAL TYPE.
C
C
IVTNUM = 20
IF (ICZERO) 30200, 0200, 30200
0200 CONTINUE
LVONT1 = .FALSE.
LVONF6 = .TRUE.
IVCORR = 30
IVCOMP = 1
READ (I10, REC = 03) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF,
1 LVONT1, LVONF2, LVONT3, LVONF4, LVONT5, LVONF6, LVONT7, LVONF8
IF (IRECN .EQ. 03) IVCOMP = IVCOMP * 2
IF (.NOT. LVONF6) IVCOMP = IVCOMP * 3
IF (LVONT1) IVCOMP = IVCOMP * 5
40200 IF (IVCOMP - 30) 20200, 10200, 20200
30200 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10200, 0211, 20200
10200 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0211
20200 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0211 CONTINUE
C
C **** FCVS PROGRAM 413 - TEST 021 ****
C
C
C TEST 021 USES A READ STATEMENT WHERE THE INPUT LIST ITEM IS A
C ARRAY ELEMENT OF INTEGER TYPE. ONE, TWO, AND THREE
C DIMENSION ARRAYS ARE USED.
C
C
IVTNUM = 21
IF (ICZERO) 30210, 0210, 30210
0210 CONTINUE
IAON12(2) = 0
IAON12(8) = 0
IVCORR = 30
IVCOMP = 1
READ (I10, REC = 04) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF,
1 IAON12(1), IAON12(2), IAON22(1,2), IAON22(2,2), IAON32(1,1,2),
2 IAON32(2,1,2), IAON12(7), IAON12(8)
IF (IRECN .EQ. 04) IVCOMP = IVCOMP * 2
IF (IAON12(2) .EQ. -11) IVCOMP = IVCOMP * 3
IF (IAON12(8) .EQ. 32767) IVCOMP = IVCOMP * 5
C
C THE ABOVE 3 IF STATEMENTS CHECK THE RECORD NUMBER, A NEGATIVE
C FIELD VALUE AND A POSITIVE FIELD VALUE.
C
40210 IF (IVCOMP - 30) 20210, 10210, 20210
30210 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10210, 0221, 20210
10210 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0221
20210 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0221 CONTINUE
C
C **** FCVS PROGRAM 413 - TEST 022 ****
C
C
C TEST 022 USES A READ STATEMENT WHERE THE INPUT LIST ITEM IS A
C ARRAY ELEMENT OF REAL TYPE. ONE, TWO, AND THREE
C DIMENSION ARRAYS ARE USED.
C
C
IVTNUM = 22
IF (ICZERO) 30220, 0220, 30220
0220 CONTINUE
RAON22(2,2) = 0.0
RAON32(1,1,2) = 0.0
IVCORR = 30
IVCOMP = 1
READ (I10, REC = 05) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF,
1 RAON12(1), RAON12(2), RAON22(1,2), RAON22(2,2), RAON32(1,1,2),
2 RAON32(2,1,2), RAON12(7), RAON12(8)
IF (IRECN .EQ. 05) IVCOMP = IVCOMP * 2
IF (RAON22(2,2) .EQ. -7.77) IVCOMP = IVCOMP * 3
IF (RAON32(1,1,2) .EQ. .512 ) IVCOMP = IVCOMP * 5
C
C THE ABOVE 3 IF STATEMENTS CHECK THE RECORD NUMBER, A NEGATIVE
C FIELD VALUE AND A POSITIVE FIELD VALUE.
C
40220 IF (IVCOMP - 30) 20220, 10220, 20220
30220 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10220, 0231, 20220
10220 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0231
20220 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0231 CONTINUE
C
C **** FCVS PROGRAM 413 - TEST 023 ****
C
C
C TEST 023 USES A READ STATEMENT WHERE THE INPUT LIST ITEM IS A
C ARRAY ELEMENT OF LOGICAL TYPE. ONE, TWO, AND THREE
C DIMENSION ARRAYS ARE USED.
C
C
IVTNUM = 23
IF (ICZERO) 30230, 0230, 30230
0230 CONTINUE
LAON12(1) = .FALSE.
LAON32(2,1,2) = .TRUE.
IVCORR = 30
IVCOMP = 1
READ (I10, REC = 06) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF,
1 LAON12(1), LAON12(2), LAON22(1,2), LAON22(2,2), LAON32(1,1,2),
2 LAON32(2,1,2), LAON12(7), LAON12(8)
IF (IRECN .EQ. 06) IVCOMP = IVCOMP * 2
IF (LAON12(1)) IVCOMP = IVCOMP * 3
IF (.NOT. LAON32(2,1,2)) IVCOMP = IVCOMP * 5
40230 IF (IVCOMP - 30) 20230, 10230, 20230
30230 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10230, 0241, 20230
10230 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0241
20230 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0241 CONTINUE
C
C **** FCVS PROGRAM 413 - TEST 024 ****
C
C
C TEST 024 USES A READ STATEMENT WHERE THE INPUT LIST ITEM IS A
C ARRAY OF INTEGER TYPE.
C
C
IVTNUM = 24
IF (ICZERO) 30240, 0240, 30240
0240 CONTINUE
IAON32(2,1,1) = 0
IAON32(2,2,2) = 0
IVCORR = 30
IVCOMP = 1
READ (I10, REC = 07) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF,
1 IAON32
IF (IRECN .EQ. 07) IVCOMP = IVCOMP * 2
IF (IAON32(2,1,1) .EQ. -11) IVCOMP = IVCOMP * 3
IF (IAON32(2,2,2) .EQ. 32767) IVCOMP = IVCOMP * 5
C
C THE ABOVE 3 IF STATEMENTS CHECK THE RECORD NUMBER, A NEGATIVE
C FIELD VALUE AND A POSITIVE FIELD VALUE.
C
40240 IF (IVCOMP - 30) 20240, 10240, 20240
30240 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10240, 0251, 20240
10240 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0251
20240 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0251 CONTINUE
C
C **** FCVS PROGRAM 413 - TEST 025 ****
C
C
C TEST 025 USES A READ STATEMENT WHERE THE INPUT LIST ITEM IS A
C ARRAY OF REAL TYPE.
C
C
IVTNUM = 25
IF (ICZERO) 30250, 0250, 30250
0250 CONTINUE
RAON32(2,1,1) = 0.0
RAON32(2,2,2) = 0.0
IVCORR = 30
IVCOMP = 1
READ (I10, REC = 08) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF,
1 RAON32
IF (IRECN .EQ. 08) IVCOMP = IVCOMP * 2
IF (RAON32(2,1,1) .EQ. -11.) IVCOMP = IVCOMP * 3
IF (RAON32(2,2,2) .EQ. 32767.) IVCOMP = IVCOMP * 5
C
C THE ABOVE 3 IF STATEMENTS CHECK THE RECORD NUMBER, A NEGATIVE
C FIELD VALUE AND A POSITIVE FIELD VALUE.
C
40250 IF (IVCOMP - 30) 20250, 10250, 20250
30250 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10250, 0261, 20250
10250 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0261
20250 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0261 CONTINUE
C
C **** FCVS PROGRAM 413 - TEST 026 ****
C
C
C TEST 026 USES A READ STATEMENT WHERE THE INPUT LIST ITEM IS A
C ARRAY OF LOGICAL TYPE.
C
C
IVTNUM = 26
IF (ICZERO) 30260, 0260, 30260
0260 CONTINUE
LAON32(1,1,1) = .FALSE.
LAON32(2,2,2) = .TRUE.
IVCORR = 30
IVCOMP = 1
READ (I10, REC = 09) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF,
1 LAON32
IF (IRECN .EQ. 09) IVCOMP = IVCOMP * 2
IF (LAON32(1,1,1)) IVCOMP = IVCOMP * 3
IF (.NOT. LAON32(2,2,2)) IVCOMP = IVCOMP * 5
40260 IF (IVCOMP - 30) 20260, 10260, 20260
30260 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10260, 0271, 20260
10260 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0271
20260 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0271 CONTINUE
C
C **** FCVS PROGRAM 413 - TEST 027 ****
C
C
C TEST 027 USES A READ STATEMENT WHERE THE INPUT LIST ITEM IS A
C IMPLIED-DO WITH AN ITEM OF INTEGER TYPE. THE STORAGE VALUES IN
C THE ARRAY (BY THE IMPLIED-DO DURING THE READ) SHOULD RESULT IN A
C DIFFERENT STORAGE SEQUENCE IN THE ARRAY THAN FOUND IN THE RECORD
C OF THE FILE. THIS RECORD IS RECORD NUMBER 10 AND WAS CREATED IN
C TEST 012 ABOVE. THE FIELD VALUE, FIELD POSITION, POSITION WITHIN
C ARRAY IAON32 AND SUBSCRIPT VALUE AFTER THE READ IS
C
C VALUE 11 777 512 -32767 -11 -777 -512 32767
C FIELD POS 1 3 2 4 5 7 6 8
C IAON32 1 2 3 4 5 6 7 8
C SUBSCRIPT 1,1,1 2,1,1 1,2,1 2,2,1 1,1,2 2,1,2 1,2,2 2,2,2
C
C
IVTNUM = 27
IF (ICZERO) 30270, 0270, 30270
0270 CONTINUE
IAON32(2,1,1) = 0
IAON32(2,2,1) = 0
IVCORR = 30
IVCOMP = 1
READ (I10, REC = 10) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF,
1 (((IAON32 (J,K,I), K=1,2), J=1,2), I=1,2)
IF (IRECN .EQ. 10) IVCOMP = IVCOMP * 2
IF (IAON32(2,1,1) .EQ. 777) IVCOMP = IVCOMP * 3
IF (IAON32(2,2,1) .EQ. -32767) IVCOMP = IVCOMP * 5
C
C THE ABOVE 3 IF STATEMENTS CHECK THE RECORD NUMBER, A NEGATIVE
C FIELD VALUE AND A POSITIVE FIELD VALUE.
C
40270 IF (IVCOMP - 30) 20270, 10270, 20270
30270 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10270, 0281, 20270
10270 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0281
20270 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0281 CONTINUE
C
C **** FCVS PROGRAM 413 - TEST 028 ****
C
C
C TEST 028 USES A READ STATEMENT WHERE THE INPUT LIST ITEM IS A
C IMPLIED-DO WITH AN ITEM OF REAL TYPE. THE STORAGE VALUES IN
C THE ARRAY (BY THE IMPLIED-DO DURING THE READ) SHOULD RESULT IN A
C SEQUENCE THE SAME AS FOUND IN THE RECORD OF THE FILE. THIS REC-
C ORD IS RECORD NUMBER 011 AND WAS CREATED IN TEST 013 ABOVE.
C THE FIELD VALUE, FIELD POSITION, POSITION WITHIN ARRAY RAON32 AND
C SUBSCRIPT VALUE AFTER THE THE READ IS
C
C VALUE 11. -11. 7.77 -7.77 .512 -.512 -32767. 32767.
C FIELD POS 1 2 3 4 5 6 7 8
C RAON32 1 2 3 4 5 6 7 8
C SUBSCRIPT 1,1,1 2,1,1 1,2,1 2,2,1 1,1,2 2,1,2 1,2,2 2,2,2
C
C
IVTNUM = 28
IF (ICZERO) 30280, 0280, 30280
0280 CONTINUE
RAON32(1,2,1) = 0.0
RAON32(1,2,2) = 0.0
IVCORR = 30
IVCOMP = 1
READ (I10, REC = 11) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF,
1 (((RAON32 (J,K,I), J=1,2), K=1,2), I=1,2)
IF (IRECN .EQ. 11) IVCOMP = IVCOMP * 2
IF (RAON32(1,2,1) .EQ. 7.77) IVCOMP = IVCOMP * 3
IF (RAON32(1,2,2) .EQ. -32767.) IVCOMP = IVCOMP * 5
C
C THE ABOVE 3 IF STATEMENTS CHECK THE RECORD NUMBER, A NEGATIVE
C FIELD VALUE AND A POSITIVE FIELD VALUE.
C
40280 IF (IVCOMP - 30) 20280, 10280, 20280
30280 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10280, 0291, 20280
10280 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0291
20280 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0291 CONTINUE
C
C **** FCVS PROGRAM 413 - TEST 029 ****
C
C
C TEST 029 USES A READ STATEMENT WHERE THE INPUT LIST ITEM IS A
C IMPLIED-DO WITH AN ITEM OF LOGICAL TYPE. THE STORAGE VALUES IN
C THE ARRAY (BY THE IMPLIED-DO DURING THE READ) SHOULD RESULT IN A
C DIFFERENT STORAGE SEQUENCE IN THE ARRAY THAN FOUND IN THE RECORD
C OF THE FILE. THIS RECORD IS RECORD NUMBER 12 AND WAS CREATED IN
C TEST 014 ABOVE. THE FIELD VALUE, FIELD POSITION, POSITION WITHIN
C ARRAY LAON32 AND SUBSCRIPT VALUE AFTER THE READ IS
C
C VALUE T T F F T T F F
C FIELD POS 1 5 3 7 2 6 4 8
C LAON32 1 2 3 4 5 6 7 8
C SUBSCRIPT 1,1,1 2,1,1 1,2,1 2,2,1 1,1,2 2,1,2 1,2,2 2,2,2
C
C
IVTNUM = 29
IF (ICZERO) 30290, 0290, 30290
0290 CONTINUE
LAON32(1,2,1) = .TRUE.
LAON32(2,1,1) = .FALSE.
IVCORR = 30
IVCOMP = 1
READ (I10, REC = 12) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF,
1 (((LAON32 (J,K,I), I=1,2), K=1,2), J=1,2)
IF (IRECN .EQ. 12) IVCOMP = IVCOMP * 2
IF ( .NOT. LAON32(1,2,1)) IVCOMP = IVCOMP * 3
IF (LAON32(2,1,1)) IVCOMP = IVCOMP * 5
40290 IF (IVCOMP - 30) 20290, 10290, 20290
30290 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10290, 0301, 20290
10290 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0301
20290 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0301 CONTINUE
C
C **** FCVS PROGRAM 413 - TEST 030 ****
C
C
C TEST 030 USES A READ STATEMENT WITHOUT ANY INPUT LIST ITEMS
C (INPUT LIST ITEMS ARE OPTIONAL FOR THE READ STATEMENT). THIS
C RECORD WAS WRITTEN IN TEST 14 AND SHOULD BE RECORD NUMBER 13.
C THE PURPOSE OF THIS TEST IS TO SEE THAT THE STATEMENT CONSTRUCT
C IS ACCEPTABLE TO THE COMPILER.
C ALSO THE LENGTH OF AN UNFORMATTED RECORD MAY BE ZERO.
C
C SEE SECTIONS 12.1.2, UNFORMATTED RECORDS
C 12.8, READ, WRITE AND PRINT STATEMENTS
C
C
IVTNUM = 30
IF (ICZERO) 30300, 0300, 30300
0300 CONTINUE
IRECN = 13
IVCORR = 13
READ (I10, REC = 13)
IVCOMP = IRECN
40300 IF (IVCOMP - 13) 20300, 10300, 20300
30300 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10300, 0311, 20300
10300 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0311
20300 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0311 CONTINUE
C
C **** FCVS PROGRAM 413 - TEST 031 ****
C
C
C TEST 031 USES A READ STATEMENT IN WHICH THE NUMBER OF VALUES
C REQUIRED BY THE INPUT LIST IS LESS THAN THE NUMBER OF VALUES IN
C THE RECORD.
C
C SEE SECTION 12.9.5.1, UNFORMATED DATA TRANSFER
C
C
IVTNUM = 31
IF (ICZERO) 30310, 0310, 30310
0310 CONTINUE
IVON21 = 0
IVON22 = 0
IVON31 = 0
IVCORR = 0
IVCOMP = 1
READ (I10, REC = 01) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF,
1 IVON21, IVON22, IVON31
IF (IRECN .EQ. 01) IVCOMP = IVCOMP * 2
IF (IVON21 .EQ. 11) IVCOMP = IVCOMP * 3
IF (IVON22 .EQ. -11) IVCOMP = IVCOMP * 5
40310 IF (IVCOMP - 30) 20310, 10310, 20310
30310 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10310, 0321, 20310
10310 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0321
20310 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0321 CONTINUE
C
C
C TEST 032 AND 033 VERIFIES THAT RECORDS MAY BE READ IN ANY ORDER
C ALSO THAT A VARIABLE MAY BE USED AS THE OPERAND OF THE REC SPEC-
C IFIER FOR A READ STATEMENT.
C
C SEE SECTION 2.2.4.2(1) , DIRECT ACCESS
C
C
C
C **** FCVS PROGRAM 413 - TEST 032 ****
C
C
C TEST 032 READS THE RECORDS WRITTEN IN TEST 16. EVERY OTHER
C RECORD IS READ FOR A TOTAL OF 100 RECORDS (THE REC SPECIFIER
C VARIABLE IS INCREMENTED BY 2).
C
C
IVTNUM = 32
IF (ICZERO) 30320, 0320, 30320
0320 CONTINUE
IRECCK = 13
IRECN = 0
IREC = 13
IVCOMP = 0
DO 4134 I = 1,100
IREC = IREC + 2
IRECCK = IRECCK + 2
READ (I10, REC = IREC) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF,
1 IVON21, IVON22, IVON31, IVON32, IVON33, IVON34, IVON55, IVON56
IF (IRECN .EQ. IRECCK) IVCOMP = IVCOMP + 1
4134 CONTINUE
IVCORR = 100
40320 IF (IVCOMP - 100) 20320, 10320, 20320
30320 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10320, 0331, 20320
10320 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0331
20320 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0331 CONTINUE
C
C **** FCVS PROGRAM 413 - TEST 033 ****
C
C
C TEST 033 READS THE RECORDS WRITTEN IN TEST 17. THIS TEST IS
C SIMILAR TO TEST 32 ABOVE EXCEPT THE FILE IS READ IN REVERSE
C RECORD NUMBER ORDER.
C
C
IVTNUM = 33
IF (ICZERO) 30330, 0330, 30330
0330 CONTINUE
IRECCK = 216
IRECN = 0
IVCOMP = 0
IREC = 216
DO 4135 I = 1,100
IREC = IREC - 2
IRECCK = IRECCK - 2
READ (I10, REC = IREC) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF,
1 IVON21, IVON22, IVON31, IVON32, IVON33, IVON34, IVON55, IVON56
IF (IRECN .EQ. IRECCK) IVCOMP = IVCOMP + 1
4135 CONTINUE
IVCORR = 100
40330 IF (IVCOMP - 100) 20330, 10330, 20330
30330 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10330, 0341, 20330
10330 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0341
20330 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0341 CONTINUE
C
C **** FCVS PROGRAM 413 - TEST 034 ****
C
C
C TEST 034 VERIFIES THAT THE VALUES OF A RECORD MAY BE CHANGED
C WHEN THE RECORD IS REWRITTEN. RECORD NUMBER 01 IS USED FOR
C TESTING. THE RECORD WAS WRITTEN IN TEST 02 AND READ IN TEST 18.
C A RECORD CANNOT BE DELETED FROM THE FILE BUT IT CAN BE REWRITTEN.
C
C SEE SECTION 12.2.4.2 (5), DIRECT ACCESS
C
C
IVTNUM = 34
IF (ICZERO) 30340, 0340, 30340
0340 CONTINUE
IRECN = 01
WRITE (I10, REC = 01) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF,
1 ICON31, ICON32, ICON21, ICON22, ICON55, ICON56, ICON33, ICON34
READ (I10, REC=01) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF,
1 IVON61, IVON62, IVON63, IVON64, IVON65,IVON66, IVON67, IVON68
IVCORR = 210
IVCOMP = 1
IF (IRECN .EQ. 01) IVCOMP = IVCOMP * 2
IF (IVON61 .EQ. 777) IVCOMP = IVCOMP * 3
IF (IVON62 .EQ. -777) IVCOMP = IVCOMP * 5
IF (IVON66 .EQ. 32767) IVCOMP = IVCOMP * 7
40340 IF (IVCOMP - 210) 20340, 10340, 20340
30340 IVDELE = IVDELE + 1
WRITE (I02,80000) IVTNUM
IF (ICZERO) 10340, 0351, 20340
10340 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0351
20340 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0351 CONTINUE
C
C
C THE FOLLOWING SOURCE CODE BRACKETED BY THE COMMENT LINES
C ***** BEGIN-FILE-DUMP SECTION AND ***** END-FILE-DUMP SECTION
C MAY OR MAY NOT APPEAR AS COMMENTS IN THE SOURCE PROGRAM.
C THIS CODE IS OPTIONAL AND BY DEFAULT IT IS AUTOMATICALLY COMMENTED
C OUT BY THE EXECUTIVE ROUTINE. A DUMP OF THE FILE USED BY THIS
C ROUTINE IS PROVIDED BY USING THE *OPT1 EXECUTIVE ROUTINE CONTROL
C CARD. IF THE OPTIONAL CODE IS SELECTED THE ROUTINE WILL DUMP
C THE CONTENTS OF THE FILE TO THE PRINT FILE FOLLOWING THE TEST
C REPORT AND BEFORE THE TEST REPORT SUMMARY.
C
CDB** BEGIN FILE DUMP CODE
C ITOTR = 214
C ILUN = I10
C IRLGN = 80
C IRNUM = 1
C7701 FORMAT (80A1)
C7702 FORMAT (1X,80A1)
C7703 FORMAT (10X,5HFILE ,I2,5H HAS ,I3,13H RECORDS - OK)
C7704 FORMAT (10X,5HFILE ,I2,5H HAS ,I3,27H RECORDS - THERE SHOULD BE ,I
C 13,9H RECORDS.)
C DO 7771 IRNUM = 1, ITOTR
C READ (ILUN, REC = IRNUM) (IDUMP(ICH), ICH = 1, IRLGN)
C WRITE (I02, 7702) (IDUMP(ICH), ICH = 1, IRLGN)
C7771 CONTINUE
CDE** END OF DUMP CODE
C TEST 034 IS THE LAST TEST IN THIS PROGRAM. THE ROUTINE SHOULD
C HAVE MADE 34 EXPLICIT TESTS AND PROCESSED ONE FILE CONNECTED FOR
C DIRECT ACCESS
C
C
C
C WRITE OUT TEST SUMMARY
C
WRITE (I02,90004)
WRITE (I02,90014)
WRITE (I02,90004)
WRITE (I02,90000)
WRITE (I02,90004)
WRITE (I02,90020) IVFAIL
WRITE (I02,90022) IVPASS
WRITE (I02,90024) IVDELE
STOP
90001 FORMAT (1H ,24X,5HFM413)
90000 FORMAT (1H ,20X,20HEND OF PROGRAM FM413)
C
C FORMATS FOR TEST DETAIL LINES
C
80000 FORMAT (1H ,4X,I5,6X,7HDELETED)
80002 FORMAT (1H ,4X,I5,7X,4HPASS)
80010 FORMAT (1H ,4X,I5,7X,4HFAIL,10X,I6,9X,I6)
80012 FORMAT (1H ,4X,I5,7X,4HFAIL,4X,E12.5,3X,E12.5)
80018 FORMAT (1H ,4X,I5,7X,4HFAIL,2X,A14,1X,A14)
C
C FORMAT STATEMENTS FOR PAGE HEADERS
C
90002 FORMAT (1H1)
90004 FORMAT (1H )
90006 FORMAT (1H ,10X,34HFORTRAN COMPILER VALIDATION SYSTEM)
90008 FORMAT (1H ,21X,11HVERSION 1.0)
90010 FORMAT (1H ,8X,38HFOR OFFICIAL USE ONLY - COPYRIGHT 1978)
90012 FORMAT (1H ,5X,4HTEST,5X,9HPASS/FAIL,5X,8HCOMPUTED,8X,7HCORRECT)
90014 FORMAT (1H ,5X,46H----------------------------------------------)
90016 FORMAT (1H ,18X,17HSUBSET LEVEL TEST)
C
C FORMAT STATEMENTS FOR RUN SUMMARY
C
90020 FORMAT (1H ,19X,I5,13H TESTS FAILED)
90022 FORMAT (1H ,19X,I5,13H TESTS PASSED)
90024 FORMAT (1H ,19X,I5,14H TESTS DELETED)
END
*END-OF,FM413
FM500.f 481036388 170 2 100666 29102 `
*HEADER,FORTR,FM500
*FILES1,FORTR,FM500
C***********************************************************************
C***** FORTRAN 77
C***** FM500
C***** BLKD1 - (260)
C***** THIS PROGRAM USES SN501 AND AN502
C***********************************************************************
C***** TESTING OF BLOCK DATA SUBPROGRAMS FEATURES ANS REF
C***** IMPLICIT, PARAMETER, EXTERNAL, AND SAVE 16
C***** THIS SEGMENT USES BLOCK DATA PROGRAM
C***** AN502 AND SUBROUTINE SN501
C*****
C***** S P E C I F I C A T I O N S SEGMENT 260
EXTERNAL AN502
C***** DECLARATION OF VARIABLES IN COMMON BLOCKS
C***** PARAMETER (KPI = 2, LPI = 10)
C***** INTEGER FXVI
C***** REAL JX1S
C***** DOUBLE PRECISION AX1D, BX4D
C***** DIMENSION BX4D(KPI, KPI, KPI, KPI)
C***** COMPLEX AXVC, BX1C, CZ5C
C***** LOGICAL AXVB, BZ1B, CX6B(2,2,2,2,2,2)
C***** CHARACTER*1 A1XVK, B1X1K, C1X7K
C***** CHARACTER*2 D2Z1K
C***** CHARACTER*4 E4XVK, G4X2K
C***** CHARACTER*(LPI) I10XVK
C*****
C***** COMMON /BLK1/ IXVI, FXVI, KX1I(2), HX2I(2,2), MX2I(2,2)
C***** COMMON /BLK2/ AXVS, BXVS, JX1S(2), CX2S(2,2), DZ3S(2,2,2), EZVS
C***** COMMON /BLK3/ RXVD, AX1D(2), BX4D
C***** COMMON /BLK4/ AXVC, BX1C(2), CZ5C(2,2,2,2,2)
C***** COMMON /BLK5/ AXVB, BZ1B(2), CX6B
C***** COMMON /BLK6/ A1XVK, B1X1K(2), C1X7K(2,2,2,2,2,2,2),
C***** S2XVK, D2Z1K(2), E4XVK, G4X2K(2,2), I10XVK
C*****
CALL SN501
STOP
C***** END OF TEST SEGMENT 260
END
*HEADER,FORTR,FM500,SUBRTN,FM501
C***********************************************************************
C***** FORTRAN 77
C***** FM501 SN501 - (251)
C***** THIS SUBROUTINE IS CALLED BY PROGRAM FM500
C***********************************************************************
C*****
C***** GENERAL PURPOSE
C***** THIS SEGMENT IS TO BE RUN WITH TEST SEGMENT 250
C***** THIS SEGMENT CONTAINS A SUBROUTINE THAT CHECKS TO SEE IF
C***** IF THE BLOCK DATA PROGRAM CORRECTLY INITIALIZED THE MANY
C***** VARIABLES
C*****
CBB** ********************** BBCCOMNT **********************************
C****
C**** 1978 FORTRAN COMPILER VALIDATION SYSTEM
C**** VERSION 2.0
C****
C****
C**** SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO
C**** GENERAL SERVICES ADMINISTRATION
C**** FEDERAL SOFTWARE TESTING CENTER
C**** 5203 LEESBURG PIKE, SUITE 1100
C**** FALLS CHURCH, VA. 22041
C****
C**** (703) 756-6153
C****
CBE** ********************** BBCCOMNT **********************************
SUBROUTINE SN501
C*****
IMPLICIT INTEGER (H)
IMPLICIT DOUBLE PRECISION (R)
IMPLICIT CHARACTER*2 (S)
C***** DECLARATION OF VARIABLES IN COMMON BLOCKS
PARAMETER (KPI = 2, LPI = 10)
INTEGER FXVI
REAL JX1S
DOUBLE PRECISION AX1D, BX4D, DVCORR
DIMENSION BX4D(KPI, KPI, KPI, KPI)
COMPLEX AXVC, BX1C, CZ5C
LOGICAL AXVB, BZ1B, CX6B(2,2,2,2,2,2)
CHARACTER*1 A1XVK, B1X1K, C1X7K, CVNC01
CHARACTER*2 D2Z1K, CVNC02
CHARACTER*4 E4XVK, G4X2K, CVNC04
CHARACTER*(LPI) I10XVK, CVNC10
C*****
COMMON /BLK1/ IXVI, FXVI, KX1I(2), HX2I(2,2), MX2I(2,2)
COMMON /BLK2/ AXVS, BXVS, JX1S(2), CX2S(2,2), DZ3S(2,2,2), EZVS
COMMON /BLK3/ RXVD, AX1D(2), BX4D
COMMON /BLK4/ AXVC, BX1C(2), CZ5C(2,2,2,2,2)
COMMON /BLK5/ AXVB, BZ1B(2), CX6B
COMMON /BLK6/ A1XVK, B1X1K(2), C1X7K(2,2,2,2,2,2,2),
1 S2XVK, D2Z1K(2), E4XVK, G4X2K(2,2), I10XVK
C*****
SAVE/BLK6/
C*****
EQUIVALENCE (NYVI, EZVS)
C***** LOCAL DECLARATIONS
DOUBLE PRECISION AVD
COMPLEX AVC
C***** O U T P U T T A P E ASSIGNMENT STATEMENT. NO INPUT TAPE.
CBB** ********************** BBCINITA **********************************
C**** SPECIFICATION STATEMENTS
C****
CHARACTER ZVERS*13, ZVERSD*17, ZDATE*17, ZPROG*5, ZCOMPL*20,
1 ZNAME*20, ZTAPE*10, ZPROJ*13, REMRKS*31, ZTAPED*13
CBE** ********************** BBCINITA **********************************
CBB** ********************** BBCINITB **********************************
C**** INITIALIZE SECTION
DATA ZVERS, ZVERSD, ZDATE
1 /'VERSION 2.0 ', '82/08/02*18.33.46', '*NO DATE*TIME'/
DATA ZCOMPL, ZNAME, ZTAPE
1 /'*NONE SPECIFIED*', '*NO COMPANY NAME*', '*NO TAPE*'/
DATA ZPROJ, ZTAPED, ZPROG
1 /'*NO PROJECT*', '*NO TAPE DATE', 'XXXXX'/
DATA REMRKS /' '/
C**** THE FOLLOWING 9 COMMENT LINES (CZ01, CZ02, ...) CAN BE REPLACED
C**** FOR IDENTIFYING THE TEST ENVIRONMENT
C****
CZ01 ZVERS = 'VERSION OF THE COMPILER VALIDATION SYSTEM'
CZ02 ZVERSD = 'CREATION DATE/TIME OF THE COMPILER VALIDATION SYSTEM'
CZ03 ZPROG = 'PROGRAM NAME'
CZ04 ZDATE = 'DATE OF TEST'
CZ05 ZCOMPL = 'COMPILER IDENTIFICATION'
CZ06 ZPROJ = 'PROJECT NUMBER/IDENTIFICATION'
CZ07 ZNAME = 'NAME OF USER'
CZ08 ZTAPE = 'TAPE OWNER/ID'
CZ09 ZTAPED = 'DATE TAPE COPIED'
C
IVPASS = 0
IVFAIL = 0
IVDELE = 0
IVINSP = 0
IVTOTL = 0
IVTOTN = 0
ICZERO = 0
C
C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER.
I01 = 05
C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER.
I02 = 06
C
CX010 REPLACED BY FEXEC X-010 CONTROL CARD (CARD-READER UNIT NUMBER).
C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5
CX011 REPLACED BY FEXEC X-011 CONTROL CARD. CX011 IS FOR SYSTEMS
C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX010.
C
CX020 REPLACED BY FEXEC X-020 CONTROL CARD (PRINTER UNIT NUMBER).
C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02= 6
CX021 REPLACED BY FEXEC X-021 CONTROL CARD. CX021 IS FOR SYSTEMS
C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX020.
C
CBE** ********************** BBCINITB **********************************
NWVI = I02
IVTOTL = 37
ZPROG='FM500'
CBB** ********************** BBCHED0A **********************************
C****
C**** WRITE REPORT TITLE
C****
WRITE (I02, 90002)
WRITE (I02, 90006)
WRITE (I02, 90007)
WRITE (I02, 90008) ZVERS, ZVERSD
WRITE (I02, 90009) ZPROG, ZPROG
WRITE (I02, 90010) ZDATE, ZCOMPL
CBE** ********************** BBCHED0A **********************************
C*****
WRITE(NWVI,26000)
26000 FORMAT( / 40H BLKD1 - (260) BLOCK DATA SUBPROGRAMS --/
1 37H IMPLICIT, PARAMETER, EXTERNAL, SAVE//
2 15H ANS REF. - 16)
C*****
CBB** ********************** BBCHED0B **********************************
C**** WRITE DETAIL REPORT HEADERS
C****
WRITE (I02,90004)
WRITE (I02,90004)
WRITE (I02,90013)
WRITE (I02,90014)
WRITE (I02,90015) IVTOTL
CBE** ********************** BBCHED0B **********************************
C**** TO DELETE A TEST USED CODE SHOWN IN TEST 1
C**** REPLACE THE DELETE COMMENT WITH DELETE CODE
CT001* TEST 1 INTEGER VARIABLE
IVTNUM=1
WRITE (NWVI,70140)
IVCORR=5
40010 IF (IXVI - 5) 20010,10010,20010
10010 IVPASS=IVPASS+1
WRITE (NWVI,80002) IVTNUM
GO TO 0011
20010 IVFAIL=IVFAIL+1
WRITE (NWVI,80008) IVTNUM
WRITE (NWVI,80024) IXVI
WRITE (NWVI,80026) IVCORR
0011 CONTINUE
CT002* TEST 2 INTEGER DECLARE VARIABLE
IVTNUM = 2
IVCORR=6
IF (FXVI - 6) 20020,10020,20020
10020 IVPASS=IVPASS+1
WRITE (NWVI,80002) IVTNUM
GO TO 0021
20020 IVFAIL=IVFAIL+1
WRITE (NWVI,80008) IVTNUM
WRITE (NWVI,80024) FXVI
WRITE (NWVI,80026) IVCORR
0021 CONTINUE
CT003* TEST 3 INTEGER ARRAY
IVTNUM = 3
IVCORR=8
IF (KX1I(2) - 8) 20030,10030,20030
10030 IVPASS=IVPASS+1
WRITE (NWVI,80002) IVTNUM
GO TO 0031
20030 IVFAIL=IVFAIL+1
WRITE (NWVI,80008) IVTNUM
WRITE (NWVI,80024) KX1I(2)
WRITE (NWVI,80026) IVCORR
0031 CONTINUE
CT004* TEST 4 IMPLICIT INTEGER ARRAY
IVTNUM = 4
IVCORR=1
IF (HX2I(1,2) - 1) 20040,10040,20040
10040 IVPASS=IVPASS+1
WRITE (NWVI,80002) IVTNUM
GO TO 0041
20040 IVFAIL=IVFAIL+1
WRITE (NWVI,80008) IVTNUM
WRITE (NWVI,80024) HX2I(1,2)
WRITE (NWVI,80026) IVCORR
0041 CONTINUE
CT005* TEST 5
IVTNUM = 5
IVCORR=5
IF (HX2I(2,2) - 5) 20050,10050,20050
10050 IVPASS=IVPASS+1
WRITE (NWVI,80002) IVTNUM
GO TO 0051
20050 IVFAIL=IVFAIL+1
WRITE (NWVI,80008) IVTNUM
WRITE (NWVI,80024) HX2I(2,2)
WRITE (NWVI,80026) IVCORR
0051 CONTINUE
CT006* TEST 6 DO INITIALIZE INTEGER ARRAY
IVTNUM = 6
IVINSP=IVINSP+1
WRITE (NWVI,80004) IVTNUM
DO 70101 KVI = 1, 2
IVI = MX2I(KVI, KVI) - 4
WRITE (NWVI, 70100) IVI
70101 CONTINUE
CT007* TEST 7 REAL VARIABLE
IVTNUM = 7
RVCORR=5.3
RVCOMP=0.0
RVCOMP=AXVS - 5.3
IF (RVCOMP + .00005) 20070,10070,40070
40070 IF (RVCOMP - .00005) 10070,10070,20070
10070 IVPASS=IVPASS+1
WRITE (NWVI,80002) IVTNUM
GO TO 0071
20070 IVFAIL=IVFAIL+1
WRITE (NWVI,80008) IVTNUM
WRITE (NWVI,80028) AXVS
WRITE (NWVI,80030) RVCORR
0071 CONTINUE
CT008* TEST 8 EXTENDED PRECISION REAL
IVTNUM = 8
AVS = BXVS - 1.23456789012345
RVCOMP=1.23456789012345
IF (AVS + .00005) 20080,10080,40080
40080 IF (AVS - .00005) 10080,10080,20080
10080 IVPASS=IVPASS+1
WRITE (NWVI,80002) IVTNUM
GO TO 0081
20080 IVFAIL=IVFAIL+1
WRITE (NWVI,80004) IVTNUM
70080 FORMAT (1H ,16X,10HCOMPUTED: ,E20.14)
WRITE (NWVI,70080) BXVS
70081 FORMAT (1H ,16X,10HCORRECT: ,E20.14)
WRITE (NWVI, 70081) RVCOMP
0081 CONTINUE
CT009* TEST 9 DECLARED REAL ARRAY
IVTNUM = 9
RVCORR=2.45
RVCOMP=2.0
RVCOMP=(JX1S(1) - 2.45)
IF (RVCOMP + .00005) 20090,10090,40090
40090 IF (RVCOMP - .00005) 10090,10090,20090
10090 IVPASS=IVPASS+1
WRITE (NWVI,80002) IVTNUM
GO TO 0091
20090 IVFAIL=IVFAIL+1
WRITE (NWVI,80008) IVTNUM
WRITE (NWVI,80028) JX1S(1)
WRITE (NWVI,80030) RVCORR
0091 CONTINUE
CT010* TEST 10
IVTNUM = 10
RVCORR=4.58
RVCOMP=2.0
RVCOMP=(JX1S(2) - 4.58)
40100 IF (RVCOMP + .00005) 20100,10100,40101
40101 IF (RVCOMP - .00005) 10100,10100,20100
10100 IVPASS=IVPASS+1
WRITE (NWVI,80002)
GO TO 0100
20100 IVFAIL=IVFAIL+1
WRITE (NWVI,80008) IVTNUM
WRITE (NWVI,80028) JX1S(2)
WRITE (NWVI,80030) RVCORR
0100 CONTINUE
CT011* TEST 11 REAL ARRAY - NAME ONLY
IVTNUM = 11
IVINSP=IVINSP+1
WRITE (NWVI,80004) IVTNUM
DO 70103 KVI = 1, 2
AVS = CX2S(KVI, KVI) - 1.2
WRITE (NWVI, 70102) AVS
70103 CONTINUE
CT012* TEST 12 EQUIVALENCED REAL ARRAY
IVTNUM = 12
IVINSP=IVINSP+1
WRITE (NWVI,80004) IVTNUM
DO 70104 KVI=1,2
AVS = DZ3S(KVI, KVI, KVI) - 1.1
WRITE (NWVI, 70102) AVS
70104 CONTINUE
CT013* TEST 13 REAL VARIABLE - EQUIVALENCED INTEGER
IVTNUM = 13
IVCORR=34
IVI = NYVI - 34
40130 IF (IVI - 0) 20130,10130,20130
10130 IVPASS=IVPASS+1
WRITE (NWVI,80002) IVTNUM
GO TO 0131
20130 IVFAIL=IVFAIL+1
WRITE (NWVI,80008) IVTNUM
WRITE (NWVI,80028) NYVI
WRITE (NWVI,80026) IVCORR
0131 CONTINUE
CT014* TEST 14 DOUBLE PRECISION ARRAY
IVTNUM = 14
KVI=1
AVD = AX1D(KVI) - 1.456D3
DVCORR=1.456D3
IF (AVD + .0000000005) 20140,40141,40140
40140 IF (AVD - .0000000005) 40141,40141,20140
40141 KVI=2
AVD = AX1D(KVI) - 1.456D3
IF (AVD + .0000000005) 20140,10140,40142
40142 IF (AVD - .0000000005) 10140,10140,20140
10140 IVPASS=IVPASS+1
WRITE (NWVI,80002) IVTNUM
GO TO 0141
20140 IVFAIL=IVFAIL+1
WRITE (NWVI,80008) IVTNUM
WRITE (NWVI, 80033) AX1D(KVI)
WRITE (NWVI,80035) DVCORR
0141 CONTINUE
CT015* TEST 15 DIMENSION DOUBLE PRECISION ARRAY
IVTNUM = 15
AVD = BX4D(1,2,1,1) - 34.9D8
IF (AVD + .0000000005) 20150,10150,40150
40150 IF (AVD - .0000000005) 10150,10150,20150
10150 IVPASS=IVPASS+1
WRITE (NWVI,80002) IVTNUM
GO TO 0151
20150 IVFAIL=IVFAIL+1
DVCORR=34.9D8
WRITE (NWVI,80008) IVTNUM
WRITE (NWVI, 80033) BX4D(1,2,1,1)
WRITE (NWVI,80035) DVCORR
0151 CONTINUE
CT016* TEST 16
IVTNUM = 16
DVCORR=0.00
AVD = BX4D(1,2,1,2) - 2.123D0
IF (AVD + .0000000005) 20160,10160,40160
40160 IF (AVD - .0000000005) 10160,10160,20160
10160 IVPASS=IVPASS+1
WRITE (NWVI,80002) IVTNUM
GO TO 0161
20160 IVFAIL=IVFAIL+1
DVCORR=2.123D0
WRITE (NWVI,80008) IVTNUM
WRITE (NWVI, 80033) BX4D(1,2,1,2)
WRITE (NWVI,80035) DVCORR
0161 CONTINUE
CT017* TEST 17
IVTNUM = 17
DVCORR=0.00
AVD = BX4D(2,1,1,2) - 873.84D-1
IF (AVD + .0000000005) 20170,10170,40170
40170 IF (AVD - .0000000005) 10170,10170,20170
10170 IVPASS=IVPASS+1
WRITE (NWVI,80002) IVTNUM
GO TO 0171
20170 IVFAIL=IVFAIL+1
WRITE (NWVI,80008) IVTNUM
DVCORR=873.84D-1
WRITE (NWVI, 80033) BX4D(2,1,1,2)
WRITE (NWVI,80035) DVCORR
0171 CONTINUE
CT018* TEST 18 COMPLEX VARIABLE
IVTNUM = 18
AVC = AXVC - (1.5, 2.3)
IVINSP=IVINSP+1
WRITE (NWVI,80004) IVTNUM
WRITE (NWVI,70107) AVC
CT019* TEST 19 COMPLEX ARRAY
IVTNUM = 19
AVC = BX1C(1) - (1.1, 1.2)
IVINSP=IVINSP+1
WRITE (NWVI,80004) IVTNUM
WRITE (NWVI, 70107) AVC
CT020* TEST 20
IVTNUM = 20
AVC = BX1C(2) - (3.2, 2.3)
IVINSP=IVINSP+1
WRITE (NWVI,80004) IVTNUM
WRITE (NWVI, 70107) AVC
CT021* TEST 21 COMPLEX ARRAY - EQUIVALENCE
IVTNUM = 21
AVC = CZ5C(1,1,1,2,1) - (1.2, 2.1)
IVINSP=IVINSP+1
WRITE (NWVI,80004) IVTNUM
WRITE (NWVI, 70107) AVC
CT022* TEST 22
IVTNUM = 22
AVC = CZ5C(1,2,1,1,2) - (45.3, 2.1)
IVINSP=IVINSP+1
WRITE (NWVI,80004) IVTNUM
WRITE (NWVI, 70107) AVC
CT023* TEST 23
IVTNUM = 23
AVC = CZ5C(2,1,1,1,2) - (309.89, 102.1)
IVINSP=IVINSP+1
WRITE (NWVI,80004) IVTNUM
WRITE (NWVI, 70107) AVC
CT024* TEST 24 LOGICAL VARIABLE
IVTNUM = 24
IVCOMP=0
IF (AXVB) IVCOMP=1
40240 IF (IVCOMP-1) 20240,10240,20240
10240 IVPASS=IVPASS+1
WRITE (NWVI,80002) IVTNUM
GO TO 0241
20240 IVFAIL=IVFAIL+1
WRITE (NWVI,80008) IVTNUM
0241 CONTINUE
CT025* TEST 25 LOGICAL ARRAY - EQUIVALENCE
IVTNUM = 25
IVCOMP=0
IF (.NOT. BZ1B(2)) IVCOMP=1
40250 IF (IVCOMP-1) 20250,10250,20250
10250 IVPASS=IVPASS+1
WRITE (NWVI,80002) IVTNUM
GO TO 0251
20250 IVFAIL=IVFAIL+1
WRITE (NWVI,80008) IVTNUM
0251 CONTINUE
CT026* TEST 26 DECLARED LOGICAL ARRAY
IVTNUM = 26
IVCOMP=0
IF (CX6B(1,1,1,2,2,1)) IVCOMP=1
40260 IF (IVCOMP-1) 20260,10260,20260
10260 IVPASS=IVPASS+1
WRITE (NWVI,80002) IVTNUM
GO TO 0261
20260 IVFAIL=IVFAIL+1
WRITE (NWVI,80008) IVTNUM
0261 CONTINUE
CT027* TEST 27 1 CHARACTER VARIABLE
IVTNUM = 27
CVNC01='A'
IVCOMP=0
IF (A1XVK .EQ. 'A') IVCOMP=1
40270 IF (IVCOMP-1) 20270,10270,20270
10270 IVPASS=IVPASS+1
WRITE (NWVI,80002) IVTNUM
GO TO 0271
20270 IVFAIL=IVFAIL+1
WRITE (NWVI,80008) IVTNUM
WRITE (NWVI,80020) A1XVK
WRITE (NWVI,80022) CVNC01
0271 CONTINUE
CT028* TEST 28 1 CHARACTER ARRAY
IVTNUM = 28
CVNC01='K'
IVCOMP=0
IF (B1X1K(1) .EQ. 'K') IVCOMP=1
40280 IF (IVCOMP-1) 20280,10280,20280
10280 IVPASS=IVPASS+1
WRITE (NWVI,80002) IVTNUM
GO TO 0281
20280 IVFAIL=IVFAIL+1
WRITE (NWVI,80008) IVTNUM
WRITE (NWVI,80020) B1X1K(1)
WRITE (NWVI,80022) CVNC01
0281 CONTINUE
CT029* TEST 29
IVTNUM = 29
CVNC01='K'
IVCOMP=0
IF (B1X1K(2) .EQ. 'K') IVCOMP=1
IF (IVCOMP-1) 20290,10290,20290
10290 IVPASS=IVPASS+1
WRITE (NWVI,80002) IVTNUM
GO TO 0291
20290 IVFAIL=IVFAIL+1
WRITE (NWVI,80008) IVTNUM
WRITE (NWVI,80020) B1X1K(2)
WRITE (NWVI,80022) CVNC01
0291 CONTINUE
CT030* TEST 30 7 DIMENSION 1 CHARACTER ARRAY
IVTNUM = 30
CVNC01='X'
IVCOMP=0
KVI=1
IF (C1X7K(KVI,KVI,KVI,KVI,KVI,KVI,KVI) .EQ. 'X') IVCOMP=1
40300 IF(IVCOMP-1) 20300,40301,20300
40301 KVI=2
IVCOMP=0
IF (C1X7K(KVI,KVI,KVI,KVI,KVI,KVI,KVI) .EQ. 'X') IVCOMP=1
40302 IF (IVCOMP-1) 20300,40303,20300
40303 IVPASS=IVPASS+1
WRITE (NWVI,80002) IVTNUM
GO TO 0301
20300 IVFAIL=IVFAIL+1
WRITE (NWVI,80008) IVTNUM
WRITE (NWVI,80020) C1X7K(KVI,KVI,KVI,KVI,KVI,KVI,KVI)
WRITE (NWVI,80022) CVNC01
0301 CONTINUE
CT031* TEST 31 IMPLICIT 2 CHARACTER VARIABLE
IVTNUM = 31
CVNC02='.,'
IVCOMP=0
IF (S2XVK .EQ. '.,') IVCOMP=1
40310 IF (IVCOMP-1) 20310,10310,20310
10310 IVPASS=IVPASS+1
WRITE (NWVI,80002) IVTNUM
GO TO 0311
20310 IVFAIL=IVFAIL+1
WRITE (NWVI,80008) IVTNUM
WRITE (NWVI,80020) S2XVK
WRITE (NWVI,80022) CVNC02
0311 CONTINUE
CT032* TEST 32 2 CHARACTER ARRAY - EQUIVALENCED
IVTNUM = 32
CVNC02='TE'
IVCOMP=0
IF (D2Z1K(1) .EQ. 'TE') IVCOMP=1
40320 IF (IVCOMP-1) 20320,10320,20320
10320 IVPASS=IVPASS+1
WRITE (NWVI,80002) IVTNUM
GO TO 0321
20320 IVFAIL=IVFAIL+1
WRITE (NWVI,80008) IVTNUM
WRITE (NWVI,80020) D2Z1K(1)
WRITE (NWVI,80022) CVNC02
0321 CONTINUE
CT033* TEST 33
IVTNUM = 33
CVNC02='ST'
IVCOMP=0
IF (D2Z1K(2) .EQ. 'ST') IVCOMP=1
40330 IF (IVCOMP-1) 20330,10330,20330
10330 IVPASS=IVPASS+1
WRITE (NWVI,80002) IVTNUM
GO TO 0331
20330 IVFAIL=IVFAIL+1
WRITE (NWVI,80008) IVTNUM
WRITE (NWVI,80020) D2Z1K(2)
WRITE (NWVI,80022) CVNC02
0331 CONTINUE
CT034* TEST 34 DECLARED 4 CHARACTER VARIABLE
IVTNUM = 34
CVNC04='ZXCV'
IVCOMP=0
IF (E4XVK .EQ. 'ZXCV') IVCOMP=1
40340 IF (IVCOMP-1) 20340,10340,20340
10340 IVPASS=IVPASS+1
WRITE (NWVI,80002) IVTNUM
GO TO 0341
20340 IVFAIL=IVFAIL+1
WRITE (NWVI,80008) IVTNUM
WRITE (NWVI,80020) E4XVK
WRITE (NWVI,80022) CVNC04
0341 CONTINUE
CT035* TEST 35 DECLARED 4 CHARACTER ARRAY
IVTNUM = 35
CVNC02='SO'
IVCOMP=0
IF (G4X2K(1,1) .EQ. 'SO') IVCOMP=1
40350 IF (IVCOMP-1) 20350,10350,20350
10350 IVPASS=IVPASS+1
WRITE (NWVI,80002) IVTNUM
GO TO 0351
20350 IVFAIL=IVFAIL+1
WRITE (NWVI,80008) IVTNUM
WRITE (NWVI,80020) G4X2K(1,1)
WRITE (NWVI,80022) CVNC02
0351 CONTINUE
CT036* TEST 36
IVTNUM = 36
CVNC02='OS'
IVCOMP=0
IF (G4X2K(2,1) .EQ. 'OS') IVCOMP=1
40360 IF (IVCOMP-1) 20360,10360,20360
10360 IVPASS=IVPASS+1
WRITE (NWVI,80002) IVTNUM
GO TO 0361
20360 IVFAIL=IVFAIL+1
WRITE (NWVI,80008) IVTNUM
WRITE (NWVI,80020) G4X2K(2,1)
WRITE (NWVI,80022) CVNC02
0361 CONTINUE
CT037* TEST 37 CHARACTER VARIABLE - PARAMTER LENGTH
IVTNUM = 37
CVNC10='FINAL TEST'
IVCOMP=0
IF (I10XVK .EQ. 'FINAL TEST') IVCOMP=1
40370 IF (IVCOMP-1) 20370, 10370, 20370
10370 IVPASS=IVPASS+1
WRITE (NWVI,80002) IVTNUM
GO TO 0371
20370 IVFAIL=IVFAIL+1
WRITE (NWVI,80008) IVTNUM
WRITE (NWVI,80020) I10XVK
WRITE (NWVI,80022) CVNC10
0371 CONTINUE
C*****
70100 FORMAT(1H ,26X,I5)
70102 FORMAT(1H ,26X,F7.2)
70106 FORMAT(1H ,26X,F7.2)
70107 FORMAT(1H ,26X,1H(,F7.2,2H, ,F7.2,1H),4X,14HSHOULD BE ZERO)
70140 FORMAT (/49X,28HALL VISUAL ANSWERS SHOULD BE
1 /49X,27HZERO FOR TEST SEGMENT TO BE
2 /49X,10HSUCCESSFUL)
CBB** ********************** BBCSUM0 **********************************
C**** WRITE OUT TEST SUMMARY
C****
IVTOTN = IVPASS + IVFAIL + IVDELE + IVINSP
WRITE (I02, 90004)
WRITE (I02, 90014)
WRITE (I02, 90004)
WRITE (I02, 90020) IVPASS
WRITE (I02, 90022) IVFAIL
WRITE (I02, 90024) IVDELE
WRITE (I02, 90026) IVINSP
WRITE (I02, 90028) IVTOTN, IVTOTL
CBE** ********************** BBCSUM0 **********************************
CBB** ********************** BBCFOOT0 **********************************
C**** WRITE OUT REPORT FOOTINGS
C****
WRITE (I02,90016) ZPROG, ZPROG
WRITE (I02,90018) ZPROJ, ZNAME, ZTAPE, ZTAPED
WRITE (I02,90019)
CBE** ********************** BBCFOOT0 **********************************
CBB** ********************** BBCFMT0A **********************************
C**** FORMATS FOR TEST DETAIL LINES
C****
80000 FORMAT (1H ,2X,I3,4X,7HDELETED,32X,A31)
80002 FORMAT (1H ,2X,I3,4X,7H PASS ,32X,A31)
80004 FORMAT (1H ,2X,I3,4X,7HINSPECT,32X,A31)
80008 FORMAT (1H ,2X,I3,4X,7H FAIL ,32X,A31)
80010 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,15X,10HCOMPUTED= ,
1I6,/,1H ,15X,10HCORRECT= ,I6)
80012 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
1E12.5,/,1H ,16X,10HCORRECT= ,E12.5)
80018 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
1A21,/,1H ,16X,10HCORRECT= ,A21)
80020 FORMAT (1H ,16X,10HCOMPUTED= ,A21,1X,A31)
80022 FORMAT (1H ,16X,10HCORRECT= ,A21,1X,A31)
80024 FORMAT (1H ,16X,10HCOMPUTED= ,I6,16X,A31)
80026 FORMAT (1H ,16X,10HCORRECT= ,I6,16X,A31)
80028 FORMAT (1H ,16X,10HCOMPUTED= ,E12.5,10X,A31)
80030 FORMAT (1H ,16X,10HCORRECT= ,E12.5,10X,A31)
80050 FORMAT (1H ,48X,A31)
CBE** ********************** BBCFMT0A **********************************
CBB** ********************** BBCFMAT1 **********************************
C**** FORMATS FOR TEST DETAIL LINES - FULL LANGUAGE
C****
80031 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
1D17.10,/,1H ,16X,10HCORRECT= ,D17.10)
80033 FORMAT (1H ,16X,10HCOMPUTED= ,D17.10,10X,A31)
80035 FORMAT (1H ,16X,10HCORRECT= ,D17.10,10X,A31)
80037 FORMAT (1H ,16X,10HCOMPUTED= ,1H(,E12.5,2H, ,E12.5,1H),6X,A31)
80039 FORMAT (1H ,16X,10HCORRECT= ,1H(,E12.5,2H, ,E12.5,1H),6X,A31)
80041 FORMAT (1H ,16X,10HCOMPUTED= ,1H(,F12.5,2H, ,F12.5,1H),6X,A31)
80043 FORMAT (1H ,16X,10HCORRECT= ,1H(,F12.5,2H, ,F12.5,1H),6X,A31)
80045 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
11H(,F12.5,2H, ,F12.5,1H)/,1H ,16X,10HCORRECT= ,
21H(,F12.5,2H, ,F12.5,1H))
CBE** ********************** BBCFMAT1 **********************************
CBB** ********************** BBCFMT0B **********************************
C**** FORMAT STATEMENTS FOR PAGE HEADERS
C****
90002 FORMAT (1H1)
90004 FORMAT (1H )
90006 FORMAT (1H ,20X,31HFEDERAL SOFTWARE TESTING CENTER)
90007 FORMAT (1H ,19X,34HFORTRAN COMPILER VALIDATION SYSTEM)
90008 FORMAT (1H ,21X,A13,A17)
90009 FORMAT (1H ,/,2H *,A5,6HBEGIN*,12X,15HTEST RESULTS - ,A5,/)
90010 FORMAT (1H ,8X,16HTEST DATE*TIME= ,A17,15H - COMPILER= ,A20)
90013 FORMAT (1H ,8H TEST ,10HPASS/FAIL ,6X,17HDISPLAYED RESULTS,
1 7X,7HREMARKS,24X)
90014 FORMAT (1H ,46H----------------------------------------------,
1 33H---------------------------------)
90015 FORMAT (1H ,48X,17HTHIS PROGRAM HAS ,I3,6H TESTS,/)
C****
C**** FORMAT STATEMENTS FOR REPORT FOOTINGS
C****
90016 FORMAT (1H ,/,2H *,A5,4HEND*,14X,14HEND OF TEST - ,A5,/)
90018 FORMAT (1H ,A13,13X,A20,7H * ,A10,1H/,
1 A13)
90019 FORMAT (1H ,26HFOR OFFICIAL USE ONLY ,35X,15HCOPYRIGHT 1982)
C****
C**** FORMAT STATEMENTS FOR RUN SUMMARY
C****
90020 FORMAT (1H ,21X,I5,13H TESTS PASSED)
90022 FORMAT (1H ,21X,I5,13H TESTS FAILED)
90024 FORMAT (1H ,21X,I5,14H TESTS DELETED)
90026 FORMAT (1H ,21X,I5,25H TESTS REQUIRE INSPECTION)
90028 FORMAT (1H ,21X,I5,4H OF ,I3,15H TESTS EXECUTED)
CBE** ********************** BBCFMT0B **********************************
C*****
RETURN
END
*HEADER,FORTR,FM500,SUBRTN,FM502
C***********************************************************************
C***** FORTRAN 77
C***** FM502 AN502
C***** THIS BLOCK DATA SUBPROGRAM IS USED BY MIAN PROGRAM FM500
C***********************************************************************
C*****
C***** GENERAL PURPOSE
C***** THIS SEGMENT CONTAINS A BLOCK DATA SUBPROGRAM THAT IS
C***** TO BE RUN WITH SEGMENT FM500
C***** THIS SEGMENT WILL USE IMPLICIT, PARAMETER, EXTERNAL
C***** AND SAVE STATEMENTS WITHIN IT.
C*****
BLOCK DATA AN502
C*****
IMPLICIT INTEGER (H)
IMPLICIT DOUBLE PRECISION (R)
IMPLICIT CHARACTER*2 (S)
C*****
SAVE/BLK6/
C***** DECLARATION OF VARIABLES IN COMMON BLOCKS
PARAMETER (KPI = 2, LPI = 10)
INTEGER FXVI
REAL JX1S
DOUBLE PRECISION AX1D, BX4D
DIMENSION BX4D(KPI, KPI, KPI, KPI)
COMPLEX AXVC, BX1C, CZ5C
LOGICAL AXVB, BZ1B, CX6B(2,2,2,2,2,2)
CHARACTER*1 A1XVK, B1X1K, C1X7K
CHARACTER*2 D2Z1K
CHARACTER*4 E4XVK, G4X2K
CHARACTER*(LPI) I10XVK
C*****
COMMON /BLK1/ IXVI, FXVI, KX1I(2), HX2I(2,2), MX2I(2,2)
COMMON /BLK2/ AXVS, BXVS, JX1S(2), CX2S(2,2), DZ3S(2,2,2), EZVS
COMMON /BLK3/ RXVD, AX1D(2), BX4D
COMMON /BLK4/ AXVC, BX1C(2), CZ5C(2,2,2,2,2)
COMMON /BLK5/ AXVB, BZ1B(2), CX6B
COMMON /BLK6/ A1XVK, B1X1K(2), C1X7K(2,2,2,2,2,2,2),
1 S2XVK, D2Z1K(2), E4XVK, G4X2K(2,2), I10XVK
C***** DECLARATION OF VARIABLES FOR EQUIVALENCE STATEMENTS
DIMENSION AY3S(2,2,2)
COMPLEX AY5C (2,2,2,2,2)
LOGICAL AY1B(2)
CHARACTER*2 A2Y1K(2)
CHARACTER*1 APK
PARAMETER (IPI = 5, APS = 5.3, JPI = 2, APK = 'X', MPI = 128)
C*****
EQUIVALENCE (AY3S, DZ3S)
EQUIVALENCE (NYVI, EZVS)
EQUIVALENCE (AY5C, CZ5C)
EQUIVALENCE (AY1B, BZ1B)
EQUIVALENCE (A2Y1K, D2Z1K)
C*****
DATA IXVI, FXVI, KX1I(2), HX2I(1,2), HX2I(2,2),
1 ((MX2I(IVI, JVI), IVI=1,2), JVI=1,2) /IPI, 6, 8, 1, 5, 4*4/
DATA AXVS, BXVS, JX1S(1), JX1S(2), CX2S /APS, 1.23456789012345,
1 2.45, 4.58, 4*1.2/
DATA AY3S / 8*1.1/
DATA NYVI /34/
DATA AX1D, BX4D(1,2,1,1), BX4D(1,2,1,2), BX4D(2,1,1,2)
1 /JPI*1.456D3, 34.9D8, 2.123D0, 873.84D-1/
DATA AXVC /(1.5, 2.3)/
DATA AY5C(1,1,1,2,1), AY5C(1,2,1,1,2), AY5C(2,1,1,1,2)
1 /(1.2, 2.1), (45.3, 2.1), (309.89, 102.1)/
DATA BX1C(1), BX1C(2), AXVB /(1.1, 1.2), (3.2, 2.3), .TRUE./
DATA AY1B(2), CX6B(1,1,1,2,2,1) /.FALSE., .TRUE./
DATA A1XVK, C1X7K, S2XVK, A2Y1K(1), A2Y1K(2), E4XVK, G4X2K(1,1),
1 G4X2K(2,1), I10XVK, (B1X1K(IVI), IVI=1,2)
2 /'A', MPI*APK, '.,', 'TE', 'ST', 'ZXCV', 'SO', 'OS',
3 'FINAL TEST', 2*'K'/
C*****
END
*END-OF,FM500
FM503.f 481036392 170 2 100666 14469 `
*HEADER,FORTR,FM503
*FILES1,FORTR,FM503
C***********************************************************************
C***** FORTRAN 77
C***** FM503
C***** BLKD2 - (261)
C***** THIS PROGRAM USES FM504 (UNNAMED BLOCK DATA SUBPROGRAM
C***** AND SUBROUTINE SN505
C***********************************************************************
C***** TESTING OF BLOCK DATA SUBPROGRAMS ANS REF
C***** DATA INTERNAL FORMS 16
C***** THIS SEGMENT USES SEGMENTS 702 AND 703, BLOCK DATA PROGRAM
C***** FM504 AND SUBROUTINE SN505
C*****
CBB** ********************** BBCCOMNT **********************************
C****
C**** 1978 FORTRAN COMPILER VALIDATION SYSTEM
C**** VERSION 2.0
C****
C****
C**** SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO
C**** GENERAL SERVICES ADMINISTRATION
C**** FEDERAL SOFTWARE TESTING CENTER
C**** 5203 LEESBURG PIKE, SUITE 1100
C**** FALLS CHURCH, VA. 22041
C****
C**** (703) 756-6153
C****
CBE** ********************** BBCCOMNT **********************************
C*****
C***** S P E C I F I C A T I O N S SEGMENT 261
C*****
C***** DECLARATION OF VARIABLES IN COMMON BLOCKS
C***** DOUBLE PRECISION AXVD, DVCORR
C***** COMPLEX AXVC, ZVCORR
C***** LOGICAL AXVB
C***** CHARACTER*6 A6XVK, B6XVK, CVCORR
C*****
C***** COMMON /BLK9/ AXVS, BXVS, IXVI, AXVD, AXVC, AXVB
C***** COMMON /BLK7/ A6XVK, B6XVK
C*****
C*****
CALL SN505
STOP
C*****
C***** END OF TEST SEGMENT 261
END
*HEADER,FORTR,FM503,SUBRTN,FM504
C***********************************************************************
C***** FORTRAN 77
C***** FM504 BDS2 (UNNAMED) - (702)
C***** THIS BLOCK DATA SUBPROGRAM IS USED BY FM503
C***********************************************************************
C*****
C***** GENERAL PURPOSE
C***** THIS SEGMENT CONTAINS A BLOCK DATA SUBPROGRAM THAT IS
C***** TO BE RUN WITH TEST SEGMENT 261
C***** THIS SEGMENT WILL TEST INTERNAL DATA FORMS, AS WELL
C***** AS THE USE OF UNNAMED BLOCK DATA PROGRAM
C*****
BLOCK DATA
C*****
C***** DECLARATION OF VARIABLES IN COMMON BLOCKS
DOUBLE PRECISION AXVD
COMPLEX AXVC
LOGICAL AXVB
CHARACTER*6 A6XVK, B6XVK
C*****
COMMON /BLK9/ AXVS, BXVS, IXVI, AXVD, AXVC, AXVB
COMMON /BLK7/ A6XVK, B6XVK
DATA AXVS, BXVS, IXVI, AXVD, AXVC, AXVB /34.25E-1, 43.23, 21,
1 1.23456, (234.23, 34.9), .TRUE./
DATA A6XVK, B6XVK /'ABCDE', 'FGHIJK'/
C*****
END
*HEADER,FORTR,FM503,SUBRTN,FM505
C***********************************************************************
C***** FORTRAN 77
C***** FM505 BLKD2Q - (703)
C***** THIS SUBROUTINE IS CALLED BY FM503
C***********************************************************************
C*****
C***** GENERAL PURPOSE
C***** THIS SEGMENT IS TO BE RUN WITH TEST SEGMENT 261
C***** THIS SEGMENT CONTAINS A SUBROUTINE THAT CHECKS TO SEE IF
C***** IF THE BLOCK DATA PROGRAM CORRECTLY INITIALIZED THE MANY
C***** VARIABLES
C*****
SUBROUTINE SN505
C*****
C*****
C***** DECLARATION OF VARIABLES IN COMMON BLOCKS
DOUBLE PRECISION AXVD, DVCORR
COMPLEX AXVC, ZVCORR
LOGICAL AXVB
CHARACTER*6 A6XVK, B6XVK, CVCORR
C*****
COMMON /BLK9/ AXVS, BXVS, IXVI, AXVD, AXVC, AXVB
COMMON /BLK7/ A6XVK, B6XVK
C***** LOCAL DECLARATION
DOUBLE PRECISION AVD
COMPLEX AVC
REAL R2E(2)
EQUIVALENCE (AVC, R2E)
C*****
CBB** ********************** BBCINITA **********************************
C**** SPECIFICATION STATEMENTS
C****
CHARACTER ZVERS*13, ZVERSD*17, ZDATE*17, ZPROG*5, ZCOMPL*20,
1 ZNAME*20, ZTAPE*10, ZPROJ*13, REMRKS*31, ZTAPED*13
CBE** ********************** BBCINITA **********************************
CBB** ********************** BBCINITB **********************************
C**** INITIALIZE SECTION
DATA ZVERS, ZVERSD, ZDATE
1 /'VERSION 2.0 ', '82/08/02*18.33.46', '*NO DATE*TIME'/
DATA ZCOMPL, ZNAME, ZTAPE
1 /'*NONE SPECIFIED*', '*NO COMPANY NAME*', '*NO TAPE*'/
DATA ZPROJ, ZTAPED, ZPROG
1 /'*NO PROJECT*', '*NO TAPE DATE', 'XXXXX'/
DATA REMRKS /' '/
C**** THE FOLLOWING 9 COMMENT LINES (CZ01, CZ02, ...) CAN BE REPLACED
C**** FOR IDENTIFYING THE TEST ENVIRONMENT
C****
CZ01 ZVERS = 'VERSION OF THE COMPILER VALIDATION SYSTEM'
CZ02 ZVERSD = 'CREATION DATE/TIME OF THE COMPILER VALIDATION SYSTEM'
CZ03 ZPROG = 'PROGRAM NAME'
CZ04 ZDATE = 'DATE OF TEST'
CZ05 ZCOMPL = 'COMPILER IDENTIFICATION'
CZ06 ZPROJ = 'PROJECT NUMBER/IDENTIFICATION'
CZ07 ZNAME = 'NAME OF USER'
CZ08 ZTAPE = 'TAPE OWNER/ID'
CZ09 ZTAPED = 'DATE TAPE COPIED'
C
IVPASS = 0
IVFAIL = 0
IVDELE = 0
IVINSP = 0
IVTOTL = 0
IVTOTN = 0
ICZERO = 0
C
C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER.
I01 = 05
C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER.
I02 = 06
C
CX010 REPLACED BY FEXEC X-010 CONTROL CARD (CARD-READER UNIT NUMBER).
C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5
CX011 REPLACED BY FEXEC X-011 CONTROL CARD. CX011 IS FOR SYSTEMS
C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX010.
C
CX020 REPLACED BY FEXEC X-020 CONTROL CARD (PRINTER UNIT NUMBER).
C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02= 6
CX021 REPLACED BY FEXEC X-021 CONTROL CARD. CX021 IS FOR SYSTEMS
C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX020.
C
CBE** ********************** BBCINITB **********************************
NUVI = I02
IVTOTL = 8
ZPROG = 'FM503'
CBB** ********************** BBCHED0A **********************************
C****
C**** WRITE REPORT TITLE
C****
WRITE (I02, 90002)
WRITE (I02, 90006)
WRITE (I02, 90007)
WRITE (I02, 90008) ZVERS, ZVERSD
WRITE (I02, 90009) ZPROG, ZPROG
WRITE (I02, 90010) ZDATE, ZCOMPL
CBE** ********************** BBCHED0A **********************************
WRITE(NUVI,26100)
26100 FORMAT( 1H , / 39H BLKD2 - (261) BLOCK DATA SUBPROGRAM --//
1 21H DATA INTERNAL FORMS//
2 15H ANS REF. - 16)
CBB** ********************** BBCHED0B **********************************
C**** WRITE DETAIL REPORT HEADERS
C****
WRITE (I02,90004)
WRITE (I02,90004)
WRITE (I02,90013)
WRITE (I02,90014)
WRITE (I02,90015) IVTOTL
CBE** ********************** BBCHED0B **********************************
C*****
CT001* TEST 1 REAL VARIABLE - EXPONENT FORM
IVTNUM = 1
AVS = AXVS
IF (AVS - 0.34248E+01) 20010, 10010, 40010
40010 IF (AVS - 0.34252E+01) 10010, 10010, 20010
10010 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0011
20010 IVFAIL = IVFAIL + 1
RVCORR = 34.25E-1
WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR
0011 CONTINUE
CT002* TEST 2 REAL VARIABLE - NON EXPONENT FORM
IVTNUM = 2
AVS = BXVS
IF (AVS - 0.43227E+02) 20020, 10020, 40020
40020 IF (AVS - 0.43233E+02) 10020, 10020, 20020
10020 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0021
20020 IVFAIL = IVFAIL + 1
RVCORR = 43.23
WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR
0021 CONTINUE
CT003* TEST 3 INTEGER VARIABLE
IVTNUM = 3
IVI = IXVI
IF (IVI - 21) 20030, 10030, 20030
10030 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0031
20030 IVFAIL = IVFAIL + 1
IVCORR = 21
WRITE (NUVI, 80010) IVTNUM, IVI, IVCORR
0031 CONTINUE
CT004* TEST 4 DOUBLE PRECISION VARIABLE
IVTNUM = 4
AVD = AXVD
IF (AVD - 0.12345D+01) 20040, 10040, 40040
40040 IF (AVD - 0.12347D+01) 10040, 10040, 20040
10040 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0041
20040 IVFAIL = IVFAIL + 1
DVCORR = 1.23456D+0
WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR
0041 CONTINUE
CT005* TEST 5 COMPLEX VARIABLE
IVTNUM = 5
AVC = AXVC
IF (R2E(1) - 0.23421E+03) 20050, 40052, 40051
40051 IF (R2E(1) - 0.23425E+03) 40052, 40052, 20050
40052 IF (R2E(2) - 0.34898E+02) 20050, 10050, 40050
40050 IF (R2E(2) - 0.34902E+02) 10050, 10050, 20050
10050 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0051
20050 IVFAIL = IVFAIL + 1
ZVCORR = (234.23, 34.9)
WRITE (NUVI, 80045) IVTNUM, AVC, ZVCORR
0051 CONTINUE
CT006* TEST 6 LOGICAL VARIABLE
IVTNUM = 6
IVI = 0
IF (AXVB) IVI = 1
IF (IVI - 1) 20060, 10060, 20060
10060 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0061
20060 IVFAIL = IVFAIL + 1
LVCORR = 1
REMRKS = '1 = TRUE ; 0 = FALSE'
WRITE (NUVI, 80008) IVTNUM, REMRKS
WRITE (NUVI, 80024) IVI
WRITE (NUVI, 80026) LVCORR
0061 CONTINUE
CT007* TEST 7 6 CHARACTER VARIABLE - INIT WITH 5 CHARACTERS
IVTNUM = 7
IVI = 0
IF (A6XVK.EQ.'ABCDE ') IVI = 1
IF (IVI - 1) 20070, 10070, 20070
10070 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0071
20070 IVFAIL = IVFAIL + 1
CVCORR = 'ABCDE '
WRITE (NUVI, 80018) IVTNUM, A6XVK, CVCORR
0071 CONTINUE
CT008* TEST 8 6 CHARACTER VARIABLE - INIT WITH 6 CHARACTERS
IVTNUM = 8
IVI = 0
IF (B6XVK.EQ.'FGHIJK') IVI = 1
IF (IVI - 1) 20080, 10080, 20080
10080 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0081
20080 IVFAIL = IVFAIL + 1
CVCORR = 'FGHIJK'
WRITE (NUVI, 80018) IVTNUM, B6XVK, CVCORR
0081 CONTINUE
C*****
CBB** ********************** BBCSUM0 **********************************
C**** WRITE OUT TEST SUMMARY
C****
IVTOTN = IVPASS + IVFAIL + IVDELE + IVINSP
WRITE (I02, 90004)
WRITE (I02, 90014)
WRITE (I02, 90004)
WRITE (I02, 90020) IVPASS
WRITE (I02, 90022) IVFAIL
WRITE (I02, 90024) IVDELE
WRITE (I02, 90026) IVINSP
WRITE (I02, 90028) IVTOTN, IVTOTL
CBE** ********************** BBCSUM0 **********************************
CBB** ********************** BBCFOOT0 **********************************
C**** WRITE OUT REPORT FOOTINGS
C****
WRITE (I02,90016) ZPROG, ZPROG
WRITE (I02,90018) ZPROJ, ZNAME, ZTAPE, ZTAPED
WRITE (I02,90019)
CBE** ********************** BBCFOOT0 **********************************
CBB** ********************** BBCFMT0A **********************************
C**** FORMATS FOR TEST DETAIL LINES
C****
80000 FORMAT (1H ,2X,I3,4X,7HDELETED,32X,A31)
80002 FORMAT (1H ,2X,I3,4X,7H PASS ,32X,A31)
80004 FORMAT (1H ,2X,I3,4X,7HINSPECT,32X,A31)
80008 FORMAT (1H ,2X,I3,4X,7H FAIL ,32X,A31)
80010 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,15X,10HCOMPUTED= ,
1I6,/,1H ,15X,10HCORRECT= ,I6)
80012 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
1E12.5,/,1H ,16X,10HCORRECT= ,E12.5)
80018 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
1A21,/,1H ,16X,10HCORRECT= ,A21)
80020 FORMAT (1H ,16X,10HCOMPUTED= ,A21,1X,A31)
80022 FORMAT (1H ,16X,10HCORRECT= ,A21,1X,A31)
80024 FORMAT (1H ,16X,10HCOMPUTED= ,I6,16X,A31)
80026 FORMAT (1H ,16X,10HCORRECT= ,I6,16X,A31)
80028 FORMAT (1H ,16X,10HCOMPUTED= ,E12.5,10X,A31)
80030 FORMAT (1H ,16X,10HCORRECT= ,E12.5,10X,A31)
80050 FORMAT (1H ,48X,A31)
CBE** ********************** BBCFMT0A **********************************
CBB** ********************** BBCFMAT1 **********************************
C**** FORMATS FOR TEST DETAIL LINES - FULL LANGUAGE
C****
80031 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
1D17.10,/,1H ,16X,10HCORRECT= ,D17.10)
80033 FORMAT (1H ,16X,10HCOMPUTED= ,D17.10,10X,A31)
80035 FORMAT (1H ,16X,10HCORRECT= ,D17.10,10X,A31)
80037 FORMAT (1H ,16X,10HCOMPUTED= ,1H(,E12.5,2H, ,E12.5,1H),6X,A31)
80039 FORMAT (1H ,16X,10HCORRECT= ,1H(,E12.5,2H, ,E12.5,1H),6X,A31)
80041 FORMAT (1H ,16X,10HCOMPUTED= ,1H(,F12.5,2H, ,F12.5,1H),6X,A31)
80043 FORMAT (1H ,16X,10HCORRECT= ,1H(,F12.5,2H, ,F12.5,1H),6X,A31)
80045 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
11H(,F12.5,2H, ,F12.5,1H)/,1H ,16X,10HCORRECT= ,
21H(,F12.5,2H, ,F12.5,1H))
CBE** ********************** BBCFMAT1 **********************************
CBB** ********************** BBCFMT0B **********************************
C**** FORMAT STATEMENTS FOR PAGE HEADERS
C****
90002 FORMAT (1H1)
90004 FORMAT (1H )
90006 FORMAT (1H ,20X,31HFEDERAL SOFTWARE TESTING CENTER)
90007 FORMAT (1H ,19X,34HFORTRAN COMPILER VALIDATION SYSTEM)
90008 FORMAT (1H ,21X,A13,A17)
90009 FORMAT (1H ,/,2H *,A5,6HBEGIN*,12X,15HTEST RESULTS - ,A5,/)
90010 FORMAT (1H ,8X,16HTEST DATE*TIME= ,A17,15H - COMPILER= ,A20)
90013 FORMAT (1H ,8H TEST ,10HPASS/FAIL ,6X,17HDISPLAYED RESULTS,
1 7X,7HREMARKS,24X)
90014 FORMAT (1H ,46H----------------------------------------------,
1 33H---------------------------------)
90015 FORMAT (1H ,48X,17HTHIS PROGRAM HAS ,I3,6H TESTS,/)
C****
C**** FORMAT STATEMENTS FOR REPORT FOOTINGS
C****
90016 FORMAT (1H ,/,2H *,A5,4HEND*,14X,14HEND OF TEST - ,A5,/)
90018 FORMAT (1H ,A13,13X,A20,7H * ,A10,1H/,
1 A13)
90019 FORMAT (1H ,26HFOR OFFICIAL USE ONLY ,35X,15HCOPYRIGHT 1982)
C****
C**** FORMAT STATEMENTS FOR RUN SUMMARY
C****
90020 FORMAT (1H ,21X,I5,13H TESTS PASSED)
90022 FORMAT (1H ,21X,I5,13H TESTS FAILED)
90024 FORMAT (1H ,21X,I5,14H TESTS DELETED)
90026 FORMAT (1H ,21X,I5,25H TESTS REQUIRE INSPECTION)
90028 FORMAT (1H ,21X,I5,4H OF ,I3,15H TESTS EXECUTED)
CBE** ********************** BBCFMT0B **********************************
C*****
END
*END-OF,FM503
FM506.f 481036396 170 2 100666 13159 `
*HEADER,FORTR,FM506
*FILES1,FORTR,FM506
C***********************************************************************
C***** FORTRAN 77
C***** FM506
C***** BLKD3 - (262)
C***** USES BLOCK DATA SUBPROGRAM AN507 AND SUBROUTINE SN508
C***********************************************************************
C***** TESTING OF BLOCK DATA SUBPROGRAMS ANS REF
C***** VARYING CHARACTER VARIABLE LENGTHS 16
C***** THIS SEGMENT USES SEGMENTS 704 AND 705, BLOCK DATA PROGRAM
C***** AN507 AND SUBROUTINE SN508
C*****
CBB** ********************** BBCCOMNT **********************************
C****
C**** 1978 FORTRAN COMPILER VALIDATION SYSTEM
C**** VERSION 2.0
C****
C****
C**** SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO
C**** GENERAL SERVICES ADMINISTRATION
C**** FEDERAL SOFTWARE TESTING CENTER
C**** 5203 LEESBURG PIKE, SUITE 1100
C**** FALLS CHURCH, VA. 22041
C****
C**** (703) 756-6153
C****
CBE** ********************** BBCCOMNT **********************************
C*****
C***** S P E C I F I C A T I O N S SEGMENT 262
C*****
C***** CHARACTER*3 C3XVK, F3XVK
C***** CHARACTER*2 D2XVK
C***** CHARACTER*5 E5XVK
C***** COMMON /BLK8/ C3XVK, D2XVK, E5XVK, F3XVK
C*****
NUVI = 4
C*****
CALL SN508(NUVI)
C*****
C***** END OF TEST SEGMENT 262
STOP
END
*HEADER,FORTR,FM506,SUBRTN,FM507
C***********************************************************************
C***** FORTRAN 77
C***** FM507 BDS3 - (704)
C***** BLOCK DATA SUBPROGRAM AN507 USED BY FM506
C***********************************************************************
C*****
C***** GENERAL PURPOSE
C***** THIS SEGMENT CONTAINS A BLOCK DATA SUBPROGRAM THAT IS
C***** TO BE RUN WITH TEST SEGMENT FM506 (262)
C***** THIS SEGMENT WILL TEST CHARACTER VARIABLES WITH VARYING
C***** LENGHTS IN COMMON AREAS
C*****
CBB** ********************** BBCCOMNT **********************************
C****
C**** 1978 FORTRAN COMPILER VALIDATION SYSTEM
C**** VERSION 2.0
C****
C****
C**** SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO
C**** GENERAL SERVICES ADMINISTRATION
C**** FEDERAL SOFTWARE TESTING CENTER
C**** 5203 LEESBURG PIKE, SUITE 1100
C**** FALLS CHURCH, VA. 22041
C****
C**** (703) 756-6153
C****
CBE** ********************** BBCCOMNT **********************************
BLOCK DATA AN507
C*****
CHARACTER*3 C3XVK, F3XVK
CHARACTER*2 D2XVK
CHARACTER*5 E5XVK
COMMON /BLK8/ C3XVK, D2XVK, E5XVK, F3XVK
DATA C3XVK, D2XVK, E5XVK, F3XVK /'123', 'GH', 'LONGS', 'END'/
C*****
END
*HEADER,FORTR,FM506,SUBRTN,FM508
C***********************************************************************
C***** FORTRAN 77
C***** FM508 BLKD3Q - (705)
C***** THIS SUBROUTINE IS CALLED BY FM506
C***********************************************************************
C*****
C***** GENERAL PURPOSE
C***** THIS SEGMENT IS TO BE RUN WITH TEST SEGMENT 262
C***** THIS SEGMENT CONTAINS A SUBROUTINE THAT CHECKS TO SEE IF
C***** IF THE BLOCK DATA PROGRAM CORRECTLY INITIALIZED CHARACTER
C***** VARIABLES INTERMIXED WITH DIFFERENT LENGTHS
C*****
SUBROUTINE SN508 (NWVI)
C*****
CBB** ********************** BBCCOMNT **********************************
C****
C**** 1978 FORTRAN COMPILER VALIDATION SYSTEM
C**** VERSION 2.0
C****
C****
C**** SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO
C**** GENERAL SERVICES ADMINISTRATION
C**** FEDERAL SOFTWARE TESTING CENTER
C**** 5203 LEESBURG PIKE, SUITE 1100
C**** FALLS CHURCH, VA. 22041
C****
C**** (703) 756-6153
C****
CBE** ********************** BBCCOMNT **********************************
CHARACTER*3 C3XVK, F3XVK
CHARACTER*2 D2XVK
CHARACTER*5 E5XVK, CVCORR
COMMON /BLK8/ C3XVK, D2XVK, E5XVK, F3XVK
CBB** ********************** BBCINITA **********************************
C**** SPECIFICATION STATEMENTS
C****
CHARACTER ZVERS*13, ZVERSD*17, ZDATE*17, ZPROG*5, ZCOMPL*20,
1 ZNAME*20, ZTAPE*10, ZPROJ*13, REMRKS*31, ZTAPED*13
CBE** ********************** BBCINITA **********************************
CBB** ********************** BBCINITB **********************************
C**** INITIALIZE SECTION
DATA ZVERS, ZVERSD, ZDATE
1 /'VERSION 2.0 ', '82/08/02*18.33.46', '*NO DATE*TIME'/
DATA ZCOMPL, ZNAME, ZTAPE
1 /'*NONE SPECIFIED*', '*NO COMPANY NAME*', '*NO TAPE*'/
DATA ZPROJ, ZTAPED, ZPROG
1 /'*NO PROJECT*', '*NO TAPE DATE', 'XXXXX'/
DATA REMRKS /' '/
C**** THE FOLLOWING 9 COMMENT LINES (CZ01, CZ02, ...) CAN BE REPLACED
C**** FOR IDENTIFYING THE TEST ENVIRONMENT
C****
CZ01 ZVERS = 'VERSION OF THE COMPILER VALIDATION SYSTEM'
CZ02 ZVERSD = 'CREATION DATE/TIME OF THE COMPILER VALIDATION SYSTEM'
CZ03 ZPROG = 'PROGRAM NAME'
CZ04 ZDATE = 'DATE OF TEST'
CZ05 ZCOMPL = 'COMPILER IDENTIFICATION'
CZ06 ZPROJ = 'PROJECT NUMBER/IDENTIFICATION'
CZ07 ZNAME = 'NAME OF USER'
CZ08 ZTAPE = 'TAPE OWNER/ID'
CZ09 ZTAPED = 'DATE TAPE COPIED'
C
IVPASS = 0
IVFAIL = 0
IVDELE = 0
IVINSP = 0
IVTOTL = 0
IVTOTN = 0
ICZERO = 0
C
C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER.
I01 = 05
C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER.
I02 = 06
C
CX010 REPLACED BY FEXEC X-010 CONTROL CARD (CARD-READER UNIT NUMBER).
C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5
CX011 REPLACED BY FEXEC X-011 CONTROL CARD. CX011 IS FOR SYSTEMS
C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX010.
C
CX020 REPLACED BY FEXEC X-020 CONTROL CARD (PRINTER UNIT NUMBER).
C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02= 6
CX021 REPLACED BY FEXEC X-021 CONTROL CARD. CX021 IS FOR SYSTEMS
C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX020.
C
CBE** ********************** BBCINITB **********************************
NUVI = I02
IVTOTL = 4
ZPROG = 'FM506'
CBB** ********************** BBCHED0A **********************************
C****
C**** WRITE REPORT TITLE
C****
WRITE (I02, 90002)
WRITE (I02, 90006)
WRITE (I02, 90007)
WRITE (I02, 90008) ZVERS, ZVERSD
WRITE (I02, 90009) ZPROG, ZPROG
WRITE (I02, 90010) ZDATE, ZCOMPL
CBE** ********************** BBCHED0A **********************************
C*****
WRITE(NUVI,26200)
26200 FORMAT( 1H , / 39H BLKD3 - (262) BLOCK DATA SUBPROGRAM --//
1 36H VARYING CHARACTER VARIABLE LENGTHS//
2 15H ANS REF. - 16)
CBB** ********************** BBCHED0B **********************************
C**** WRITE DETAIL REPORT HEADERS
C****
WRITE (I02,90004)
WRITE (I02,90004)
WRITE (I02,90013)
WRITE (I02,90014)
WRITE (I02,90015) IVTOTL
CBE** ********************** BBCHED0B **********************************
C*****
CT001* TEST 1 3 CHARACTER VARIABLE
IVTNUM = 1
IVCOMP = 0
IF (C3XVK.EQ.'123') IVCOMP = 1
IF (IVCOMP - 1) 20010, 10010, 20010
10010 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0011
20010 IVFAIL = IVFAIL + 1
CVCORR = '123'
WRITE (NUVI, 80018) IVTNUM, C3XVK, CVCORR
0011 CONTINUE
CT002* TEST 2 2 CHARACTER VARIABLE
IVTNUM = 2
IVCOMP = 0
IF (D2XVK.EQ.'GH') IVCOMP = 1
IF (IVCOMP - 1) 20020, 10020, 20020
10020 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0021
20020 IVFAIL = IVFAIL + 1
CVCORR = 'GH'
WRITE (NUVI, 80018) IVTNUM, D2XVK, CVCORR
0021 CONTINUE
CT003* TEST 3 5 CHARACTER VARIABLE
IVTNUM = 3
IVCOMP = 0
IF (E5XVK.EQ.'LONGS') IVCOMP = 1
IF (IVCOMP - 1) 20030, 10030, 20030
10030 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0031
20030 IVFAIL = IVFAIL + 1
CVCORR = 'LONGS'
WRITE (NUVI, 80018) IVTNUM, E5XVK, CVCORR
0031 CONTINUE
CT004* TEST 4 3 CHARACTER VARIABLE
IVTNUM = 4
IVCOMP = 0
IF (F3XVK.EQ.'END') IVCOMP = 1
IF (IVCOMP - 1) 20040, 10040, 20040
10040 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0041
20040 IVFAIL = IVFAIL + 1
CVCORR = 'END'
WRITE (NUVI, 80018) IVTNUM, F3XVK, CVCORR
0041 CONTINUE
C*****
CBB** ********************** BBCSUM0 **********************************
C**** WRITE OUT TEST SUMMARY
C****
IVTOTN = IVPASS + IVFAIL + IVDELE + IVINSP
WRITE (I02, 90004)
WRITE (I02, 90014)
WRITE (I02, 90004)
WRITE (I02, 90020) IVPASS
WRITE (I02, 90022) IVFAIL
WRITE (I02, 90024) IVDELE
WRITE (I02, 90026) IVINSP
WRITE (I02, 90028) IVTOTN, IVTOTL
CBE** ********************** BBCSUM0 **********************************
CBB** ********************** BBCFOOT0 **********************************
C**** WRITE OUT REPORT FOOTINGS
C****
WRITE (I02,90016) ZPROG, ZPROG
WRITE (I02,90018) ZPROJ, ZNAME, ZTAPE, ZTAPED
WRITE (I02,90019)
CBE** ********************** BBCFOOT0 **********************************
CBB** ********************** BBCFMT0A **********************************
C**** FORMATS FOR TEST DETAIL LINES
C****
80000 FORMAT (1H ,2X,I3,4X,7HDELETED,32X,A31)
80002 FORMAT (1H ,2X,I3,4X,7H PASS ,32X,A31)
80004 FORMAT (1H ,2X,I3,4X,7HINSPECT,32X,A31)
80008 FORMAT (1H ,2X,I3,4X,7H FAIL ,32X,A31)
80010 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,15X,10HCOMPUTED= ,
1I6,/,1H ,15X,10HCORRECT= ,I6)
80012 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
1E12.5,/,1H ,16X,10HCORRECT= ,E12.5)
80018 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
1A21,/,1H ,16X,10HCORRECT= ,A21)
80020 FORMAT (1H ,16X,10HCOMPUTED= ,A21,1X,A31)
80022 FORMAT (1H ,16X,10HCORRECT= ,A21,1X,A31)
80024 FORMAT (1H ,16X,10HCOMPUTED= ,I6,16X,A31)
80026 FORMAT (1H ,16X,10HCORRECT= ,I6,16X,A31)
80028 FORMAT (1H ,16X,10HCOMPUTED= ,E12.5,10X,A31)
80030 FORMAT (1H ,16X,10HCORRECT= ,E12.5,10X,A31)
80050 FORMAT (1H ,48X,A31)
CBE** ********************** BBCFMT0A **********************************
CBB** ********************** BBCFMAT1 **********************************
C**** FORMATS FOR TEST DETAIL LINES - FULL LANGUAGE
C****
80031 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
1D17.10,/,1H ,16X,10HCORRECT= ,D17.10)
80033 FORMAT (1H ,16X,10HCOMPUTED= ,D17.10,10X,A31)
80035 FORMAT (1H ,16X,10HCORRECT= ,D17.10,10X,A31)
80037 FORMAT (1H ,16X,10HCOMPUTED= ,1H(,E12.5,2H, ,E12.5,1H),6X,A31)
80039 FORMAT (1H ,16X,10HCORRECT= ,1H(,E12.5,2H, ,E12.5,1H),6X,A31)
80041 FORMAT (1H ,16X,10HCOMPUTED= ,1H(,F12.5,2H, ,F12.5,1H),6X,A31)
80043 FORMAT (1H ,16X,10HCORRECT= ,1H(,F12.5,2H, ,F12.5,1H),6X,A31)
80045 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
11H(,F12.5,2H, ,F12.5,1H)/,1H ,16X,10HCORRECT= ,
21H(,F12.5,2H, ,F12.5,1H))
CBE** ********************** BBCFMAT1 **********************************
CBB** ********************** BBCFMT0B **********************************
C**** FORMAT STATEMENTS FOR PAGE HEADERS
C****
90002 FORMAT (1H1)
90004 FORMAT (1H )
90006 FORMAT (1H ,20X,31HFEDERAL SOFTWARE TESTING CENTER)
90007 FORMAT (1H ,19X,34HFORTRAN COMPILER VALIDATION SYSTEM)
90008 FORMAT (1H ,21X,A13,A17)
90009 FORMAT (1H ,/,2H *,A5,6HBEGIN*,12X,15HTEST RESULTS - ,A5,/)
90010 FORMAT (1H ,8X,16HTEST DATE*TIME= ,A17,15H - COMPILER= ,A20)
90013 FORMAT (1H ,8H TEST ,10HPASS/FAIL ,6X,17HDISPLAYED RESULTS,
1 7X,7HREMARKS,24X)
90014 FORMAT (1H ,46H----------------------------------------------,
1 33H---------------------------------)
90015 FORMAT (1H ,48X,17HTHIS PROGRAM HAS ,I3,6H TESTS,/)
C****
C**** FORMAT STATEMENTS FOR REPORT FOOTINGS
C****
90016 FORMAT (1H ,/,2H *,A5,4HEND*,14X,14HEND OF TEST - ,A5,/)
90018 FORMAT (1H ,A13,13X,A20,7H * ,A10,1H/,
1 A13)
90019 FORMAT (1H ,26HFOR OFFICIAL USE ONLY ,35X,15HCOPYRIGHT 1982)
C****
C**** FORMAT STATEMENTS FOR RUN SUMMARY
C****
90020 FORMAT (1H ,21X,I5,13H TESTS PASSED)
90022 FORMAT (1H ,21X,I5,13H TESTS FAILED)
90024 FORMAT (1H ,21X,I5,14H TESTS DELETED)
90026 FORMAT (1H ,21X,I5,25H TESTS REQUIRE INSPECTION)
90028 FORMAT (1H ,21X,I5,4H OF ,I3,15H TESTS EXECUTED)
CBE** ********************** BBCFMT0B **********************************
C*****
END
*END-OF,FM506
FM509.f 481036399 170 2 100666 19281 `
*HEADER,FORTR,FM509
*FILES1,FORTR,FM509
PROGRAM FM509
C
C THIS ROUTINE TESTS SUBROUTINE SUBPROGRAMS AND ANS REF.
C FUNCTION SUBPROGRAMS WITH MULTIPLE ENTRIES. 15.6.1
C THIS ROUTINE ALSO TESTS THE USE OF SYMBOLIC 15.7, 15.7.1
C NAMES OF CONSTANTS, SUBSTRINGS NAMES, AND 15.9.2
C ARRAY ELEMENT SUBSTRINGS AS ARGUMENTS. 15.9.3.2
C 15.9.3.3
C THIS ROUTINE USES THE SUBROUTINE SUBPROGRAMS SN510,
C SN511, AND SN512, AND THE FUNCTION SUBPROGRAM RF513.
C
CBB** ********************** BBCCOMNT **********************************
C****
C**** 1978 FORTRAN COMPILER VALIDATION SYSTEM
C**** VERSION 2.0
C****
C****
C**** SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO
C**** GENERAL SERVICES ADMINISTRATION
C**** FEDERAL SOFTWARE TESTING CENTER
C**** 5203 LEESBURG PIKE, SUITE 1100
C**** FALLS CHURCH, VA. 22041
C****
C**** (703) 756-6153
C****
CBE** ********************** BBCCOMNT **********************************
IMPLICIT DOUBLE PRECISION (D), COMPLEX (Z), LOGICAL (L)
IMPLICIT CHARACTER*27 (C)
CBB** ********************** BBCINITA **********************************
C**** SPECIFICATION STATEMENTS
C****
CHARACTER ZVERS*13, ZVERSD*17, ZDATE*17, ZPROG*5, ZCOMPL*20,
1 ZNAME*20, ZTAPE*10, ZPROJ*13, REMRKS*31, ZTAPED*13
CBE** ********************** BBCINITA **********************************
C
INTEGER I2N001(2,2)
CHARACTER CVCOMP*12,CVCORR*12,CVN001*30
CHARACTER C1N001(6)*10
PARAMETER (IPN001=31)
COMMON IVC001, IVC002, IVC003
EXTERNAL RF513
DATA I2N001 /1, 3, 5, 7/
DATA CVN001 /'REDORANGEYELLOWGREENBLUEVIOLET'/
DATA C1N001 /'FIRST-AID:','SECONDRATE','THIRD-TERM',
1 'FOURTH-DAY','FIFTHROUND','SIXTHMONTH'/
C
C
CBB** ********************** BBCINITB **********************************
C**** INITIALIZE SECTION
DATA ZVERS, ZVERSD, ZDATE
1 /'VERSION 2.0 ', '82/08/02*18.33.46', '*NO DATE*TIME'/
DATA ZCOMPL, ZNAME, ZTAPE
1 /'*NONE SPECIFIED*', '*NO COMPANY NAME*', '*NO TAPE*'/
DATA ZPROJ, ZTAPED, ZPROG
1 /'*NO PROJECT*', '*NO TAPE DATE', 'XXXXX'/
DATA REMRKS /' '/
C**** THE FOLLOWING 9 COMMENT LINES (CZ01, CZ02, ...) CAN BE REPLACED
C**** FOR IDENTIFYING THE TEST ENVIRONMENT
C****
CZ01 ZVERS = 'VERSION OF THE COMPILER VALIDATION SYSTEM'
CZ02 ZVERSD = 'CREATION DATE/TIME OF THE COMPILER VALIDATION SYSTEM'
CZ03 ZPROG = 'PROGRAM NAME'
CZ04 ZDATE = 'DATE OF TEST'
CZ05 ZCOMPL = 'COMPILER IDENTIFICATION'
CZ06 ZPROJ = 'PROJECT NUMBER/IDENTIFICATION'
CZ07 ZNAME = 'NAME OF USER'
CZ08 ZTAPE = 'TAPE OWNER/ID'
CZ09 ZTAPED = 'DATE TAPE COPIED'
C
IVPASS = 0
IVFAIL = 0
IVDELE = 0
IVINSP = 0
IVTOTL = 0
IVTOTN = 0
ICZERO = 0
C
C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER.
I01 = 05
C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER.
I02 = 06
C
CX010 REPLACED BY FEXEC X-010 CONTROL CARD (CARD-READER UNIT NUMBER).
C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5
CX011 REPLACED BY FEXEC X-011 CONTROL CARD. CX011 IS FOR SYSTEMS
C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX010.
C
CX020 REPLACED BY FEXEC X-020 CONTROL CARD (PRINTER UNIT NUMBER).
C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02= 6
CX021 REPLACED BY FEXEC X-021 CONTROL CARD. CX021 IS FOR SYSTEMS
C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX020.
C
CBE** ********************** BBCINITB **********************************
ZPROG = 'FM509'
IVTOTL = 16
CBB** ********************** BBCHED0A **********************************
C****
C**** WRITE REPORT TITLE
C****
WRITE (I02, 90002)
WRITE (I02, 90006)
WRITE (I02, 90007)
WRITE (I02, 90008) ZVERS, ZVERSD
WRITE (I02, 90009) ZPROG, ZPROG
WRITE (I02, 90010) ZDATE, ZCOMPL
CBE** ********************** BBCHED0A **********************************
CBB** ********************** BBCHED0B **********************************
C**** WRITE DETAIL REPORT HEADERS
C****
WRITE (I02,90004)
WRITE (I02,90004)
WRITE (I02,90013)
WRITE (I02,90014)
WRITE (I02,90015) IVTOTL
CBE** ********************** BBCHED0B **********************************
C
CT001* TEST 001 **** FCVS PROGRAM 509 ****
C SUBROUTINE WITH MULTIPLE ENTRIES
C
IVTNUM = 1
IVCOMP = 0
IVCORR = 25
CALL SN510(3,IVN001)
CALL EN851(IVN001,IVCOMP)
40010 IF (IVCOMP - 25) 20010, 10010, 20010
10010 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0011
20010 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0011 CONTINUE
C
CT002* TEST 002 **** FCVS PROGRAM 509 ****
C ENTRY WITH ONE ARGUMENT
C
IVTNUM = 2
IVCOMP = 0
IVCORR = 137
IVN001 = 37
CALL EN852(IVN001)
IVCOMP = IVN001
40020 IF (IVCOMP - 137) 20020, 10020, 20020
10020 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0021
20020 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0021 CONTINUE
C
CT003* TEST 003 **** FCVS PROGRAM 509 ****
C ENTRY WITH TWO ARGUMENT
C
IVTNUM = 3
IVCOMP = 0
IVCORR = -51
CALL EN853(-9,IVCOMP)
40030 IF (IVCOMP + 51) 20030, 10030, 20030
10030 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0031
20030 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0031 CONTINUE
C
CT004* TEST 004 **** FCVS PROGRAM 509 ****
C ENTRY WITH THREE ARGUMENTS
C
IVTNUM = 4
IVCOMP = 0
IVCORR = -71
CALL EN854(275,147,IVCOMP)
40040 IF (IVCOMP + 71) 20040, 10040, 20040
10040 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0041
20040 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0041 CONTINUE
C
CT005* TEST 005 **** FCVS PROGRAM 509 ****
C ENTRY WITH FOUR ARGUMENTS
C
IVTNUM = 5
IVCOMP = 0
IVCORR = 567
CALL EN855(12,-15,63,IVCOMP)
40050 IF (IVCOMP - 567) 20050, 10050, 20050
10050 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0051
20050 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0051 CONTINUE
C
CT006* TEST 006 **** FCVS PROGRAM 509 ****
C ENTRY WITH ARRAY AS DUMMY ARGUMENT
C
IVTNUM = 6
IVCOMP = 0
IVCORR = 16
IVN001 = 2
CALL EN856(IVN001,I2N001,IVCOMP)
40060 IF (IVCOMP - 16) 20060, 10060, 20060
10060 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0061
20060 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0061 CONTINUE
C
CT007* TEST 007 **** FCVS PROGRAM 509 ****
C ENTRY WITH PROCEDURE AS DUMMY ARGUMENT
C
IVTNUM = 7
RVCOMP = 0.0
RVCORR = 2.25
CALL EN857(1.5,RVCOMP,RF513)
IF (RVCOMP - 0.22498E+01) 20070, 10070, 40070
40070 IF (RVCOMP - 0.22502E+01) 10070, 10070, 20070
10070 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0071
20070 IVFAIL = IVFAIL + 1
WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR
0071 CONTINUE
C
CT008* TEST 008 **** FCVS PROGRAM 509 ****
C ENTRY WITH ASTERISK AS DUMMY ARGUMENT
C
IVTNUM = 8
IVCOMP = 0
IVCORR = 19
IVN001 = 2
CALL EN858(IVN001,*0082,*0083)
0082 IVCOMP = 5
GO TO 0084
0083 IVCOMP = 19
0084 CONTINUE
40080 IF (IVCOMP - 19) 20080, 10080, 20080
10080 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0081
20080 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0081 CONTINUE
C
C TESTS 9 AND 10 TEST ENTRY WITHOUT ARGUMENTS
C
CT009* TEST 009 **** FCVS PROGRAM 509 ****
C
IVTNUM = 9
IVCOMP = 0
IVCORR = 88
IVC002 = 65
IVC003 = 23
CALL EN859( )
IVCOMP = IVC001
40090 IF (IVCOMP - 88) 20090, 10090, 20090
10090 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0091
20090 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0091 CONTINUE
C
CT010* TEST 010 **** FCVS PROGRAM 509 ****
C
IVTNUM = 10
IVCOMP = 0
IVCORR = -13
IVC001 = 4
IVC002 = -17
CALL EN860
IVCOMP = IVC003
40100 IF (IVCOMP + 13) 20100, 10100, 20100
10100 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0101
20100 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0101 CONTINUE
C
CT011* TEST 011 **** FCVS PROGRAM 509 ****
C FUNCTION SUBPROGRAM WITH MULTIPLE ENTRIES
C
IVTNUM = 11
RVCOMP = 0.0
RVCORR = 3.675E-3
RVN001 = RF513(3.5E-2)
RVCOMP = EF852(RVN001)
IF (RVCOMP - 0.36748E-02) 20110, 10110, 40110
40110 IF (RVCOMP - 0.36752E-02) 10110, 10110, 20110
10110 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0111
20110 IVFAIL = IVFAIL + 1
WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR
0111 CONTINUE
C
CT012* TEST 012 **** FCVS PROGRAM 509 ****
C SYMBOLIC NAME OF A CONSTANT AS AN ACTUAL ARGUMENT
C
IVTNUM = 12
IVCOMP = 0
IVCORR = 34
CALL SN510(IPN001,IVCOMP)
40120 IF (IVCOMP - 34) 20120, 10120, 20120
10120 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0121
20120 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0121 CONTINUE
C
C TESTS 13 AND 14 TEST THE USE OF A SUBSTRING AS AN ACTUAL ARGUMENT
C WHICH IS ASSOCIATED WITH A DUMMY ARGUMENT THAT IS A VARIABLE
C
C
CT013* TEST 013 **** FCVS PROGRAM 509 ****
C
IVTNUM = 13
CVCOMP = ' '
CVCORR = 'COLOR=YELLOW '
CALL SN511(CVN001(10:15),CVCOMP)
IVCOMP = 0
IF (CVCOMP.EQ.'COLOR=YELLOW ') IVCOMP = 1
40130 IF (IVCOMP - 1) 20130, 10130, 20130
10130 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0131
20130 IVFAIL = IVFAIL + 1
WRITE (I02,80018) IVTNUM, CVCOMP, CVCORR
0131 CONTINUE
C
CT014* TEST 014 **** FCVS PROGRAM 509 ****
C
IVTNUM = 14
CVCOMP = ' '
CVCORR = 'COLOR=VIOLET '
CALL SN511(CVN001(25:30),CVCOMP)
IVCOMP = 0
IF (CVCOMP.EQ.'COLOR=VIOLET ') IVCOMP = 1
40140 IF (IVCOMP - 1) 20140, 10140, 20140
10140 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0141
20140 IVFAIL = IVFAIL + 1
WRITE (I02,80018) IVTNUM, CVCOMP, CVCORR
0141 CONTINUE
C
C TESTS 15 AND 16 TEST THE USE OF AN ARRAY ELEMENT SUBSTRING AS AN
C ACTUAL ARGUMENT WHICH IS ASSOCIATED WITH A DUMMY ARGUMENT THAT
C IS AN ARRAY
C
C
CT015* TEST 015 **** FCVS PROGRAM 509 ****
C
IVTNUM = 15
CVCOMP = ' '
CVCORR = 'RST-AID: '
CALL SN512(C1N001(1)(3:10),CVCOMP)
IVCOMP = 0
IF (CVCOMP.EQ.'RST-AID: ') IVCOMP = 1
40150 IF (IVCOMP - 1) 20150, 10150, 20150
10150 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0151
20150 IVFAIL = IVFAIL + 1
WRITE (I02,80018) IVTNUM, CVCOMP, CVCORR
0151 CONTINUE
C
CT016* TEST 016 **** FCVS PROGRAM 509 ****
C
IVTNUM = 16
CVCOMP = ' '
CVCORR = 'IFTHROUN '
CALL SN512(C1N001(5)(2:9),CVCOMP)
IVCOMP = 0
IF (CVCOMP.EQ.'IFTHROUN ') IVCOMP = 1
40160 IF (IVCOMP - 1) 20160, 10160, 20160
10160 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0161
20160 IVFAIL = IVFAIL + 1
WRITE (I02,80018) IVTNUM, CVCOMP, CVCORR
0161 CONTINUE
C
CBB** ********************** BBCSUM0 **********************************
C**** WRITE OUT TEST SUMMARY
C****
IVTOTN = IVPASS + IVFAIL + IVDELE + IVINSP
WRITE (I02, 90004)
WRITE (I02, 90014)
WRITE (I02, 90004)
WRITE (I02, 90020) IVPASS
WRITE (I02, 90022) IVFAIL
WRITE (I02, 90024) IVDELE
WRITE (I02, 90026) IVINSP
WRITE (I02, 90028) IVTOTN, IVTOTL
CBE** ********************** BBCSUM0 **********************************
CBB** ********************** BBCFOOT0 **********************************
C**** WRITE OUT REPORT FOOTINGS
C****
WRITE (I02,90016) ZPROG, ZPROG
WRITE (I02,90018) ZPROJ, ZNAME, ZTAPE, ZTAPED
WRITE (I02,90019)
CBE** ********************** BBCFOOT0 **********************************
90001 FORMAT (1H ,56X,5HFM509)
90000 FORMAT (1H ,50X,20HEND OF PROGRAM FM509)
CBB** ********************** BBCFMT0A **********************************
C**** FORMATS FOR TEST DETAIL LINES
C****
80000 FORMAT (1H ,2X,I3,4X,7HDELETED,32X,A31)
80002 FORMAT (1H ,2X,I3,4X,7H PASS ,32X,A31)
80004 FORMAT (1H ,2X,I3,4X,7HINSPECT,32X,A31)
80008 FORMAT (1H ,2X,I3,4X,7H FAIL ,32X,A31)
80010 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,15X,10HCOMPUTED= ,
1I6,/,1H ,15X,10HCORRECT= ,I6)
80012 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
1E12.5,/,1H ,16X,10HCORRECT= ,E12.5)
80018 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
1A21,/,1H ,16X,10HCORRECT= ,A21)
80020 FORMAT (1H ,16X,10HCOMPUTED= ,A21,1X,A31)
80022 FORMAT (1H ,16X,10HCORRECT= ,A21,1X,A31)
80024 FORMAT (1H ,16X,10HCOMPUTED= ,I6,16X,A31)
80026 FORMAT (1H ,16X,10HCORRECT= ,I6,16X,A31)
80028 FORMAT (1H ,16X,10HCOMPUTED= ,E12.5,10X,A31)
80030 FORMAT (1H ,16X,10HCORRECT= ,E12.5,10X,A31)
80050 FORMAT (1H ,48X,A31)
CBE** ********************** BBCFMT0A **********************************
CBB** ********************** BBCFMAT1 **********************************
C**** FORMATS FOR TEST DETAIL LINES - FULL LANGUAGE
C****
80031 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
1D17.10,/,1H ,16X,10HCORRECT= ,D17.10)
80033 FORMAT (1H ,16X,10HCOMPUTED= ,D17.10,10X,A31)
80035 FORMAT (1H ,16X,10HCORRECT= ,D17.10,10X,A31)
80037 FORMAT (1H ,16X,10HCOMPUTED= ,1H(,E12.5,2H, ,E12.5,1H),6X,A31)
80039 FORMAT (1H ,16X,10HCORRECT= ,1H(,E12.5,2H, ,E12.5,1H),6X,A31)
80041 FORMAT (1H ,16X,10HCOMPUTED= ,1H(,F12.5,2H, ,F12.5,1H),6X,A31)
80043 FORMAT (1H ,16X,10HCORRECT= ,1H(,F12.5,2H, ,F12.5,1H),6X,A31)
80045 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
11H(,F12.5,2H, ,F12.5,1H)/,1H ,16X,10HCORRECT= ,
21H(,F12.5,2H, ,F12.5,1H))
CBE** ********************** BBCFMAT1 **********************************
CBB** ********************** BBCFMT0B **********************************
C**** FORMAT STATEMENTS FOR PAGE HEADERS
C****
90002 FORMAT (1H1)
90004 FORMAT (1H )
90006 FORMAT (1H ,20X,31HFEDERAL SOFTWARE TESTING CENTER)
90007 FORMAT (1H ,19X,34HFORTRAN COMPILER VALIDATION SYSTEM)
90008 FORMAT (1H ,21X,A13,A17)
90009 FORMAT (1H ,/,2H *,A5,6HBEGIN*,12X,15HTEST RESULTS - ,A5,/)
90010 FORMAT (1H ,8X,16HTEST DATE*TIME= ,A17,15H - COMPILER= ,A20)
90013 FORMAT (1H ,8H TEST ,10HPASS/FAIL ,6X,17HDISPLAYED RESULTS,
1 7X,7HREMARKS,24X)
90014 FORMAT (1H ,46H----------------------------------------------,
1 33H---------------------------------)
90015 FORMAT (1H ,48X,17HTHIS PROGRAM HAS ,I3,6H TESTS,/)
C****
C**** FORMAT STATEMENTS FOR REPORT FOOTINGS
C****
90016 FORMAT (1H ,/,2H *,A5,4HEND*,14X,14HEND OF TEST - ,A5,/)
90018 FORMAT (1H ,A13,13X,A20,7H * ,A10,1H/,
1 A13)
90019 FORMAT (1H ,26HFOR OFFICIAL USE ONLY ,35X,15HCOPYRIGHT 1982)
C****
C**** FORMAT STATEMENTS FOR RUN SUMMARY
C****
90020 FORMAT (1H ,21X,I5,13H TESTS PASSED)
90022 FORMAT (1H ,21X,I5,13H TESTS FAILED)
90024 FORMAT (1H ,21X,I5,14H TESTS DELETED)
90026 FORMAT (1H ,21X,I5,25H TESTS REQUIRE INSPECTION)
90028 FORMAT (1H ,21X,I5,4H OF ,I3,15H TESTS EXECUTED)
CBE** ********************** BBCFMT0B **********************************
STOP
END
*HEADER,FORTR,FM509,SUBRTN,FM510
C
C THIS ROUTINE IS TO BE RUN WITH ROUTINE 509.
C
C THIS SUBROUTINE IS CALLED IN THE MAIN PROGRAM TO TEST IF
C MULTIPLE ENTRIES ARE PERMITTED IN A SUBROUTINE SUBPROGRAM.
C
SUBROUTINE SN510(IVD001,IVD002)
INTEGER I2D001(2,2)
COMMON IVC001, IVC002, IVC003
DO 70010 IVN001 = 1, 3
IVD001 = IVD001 + 1
70010 CONTINUE
IVD002 = IVD001
RETURN
ENTRY EN851(IVD003,IVD004)
IVD004 = 3*IVD003 + 7
RETURN
ENTRY EN852(IVD005)
IVD005 = IVD005 + 100
RETURN
ENTRY EN853(IVD006,IVD007)
IVD007 = 5*(IVD006 + 2) - 16
RETURN
ENTRY EN854(IVD008,IVD009,IVD010)
IVD010 = 4*(IVD008 - 2*IVD009) + 5
RETURN
ENTRY EN855(IVD011, IVD012, IVD013, IVD014)
IVD014 = IVD013*(2*IVD011 + IVD012)
RETURN
ENTRY EN856(IVD015,I2D001,IVD016)
IVD016 = 0
DO 70020 IVN001 = 1, IVD015
DO 70020 IVN002 = 1, IVD015
70020 IVD016 = IVD016 + I2D001(IVN001,IVN002)
RETURN
ENTRY EN857(RVD017,RVD018,RFD001)
RVD018 = RFD001(RVD017)
RETURN
ENTRY EN858(IVD019,*,*)
RETURN IVD019
ENTRY EN859( )
IVC001 = IVC002 + IVC003
RETURN
ENTRY EN860
IVC003 = IVC001 + IVC002
RETURN
END
C
*HEADER,FORTR,FM509,SUBRTN,FM511
C
C THIS ROUTINE IS TO BE RUN WITH ROUTINE 509.
C
C THIS SUBROUTINE IS CALLED IN THE MAIN PROGRAM TO TEST THE USE
C OF A SUBSTRING NAME AS AN ACTUAL ARGUMENT WHICH IS
C ASSOCIATED WITH A DUMMY ARGUMENT THAT IS A VARIBLE
C
SUBROUTINE SN511(CVD001,CVD002)
CHARACTER CVD001*6, CVD002*12
CVD002 = 'COLOR='//CVD001
RETURN
END
*HEADER,FORTR,FM509,SUBRTN,FM512
C
C THIS ROUTINE IS TO BE RUN WIHT ROUTINE 509.
C
C THIS SUBROUTINE IS CALLED IN THE MAIN PROGRAM TO TEST THE USE OF
C AN ARRAY ELEMENT SUBSTRING AS AN ACTUAL ARGUMENT WHICH
C IS ASSOCIATED WITH A DUMMY ARGUMENT THAT IS AN ARRAY.
C
SUBROUTINE SN512(C1D001,CVD001)
CHARACTER C1D001(6)*8,CVD001*8
CVD001 = C1D001(1)
RETURN
END
*HEADER,FORTR,FM509,SUBRTN,FM513
C
C THIS FUNCTION IS TO BE RUN WITH ROUTINE 509.
C
C THIS FUNCTION IS REFERENCED IN THE MAIN PROGRAM TO TEST IF
C MULTIPLE ENTRIES ARE PERMITTED IN A FUNCTION SUBPROGRAM.
C
FUNCTION RF513(RVD001)
RF513 = RVD001**2
RETURN
ENTRY EF852(RVD002)
EF852 = 3*RVD002
RETURN
END
*END-OF,FM509
FM514.f 481036402 170 2 100666 10122 `
*HEADER,FORTR,FM514
*FILES1,FORTR,FM514
PROGRAM FM514
C
C THIS ROUTINE TESTS SUBROUTINE STATEMENT WITH ANS REF.
C ASTERISK DUMMY ARGUMENTS AND TEST ALTERNATE 15.6.1
C RETURN SPECIFIER AS AN ACTUAL ARGUMENT. 15.9.3.5
C 15.6.2.3
C THIS ROUTINE USES SUBROUTINE SUBPROGRAMS SN515 AND
C SN516.
C
CBB** ********************** BBCCOMNT **********************************
C****
C**** 1978 FORTRAN COMPILER VALIDATION SYSTEM
C**** VERSION 2.0
C****
C****
C**** SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO
C**** GENERAL SERVICES ADMINISTRATION
C**** FEDERAL SOFTWARE TESTING CENTER
C**** 5203 LEESBURG PIKE, SUITE 1100
C**** FALLS CHURCH, VA. 22041
C****
C**** (703) 756-6153
C****
CBE** ********************** BBCCOMNT **********************************
IMPLICIT DOUBLE PRECISION (D), COMPLEX (Z), LOGICAL (L)
IMPLICIT CHARACTER*27 (C)
CBB** ********************** BBCINITA **********************************
C**** SPECIFICATION STATEMENTS
C****
CHARACTER ZVERS*13, ZVERSD*17, ZDATE*17, ZPROG*5, ZCOMPL*20,
1 ZNAME*20, ZTAPE*10, ZPROJ*13, REMRKS*31, ZTAPED*13
CBE** ********************** BBCINITA **********************************
C
CBB** ********************** BBCINITB **********************************
C**** INITIALIZE SECTION
DATA ZVERS, ZVERSD, ZDATE
1 /'VERSION 2.0 ', '82/08/02*18.33.46', '*NO DATE*TIME'/
DATA ZCOMPL, ZNAME, ZTAPE
1 /'*NONE SPECIFIED*', '*NO COMPANY NAME*', '*NO TAPE*'/
DATA ZPROJ, ZTAPED, ZPROG
1 /'*NO PROJECT*', '*NO TAPE DATE', 'XXXXX'/
DATA REMRKS /' '/
C**** THE FOLLOWING 9 COMMENT LINES (CZ01, CZ02, ...) CAN BE REPLACED
C**** FOR IDENTIFYING THE TEST ENVIRONMENT
C****
CZ01 ZVERS = 'VERSION OF THE COMPILER VALIDATION SYSTEM'
CZ02 ZVERSD = 'CREATION DATE/TIME OF THE COMPILER VALIDATION SYSTEM'
CZ03 ZPROG = 'PROGRAM NAME'
CZ04 ZDATE = 'DATE OF TEST'
CZ05 ZCOMPL = 'COMPILER IDENTIFICATION'
CZ06 ZPROJ = 'PROJECT NUMBER/IDENTIFICATION'
CZ07 ZNAME = 'NAME OF USER'
CZ08 ZTAPE = 'TAPE OWNER/ID'
CZ09 ZTAPED = 'DATE TAPE COPIED'
C
IVPASS = 0
IVFAIL = 0
IVDELE = 0
IVINSP = 0
IVTOTL = 0
IVTOTN = 0
ICZERO = 0
C
C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER.
I01 = 05
C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER.
I02 = 06
C
CX010 REPLACED BY FEXEC X-010 CONTROL CARD (CARD-READER UNIT NUMBER).
C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5
CX011 REPLACED BY FEXEC X-011 CONTROL CARD. CX011 IS FOR SYSTEMS
C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX010.
C
CX020 REPLACED BY FEXEC X-020 CONTROL CARD (PRINTER UNIT NUMBER).
C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02= 6
CX021 REPLACED BY FEXEC X-021 CONTROL CARD. CX021 IS FOR SYSTEMS
C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX020.
C
CBE** ********************** BBCINITB **********************************
ZPROG = 'FM514'
IVTOTL = 2
CBB** ********************** BBCHED0A **********************************
C****
C**** WRITE REPORT TITLE
C****
WRITE (I02, 90002)
WRITE (I02, 90006)
WRITE (I02, 90007)
WRITE (I02, 90008) ZVERS, ZVERSD
WRITE (I02, 90009) ZPROG, ZPROG
WRITE (I02, 90010) ZDATE, ZCOMPL
CBE** ********************** BBCHED0A **********************************
CBB** ********************** BBCHED0B **********************************
C**** WRITE DETAIL REPORT HEADERS
C****
WRITE (I02,90004)
WRITE (I02,90004)
WRITE (I02,90013)
WRITE (I02,90014)
WRITE (I02,90015) IVTOTL
CBE** ********************** BBCHED0B **********************************
C
CT001* TEST 001 **** FCVS PROGRAM 514 ****
C TEST 001 TEST SUBROUTINE STATEMENT WITH ASTERISK DUMMY ARGUMENTS
C
IVTNUM = 1
IVCOMP = 0
IVCORR = 3
IVN001 = 1
0012 CALL SN515(IVN001,*0013,*0014)
IVCOMP = 10
0013 CONTINUE
IVCOMP = IVCOMP + IVN001
IVN001 = 2
GO TO 0012
0014 CONTINUE
IVCOMP = IVCOMP + IVN001
40010 IF (IVCOMP - 3) 20010, 10010, 20010
10010 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0011
20010 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0011 CONTINUE
C
CT002* TEST 002 **** FCVS PROGRAM 514 ****
C TEST 002 TESTS THE USE OF AN ALTERNATE RETURN SPECIFIER
C AS AN ACTUAL ARGUMENT
C
IVTNUM = 2
IVCOMP = 0
IVCORR = 0
CALL SN516(5,IVN001,*0024)
0022 IVCOMP = IVCOMP - IVN001
GO TO 0025
0023 CONTINUE
IVCOMP = IVCOMP - IVN001
CALL SN516(4,IVN001,*0022)
IVCOMP = IVCOMP + IVN001
0024 CONTINUE
IVCOMP = IVCOMP + IVN001
CALL SN516(3,IVN001,*0023)
IVCOMP = IVCOMP + IVN001
0025 CONTINUE
40020 IF (IVCOMP - 0) 20020, 10020, 20020
10020 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0021
20020 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0021 CONTINUE
C
CBB** ********************** BBCSUM0 **********************************
C**** WRITE OUT TEST SUMMARY
C****
IVTOTN = IVPASS + IVFAIL + IVDELE + IVINSP
WRITE (I02, 90004)
WRITE (I02, 90014)
WRITE (I02, 90004)
WRITE (I02, 90020) IVPASS
WRITE (I02, 90022) IVFAIL
WRITE (I02, 90024) IVDELE
WRITE (I02, 90026) IVINSP
WRITE (I02, 90028) IVTOTN, IVTOTL
CBE** ********************** BBCSUM0 **********************************
CBB** ********************** BBCFOOT0 **********************************
C**** WRITE OUT REPORT FOOTINGS
C****
WRITE (I02,90016) ZPROG, ZPROG
WRITE (I02,90018) ZPROJ, ZNAME, ZTAPE, ZTAPED
WRITE (I02,90019)
CBE** ********************** BBCFOOT0 **********************************
90001 FORMAT (1H ,56X,5HFM514)
90000 FORMAT (1H ,50X,20HEND OF PROGRAM FM514)
CBB** ********************** BBCFMT0A **********************************
C**** FORMATS FOR TEST DETAIL LINES
C****
80000 FORMAT (1H ,2X,I3,4X,7HDELETED,32X,A31)
80002 FORMAT (1H ,2X,I3,4X,7H PASS ,32X,A31)
80004 FORMAT (1H ,2X,I3,4X,7HINSPECT,32X,A31)
80008 FORMAT (1H ,2X,I3,4X,7H FAIL ,32X,A31)
80010 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,15X,10HCOMPUTED= ,
1I6,/,1H ,15X,10HCORRECT= ,I6)
80012 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
1E12.5,/,1H ,16X,10HCORRECT= ,E12.5)
80018 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
1A21,/,1H ,16X,10HCORRECT= ,A21)
80020 FORMAT (1H ,16X,10HCOMPUTED= ,A21,1X,A31)
80022 FORMAT (1H ,16X,10HCORRECT= ,A21,1X,A31)
80024 FORMAT (1H ,16X,10HCOMPUTED= ,I6,16X,A31)
80026 FORMAT (1H ,16X,10HCORRECT= ,I6,16X,A31)
80028 FORMAT (1H ,16X,10HCOMPUTED= ,E12.5,10X,A31)
80030 FORMAT (1H ,16X,10HCORRECT= ,E12.5,10X,A31)
80050 FORMAT (1H ,48X,A31)
CBE** ********************** BBCFMT0A **********************************
CBB** ********************** BBCFMAT1 **********************************
C**** FORMATS FOR TEST DETAIL LINES - FULL LANGUAGE
C****
80031 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
1D17.10,/,1H ,16X,10HCORRECT= ,D17.10)
80033 FORMAT (1H ,16X,10HCOMPUTED= ,D17.10,10X,A31)
80035 FORMAT (1H ,16X,10HCORRECT= ,D17.10,10X,A31)
80037 FORMAT (1H ,16X,10HCOMPUTED= ,1H(,E12.5,2H, ,E12.5,1H),6X,A31)
80039 FORMAT (1H ,16X,10HCORRECT= ,1H(,E12.5,2H, ,E12.5,1H),6X,A31)
80041 FORMAT (1H ,16X,10HCOMPUTED= ,1H(,F12.5,2H, ,F12.5,1H),6X,A31)
80043 FORMAT (1H ,16X,10HCORRECT= ,1H(,F12.5,2H, ,F12.5,1H),6X,A31)
80045 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
11H(,F12.5,2H, ,F12.5,1H)/,1H ,16X,10HCORRECT= ,
21H(,F12.5,2H, ,F12.5,1H))
CBE** ********************** BBCFMAT1 **********************************
CBB** ********************** BBCFMT0B **********************************
C**** FORMAT STATEMENTS FOR PAGE HEADERS
C****
90002 FORMAT (1H1)
90004 FORMAT (1H )
90006 FORMAT (1H ,20X,31HFEDERAL SOFTWARE TESTING CENTER)
90007 FORMAT (1H ,19X,34HFORTRAN COMPILER VALIDATION SYSTEM)
90008 FORMAT (1H ,21X,A13,A17)
90009 FORMAT (1H ,/,2H *,A5,6HBEGIN*,12X,15HTEST RESULTS - ,A5,/)
90010 FORMAT (1H ,8X,16HTEST DATE*TIME= ,A17,15H - COMPILER= ,A20)
90013 FORMAT (1H ,8H TEST ,10HPASS/FAIL ,6X,17HDISPLAYED RESULTS,
1 7X,7HREMARKS,24X)
90014 FORMAT (1H ,46H----------------------------------------------,
1 33H---------------------------------)
90015 FORMAT (1H ,48X,17HTHIS PROGRAM HAS ,I3,6H TESTS,/)
C****
C**** FORMAT STATEMENTS FOR REPORT FOOTINGS
C****
90016 FORMAT (1H ,/,2H *,A5,4HEND*,14X,14HEND OF TEST - ,A5,/)
90018 FORMAT (1H ,A13,13X,A20,7H * ,A10,1H/,
1 A13)
90019 FORMAT (1H ,26HFOR OFFICIAL USE ONLY ,35X,15HCOPYRIGHT 1982)
C****
C**** FORMAT STATEMENTS FOR RUN SUMMARY
C****
90020 FORMAT (1H ,21X,I5,13H TESTS PASSED)
90022 FORMAT (1H ,21X,I5,13H TESTS FAILED)
90024 FORMAT (1H ,21X,I5,14H TESTS DELETED)
90026 FORMAT (1H ,21X,I5,25H TESTS REQUIRE INSPECTION)
90028 FORMAT (1H ,21X,I5,4H OF ,I3,15H TESTS EXECUTED)
CBE** ********************** BBCFMT0B **********************************
STOP
END
*HEADER,FORTR,FM514,SUBRTN,FM515
C
C THIS ROUTINE IS TO BE RUN WITH ROUTINE 514
C
C THIS SUBROUTINE IS USED TO TEST SUBROUTINE STATEMENT WITH
C ASTERISK DUMMY ARGUMENTS
C
SUBROUTINE SN515(IVD001,*,*)
RETURN IVD001
END
*HEADER,FORTR,FM514,SUBRTN,FM516
C THIS ROUTINE IS TO BE RUN WITH ROUTINE 514.
C
C THIS SUBROUTINE IS CALLED TO TEST THE USE OF AN ALTERNATE
C RETURN SPECIFIER AS AN ACTUAL ARGUMENT
C
SUBROUTINE SN516(IVD001,IVD002,*)
IVD002 = IVD001**2
RETURN 1
END
*END-OF,FM514
FM517.f 481036405 170 2 100666 11912 `
*HEADER,FORTR,FM517
*FILES1,FORTR,FM517
PROGRAM FM517
C
C THIS PROGRAM TESTS THE RETURN STATEMENT ANS REF.
C RETURN E 15.8.1
C IN SUBROUTINE SUBPROGRAMS. E IS AN ARITHMETIC 15.8.3
C EXPRESSION WHOSE VALUE INDICATES WHERE CONTROL
C WILL BE RETURNED TO.
C
C THIS ROUTINE USES SUBROUTINE SUBPROGRAMS SN518
C AND SN519
C
CBB** ********************** BBCCOMNT **********************************
C****
C**** 1978 FORTRAN COMPILER VALIDATION SYSTEM
C**** VERSION 2.0
C****
C****
C**** SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO
C**** GENERAL SERVICES ADMINISTRATION
C**** FEDERAL SOFTWARE TESTING CENTER
C**** 5203 LEESBURG PIKE, SUITE 1100
C**** FALLS CHURCH, VA. 22041
C****
C**** (703) 756-6153
C****
CBE** ********************** BBCCOMNT **********************************
IMPLICIT DOUBLE PRECISION (D), COMPLEX (Z), LOGICAL (L)
IMPLICIT CHARACTER*27 (C)
CBB** ********************** BBCINITA **********************************
C**** SPECIFICATION STATEMENTS
C****
CHARACTER ZVERS*13, ZVERSD*17, ZDATE*17, ZPROG*5, ZCOMPL*20,
1 ZNAME*20, ZTAPE*10, ZPROJ*13, REMRKS*31, ZTAPED*13
CBE** ********************** BBCINITA **********************************
C
C
C
CBB** ********************** BBCINITB **********************************
C**** INITIALIZE SECTION
DATA ZVERS, ZVERSD, ZDATE
1 /'VERSION 2.0 ', '82/08/02*18.33.46', '*NO DATE*TIME'/
DATA ZCOMPL, ZNAME, ZTAPE
1 /'*NONE SPECIFIED*', '*NO COMPANY NAME*', '*NO TAPE*'/
DATA ZPROJ, ZTAPED, ZPROG
1 /'*NO PROJECT*', '*NO TAPE DATE', 'XXXXX'/
DATA REMRKS /' '/
C**** THE FOLLOWING 9 COMMENT LINES (CZ01, CZ02, ...) CAN BE REPLACED
C**** FOR IDENTIFYING THE TEST ENVIRONMENT
C****
CZ01 ZVERS = 'VERSION OF THE COMPILER VALIDATION SYSTEM'
CZ02 ZVERSD = 'CREATION DATE/TIME OF THE COMPILER VALIDATION SYSTEM'
CZ03 ZPROG = 'PROGRAM NAME'
CZ04 ZDATE = 'DATE OF TEST'
CZ05 ZCOMPL = 'COMPILER IDENTIFICATION'
CZ06 ZPROJ = 'PROJECT NUMBER/IDENTIFICATION'
CZ07 ZNAME = 'NAME OF USER'
CZ08 ZTAPE = 'TAPE OWNER/ID'
CZ09 ZTAPED = 'DATE TAPE COPIED'
C
IVPASS = 0
IVFAIL = 0
IVDELE = 0
IVINSP = 0
IVTOTL = 0
IVTOTN = 0
ICZERO = 0
C
C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER.
I01 = 05
C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER.
I02 = 06
C
CX010 REPLACED BY FEXEC X-010 CONTROL CARD (CARD-READER UNIT NUMBER).
C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5
CX011 REPLACED BY FEXEC X-011 CONTROL CARD. CX011 IS FOR SYSTEMS
C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX010.
C
CX020 REPLACED BY FEXEC X-020 CONTROL CARD (PRINTER UNIT NUMBER).
C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02= 6
CX021 REPLACED BY FEXEC X-021 CONTROL CARD. CX021 IS FOR SYSTEMS
C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX020.
C
CBE** ********************** BBCINITB **********************************
ZPROG = 'FM517'
IVTOTL = 5
CBB** ********************** BBCHED0A **********************************
C****
C**** WRITE REPORT TITLE
C****
WRITE (I02, 90002)
WRITE (I02, 90006)
WRITE (I02, 90007)
WRITE (I02, 90008) ZVERS, ZVERSD
WRITE (I02, 90009) ZPROG, ZPROG
WRITE (I02, 90010) ZDATE, ZCOMPL
CBE** ********************** BBCHED0A **********************************
CBB** ********************** BBCHED0B **********************************
C**** WRITE DETAIL REPORT HEADERS
C****
WRITE (I02,90004)
WRITE (I02,90004)
WRITE (I02,90013)
WRITE (I02,90014)
WRITE (I02,90015) IVTOTL
CBE** ********************** BBCHED0B **********************************
C TESTS 1 AND 2 TEST RETURN CONTROL PROCESSING IN THE EXECUTION
C OF A SUBROUTINE SUBPROGRAM WHICH PROVIDES ALTERNATE RETURN
C
CT001* TEST 001 **** FCVS PROGRAM 517 ****
C
IVTNUM = 1
IVCOMP = 0
IVCORR = 3
IVN001 = 2
CALL SN518(IVN001,*0012,*0013)
IVCOMP = 1
GO TO 0014
0012 CONTINUE
IVCOMP = 2
GO TO 0014
0013 CONTINUE
IVCOMP = 3
0014 CONTINUE
40010 IF (IVCOMP - 3) 20010, 10010, 20010
10010 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0011
20010 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0011 CONTINUE
C
CT002* TEST 002 **** FCVS PROGRAM 517 ****
C
IVTNUM = 2
IVCOMP = 0
IVCORR = 5
CALL SN519(7,*0022,*0023)
IVCOMP = 1
GO TO 0024
0022 CONTINUE
IVCOMP = 3
GO TO 0024
0023 CONTINUE
IVCOMP = 5
0024 CONTINUE
40020 IF (IVCOMP - 5) 20020, 10020, 20020
10020 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0021
20020 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0021 CONTINUE
C
CT003* TEST 003 **** FCVS PROGRAM 517 ****
C TEST 003 TESTS THE "RETURN E" STATEMENT WHERE E HAS VALUE
C LESS THAN ONE
C
IVTNUM = 3
IVCOMP = 0
IVCORR = -2
CALL SN518(-3,*0032,*0033)
IVCOMP = -2
GO TO 0034
0032 CONTINUE
IVCOMP = -4
GO TO 0034
0033 CONTINUE
IVCOMP = -6
0034 CONTINUE
40030 IF (IVCOMP + 2) 20030, 10030, 20030
10030 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0031
20030 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0031 CONTINUE
C
CT004* TEST 004 **** FCVS PROGRAM 517 ****
C TEST 004 TESTS THE "RETURN E" STATEMENT WHERE E HAS VALUE
C GREATER THAN THE NUMBER OF ASTERISKS IN A SUBROUTINE STATEMENT
C
IVTNUM = 4
IVCOMP = 0
IVCORR = 7
CALL SN518(3,*0042,*0043)
IVCOMP = 7
GO TO 0044
0042 CONTINUE
IVCOMP = 9
GO TO 0044
0043 CONTINUE
IVCOMP = 11
0044 CONTINUE
40040 IF (IVCOMP - 7) 20040, 10040, 20040
10040 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0041
20040 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0041 CONTINUE
C
CT005* TEST 005 **** FCVS PROGRAM 517 ****
C TEST 005 TESTS THE "RETURN E" STATEMENT WHERE E HAS VALUE
C GREATER THAN THE NUMBER OF ASTERISKS IN AN ENTRY STATEMENT
C
IVTNUM = 5
IVCOMP = 0
IVCORR = -10
CALL EN872(9,*0052,*0053)
IVCOMP = -10
GO TO 0054
0052 CONTINUE
IVCOMP = 3
GO TO 0054
0053 CONTINUE
IVCOMP = 11
0054 CONTINUE
40050 IF (IVCOMP + 10) 20050, 10050, 20050
10050 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0051
20050 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0051 CONTINUE
C
CBB** ********************** BBCSUM0 **********************************
C**** WRITE OUT TEST SUMMARY
C****
IVTOTN = IVPASS + IVFAIL + IVDELE + IVINSP
WRITE (I02, 90004)
WRITE (I02, 90014)
WRITE (I02, 90004)
WRITE (I02, 90020) IVPASS
WRITE (I02, 90022) IVFAIL
WRITE (I02, 90024) IVDELE
WRITE (I02, 90026) IVINSP
WRITE (I02, 90028) IVTOTN, IVTOTL
CBE** ********************** BBCSUM0 **********************************
CBB** ********************** BBCFOOT0 **********************************
C**** WRITE OUT REPORT FOOTINGS
C****
WRITE (I02,90016) ZPROG, ZPROG
WRITE (I02,90018) ZPROJ, ZNAME, ZTAPE, ZTAPED
WRITE (I02,90019)
CBE** ********************** BBCFOOT0 **********************************
90001 FORMAT (1H ,56X,5HFM517)
90000 FORMAT (1H ,50X,20HEND OF PROGRAM FM517)
CBB** ********************** BBCFMT0A **********************************
C**** FORMATS FOR TEST DETAIL LINES
C****
80000 FORMAT (1H ,2X,I3,4X,7HDELETED,32X,A31)
80002 FORMAT (1H ,2X,I3,4X,7H PASS ,32X,A31)
80004 FORMAT (1H ,2X,I3,4X,7HINSPECT,32X,A31)
80008 FORMAT (1H ,2X,I3,4X,7H FAIL ,32X,A31)
80010 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,15X,10HCOMPUTED= ,
1I6,/,1H ,15X,10HCORRECT= ,I6)
80012 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
1E12.5,/,1H ,16X,10HCORRECT= ,E12.5)
80018 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
1A21,/,1H ,16X,10HCORRECT= ,A21)
80020 FORMAT (1H ,16X,10HCOMPUTED= ,A21,1X,A31)
80022 FORMAT (1H ,16X,10HCORRECT= ,A21,1X,A31)
80024 FORMAT (1H ,16X,10HCOMPUTED= ,I6,16X,A31)
80026 FORMAT (1H ,16X,10HCORRECT= ,I6,16X,A31)
80028 FORMAT (1H ,16X,10HCOMPUTED= ,E12.5,10X,A31)
80030 FORMAT (1H ,16X,10HCORRECT= ,E12.5,10X,A31)
80050 FORMAT (1H ,48X,A31)
CBE** ********************** BBCFMT0A **********************************
CBB** ********************** BBCFMAT1 **********************************
C**** FORMATS FOR TEST DETAIL LINES - FULL LANGUAGE
C****
80031 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
1D17.10,/,1H ,16X,10HCORRECT= ,D17.10)
80033 FORMAT (1H ,16X,10HCOMPUTED= ,D17.10,10X,A31)
80035 FORMAT (1H ,16X,10HCORRECT= ,D17.10,10X,A31)
80037 FORMAT (1H ,16X,10HCOMPUTED= ,1H(,E12.5,2H, ,E12.5,1H),6X,A31)
80039 FORMAT (1H ,16X,10HCORRECT= ,1H(,E12.5,2H, ,E12.5,1H),6X,A31)
80041 FORMAT (1H ,16X,10HCOMPUTED= ,1H(,F12.5,2H, ,F12.5,1H),6X,A31)
80043 FORMAT (1H ,16X,10HCORRECT= ,1H(,F12.5,2H, ,F12.5,1H),6X,A31)
80045 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
11H(,F12.5,2H, ,F12.5,1H)/,1H ,16X,10HCORRECT= ,
21H(,F12.5,2H, ,F12.5,1H))
CBE** ********************** BBCFMAT1 **********************************
CBB** ********************** BBCFMT0B **********************************
C**** FORMAT STATEMENTS FOR PAGE HEADERS
C****
90002 FORMAT (1H1)
90004 FORMAT (1H )
90006 FORMAT (1H ,20X,31HFEDERAL SOFTWARE TESTING CENTER)
90007 FORMAT (1H ,19X,34HFORTRAN COMPILER VALIDATION SYSTEM)
90008 FORMAT (1H ,21X,A13,A17)
90009 FORMAT (1H ,/,2H *,A5,6HBEGIN*,12X,15HTEST RESULTS - ,A5,/)
90010 FORMAT (1H ,8X,16HTEST DATE*TIME= ,A17,15H - COMPILER= ,A20)
90013 FORMAT (1H ,8H TEST ,10HPASS/FAIL ,6X,17HDISPLAYED RESULTS,
1 7X,7HREMARKS,24X)
90014 FORMAT (1H ,46H----------------------------------------------,
1 33H---------------------------------)
90015 FORMAT (1H ,48X,17HTHIS PROGRAM HAS ,I3,6H TESTS,/)
C****
C**** FORMAT STATEMENTS FOR REPORT FOOTINGS
C****
90016 FORMAT (1H ,/,2H *,A5,4HEND*,14X,14HEND OF TEST - ,A5,/)
90018 FORMAT (1H ,A13,13X,A20,7H * ,A10,1H/,
1 A13)
90019 FORMAT (1H ,26HFOR OFFICIAL USE ONLY ,35X,15HCOPYRIGHT 1982)
C****
C**** FORMAT STATEMENTS FOR RUN SUMMARY
C****
90020 FORMAT (1H ,21X,I5,13H TESTS PASSED)
90022 FORMAT (1H ,21X,I5,13H TESTS FAILED)
90024 FORMAT (1H ,21X,I5,14H TESTS DELETED)
90026 FORMAT (1H ,21X,I5,25H TESTS REQUIRE INSPECTION)
90028 FORMAT (1H ,21X,I5,4H OF ,I3,15H TESTS EXECUTED)
CBE** ********************** BBCFMT0B **********************************
STOP
END
*HEADER,FORTR,FM517,SUBRTN,FM518
C
C THIS ROUTINE IS TO BE RUN WITH ROUTINE 517
C
C THIS SUBROUTINE TESTS THE USE OF THE "RETURN E" STATEMENT
C WHERE E IS AN INTEGER VARIABLE
C
SUBROUTINE SN518(IVD001,*,*)
RETURN IVD001
END
*HEADER,FORTR,FM517,SUBRTN,FM519
C
C THIS ROUTINE IS TO BE RUN WITH ROUTINE 517
C
C THIS SUBROUTINE TESTS THE USE OF THE "RETURN E" STATEMENT
C WHERE E IS AN INTEGER EXPRESSION
C
SUBROUTINE SN519(IVD001,*,*)
RETURN (IVD001 - 2*(IVD001/2) + 1)
ENTRY EN872(IVD002,*,*)
RETURN (IVD002 - 3)
END
*END-OF,FM517
FM520.f 481036411 170 2 100666 21016 `
*HEADER,FORTR,FM520
*FILES1,FORTR,FM520,X
PROGRAM FM520
C
C TESTING PARAMETER STATEMENT
C
C
CBB** ********************** BBCCOMNT **********************************
C****
C**** 1978 FORTRAN COMPILER VALIDATION SYSTEM
C**** VERSION 2.0
C****
C****
C**** SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO
C**** GENERAL SERVICES ADMINISTRATION
C**** FEDERAL SOFTWARE TESTING CENTER
C**** 5203 LEESBURG PIKE, SUITE 1100
C**** FALLS CHURCH, VA. 22041
C****
C**** (703) 756-6153
C****
CBE** ********************** BBCCOMNT **********************************
IMPLICIT DOUBLE PRECISION (D), COMPLEX (Z), LOGICAL (L)
IMPLICIT CHARACTER*27 (C)
CBB** ********************** BBCINITA **********************************
C**** SPECIFICATION STATEMENTS
C****
CHARACTER ZVERS*13, ZVERSD*17, ZDATE*17, ZPROG*5, ZCOMPL*20,
1 ZNAME*20, ZTAPE*10, ZPROJ*13, REMRKS*31, ZTAPED*13
CBE** ********************** BBCINITA **********************************
C
PARAMETER(IPN001=5+5,IPN002=8-3,IPN003=1*5)
PARAMETER(RPN001=5.1+4.9,RPN002=8.7-3.7,RPN003=2.0*2.5)
C
C TEST 1 - 7 TEST INTEGER ARITHMETIC EXPRESSION USING
C ONLY SYMBOLIC NAMES OF ARITHMETIC CONSTANTS
C S06AF-2P 4.A
C
C
C
CBB** ********************** BBCINITB **********************************
C**** INITIALIZE SECTION
DATA ZVERS, ZVERSD, ZDATE
1 /'VERSION 2.0 ', '82/08/02*18.33.46', '*NO DATE*TIME'/
DATA ZCOMPL, ZNAME, ZTAPE
1 /'*NONE SPECIFIED*', '*NO COMPANY NAME*', '*NO TAPE*'/
DATA ZPROJ, ZTAPED, ZPROG
1 /'*NO PROJECT*', '*NO TAPE DATE', 'XXXXX'/
DATA REMRKS /' '/
C**** THE FOLLOWING 9 COMMENT LINES (CZ01, CZ02, ...) CAN BE REPLACED
C**** FOR IDENTIFYING THE TEST ENVIRONMENT
C****
CZ01 ZVERS = 'VERSION OF THE COMPILER VALIDATION SYSTEM'
CZ02 ZVERSD = 'CREATION DATE/TIME OF THE COMPILER VALIDATION SYSTEM'
CZ03 ZPROG = 'PROGRAM NAME'
CZ04 ZDATE = 'DATE OF TEST'
CZ05 ZCOMPL = 'COMPILER IDENTIFICATION'
CZ06 ZPROJ = 'PROJECT NUMBER/IDENTIFICATION'
CZ07 ZNAME = 'NAME OF USER'
CZ08 ZTAPE = 'TAPE OWNER/ID'
CZ09 ZTAPED = 'DATE TAPE COPIED'
C
IVPASS = 0
IVFAIL = 0
IVDELE = 0
IVINSP = 0
IVTOTL = 0
IVTOTN = 0
ICZERO = 0
C
C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER.
I01 = 05
C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER.
I02 = 06
C
CX010 REPLACED BY FEXEC X-010 CONTROL CARD (CARD-READER UNIT NUMBER).
C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5
CX011 REPLACED BY FEXEC X-011 CONTROL CARD. CX011 IS FOR SYSTEMS
C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX010.
C
CX020 REPLACED BY FEXEC X-020 CONTROL CARD (PRINTER UNIT NUMBER).
C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02= 6
CX021 REPLACED BY FEXEC X-021 CONTROL CARD. CX021 IS FOR SYSTEMS
C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX020.
C
CBE** ********************** BBCINITB **********************************
ZPROG='FM520'
IVTOTL = 30
CBB** ********************** BBCHED0A **********************************
C****
C**** WRITE REPORT TITLE
C****
WRITE (I02, 90002)
WRITE (I02, 90006)
WRITE (I02, 90007)
WRITE (I02, 90008) ZVERS, ZVERSD
WRITE (I02, 90009) ZPROG, ZPROG
WRITE (I02, 90010) ZDATE, ZCOMPL
CBE** ********************** BBCHED0A **********************************
CBB** ********************** BBCHED0B **********************************
C**** WRITE DETAIL REPORT HEADERS
C****
WRITE (I02,90004)
WRITE (I02,90004)
WRITE (I02,90013)
WRITE (I02,90014)
WRITE (I02,90015) IVTOTL
CBE** ********************** BBCHED0B **********************************
C
CT001* TEST 001 **** FCVS PROGRAM 520 ****
C
C
IVTNUM = 1
IVCOMP=+IPN001
IVCORR=+10
40010 IF (IVCOMP - 10) 20010, 10010, 20010
10010 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0021
20010 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0021 CONTINUE
C
CT002* TEST 002 **** FCVS PROGRAM 520 ****
C
C
IVTNUM = 2
IVCOMP=-IPN001
IVCORR=-10
40020 IF (IVCOMP + 10) 20020, 10020, 20020
10020 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0031
20020 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0031 CONTINUE
C
CT003* TEST 003 **** FCVS PROGRAM 520 ****
C
C
IVTNUM = 3
IVCOMP=IPN001+IPN002
IVCORR=15
40030 IF (IVCOMP - 15) 20030, 10030, 20030
10030 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0041
20030 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0041 CONTINUE
C
CT004* TEST 004 **** FCVS PROGRAM 520 ****
C
C
IVTNUM = 4
IVCOMP=IPN001-IPN002
IVCORR=5
40040 IF (IVCOMP - 5) 20040, 10040, 20040
10040 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0051
20040 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0051 CONTINUE
C
CT005* TEST 005 **** FCVS PROGRAM 520 ****
C
C
IVTNUM = 5
IVCOMP=IPN001*IPN002
IVCORR=50
40050 IF (IVCOMP - 50) 20050, 10050, 20050
10050 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0061
20050 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0061 CONTINUE
C
CT006* TEST 006 **** FCVS PROGRAM 520 ****
C
C
IVTNUM = 6
IVCOMP=IPN001/IPN002
IVCORR=2
40060 IF (IVCOMP - 2) 20060, 10060, 20060
10060 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0071
20060 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0071 CONTINUE
C
CT007* TEST 007 **** FCVS PROGRAM 520 ****
C
C
IVTNUM = 7
IVCOMP=IPN001**IPN002
IVCORR=100000
40070 IF (IVCOMP - 100000) 20070, 10070, 20070
10070 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0081
20070 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0081 CONTINUE
C
C
C TEST 8 - 14 TEST REAL ARITHMETIC EXPRESSION USING
C ONLY SYMBOLIC NAMES OF ARITHMETIC CONSTANTS
C S06AF-2P 4.A
C
CT008* TEST 008 **** FCVS PROGRAM 520 ****
C
C
IVTNUM = 8
RVCOMP=+RPN001
RVCORR=+10.0
IF (RVCOMP - 0.99995E+01) 20080, 10080, 40080
40080 IF (RVCOMP - 0.10001E+02) 10080, 10080, 20080
10080 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0091
20080 IVFAIL = IVFAIL + 1
WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR
0091 CONTINUE
C
CT009* TEST 009 **** FCVS PROGRAM 520 ****
C
C
IVTNUM = 9
RVCOMP=-RPN001
RVCORR=-10.0
IF (RVCOMP + 0.10001E+02) 20090, 10090, 40090
40090 IF (RVCOMP + 0.99995E+01) 10090, 10090, 20090
10090 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0101
20090 IVFAIL = IVFAIL + 1
WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR
0101 CONTINUE
C
CT010* TEST 010 **** FCVS PROGRAM 520 ****
C
IVTNUM = 10
RVCOMP=RPN001+RPN002
RVCORR=15.0
IF (RVCOMP - 0.14999E+02) 20100, 10100, 40100
40100 IF (RVCOMP - 0.15001E+02) 10100, 10100, 20100
10100 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0111
20100 IVFAIL = IVFAIL + 1
WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR
0111 CONTINUE
C
CT011* TEST 011 **** FCVS PROGRAM 520 ****
C
C
IVTNUM = 11
RVCOMP=RPN001-RPN002
RVCORR=5.0
IF (RVCOMP - 0.49997E+01) 20110, 10110, 40110
40110 IF (RVCOMP - 0.50003E+01) 10110, 10110, 20110
10110 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0121
20110 IVFAIL = IVFAIL + 1
WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR
0121 CONTINUE
C
CT012* TEST 012 **** FCVS PROGRAM 520 ****
C
C
IVTNUM = 12
RVCOMP=RPN001*RPN002
RVCORR=50.0
IF (RVCOMP - 0.49997E+02) 20120, 10120, 40120
40120 IF (RVCOMP - 0.50003E+02) 10120, 10120, 20120
10120 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0131
20120 IVFAIL = IVFAIL + 1
WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR
0131 CONTINUE
C
CT013* TEST 013 **** FCVS PROGRAM 520 ****
C
IVTNUM = 13
RVCOMP=RPN001/RPN002
RVCORR=2.0
IF (RVCOMP - 0.19999E+01) 20130, 10130, 40130
40130 IF (RVCOMP - 0.20001E+01) 10130, 10130, 20130
10130 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0141
20130 IVFAIL = IVFAIL + 1
WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR
0141 CONTINUE
C
CT014* TEST 014 **** FCVS PROGRAM 520 ****
C
IVTNUM = 14
RVCOMP=RPN001**RPN002
RVCORR=100000.0
IF (RVCOMP - 0.99995E+05) 20140, 10140, 40140
40140 IF (RVCOMP - 0.10001E+06) 10140, 10140, 20140
10140 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0151
20140 IVFAIL = IVFAIL + 1
WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR
0151 CONTINUE
C
C
C TEST 15 - 18 REPEATS TEST 1 - 7 USING MORE THAN ONE OPERATOR
C S06AF-2P 4.C
C
CT015* TEST 015 **** FCVS PROGRAM 520 ****
C
C
IVTNUM = 15
IVCOMP=IPN001+IPN001-IPN002
IVCORR=15
40150 IF (IVCOMP - 15) 20150, 10150, 20150
10150 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0161
20150 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0161 CONTINUE
C
CT016* TEST 016 **** FCVS PROGRAM 520 ****
C
IVTNUM = 16
IVCOMP=IPN001+IPN001-IPN002*IPN002
IVCORR=-5
40160 IF (IVCOMP + 5) 20160, 10160, 20160
10160 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0171
20160 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0171 CONTINUE
C
CT017* TEST 017 **** FCVS PROGRAM 520 ****
C
C
IVTNUM = 17
IVCOMP=IPN001+IPN001-IPN002*IPN002/IPN003
IVCORR=15
40170 IF (IVCOMP - 15) 20170, 10170, 20170
10170 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0181
20170 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0181 CONTINUE
C
CT018* TEST 018 **** FCVS PROGRAM 520 ****
C
IVTNUM = 18
IVCOMP=IPN001+IPN001**IPN002-IPN002*IPN002/IPN003
IVCORR=100005
40180 IF (IVCOMP - 100005) 20180, 10180, 20180
10180 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0191
20180 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0191 CONTINUE
C
C
C TEST 19 - 22 REPEATS TEST 8 - 14 USING MORE THAN ONE OPERATOR
C S06AF-2P 4.C
C
CT019* TEST 019 **** FCVS PROGRAM 520 ****
C
IVTNUM = 19
RVCOMP=RPN001+RPN001-RPN002
RVCORR=15.0
IF (RVCOMP - 0.14999E+02) 20190, 10190, 40190
40190 IF (RVCOMP - 0.15001E+02) 10190, 10190, 20190
10190 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0201
20190 IVFAIL = IVFAIL + 1
WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR
0201 CONTINUE
C
CT020* TEST 020 **** FCVS PROGRAM 520 ****
C
IVTNUM = 20
RVCOMP=RPN001+RPN001-RPN002*RPN002
RVCORR=-5.0
IF (RVCOMP + 0.50003E+01) 20200, 10200, 40200
40200 IF (RVCOMP + 0.49997E+01) 10200, 10200, 20200
10200 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0211
20200 IVFAIL = IVFAIL + 1
WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR
0211 CONTINUE
C
CT021* TEST 021 **** FCVS PROGRAM 520 ****
C
IVTNUM = 21
RVCOMP=RPN001+RPN001-RPN002*RPN002/RPN003
RVCORR=15.0
IF (RVCOMP - 0.14999E+02) 20210, 10210, 40210
40210 IF (RVCOMP - 0.15001E+02) 10210, 10210, 20210
10210 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0221
20210 IVFAIL = IVFAIL + 1
WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR
0221 CONTINUE
C
CT022* TEST 022 **** FCVS PROGRAM 520 ****
C
IVTNUM = 22
RVCOMP=RPN001+RPN001**RPN002-RPN002*RPN002/RPN003
RVCORR=100005.0
IF (RVCOMP - 0.10000E+06) 20220, 10220, 40220
40220 IF (RVCOMP - 0.10001E+06) 10220, 10220, 20220
10220 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0231
20220 IVFAIL = IVFAIL + 1
WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR
0231 CONTINUE
C
C
C TEST 23 - 26 REPEATS TEST 15 - 18 USING PARENTHESES
C S06AF-2P 4.D
C
C
C
CT023* TEST 023 **** FCVS PROGRAM 520 ****
C
IVTNUM = 23
IVCOMP=IPN001+(IPN001-IPN002)
IVCORR=15
40230 IF (IVCOMP - 15) 20230, 10230, 20230
10230 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0241
20230 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0241 CONTINUE
C
CT024* TEST 024 **** FCVS PROGRAM 520 ****
C
IVTNUM = 24
IVCOMP=((IPN001+IPN001)-IPN002)*IPN002
IVCORR=75
40240 IF (IVCOMP - 75) 20240, 10240, 20240
10240 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0251
20240 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0251 CONTINUE
C
CT025* TEST 025 **** FCVS PROGRAM 520 ****
C
IVTNUM = 25
IVCOMP=(IPN001+IPN001)-IPN002*(IPN002/IPN003)
IVCORR=15
40250 IF (IVCOMP - 15) 20250, 10250, 20250
10250 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0261
20250 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0261 CONTINUE
C
CT026* TEST 026 **** FCVS PROGRAM 520 ****
C
IVTNUM = 26
IVCOMP=(IPN001+IPN001)**2-((IPN002*IPN002)/IPN003)
IVCORR=395
40260 IF (IVCOMP - 395) 20260, 10260, 20260
10260 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0271
20260 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0271 CONTINUE
C
C TEST 27 - 30 REPEATS TEST 19 - 22 USING PARENTHESES
C S06AF-2P 4.D
C
CT027* TEST 027 **** FCVS PROGRAM 520 ****
C
IVTNUM = 27
RVCOMP=RPN001+(RPN001-RPN002)
RVCORR=15.0
IF (RVCOMP - 0.14999E+02) 20270, 10270, 40270
40270 IF (RVCOMP - 0.15001E+02) 10270, 10270, 20270
10270 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0281
20270 IVFAIL = IVFAIL + 1
WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR
0281 CONTINUE
C
CT028* TEST 028 **** FCVS PROGRAM 520 ****
C
IVTNUM = 28
RVCOMP=((RPN001+RPN001)-RPN002)*RPN002
RVCORR=75.0
IF (RVCOMP - 0.74996E+02) 20280, 10280, 40280
40280 IF (RVCOMP - 0.75004E+02) 10280, 10280, 20280
10280 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0291
20280 IVFAIL = IVFAIL + 1
WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR
0291 CONTINUE
C
CT029* TEST 029 **** FCVS PROGRAM 520 ****
C
IVTNUM = 29
RVCOMP=(RPN001+RPN001)-RPN002*(RPN002/RPN003)
RVCORR=15.0
IF (RVCOMP - 0.14999E+02) 20290, 10290, 40290
40290 IF (RVCOMP - 0.15001E+02) 10290, 10290, 20290
10290 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0301
20290 IVFAIL = IVFAIL + 1
WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR
0301 CONTINUE
C
CT030* TEST 030 **** FCVS PROGRAM 520 ****
C
C
IVTNUM = 30
RVCOMP=(RPN001+RPN001)**3.0-((RPN002*RPN002)/RPN003)
RVCORR=7995.0
IF (RVCOMP - 0.79946E+04) 20300, 10300, 40300
40300 IF (RVCOMP - 0.79954E+04) 10300, 10300, 20300
10300 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0311
20300 IVFAIL = IVFAIL + 1
WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR
0311 CONTINUE
C
CBB** ********************** BBCSUM0 **********************************
C**** WRITE OUT TEST SUMMARY
C****
IVTOTN = IVPASS + IVFAIL + IVDELE + IVINSP
WRITE (I02, 90004)
WRITE (I02, 90014)
WRITE (I02, 90004)
WRITE (I02, 90020) IVPASS
WRITE (I02, 90022) IVFAIL
WRITE (I02, 90024) IVDELE
WRITE (I02, 90026) IVINSP
WRITE (I02, 90028) IVTOTN, IVTOTL
CBE** ********************** BBCSUM0 **********************************
CBB** ********************** BBCFOOT0 **********************************
C**** WRITE OUT REPORT FOOTINGS
C****
WRITE (I02,90016) ZPROG, ZPROG
WRITE (I02,90018) ZPROJ, ZNAME, ZTAPE, ZTAPED
WRITE (I02,90019)
CBE** ********************** BBCFOOT0 **********************************
90001 FORMAT (1H ,56X,5HFM520)
90000 FORMAT (1H ,50X,20HEND OF PROGRAM FM520)
CBB** ********************** BBCFMT0A **********************************
C**** FORMATS FOR TEST DETAIL LINES
C****
80000 FORMAT (1H ,2X,I3,4X,7HDELETED,32X,A31)
80002 FORMAT (1H ,2X,I3,4X,7H PASS ,32X,A31)
80004 FORMAT (1H ,2X,I3,4X,7HINSPECT,32X,A31)
80008 FORMAT (1H ,2X,I3,4X,7H FAIL ,32X,A31)
80010 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,15X,10HCOMPUTED= ,
1I6,/,1H ,15X,10HCORRECT= ,I6)
80012 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
1E12.5,/,1H ,16X,10HCORRECT= ,E12.5)
80018 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
1A21,/,1H ,16X,10HCORRECT= ,A21)
80020 FORMAT (1H ,16X,10HCOMPUTED= ,A21,1X,A31)
80022 FORMAT (1H ,16X,10HCORRECT= ,A21,1X,A31)
80024 FORMAT (1H ,16X,10HCOMPUTED= ,I6,16X,A31)
80026 FORMAT (1H ,16X,10HCORRECT= ,I6,16X,A31)
80028 FORMAT (1H ,16X,10HCOMPUTED= ,E12.5,10X,A31)
80030 FORMAT (1H ,16X,10HCORRECT= ,E12.5,10X,A31)
80050 FORMAT (1H ,48X,A31)
CBE** ********************** BBCFMT0A **********************************
CBB** ********************** BBCFMAT1 **********************************
C**** FORMATS FOR TEST DETAIL LINES - FULL LANGUAGE
C****
80031 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
1D17.10,/,1H ,16X,10HCORRECT= ,D17.10)
80033 FORMAT (1H ,16X,10HCOMPUTED= ,D17.10,10X,A31)
80035 FORMAT (1H ,16X,10HCORRECT= ,D17.10,10X,A31)
80037 FORMAT (1H ,16X,10HCOMPUTED= ,1H(,E12.5,2H, ,E12.5,1H),6X,A31)
80039 FORMAT (1H ,16X,10HCORRECT= ,1H(,E12.5,2H, ,E12.5,1H),6X,A31)
80041 FORMAT (1H ,16X,10HCOMPUTED= ,1H(,F12.5,2H, ,F12.5,1H),6X,A31)
80043 FORMAT (1H ,16X,10HCORRECT= ,1H(,F12.5,2H, ,F12.5,1H),6X,A31)
80045 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
11H(,F12.5,2H, ,F12.5,1H)/,1H ,16X,10HCORRECT= ,
21H(,F12.5,2H, ,F12.5,1H))
CBE** ********************** BBCFMAT1 **********************************
CBB** ********************** BBCFMT0B **********************************
C**** FORMAT STATEMENTS FOR PAGE HEADERS
C****
90002 FORMAT (1H1)
90004 FORMAT (1H )
90006 FORMAT (1H ,20X,31HFEDERAL SOFTWARE TESTING CENTER)
90007 FORMAT (1H ,19X,34HFORTRAN COMPILER VALIDATION SYSTEM)
90008 FORMAT (1H ,21X,A13,A17)
90009 FORMAT (1H ,/,2H *,A5,6HBEGIN*,12X,15HTEST RESULTS - ,A5,/)
90010 FORMAT (1H ,8X,16HTEST DATE*TIME= ,A17,15H - COMPILER= ,A20)
90013 FORMAT (1H ,8H TEST ,10HPASS/FAIL ,6X,17HDISPLAYED RESULTS,
1 7X,7HREMARKS,24X)
90014 FORMAT (1H ,46H----------------------------------------------,
1 33H---------------------------------)
90015 FORMAT (1H ,48X,17HTHIS PROGRAM HAS ,I3,6H TESTS,/)
C****
C**** FORMAT STATEMENTS FOR REPORT FOOTINGS
C****
90016 FORMAT (1H ,/,2H *,A5,4HEND*,14X,14HEND OF TEST - ,A5,/)
90018 FORMAT (1H ,A13,13X,A20,7H * ,A10,1H/,
1 A13)
90019 FORMAT (1H ,26HFOR OFFICIAL USE ONLY ,35X,15HCOPYRIGHT 1982)
C****
C**** FORMAT STATEMENTS FOR RUN SUMMARY
C****
90020 FORMAT (1H ,21X,I5,13H TESTS PASSED)
90022 FORMAT (1H ,21X,I5,13H TESTS FAILED)
90024 FORMAT (1H ,21X,I5,14H TESTS DELETED)
90026 FORMAT (1H ,21X,I5,25H TESTS REQUIRE INSPECTION)
90028 FORMAT (1H ,21X,I5,4H OF ,I3,15H TESTS EXECUTED)
CBE** ********************** BBCFMT0B **********************************
END
*END-OF,FM520
FM700.f 481036416 170 2 100666 21101 `
*HEADER,FORTR,FM700
*FILES1,FORTR,FM700,X
PROGRAM FM700
C
C THIS PROGRAM TESTS THE DATA STATEMENT WITH ANS REF.
C VARIABLE NAMES, ARRAY NAMES, ARRAY ELEMENT 9.1
C NAMES, SUBSTRING NAMES, AND IMPLIED-DO LISTS. 9.2
C 9.3
C SYMBOLIC NAMES OF CONSTANTS ARE PERMITTED IN THE
C CLIST OF THE DATA STATEMENT. IF NECESSARY,
C THE CLIST CONSTANT IS CONVERTED TO THE TYPE
C OF THE NLIST ENTITY ACCORDING TO THE RULES
C FOR ARITHMETIC CONVERSION.
C
C
CBB** ********************** BBCCOMNT **********************************
C****
C**** 1978 FORTRAN COMPILER VALIDATION SYSTEM
C**** VERSION 2.0
C****
C****
C**** SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO
C**** GENERAL SERVICES ADMINISTRATION
C**** FEDERAL SOFTWARE TESTING CENTER
C**** 5203 LEESBURG PIKE, SUITE 1100
C**** FALLS CHURCH, VA. 22041
C****
C**** (703) 756-6153
C****
CBE** ********************** BBCCOMNT **********************************
IMPLICIT DOUBLE PRECISION (D), COMPLEX (Z), LOGICAL (L)
IMPLICIT CHARACTER*27 (C)
CBB** ********************** BBCINITA **********************************
C**** SPECIFICATION STATEMENTS
C****
CHARACTER ZVERS*13, ZVERSD*17, ZDATE*17, ZPROG*5, ZCOMPL*20,
1 ZNAME*20, ZTAPE*10, ZPROJ*13, REMRKS*31, ZTAPED*13
CBE** ********************** BBCINITA **********************************
C
INTEGER I2N001(2,3), I2N002(7), I2N003(3,7)
INTEGER I2N004(3,10), I2N005(4,5), I2N006(6,8)
CHARACTER CVCOMP*25, CVCORR*25, CPN001*5
CHARACTER CVN001*25, CVN002*5, C1N001(3)*5
CHARACTER C2N001(3,4)*4, CVN003*17
REAL R2E001(2), R2N001(5,3)
DOUBLE PRECISION DVCOMP, DVCORR, DVN001, D1N001(9), DPN001
COMPLEX ZVCOMP, ZVCORR, ZVN001, Z1N001(10)
PARAMETER (IPN001=-14, CPN001='SEVEN', IPN002=5, DPN001=0.1948D+3)
EQUIVALENCE (ZVCOMP, R2E001)
DATA IVN001, C1N001, I2N001(2,1), CVN001(11:22)
1 /-137, 'FIRST', 'SECND', 'THIRD', 65, 'ELEVENTWELVE'/
DATA (I2N001(1,I), I=1,3) /-47, 198, -217/
DATA IVN002, CVN002 /IPN001, CPN001/
DATA I2N002, (I2N003(I,7), I=1,3), C2N001, CVN003(13:16)
1 /3*19, 7*-4, 13*'SAME'/
DATA IVN003, IVN004, RVN001, ZVN001, DVN001, DVN002
1 /-0.473E+3, 239.2D-1, 71, (71, -27), 6, 9.1534E-2/
DATA (I2N004(2,J), J=1,10) /9,8,7,6,5,4,3,2,1,0/
DATA ((R2N001(I,J), J=1,3), I=3,5)
1 /3.1, 3.2, 3.3, 4.1, 4.2, 4.3, 5.1, 5.2, 5.3/
DATA (Z1N001(I), I=3,7) /IPN002*(7.3, -2.28)/
DATA (D1N001(I), I=1,9,2) /IPN002*DPN001/
DATA (I2N005(I,I+1),I=1,4) / 91, -82, 73, -64/
DATA ((I2N006(2*I,I*J-1), I=2,3), J=1,3,2) /41, 62, 45, 68/
C
C
CBB** ********************** BBCINITB **********************************
C**** INITIALIZE SECTION
DATA ZVERS, ZVERSD, ZDATE
1 /'VERSION 2.0 ', '82/08/02*18.33.46', '*NO DATE*TIME'/
DATA ZCOMPL, ZNAME, ZTAPE
1 /'*NONE SPECIFIED*', '*NO COMPANY NAME*', '*NO TAPE*'/
DATA ZPROJ, ZTAPED, ZPROG
1 /'*NO PROJECT*', '*NO TAPE DATE', 'XXXXX'/
DATA REMRKS /' '/
C**** THE FOLLOWING 9 COMMENT LINES (CZ01, CZ02, ...) CAN BE REPLACED
C**** FOR IDENTIFYING THE TEST ENVIRONMENT
C****
CZ01 ZVERS = 'VERSION OF THE COMPILER VALIDATION SYSTEM'
CZ02 ZVERSD = 'CREATION DATE/TIME OF THE COMPILER VALIDATION SYSTEM'
CZ03 ZPROG = 'PROGRAM NAME'
CZ04 ZDATE = 'DATE OF TEST'
CZ05 ZCOMPL = 'COMPILER IDENTIFICATION'
CZ06 ZPROJ = 'PROJECT NUMBER/IDENTIFICATION'
CZ07 ZNAME = 'NAME OF USER'
CZ08 ZTAPE = 'TAPE OWNER/ID'
CZ09 ZTAPED = 'DATE TAPE COPIED'
C
IVPASS = 0
IVFAIL = 0
IVDELE = 0
IVINSP = 0
IVTOTL = 0
IVTOTN = 0
ICZERO = 0
C
C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER.
I01 = 05
C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER.
I02 = 06
C
CX010 REPLACED BY FEXEC X-010 CONTROL CARD (CARD-READER UNIT NUMBER).
C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5
CX011 REPLACED BY FEXEC X-011 CONTROL CARD. CX011 IS FOR SYSTEMS
C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX010.
C
CX020 REPLACED BY FEXEC X-020 CONTROL CARD (PRINTER UNIT NUMBER).
C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02= 6
CX021 REPLACED BY FEXEC X-021 CONTROL CARD. CX021 IS FOR SYSTEMS
C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX020.
C
CBE** ********************** BBCINITB **********************************
ZPROG = 'FM700'
IVTOTL = 23
CBB** ********************** BBCHED0A **********************************
C****
C**** WRITE REPORT TITLE
C****
WRITE (I02, 90002)
WRITE (I02, 90006)
WRITE (I02, 90007)
WRITE (I02, 90008) ZVERS, ZVERSD
WRITE (I02, 90009) ZPROG, ZPROG
WRITE (I02, 90010) ZDATE, ZCOMPL
CBE** ********************** BBCHED0A **********************************
CBB** ********************** BBCHED0B **********************************
C**** WRITE DETAIL REPORT HEADERS
C****
WRITE (I02,90004)
WRITE (I02,90004)
WRITE (I02,90013)
WRITE (I02,90014)
WRITE (I02,90015) IVTOTL
CBE** ********************** BBCHED0B **********************************
C
C
C TESTS 1 THRU 5 TEST DATA STATEMENT WITH VARIABLE NAMES,
C ARRAY NAMES, ARRAY ELEMENT NAMES, SUBSTRING NAMES, AND IMPLIED-
C DO LISTS.
C
CT001* TEST 001 **** FCVS PROGRAM 700 *****
C VARIABLE NAME
C
IVTNUM = 1
IVCOMP = 0
IVCORR = -137
IVCOMP = IVN001
40010 IF (IVCOMP + 137) 20010, 10010, 20010
10010 IVPASS = IVPASS + 1
WRITE (I02, 80002) IVTNUM
GO TO 0011
20010 IVFAIL = IVFAIL + 1
WRITE (I02, 80010) IVTNUM, IVCOMP, IVCORR
0011 CONTINUE
C
CT002* TEST 002 **** FCVS PROGRAM 700 *****
C ARRAY NAME
C
IVTNUM = 2
CVCOMP = ' '
CVCORR = 'SECND'
CVCOMP = C1N001(2)
IVCOMP = 0
IF (CVCOMP.EQ.'SECND') IVCOMP = 1
40020 IF (IVCOMP - 1) 20020, 10020, 20020
10020 IVPASS = IVPASS + 1
WRITE (I02, 80002) IVTNUM
GO TO 0021
20020 IVFAIL = IVFAIL + 1
WRITE (I02, 80018) IVTNUM, CVCOMP, CVCORR
0021 CONTINUE
C
CT003* TEST 003 **** FCVS PROGRAM 700 *****
C ARRAY ELEMENT NAME
C
IVTNUM = 3
IVCOMP = 0
IVCORR = 65
IVCOMP = I2N001(2,1)
40030 IF (IVCOMP - 65) 20030, 10030, 20030
10030 IVPASS = IVPASS + 1
WRITE (I02, 80002) IVTNUM
GO TO 0031
20030 IVFAIL = IVFAIL + 1
WRITE (I02, 80010) IVTNUM, IVCOMP, IVCORR
0031 CONTINUE
C
CT004* TEST 004 **** FCVS PROGRAM 700 *****
C SUBSTRING NAME
C
IVTNUM = 4
CVCOMP = ' '
CVCORR = 'ELEVENTWELVE'
CVCOMP = CVN001(11:22)
IVCOMP = 0
IF (CVCOMP.EQ.'ELEVENTWELVE') IVCOMP = 1
40040 IF (IVCOMP - 1) 20040, 10040, 20040
10040 IVPASS = IVPASS + 1
WRITE (I02, 80002) IVTNUM
GO TO 0041
20040 IVFAIL = IVFAIL + 1
WRITE (I02, 80018) IVTNUM, CVCOMP, CVCORR
0041 CONTINUE
C
CT005* TEST 005 **** FCVS PROGRAM 700 *****
C IMPLIED-DO LIST
C
IVTNUM = 5
IVCOMP = 0
IVCORR = -217
IVCOMP = I2N001(1,3)
40050 IF (IVCOMP + 217) 20050, 10050, 20050
10050 IVPASS = IVPASS + 1
WRITE (I02, 80002) IVTNUM
GO TO 0051
20050 IVFAIL = IVFAIL + 1
WRITE (I02, 80010) IVTNUM, IVCOMP, IVCORR
0051 CONTINUE
C
CT006* TEST 006 **** FCVS PROGRAM 700 *****
C CLIST CONTAINS A SYMBOLIC NAME OF AN INTEGER CONSTANT
C
IVTNUM = 6
IVCOMP = 0
IVCORR = -14
IVCOMP = IVN002
40060 IF (IVCOMP + 14) 20060, 10060, 20060
10060 IVPASS = IVPASS + 1
WRITE (I02, 80002) IVTNUM
GO TO 0061
20060 IVFAIL = IVFAIL + 1
WRITE (I02, 80010) IVTNUM, IVCOMP, IVCORR
0061 CONTINUE
C
CT007* TEST 007 **** FCVS PROGRAM 700 *****
C CLIST CONTAINS A SYMBOLIC NAME OF A CHARACTER CONSTANT
C
IVTNUM = 7
CVCOMP = ' '
CVCORR = 'SEVEN'
CVCOMP = CVN002
IVCOMP = 0
IF (CVCOMP.EQ.'SEVEN') IVCOMP = 1
40070 IF (IVCOMP - 1) 20070, 10070, 20070
10070 IVPASS = IVPASS + 1
WRITE (I02, 80002) IVTNUM
GO TO 0071
20070 IVFAIL = IVFAIL + 1
WRITE (I02, 80018) IVTNUM, CVCOMP, CVCORR
0071 CONTINUE
C
C TESTS 8 THRU 11 TEST COMBINATIONS OF SUBSTRING NAMES AND
C ARRAY NAMES AND THE R*C FORMAT OF THE CLIST
C
CT008* TEST 008 **** FCVS PROGRAM 700 *****
C
IVTNUM = 8
IVCOMP = 0
IVCORR = 23
IVCOMP = I2N002(3) - I2N002(4)
40080 IF (IVCOMP - 23) 20080, 10080, 20080
10080 IVPASS = IVPASS + 1
WRITE (I02, 80002) IVTNUM
GO TO 0081
20080 IVFAIL = IVFAIL + 1
WRITE (I02, 80010) IVTNUM, IVCOMP, IVCORR
0081 CONTINUE
C
CT009* TEST 009 **** FCVS PROGRAM 700 *****
C
IVTNUM = 9
IVCOMP = 0
IVCORR = -4
DO 0092 I = 1, 3
IF (I2N003(I,7) + 4) 0093, 0092, 0093
0092 CONTINUE
0093 IVCOMP = I2N003(3,7)
40090 IF (IVCOMP + 4) 20090, 10090, 20090
10090 IVPASS = IVPASS + 1
WRITE (I02, 80002) IVTNUM
GO TO 0091
20090 IVFAIL = IVFAIL + 1
WRITE (I02, 80010) IVTNUM, IVCOMP, IVCORR
0091 CONTINUE
C
CT010* TEST 010 **** FCVS PROGRAM 700 *****
C
IVTNUM = 10
CVCOMP = ' '
CVCORR = 'SAME'
DO 0102 I = 1, 3
DO 0102 J = 1, 4
IF (C2N001(I,J).NE.'SAME') GO TO 0103
0102 CONTINUE
0103 CVCOMP = C2N001(3,4)
IVCOMP = 0
IF (CVCOMP.EQ.'SAME') IVCOMP = 1
40100 IF (IVCOMP - 1) 20100, 10100, 20100
10100 IVPASS = IVPASS + 1
WRITE (I02, 80002) IVTNUM
GO TO 0101
20100 IVFAIL = IVFAIL + 1
WRITE (I02, 80018) IVTNUM, CVCOMP, CVCORR
0101 CONTINUE
C
CT011* TEST 011 **** FCVS PROGRAM 700 *****
C
IVTNUM = 11
CVCOMP = ' '
CVCORR = 'SAME'
CVCOMP = CVN003(13:16)
IVCOMP = 0
IF (CVCOMP.EQ.'SAME') IVCOMP = 1
40110 IF (IVCOMP - 1) 20110, 10110, 20110
10110 IVPASS = IVPASS + 1
WRITE (I02, 80002) IVTNUM
GO TO 0111
20110 IVFAIL = IVFAIL + 1
WRITE (I02, 80018) IVTNUM, CVCOMP, CVCORR
0111 CONTINUE
C
C TESTS 12 THRU 17 TEST ARITHMETIC CONVERSION OF CLIST
C CONSTANTS TO THE TYPE OF THE CORRESPONDING NLIST ENTITIES
C
CT012* TEST 012 **** FCVS PROGRAM 700 *****
C REAL TO INTEGER
C
IVTNUM = 12
IVCOMP = 0
IVCORR = -473
IVCOMP = IVN003
40120 IF (IVCOMP + 473) 20120, 10120, 20120
10120 IVPASS = IVPASS + 1
WRITE (I02, 80002) IVTNUM
GO TO 0121
20120 IVFAIL = IVFAIL + 1
WRITE (I02, 80010) IVTNUM, IVCOMP, IVCORR
0121 CONTINUE
C
CT013* TEST 013 **** FCVS PROGRAM 700 *****
C DOUBLE PRECISION TO INTEGER
C
IVTNUM = 13
IVCOMP = 0
IVCORR = 23
IVCOMP = IVN004
40130 IF (IVCOMP - 23) 20130, 10130, 20130
10130 IVPASS = IVPASS + 1
WRITE (I02, 80002) IVTNUM
GO TO 0131
20130 IVFAIL = IVFAIL + 1
WRITE (I02, 80010) IVTNUM, IVCOMP, IVCORR
0131 CONTINUE
C
CT014* TEST 014 **** FCVS PROGRAM 700 *****
C INTEGER TO REAL
C
IVTNUM = 14
RVCOMP = 0.0
RVCORR = 71.0
RVCOMP = RVN001
IF (RVCOMP - 0.70996E+02) 20140, 10140, 40140
40140 IF (RVCOMP - 0.71004E+02) 10140, 10140, 20140
10140 IVPASS = IVPASS + 1
WRITE (I02, 80002) IVTNUM
GO TO 0141
20140 IVFAIL = IVFAIL + 1
WRITE (I02, 80012) IVTNUM, RVCOMP, RVCORR
0141 CONTINUE
C
CT015* TEST 015 **** FCVS PROGRAM 700 *****
C COMPLEX
C
IVTNUM = 15
ZVCOMP = (0.0, 0.0)
ZVCORR = (71.0, -27.0)
ZVCOMP = ZVN001
IF (R2E001(1) - 0.70996E+02) 20150, 40152, 40151
40151 IF (R2E001(1) - 0.71004E+02) 40152, 40152, 20150
40152 IF (R2E001(2) + 0.27002E+02) 20150, 10150, 40150
40150 IF (R2E001(2) + 0.26998E+02) 10150, 10150, 20150
10150 IVPASS = IVPASS + 1
WRITE (I02, 80002) IVTNUM
GO TO 0151
20150 IVFAIL = IVFAIL + 1
WRITE (I02, 80045) IVTNUM, ZVCOMP, ZVCORR
0151 CONTINUE
C
CT016* TEST 016 **** FCVS PROGRAM 700 *****
C INTEGER TO DOUBLE PRECISION
C
IVTNUM = 16
DVCOMP = 0.0D0
DVCORR = 6.0D0
DVCOMP = DVN001
IF (DVCOMP - 0.5999999997D+01) 20160, 10160, 40160
40160 IF (DVCOMP - 0.6000000003D+01) 10160, 10160, 20160
10160 IVPASS = IVPASS + 1
WRITE (I02, 80002) IVTNUM
GO TO 0161
20160 IVFAIL = IVFAIL + 1
WRITE (I02, 80031) IVTNUM, DVCOMP, DVCORR
0161 CONTINUE
C
CT017* TEST 017 **** FCVS PROGRAM 700 *****
C REAL TO DOUBLE PRECISION
C
IVTNUM = 17
DVCOMP = 0.0D0
DVCORR = 9.1534D-2
DVCOMP = DVN002
IF (DVCOMP - 0.91529D-01) 20170, 10170, 40170
40170 IF (DVCOMP - 0.91539D-01) 10170, 10170, 20170
10170 IVPASS = IVPASS + 1
WRITE (I02, 80002) IVTNUM
GO TO 0171
20170 IVFAIL = IVFAIL + 1
WRITE (I02, 80031) IVTNUM, DVCOMP, DVCORR
0171 CONTINUE
C
C TESTS 18 THRU 21 TEST DIFFERENT DATA TYPES USING THE IMPLIED-DO
C
CT018* TEST 018 **** FCVS PROGRAM 700 *****
C INTEGER
C
IVTNUM = 18
IVCOMP = 0
IVCORR = 3
IVCOMP = I2N004(2,7)
40180 IF (IVCOMP - 3) 20180, 10180, 20180
10180 IVPASS = IVPASS + 1
WRITE (I02, 80002) IVTNUM
GO TO 0181
20180 IVFAIL = IVFAIL + 1
WRITE (I02, 80010) IVTNUM, IVCOMP, IVCORR
0181 CONTINUE
C
CT019* TEST 019 **** FCVS PROGRAM 700 *****
C REAL
C
IVTNUM = 19
RVCOMP = 0.0
RVCORR = 4.1
RVCOMP = R2N001(4,1)
IF (RVCOMP - 0.40998E+01) 20190, 10190, 40190
40190 IF (RVCOMP - 0.41002E+01) 10190, 10190, 20190
10190 IVPASS = IVPASS + 1
WRITE (I02, 80002) IVTNUM
GO TO 0191
20190 IVFAIL = IVFAIL + 1
WRITE (I02, 80012) IVTNUM, RVCOMP, RVCORR
0191 CONTINUE
C
CT020* TEST 020 **** FCVS PROGRAM 700 *****
C COMPLEX
C
IVTNUM = 20
ZVCOMP = (0.0, 0.0)
ZVCORR = (7.3, -2.28)
ZVCOMP = Z1N001(7)
IF (R2E001(1) - 0.72996E+01) 20200, 40202, 40201
40201 IF (R2E001(1) - 0.73004E+01) 40202, 40202, 20200
40202 IF (R2E001(2) + 0.22802E+01) 20200, 10200, 40200
40200 IF (R2E001(2) + 0.22798E+01) 10200, 10200, 20200
10200 IVPASS = IVPASS + 1
WRITE (I02, 80002) IVTNUM
GO TO 0201
20200 IVFAIL = IVFAIL + 1
WRITE (I02, 80045) IVTNUM, ZVCOMP, ZVCORR
0201 CONTINUE
C
CT021* TEST 021 **** FCVS PROGRAM 700 *****
C DOUBLE PRECISION
C
IVTNUM = 21
DVCOMP = 0.0D0
DVCORR = 0.1948D+3
DVCOMP = D1N001(9)
IF (DVCOMP - 0.1947999999D+03) 20210, 10210, 40210
40210 IF (DVCOMP - 0.1948000001D+03) 10210, 10210, 20210
10210 IVPASS = IVPASS + 1
WRITE (I02, 80002) IVTNUM
GO TO 0211
20210 IVFAIL = IVFAIL + 1
WRITE (I02, 80031) IVTNUM, DVCOMP, DVCORR
0211 CONTINUE
C
C TESTS 22 AND 23 TEST THAT EACH SUBSCRIPT EXPRESSION
C IN AN IMPLIED-DO LIST MAY CONTAIN IMPLIED-DO-VARIABLES OF
C THE LIST THAT HAS THE SUBSCRIPT EXPRESSION WITHIN ITS RANGE.
C
CT022* TEST 022 **** FCVS PROGRAM 700 *****
C
IVTNUM = 22
IVCOMP = 0
IVCORR = 155
IVCOMP = I2N005(3,4) - I2N005(2,3)
40220 IF (IVCOMP - 155) 20220, 10220, 20220
10220 IVPASS = IVPASS + 1
WRITE (I02, 80002) IVTNUM
GO TO 0221
20220 IVFAIL = IVFAIL + 1
WRITE (I02, 80010) IVTNUM, IVCOMP, IVCORR
0221 CONTINUE
C
CT023* TEST 023 **** FCVS PROGRAM 700 *****
C
IVTNUM = 23
IVCOMP = 0
IVCORR = 130
IVCOMP = I2N006(6,2) + I2N006(6,8)
40230 IF (IVCOMP - 130) 20230, 10230, 20230
10230 IVPASS = IVPASS + 1
WRITE (I02, 80002) IVTNUM
GO TO 0231
20230 IVFAIL = IVFAIL + 1
WRITE (I02, 80010) IVTNUM, IVCOMP, IVCORR
0231 CONTINUE
C
CBB** ********************** BBCSUM0 **********************************
C**** WRITE OUT TEST SUMMARY
C****
IVTOTN = IVPASS + IVFAIL + IVDELE + IVINSP
WRITE (I02, 90004)
WRITE (I02, 90014)
WRITE (I02, 90004)
WRITE (I02, 90020) IVPASS
WRITE (I02, 90022) IVFAIL
WRITE (I02, 90024) IVDELE
WRITE (I02, 90026) IVINSP
WRITE (I02, 90028) IVTOTN, IVTOTL
CBE** ********************** BBCSUM0 **********************************
CBB** ********************** BBCFOOT0 **********************************
C**** WRITE OUT REPORT FOOTINGS
C****
WRITE (I02,90016) ZPROG, ZPROG
WRITE (I02,90018) ZPROJ, ZNAME, ZTAPE, ZTAPED
WRITE (I02,90019)
CBE** ********************** BBCFOOT0 **********************************
90001 FORMAT (1H ,56X,5HFM700)
90000 FORMAT (1H ,50X,20HEND OF PROGRAM FM700)
CBB** ********************** BBCFMT0A **********************************
C**** FORMATS FOR TEST DETAIL LINES
C****
80000 FORMAT (1H ,2X,I3,4X,7HDELETED,32X,A31)
80002 FORMAT (1H ,2X,I3,4X,7H PASS ,32X,A31)
80004 FORMAT (1H ,2X,I3,4X,7HINSPECT,32X,A31)
80008 FORMAT (1H ,2X,I3,4X,7H FAIL ,32X,A31)
80010 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,15X,10HCOMPUTED= ,
1I6,/,1H ,15X,10HCORRECT= ,I6)
80012 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
1E12.5,/,1H ,16X,10HCORRECT= ,E12.5)
80018 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
1A21,/,1H ,16X,10HCORRECT= ,A21)
80020 FORMAT (1H ,16X,10HCOMPUTED= ,A21,1X,A31)
80022 FORMAT (1H ,16X,10HCORRECT= ,A21,1X,A31)
80024 FORMAT (1H ,16X,10HCOMPUTED= ,I6,16X,A31)
80026 FORMAT (1H ,16X,10HCORRECT= ,I6,16X,A31)
80028 FORMAT (1H ,16X,10HCOMPUTED= ,E12.5,10X,A31)
80030 FORMAT (1H ,16X,10HCORRECT= ,E12.5,10X,A31)
80050 FORMAT (1H ,48X,A31)
CBE** ********************** BBCFMT0A **********************************
CBB** ********************** BBCFMAT1 **********************************
C**** FORMATS FOR TEST DETAIL LINES - FULL LANGUAGE
C****
80031 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
1D17.10,/,1H ,16X,10HCORRECT= ,D17.10)
80033 FORMAT (1H ,16X,10HCOMPUTED= ,D17.10,10X,A31)
80035 FORMAT (1H ,16X,10HCORRECT= ,D17.10,10X,A31)
80037 FORMAT (1H ,16X,10HCOMPUTED= ,1H(,E12.5,2H, ,E12.5,1H),6X,A31)
80039 FORMAT (1H ,16X,10HCORRECT= ,1H(,E12.5,2H, ,E12.5,1H),6X,A31)
80041 FORMAT (1H ,16X,10HCOMPUTED= ,1H(,F12.5,2H, ,F12.5,1H),6X,A31)
80043 FORMAT (1H ,16X,10HCORRECT= ,1H(,F12.5,2H, ,F12.5,1H),6X,A31)
80045 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
11H(,F12.5,2H, ,F12.5,1H)/,1H ,16X,10HCORRECT= ,
21H(,F12.5,2H, ,F12.5,1H))
CBE** ********************** BBCFMAT1 **********************************
CBB** ********************** BBCFMT0B **********************************
C**** FORMAT STATEMENTS FOR PAGE HEADERS
C****
90002 FORMAT (1H1)
90004 FORMAT (1H )
90006 FORMAT (1H ,20X,31HFEDERAL SOFTWARE TESTING CENTER)
90007 FORMAT (1H ,19X,34HFORTRAN COMPILER VALIDATION SYSTEM)
90008 FORMAT (1H ,21X,A13,A17)
90009 FORMAT (1H ,/,2H *,A5,6HBEGIN*,12X,15HTEST RESULTS - ,A5,/)
90010 FORMAT (1H ,8X,16HTEST DATE*TIME= ,A17,15H - COMPILER= ,A20)
90013 FORMAT (1H ,8H TEST ,10HPASS/FAIL ,6X,17HDISPLAYED RESULTS,
1 7X,7HREMARKS,24X)
90014 FORMAT (1H ,46H----------------------------------------------,
1 33H---------------------------------)
90015 FORMAT (1H ,48X,17HTHIS PROGRAM HAS ,I3,6H TESTS,/)
C****
C**** FORMAT STATEMENTS FOR REPORT FOOTINGS
C****
90016 FORMAT (1H ,/,2H *,A5,4HEND*,14X,14HEND OF TEST - ,A5,/)
90018 FORMAT (1H ,A13,13X,A20,7H * ,A10,1H/,
1 A13)
90019 FORMAT (1H ,26HFOR OFFICIAL USE ONLY ,35X,15HCOPYRIGHT 1982)
C****
C**** FORMAT STATEMENTS FOR RUN SUMMARY
C****
90020 FORMAT (1H ,21X,I5,13H TESTS PASSED)
90022 FORMAT (1H ,21X,I5,13H TESTS FAILED)
90024 FORMAT (1H ,21X,I5,14H TESTS DELETED)
90026 FORMAT (1H ,21X,I5,25H TESTS REQUIRE INSPECTION)
90028 FORMAT (1H ,21X,I5,4H OF ,I3,15H TESTS EXECUTED)
CBE** ********************** BBCFMT0B **********************************
STOP
END
*END-OF,FM700
FM701.f 481036421 170 2 100666 30043 `
*HEADER,FORTR,FM701
*FILES1,FORTR,FM701
PROGRAM FM701
C
C THIS ROUTINE TESTS ARRAY DECLARATORS WHERE DIMENSION ANS REF.
C BOUND EXPRESSIONS MAY CONTAIN CONSTANTS, 5.1.1.2
C SYMBOLIC NAMES OF CONSTANTS, OR VARIABLES 5.1.1
C OF TYPE INTEGER.
C
C THIS ROUTINE USES ROUTINES 602 THROUGH 609 AS SUBROUTINES.
C
C
CBB** ********************** BBCCOMNT **********************************
C****
C**** 1978 FORTRAN COMPILER VALIDATION SYSTEM
C**** VERSION 2.0
C****
C****
C**** SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO
C**** GENERAL SERVICES ADMINISTRATION
C**** FEDERAL SOFTWARE TESTING CENTER
C**** 5203 LEESBURG PIKE, SUITE 1100
C**** FALLS CHURCH, VA. 22041
C****
C**** (703) 756-6153
C****
CBE** ********************** BBCCOMNT **********************************
IMPLICIT DOUBLE PRECISION (D), COMPLEX (Z), LOGICAL (L)
IMPLICIT CHARACTER*27 (C)
CBB** ********************** BBCINITA **********************************
C**** SPECIFICATION STATEMENTS
C****
CHARACTER ZVERS*13, ZVERSD*17, ZDATE*17, ZPROG*5, ZCOMPL*20,
1 ZNAME*20, ZTAPE*10, ZPROJ*13, REMRKS*31, ZTAPED*13
CBE** ********************** BBCINITA **********************************
C
INTEGER I2D001(3,5), I2D002(2,4), I2D003(5,2)
PARAMETER (IPN001=1, IPN002=-1, IPN003=4)
DIMENSION I2N004(IPN001:2,3), I2N005(2,-1:IPN001),
1 I2N006(IPN002:IPN001,1:IPN003)
DIMENSION I2N007(+5:7,+1:2), I2N008(0:2,2), I2N009(1:3,-1:1),
1 I2N010(4,2), I2N011(2*2+1:7,1:2)
DIMENSION I2N012(1:+2,2:+4), I2N013(-2:0,2), I2D014(1:3,-3:-1),
1 I2N015(1:2*2+1,1:2), I2N016(2,6/3-1:2*5-7)
CHARACTER*4 CVCOMP, CVCORR
CHARACTER*4 C2N001(0:5,1:6), C2D002(2,1:3), C2N003(-2:1,3:10),
1 C2D004(1:2,5:7), C1N005(+1:6),C3D006(1:2,2,5:7)
DATA I2D001 / 12*0, -47, 2*0 /
DATA I2D002 / 6*0, 5, 0 /
DATA I2D003 / 6, 8*0, -11 /
DATA I2N004 / -4, 5*4 /
DATA I2N005 / -5, 5*5 /
DATA I2N006 / 6*6, -6, 5*6 /
DATA I2N007 / 3*7, -7, 2*7 /
DATA I2N008 / -8, 5*8 /
DATA I2N009 / 2*9, -9, 6*9 /
DATA I2N010 / -10, 7*10 /
DATA I2N011 / 3*11, -11, 2*11 /
DATA I2N012 / 7, 5*-7 /
DATA I2N013 / 8, 5*-8 /
DATA I2D014 / 9, 8*-9 /
DATA I2N015 / 9*-10, 10 /
DATA I2N016 / 11, 4*-11, -10 /
DATA C2N001 / 'C001', 35*' ' /
DATA C2D002 / 5*' ', 'C002' /
DATA C2N003 / 'C003', 31*' ' /
DATA C2D004 / 'C004', 5*' ' /
DATA C1N005 / 'C005', 5*' ' /
DATA C3D006 / 'C006', 11*' ' /
C
C
CBB** ********************** BBCINITB **********************************
C**** INITIALIZE SECTION
DATA ZVERS, ZVERSD, ZDATE
1 /'VERSION 2.0 ', '82/08/02*18.33.46', '*NO DATE*TIME'/
DATA ZCOMPL, ZNAME, ZTAPE
1 /'*NONE SPECIFIED*', '*NO COMPANY NAME*', '*NO TAPE*'/
DATA ZPROJ, ZTAPED, ZPROG
1 /'*NO PROJECT*', '*NO TAPE DATE', 'XXXXX'/
DATA REMRKS /' '/
C**** THE FOLLOWING 9 COMMENT LINES (CZ01, CZ02, ...) CAN BE REPLACED
C**** FOR IDENTIFYING THE TEST ENVIRONMENT
C****
CZ01 ZVERS = 'VERSION OF THE COMPILER VALIDATION SYSTEM'
CZ02 ZVERSD = 'CREATION DATE/TIME OF THE COMPILER VALIDATION SYSTEM'
CZ03 ZPROG = 'PROGRAM NAME'
CZ04 ZDATE = 'DATE OF TEST'
CZ05 ZCOMPL = 'COMPILER IDENTIFICATION'
CZ06 ZPROJ = 'PROJECT NUMBER/IDENTIFICATION'
CZ07 ZNAME = 'NAME OF USER'
CZ08 ZTAPE = 'TAPE OWNER/ID'
CZ09 ZTAPED = 'DATE TAPE COPIED'
C
IVPASS = 0
IVFAIL = 0
IVDELE = 0
IVINSP = 0
IVTOTL = 0
IVTOTN = 0
ICZERO = 0
C
C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER.
I01 = 05
C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER.
I02 = 06
C
CX010 REPLACED BY FEXEC X-010 CONTROL CARD (CARD-READER UNIT NUMBER).
C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5
CX011 REPLACED BY FEXEC X-011 CONTROL CARD. CX011 IS FOR SYSTEMS
C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX010.
C
CX020 REPLACED BY FEXEC X-020 CONTROL CARD (PRINTER UNIT NUMBER).
C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02= 6
CX021 REPLACED BY FEXEC X-021 CONTROL CARD. CX021 IS FOR SYSTEMS
C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX020.
C
CBE** ********************** BBCINITB **********************************
ZPROG='FM701'
IVTOTL = 35
CBB** ********************** BBCHED0A **********************************
C****
C**** WRITE REPORT TITLE
C****
WRITE (I02, 90002)
WRITE (I02, 90006)
WRITE (I02, 90007)
WRITE (I02, 90008) ZVERS, ZVERSD
WRITE (I02, 90009) ZPROG, ZPROG
WRITE (I02, 90010) ZDATE, ZCOMPL
CBE** ********************** BBCHED0A **********************************
CBB** ********************** BBCHED0B **********************************
C**** WRITE DETAIL REPORT HEADERS
C****
WRITE (I02,90004)
WRITE (I02,90004)
WRITE (I02,90013)
WRITE (I02,90014)
WRITE (I02,90015) IVTOTL
CBE** ********************** BBCHED0B **********************************
C
C TESTS 1-3 - LOWER AND/OR UPPER BOUNDS ARE ARITHMETIC EXPRESSIONS
C OF TYPE INTEGER, USING VARIABLES
C
C
CT001* TEST 001 **** FCVS PROGRAM 701 ****
C
C TEST 001 LOWER BOUND
C
IVTNUM = 1
IVCORR = -47
CALL SN702(1,1,2,6,I2D001,I2D002,I2D003,IVCOMP)
40010 IF (IVCOMP + 47) 20010, 10010, 20010
10010 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0011
20010 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0011 CONTINUE
C
CT002* TEST 002 **** FCVS PROGRAM 701 ****
C
C TEST 002 UPPER BOUND
C
IVTNUM = 2
IVCORR = 5
CALL SN702(2,1,2,6,I2D001,I2D002,I2D003,IVCOMP)
40020 IF (IVCOMP - 5) 20020, 10020, 20020
10020 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0021
20020 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0021 CONTINUE
C
CT003* TEST 003 **** FCVS PROGRAM 701 ****
C
C TEST 003 BOTH LOWER AND UPPER BOUNDS
C
IVTNUM = 3
IVCORR = 17
CALL SN702(3,1,2,6,I2D001,I2D002,I2D003,IVCOMP)
40030 IF (IVCOMP - 17) 20030, 10030, 20030
10030 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0031
20030 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0031 CONTINUE
C
C TESTS 4-6 - LOWER AND/OR UPPER BOUNDS ARE SYMBOLIC NAMES
C OF INTEGER CONSTANTS
C
C
CT004* TEST 004 **** FCVS PROGRAM 701 ****
C
C TEST 004 LOWER BOUND
C
IVTNUM = 4
IVCOMP = 0
IVCORR = -4
IVCOMP = I2N004(1,1)
40040 IF (IVCOMP + 4) 20040, 10040, 20040
10040 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0041
20040 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0041 CONTINUE
C
CT005* TEST 005 **** FCVS PROGRAM 701 ****
C
C TEST 005 UPPER BOUND
C
IVTNUM = 5
IVCOMP = 0
IVCORR = -5
IVCOMP = I2N005(1,-1)
40050 IF (IVCOMP + 5) 20050, 10050, 20050
10050 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0051
20050 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0051 CONTINUE
C
CT006* TEST 006 **** FCVS PROGRAM 701 ****
C
C TEST 006 BOTH UPPER AND LOWER BOUNDS
C
IVTNUM = 6
IVCOMP = 0
IVCORR = -6
IVCOMP = I2N006(-1,3)
40060 IF (IVCOMP + 6) 20060, 10060, 20060
10060 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0061
20060 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0061 CONTINUE
C
CT007* TEST 007 **** FCVS PROGRAM 701 ****
C
C TEST 007 LOWER BOUND POSITIVE
C
IVTNUM = 7
IVCOMP = 0
IVCORR = -7
IVCOMP = I2N007(5,2)
40070 IF (IVCOMP + 7) 20070, 10070, 20070
10070 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0071
20070 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0071 CONTINUE
C
CT008* TEST 008 **** FCVS PROGRAM 701 ****
C
C TEST 008 LOWER BOUND ZERO
C
IVTNUM = 8
IVCOMP = 0
IVCORR = -8
IVCOMP = I2N008(0,1)
40080 IF (IVCOMP + 8) 20080, 10080, 20080
10080 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0081
20080 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0081 CONTINUE
C
CT009* TEST 009 **** FCVS PROGRAM 701 ****
C
C TEST 009 LOWER BOUND NEGATIVE
C
IVTNUM = 9
IVCOMP = 0
IVCORR = -9
IVCOMP = I2N009(3,-1)
40090 IF (IVCOMP + 9) 20090, 10090, 20090
10090 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0091
20090 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0091 CONTINUE
C
CT010* TEST 010 **** FCVS PROGRAM 701 ****
C
C TEST 010 LOWER BOUND OMITTED
C
IVTNUM = 10
IVCOMP = 0
IVCORR = -10
IVCOMP = I2N010(1,1)
40100 IF (IVCOMP + 10) 20100, 10100, 20100
10100 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0101
20100 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0101 CONTINUE
C
CT011* TEST 011 **** FCVS PROGRAM 701 ****
C
C TEST 011 LOWER BOUND IS AN INTEGER EXPRESSION
C
IVTNUM = 11
IVCOMP = 0
IVCORR = -11
IVCOMP = I2N011(5,2)
40110 IF (IVCOMP + 11) 20110, 10110, 20110
10110 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0111
20110 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0111 CONTINUE
C
CT012* TEST 012 **** FCVS PROGRAM 701 ****
C
C TEST 012 UPPER BOUND POSITIVE
C
IVTNUM = 12
IVCOMP = 0
IVCORR = 7
IVCOMP = I2N012(1,2)
40120 IF (IVCOMP - 7) 20120, 10120, 20120
10120 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0121
20120 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0121 CONTINUE
C
CT013* TEST 013 **** FCVS PROGRAM 701 ****
C
C TEST 013 UPPER BOUND ZERO
C
IVTNUM = 13
IVCOMP = 0
IVCORR = 8
IVCOMP = I2N013(-2,1)
40130 IF (IVCOMP - 8) 20130, 10130, 20130
10130 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0131
20130 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0131 CONTINUE
C
CT014* TEST 014 **** FCVS PROGRAM 701 ****
C
C TEST 014 UPPER BOUND NEGATIVE
C
IVTNUM = 14
IVCOMP = 0
IVCORR = 9
IVCOMP = I2D014(1,-3)
40140 IF (IVCOMP - 9) 20140, 10140, 20140
10140 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0141
20140 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0141 CONTINUE
C
CT015* TEST 015 **** FCVS PROGRAM 701 ****
C
C TEST 015 UPPER BOUND IS INTEGER EXPRESSION
C
IVTNUM = 15
IVCOMP = 0
IVCORR = 10
IVCOMP = I2N015(5,2)
40150 IF (IVCOMP - 10) 20150, 10150, 20150
10150 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0151
20150 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0151 CONTINUE
C
CT016* TEST 016 **** FCVS PROGRAM 701 ****
C
C TEST 016 UPPER BOUNDS ARE INTEGER EXPRESSIONS
C
IVTNUM = 16
IVCOMP = 0
IVCORR = -110
IVCOMP = I2N016(1,1)*I2N016(2,3)
40160 IF (IVCOMP + 110) 20160, 10160, 20160
10160 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0161
20160 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0161 CONTINUE
C
CT017* TEST 017 **** FCVS PROGRAM 701 ****
C
C TEST 017 ZERO AS A DIMENSION
C
IVTNUM = 17
CVCOMP = ' '
IVCOMP = 0
CVCORR = 'C001'
CVCOMP = C2N001(0,1)
IF (CVCOMP .EQ. 'C001') IVCOMP = 1
IF (IVCOMP - 1) 20170, 10170, 20170
10170 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0171
20170 IVFAIL = IVFAIL + 1
WRITE (I02,80018) IVTNUM, CVCOMP, CVCORR
0171 CONTINUE
C
CT018* TEST 018 **** FCVS PROGRAM 701 ****
C
C TEST 018 UPPER DIMENSION UNDEFINED IN THE SUBROUTINE
C
IVTNUM = 18
CVCOMP = ' '
IVCOMP = 0
CVCORR = 'C002'
CALL SN703(1,1,2,C2D002,C2D004,CVCOMP)
IF (CVCOMP .EQ. 'C002') IVCOMP = 1
IF (IVCOMP - 1) 20180, 10180, 20180
10180 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0181
20180 IVFAIL = IVFAIL + 1
WRITE (I02,80018) IVTNUM, CVCOMP, CVCORR
0181 CONTINUE
C
CT019* TEST 019 **** FCVS PROGRAM 701 ****
C
C TEST 019 NEGATIVE DIMENSION
C
IVTNUM = 19
CVCOMP = ' '
IVCOMP = 0
CVCORR = 'C003'
CVCOMP = C2N003(-2,3)
IF (CVCOMP .EQ. 'C003') IVCOMP = 1
IF (IVCOMP - 1) 20190, 10190, 20190
10190 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0191
20190 IVFAIL = IVFAIL + 1
WRITE (I02,80018) IVTNUM, CVCOMP, CVCORR
0191 CONTINUE
C
CT020* TEST 020 **** FCVS PROGRAM 701 ****
C
C TEST 020 VARIABLE DIMENSION
C
IVTNUM = 20
CVCOMP = ' '
IVCOMP = 0
CVCORR = 'C004'
CALL SN703(2,1,2,C2D002,C2D004,CVCOMP)
IF (CVCOMP .EQ. 'C004') IVCOMP = 1
IF (IVCOMP - 1) 20200, 10200, 20200
10200 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0201
20200 IVFAIL = IVFAIL + 1
WRITE (I02,80018) IVTNUM, CVCOMP, CVCORR
0201 CONTINUE
C
CT021* TEST 021 **** FCVS PROGRAM 701 ****
C
C TEST 021 POSITIVE DIMENSION
C
IVTNUM = 21
CVCOMP = ' '
IVCOMP = 0
CVCORR = 'C005'
CVCOMP = C1N005(1)
IF (CVCOMP .EQ. 'C005') IVCOMP = 1
IF (IVCOMP - 1) 20210, 10210, 20210
10210 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0211
20210 IVFAIL = IVFAIL + 1
WRITE (I02,80018) IVTNUM, CVCOMP, CVCORR
0211 CONTINUE
C
C TESTS 22-25 - MIXED DIMENSION BOUNDS WITH VARIABLE NUMBER OF
C ELEMENTS IN EACH DIMENSION
C
C
CT022* TEST 022 **** FCVS PROGRAM 701 ****
C
C
IVTNUM = 22
CVCOMP = ' '
IVCOMP = 0
CVCORR = 'C006'
CALL SN704(1,1,2,5,C3D006,CVCOMP)
IF (CVCOMP .EQ. 'C006') IVCOMP = 1
IF (IVCOMP - 1) 20220, 10220, 20220
10220 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0221
20220 IVFAIL = IVFAIL + 1
WRITE (I02,80018) IVTNUM, CVCOMP, CVCORR
0221 CONTINUE
C
CT023* TEST 023 **** FCVS PROGRAM 701 ****
C
C
IVTNUM = 23
CVCOMP = ' '
IVCOMP = 0
CVCORR = 'IJKL'
CALL SN704(2,1,2,6,C3D006,CVCOMP)
IF (CVCOMP .EQ. 'IJKL') IVCOMP = 1
IF (IVCOMP - 1) 20230, 10230, 20230
10230 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0231
20230 IVFAIL = IVFAIL + 1
WRITE (I02,80018) IVTNUM, CVCOMP, CVCORR
0231 CONTINUE
C
CT024* TEST 024 **** FCVS PROGRAM 701 ****
C
C
IVTNUM = 24
CVCOMP = ' '
IVCOMP = 0
CVCORR = 'EFGH'
CALL SN704(3,1,1,5,C3D006,CVCOMP)
IF (CVCOMP .EQ. 'EFGH') IVCOMP = 1
IF (IVCOMP - 1) 20240, 10240, 20240
10240 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0241
20240 IVFAIL = IVFAIL + 1
WRITE (I02,80018) IVTNUM, CVCOMP, CVCORR
0241 CONTINUE
C
CT025* TEST 025 **** FCVS PROGRAM 701 ****
C
C
IVTNUM = 25
CVCOMP = ' '
IVCOMP = 0
CVCORR = 'ABCD'
CALL SN704(4,2,2,6,C3D006,CVCOMP)
IF (CVCOMP .EQ. 'ABCD') IVCOMP = 1
IF (IVCOMP - 1) 20250, 10250, 20250
10250 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0251
20250 IVFAIL = IVFAIL + 1
WRITE (I02,80018) IVTNUM, CVCOMP, CVCORR
0251 CONTINUE
C
C TESTS 26-28 - LOWER BOUND IS AN EXPRESSION INVOLVING
C ARITHMETIC OPERATORS
C
C
CT026* TEST 026 **** FCVS PROGRAM 701 ****
C
C
IVTNUM = 26
IVCORR = -47
CALL SN705(1,2,-1,1,I2D001,I2D002,I2D003,IVCOMP)
40260 IF (IVCOMP + 47) 20260, 10260, 20260
10260 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0261
20260 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0261 CONTINUE
C
CT027* TEST 027 **** FCVS PROGRAM 701 ****
C
C
IVTNUM = 27
IVCORR = 5
CALL SN705(2,2,-1,1,I2D001,I2D002,I2D003,IVCOMP)
40270 IF (IVCOMP - 5) 20270, 10270, 20270
10270 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0271
20270 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0271 CONTINUE
C
CT028* TEST 028 **** FCVS PROGRAM 701 ****
C
C
IVTNUM = 28
IVCORR = 17
CALL SN705(3,2,-1,1,I2D001,I2D002,I2D003,IVCOMP)
40280 IF (IVCOMP - 17) 20280, 10280, 20280
10280 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0281
20280 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0281 CONTINUE
C
C TESTS 29-31 - UPPER BOUND IS AN EXPRESSION INVOLVING
C ARITHMETIC OPERATORS
C
C
CT029* TEST 029 **** FCVS PROGRAM 701 ****
C
C
IVTNUM = 29
IVCORR = -47
CALL SN706(1,4,0,3,I2D001,I2D002,I2D003,IVCOMP)
40290 IF (IVCOMP + 47) 20290, 10290, 20290
10290 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0291
20290 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0291 CONTINUE
C
CT030* TEST 030 **** FCVS PROGRAM 701 ****
C
C
IVTNUM = 30
IVCORR = 5
CALL SN706(2,4,0,3,I2D001,I2D002,I2D003,IVCOMP)
40300 IF (IVCOMP - 5) 20300, 10300, 20300
10300 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0301
20300 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0301 CONTINUE
C
CT031* TEST 031 **** FCVS PROGRAM 701 ****
C
C
IVTNUM = 31
IVCORR = 17
CALL SN706(3,4,0,3,I2D001,I2D002,I2D003,IVCOMP)
40310 IF (IVCOMP - 17) 20310, 10310, 20310
10310 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0311
20310 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0311 CONTINUE
C
CT032* TEST 032 **** FCVS PROGRAM 701 ****
C
C TEST 032 "/" IN LOWER BOUND
C
IVTNUM = 32
IVCORR = -47
CALL SN707(1,3,2,I2D001,I2D002,IVCOMP)
40320 IF (IVCOMP + 47) 20320, 10320, 20320
10320 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0321
20320 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0321 CONTINUE
C
CT033* TEST 033 **** FCVS PROGRAM 701 ****
C
C TEST 033 "**" IN UPPER BOUND
C
IVTNUM = 33
IVCORR = 5
CALL SN707(2,3,2,I2D001,I2D002,IVCOMP)
40330 IF (IVCOMP - 5) 20330, 10330, 20330
10330 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0331
20330 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0331 CONTINUE
C
C TESTS 34-35 - UPPER AND LOWER BOUNDS WITH ARITHMETIC OPERATORS
C IN EXPRESSION
C
C
CT034* TEST 034 **** FCVS PROGRAM 701 ****
C
C
IVTNUM = 34
IVCORR = -47
CALL SN708(3,-2,2,I2D001,IVCOMP)
40340 IF (IVCOMP + 47) 20340, 10340, 20340
10340 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0341
20340 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0341 CONTINUE
C
CT035* TEST 035 **** FCVS PROGRAM 701 ****
C
C
IVTNUM = 35
IVCORR = 9
CALL SN709(-1,-2,1,I2D014,IVCOMP)
40350 IF (IVCOMP - 9) 20350, 10350, 20350
10350 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0351
20350 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0351 CONTINUE
C
CBB** ********************** BBCSUM0 **********************************
C**** WRITE OUT TEST SUMMARY
C****
IVTOTN = IVPASS + IVFAIL + IVDELE + IVINSP
WRITE (I02, 90004)
WRITE (I02, 90014)
WRITE (I02, 90004)
WRITE (I02, 90020) IVPASS
WRITE (I02, 90022) IVFAIL
WRITE (I02, 90024) IVDELE
WRITE (I02, 90026) IVINSP
WRITE (I02, 90028) IVTOTN, IVTOTL
CBE** ********************** BBCSUM0 **********************************
CBB** ********************** BBCFOOT0 **********************************
C**** WRITE OUT REPORT FOOTINGS
C****
WRITE (I02,90016) ZPROG, ZPROG
WRITE (I02,90018) ZPROJ, ZNAME, ZTAPE, ZTAPED
WRITE (I02,90019)
CBE** ********************** BBCFOOT0 **********************************
90001 FORMAT (1H ,56X,5HFM701)
90000 FORMAT (1H ,50X,20HEND OF PROGRAM FM701)
CBB** ********************** BBCFMT0A **********************************
C**** FORMATS FOR TEST DETAIL LINES
C****
80000 FORMAT (1H ,2X,I3,4X,7HDELETED,32X,A31)
80002 FORMAT (1H ,2X,I3,4X,7H PASS ,32X,A31)
80004 FORMAT (1H ,2X,I3,4X,7HINSPECT,32X,A31)
80008 FORMAT (1H ,2X,I3,4X,7H FAIL ,32X,A31)
80010 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,15X,10HCOMPUTED= ,
1I6,/,1H ,15X,10HCORRECT= ,I6)
80012 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
1E12.5,/,1H ,16X,10HCORRECT= ,E12.5)
80018 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
1A21,/,1H ,16X,10HCORRECT= ,A21)
80020 FORMAT (1H ,16X,10HCOMPUTED= ,A21,1X,A31)
80022 FORMAT (1H ,16X,10HCORRECT= ,A21,1X,A31)
80024 FORMAT (1H ,16X,10HCOMPUTED= ,I6,16X,A31)
80026 FORMAT (1H ,16X,10HCORRECT= ,I6,16X,A31)
80028 FORMAT (1H ,16X,10HCOMPUTED= ,E12.5,10X,A31)
80030 FORMAT (1H ,16X,10HCORRECT= ,E12.5,10X,A31)
80050 FORMAT (1H ,48X,A31)
CBE** ********************** BBCFMT0A **********************************
CBB** ********************** BBCFMAT1 **********************************
C**** FORMATS FOR TEST DETAIL LINES - FULL LANGUAGE
C****
80031 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
1D17.10,/,1H ,16X,10HCORRECT= ,D17.10)
80033 FORMAT (1H ,16X,10HCOMPUTED= ,D17.10,10X,A31)
80035 FORMAT (1H ,16X,10HCORRECT= ,D17.10,10X,A31)
80037 FORMAT (1H ,16X,10HCOMPUTED= ,1H(,E12.5,2H, ,E12.5,1H),6X,A31)
80039 FORMAT (1H ,16X,10HCORRECT= ,1H(,E12.5,2H, ,E12.5,1H),6X,A31)
80041 FORMAT (1H ,16X,10HCOMPUTED= ,1H(,F12.5,2H, ,F12.5,1H),6X,A31)
80043 FORMAT (1H ,16X,10HCORRECT= ,1H(,F12.5,2H, ,F12.5,1H),6X,A31)
80045 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
11H(,F12.5,2H, ,F12.5,1H)/,1H ,16X,10HCORRECT= ,
21H(,F12.5,2H, ,F12.5,1H))
CBE** ********************** BBCFMAT1 **********************************
CBB** ********************** BBCFMT0B **********************************
C**** FORMAT STATEMENTS FOR PAGE HEADERS
C****
90002 FORMAT (1H1)
90004 FORMAT (1H )
90006 FORMAT (1H ,20X,31HFEDERAL SOFTWARE TESTING CENTER)
90007 FORMAT (1H ,19X,34HFORTRAN COMPILER VALIDATION SYSTEM)
90008 FORMAT (1H ,21X,A13,A17)
90009 FORMAT (1H ,/,2H *,A5,6HBEGIN*,12X,15HTEST RESULTS - ,A5,/)
90010 FORMAT (1H ,8X,16HTEST DATE*TIME= ,A17,15H - COMPILER= ,A20)
90013 FORMAT (1H ,8H TEST ,10HPASS/FAIL ,6X,17HDISPLAYED RESULTS,
1 7X,7HREMARKS,24X)
90014 FORMAT (1H ,46H----------------------------------------------,
1 33H---------------------------------)
90015 FORMAT (1H ,48X,17HTHIS PROGRAM HAS ,I3,6H TESTS,/)
C****
C**** FORMAT STATEMENTS FOR REPORT FOOTINGS
C****
90016 FORMAT (1H ,/,2H *,A5,4HEND*,14X,14HEND OF TEST - ,A5,/)
90018 FORMAT (1H ,A13,13X,A20,7H * ,A10,1H/,
1 A13)
90019 FORMAT (1H ,26HFOR OFFICIAL USE ONLY ,35X,15HCOPYRIGHT 1982)
C****
C**** FORMAT STATEMENTS FOR RUN SUMMARY
C****
90020 FORMAT (1H ,21X,I5,13H TESTS PASSED)
90022 FORMAT (1H ,21X,I5,13H TESTS FAILED)
90024 FORMAT (1H ,21X,I5,14H TESTS DELETED)
90026 FORMAT (1H ,21X,I5,25H TESTS REQUIRE INSPECTION)
90028 FORMAT (1H ,21X,I5,4H OF ,I3,15H TESTS EXECUTED)
CBE** ********************** BBCFMT0B **********************************
END
*HEADER,FORTR,FM701,SUBRTN,FM702
C THIS SUBROUTINE IS TO BE RUN WITH ROUTINE 701.
C
C THIS SUBROUTINE TESTS DIMENSION BOUND EXPRESSIONS
C CONTAINING VARIABLES OF TYPE INTEGER.
C
SUBROUTINE SN702(IVD001,IVD002,IVD003,IVD004,I2D001,I2D002,I2D003,
1 IVD005)
C
DIMENSION I2D001(IVD002:3,1:5), I2D002(2,1:2*IVD003),
1 I2D003(IVD004/3 - 1 : IVD002 + 4, 1:2)
C
IF (IVD001 - 2) 70010, 70020, 70030
70010 IVD005 = I2D001(1,5)
RETURN
70020 IVD005 = I2D002(1,4)
RETURN
70030 IVD005 = I2D003(1,1) - I2D003(5,2)
RETURN
END
*HEADER,FORTR,FM701,SUBRTN,FM703
C THIS SUBROUTINE IS TO BE RUN WITH ROUTINE 701.
C
C THIS SUBROUTINE TESTS ASSUMED-SIZE ARRAY DECLARATORS
C AND ADJUSTABLE ARRAY DECLARATORS.
C
SUBROUTINE SN703(IVD001,IVD002,IVD003,C2D001,C2D002,CVD001)
C
CHARACTER*4 CVD001, C2D001(2,1:*), C2D002(IVD002:IVD003,5:7)
C
IF (IVD001 - 1) 70010, 70010, 70020
70010 CVD001 = C2D001(2,3)
RETURN
70020 CVD001 = C2D002(1,5)
RETURN
END
*HEADER,FORTR,FM701,SUBRTN,FM704
C THIS SUBROUTINE IS TO BE RUN WITH ROUTINE 701.
C
C THIS SUBROUTINE TESTS ADJUSTABLE ARRAY DECLARATORS.
C
SUBROUTINE SN704(IVD001,IVD002,IVD003,IVD004,C3D001,CVD001)
C
CHARACTER*4 CVD001, C3D001(IVD002:IVD003,2,IVD004:7)
C
IF (IVD001 - 2) 70010, 70020, 70030
70010 CVD001 = C3D001(1,1,5)
RETURN
70020 C3D001(1,2,6) = 'IJKL'
CVD001 = C3D001(1,2,6)
RETURN
70030 IF (IVD001 - 3) 70040, 70040, 70050
70040 C3D001(1,1,5) = 'EFGH'
CVD001 = C3D001(1,1,5)
RETURN
70050 C3D001(2,2,6) = 'ABCD'
CVD001 = C3D001(2,2,6)
RETURN
END
*HEADER,FORTR,FM701,SUBRTN,FM705
C THIS SUBROUTINE IS TO BE RUN WITH ROUTINE 701.
C
C THIS SUBROUTINE TESTS ARRAY DECLARATORS WHERE THE LOWER BOUNDS
C CONTAIN ARITHMETIC EXPRESSIONS OF TYPE
C INTEGER.
C
SUBROUTINE SN705(IVD001,IVD002,IVD003,IVD004,I2D001,I2D002,I2D003,
1 IVD005)
C
DIMENSION I2D001(IVD002-1:3,1:5),I2D002(IVD003+2:2,1:4),
1 I2D003(2*IVD004-1:5,2)
C
IF (IVD001 - 2) 70010, 70020, 70030
70010 IVD005 = I2D001(1,5)
RETURN
70020 IVD005 = I2D002(1,4)
RETURN
70030 IVD005 = I2D003(1,1) - I2D003(5,2)
RETURN
END
*HEADER,FORTR,FM701,SUBRTN,FM706
C THIS SUBROUTINE IS TO BE RUN WITH ROUTINE 701.
C
C THIS SUBROUTINE TESTS ARRAY DECLARATORS WHERE THE UPPER BOUNDS
C CONTAIN ARITHMETIC EXPRESSIONS OF TYPE
C INTEGER.
C
SUBROUTINE SN706(IVD001,IVD002,IVD003,IVD004,I2D001,I2D002,I2D003,
1 IVD005)
C
DIMENSION I2D001(1:IVD002-1,1:5),I2D002(1:IVD003+2,1:4),
1 I2D003(1:2*IVD004-1,2)
C
IF (IVD001 - 2) 70010, 70020, 70030
70010 IVD005 = I2D001(1,5)
RETURN
70020 IVD005 = I2D002(1,4)
RETURN
70030 IVD005 = I2D003(1,1) - I2D003(5,2)
RETURN
END
*HEADER,FORTR,FM701,SUBRTN,FM707
C THIS SUBROUTINE IS TO BE RUN WITH ROUTINE 701.
C
C THIS SUBROUTINE TESTS ARRAY DECLARATORS WHERE BOUND EXPRESSIONS
C MAY CONTAIN DIVISION OPERATORS OR
C EXPONENTIATION OPERATORS.
C
SUBROUTINE SN707(IVD001,IVD002,IVD003,I2D001,I2D002,IVD004)
C
DIMENSION I2D001(IVD002/3:3,1:5),I2D002(1:2,1:IVD003**2)
C
IF (IVD001 - 1) 70010, 70010, 70020
70010 IVD004 = I2D001(1,5)
RETURN
70020 IVD004 = I2D002(1,4)
RETURN
END
*HEADER,FORTR,FM701,SUBRTN,FM708
C THIS SUBROUTINE IS TO BE RUN WITH ROUTINE 701.
C
C THIS SUBROUTINE TESTS ARRAY DECLARATORS WHERE BOTH THE LOWER
C AND UPPER BOUNDS CONTAIN ARITHMETIC
C EXPRESSIONS OF TYPE INTEGER.
C
SUBROUTINE SN708(IVD001,IVD002,IVD003,I2D001,IVD004)
C
DIMENSION I2D001(IVD001/3:IVD001,IVD002+3 : 4*(2*IVD003-1)/3 + 1)
C
IVD004 = I2D001(1,5)
RETURN
END
*HEADER,FORTR,FM701,SUBRTN,FM709
C THIS SUBROUTINE IS TO BE RUN WITH ROUTINE 701.
C
C THIS SUBROUTINE TESTS ARRAY DECLARATORS WHERE THE BOUND
C EXPRESSIONS CONTAIN SYMBOLIC NAMES
C OF CONSTANTS OR VARIABLES OF TYPE
C INTEGER.
C
SUBROUTINE SN709(IVD001,IVD002,IVD003,I2D001,IVD005)
C
PARAMETER (IPN001=-3)
DIMENSION I2D001(IPN001+4:(2*IVD003 + 1),IPN001:(1-IVD001)/IVD002)
C
IVD005 = I2D001(1,-3)
RETURN
END
*END-OF,FM701
FM710.f 481036426 170 2 100666 18738 `
*HEADER,FORTR,FM710
*FILES1,FORTR,FM710,X
PROGRAM FM710
C
C THIS ROUTINE TESTS SUBSCRIPT EXPRESSIONS AND ANS REF.
C CHARACTER SUBSTRINGS. 5.4.2, 5.4.3
C 5.7.1, 5.7.2
C
C THIS ROUTINE ASSUMES THE INTRINSIC FUNCTIONS
C INT AND IABS ARE WORKING.
C
CBB** ********************** BBCCOMNT **********************************
C****
C**** 1978 FORTRAN COMPILER VALIDATION SYSTEM
C**** VERSION 2.0
C****
C****
C**** SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO
C**** GENERAL SERVICES ADMINISTRATION
C**** FEDERAL SOFTWARE TESTING CENTER
C**** 5203 LEESBURG PIKE, SUITE 1100
C**** FALLS CHURCH, VA. 22041
C****
C**** (703) 756-6153
C****
CBE** ********************** BBCCOMNT **********************************
IMPLICIT DOUBLE PRECISION (D), COMPLEX (Z), LOGICAL (L)
IMPLICIT CHARACTER*27 (C)
CBB** ********************** BBCINITA **********************************
C**** SPECIFICATION STATEMENTS
C****
CHARACTER ZVERS*13, ZVERSD*17, ZDATE*17, ZPROG*5, ZCOMPL*20,
1 ZNAME*20, ZTAPE*10, ZPROJ*13, REMRKS*31, ZTAPED*13
CBE** ********************** BBCINITA **********************************
C
DIMENSION I2N001(2,3), I2N002(3,5), I1N003(-1:8), I2N004(10,4)
CHARACTER*10 CVCOMP, CVCORR, CVN001, C2N001(2,4)
DATA I2N001 /1,2,3,4,5,6/
DATA I2N002 /11,21,31,12,22,32,13,23,33,14,24,34,15,25,35/
DATA I1N003 /1,2,3,4,5,6,7,8,9,10/
DATA I2N004 / 10, 9, 8, 7, 6, 5, 4, 3, 2, 1,
1 4,-2, 6,-3, 8,-4,10,-5, 2,-1,
2 1, 3, 5, 7, 9, 2, 4, 6, 8, 10,
3 -10,-9,-8,-7,-6,-5,-4,-3,-2,-1 /
DATA C2N001 /'11FIRSTELE','21SECONDXX','12THIRDXYZ','22FOURTHWW',
1 '13FIFTHABC','23SIXTHIJK','14SEVENTHH','24EIGHTHUV'/
C
C
CBB** ********************** BBCINITB **********************************
C**** INITIALIZE SECTION
DATA ZVERS, ZVERSD, ZDATE
1 /'VERSION 2.0 ', '82/08/02*18.33.46', '*NO DATE*TIME'/
DATA ZCOMPL, ZNAME, ZTAPE
1 /'*NONE SPECIFIED*', '*NO COMPANY NAME*', '*NO TAPE*'/
DATA ZPROJ, ZTAPED, ZPROG
1 /'*NO PROJECT*', '*NO TAPE DATE', 'XXXXX'/
DATA REMRKS /' '/
C**** THE FOLLOWING 9 COMMENT LINES (CZ01, CZ02, ...) CAN BE REPLACED
C**** FOR IDENTIFYING THE TEST ENVIRONMENT
C****
CZ01 ZVERS = 'VERSION OF THE COMPILER VALIDATION SYSTEM'
CZ02 ZVERSD = 'CREATION DATE/TIME OF THE COMPILER VALIDATION SYSTEM'
CZ03 ZPROG = 'PROGRAM NAME'
CZ04 ZDATE = 'DATE OF TEST'
CZ05 ZCOMPL = 'COMPILER IDENTIFICATION'
CZ06 ZPROJ = 'PROJECT NUMBER/IDENTIFICATION'
CZ07 ZNAME = 'NAME OF USER'
CZ08 ZTAPE = 'TAPE OWNER/ID'
CZ09 ZTAPED = 'DATE TAPE COPIED'
C
IVPASS = 0
IVFAIL = 0
IVDELE = 0
IVINSP = 0
IVTOTL = 0
IVTOTN = 0
ICZERO = 0
C
C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER.
I01 = 05
C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER.
I02 = 06
C
CX010 REPLACED BY FEXEC X-010 CONTROL CARD (CARD-READER UNIT NUMBER).
C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5
CX011 REPLACED BY FEXEC X-011 CONTROL CARD. CX011 IS FOR SYSTEMS
C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX010.
C
CX020 REPLACED BY FEXEC X-020 CONTROL CARD (PRINTER UNIT NUMBER).
C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02= 6
CX021 REPLACED BY FEXEC X-021 CONTROL CARD. CX021 IS FOR SYSTEMS
C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX020.
C
CBE** ********************** BBCINITB **********************************
ZPROG='FM710'
IVTOTL = 19
CBB** ********************** BBCHED0A **********************************
C****
C**** WRITE REPORT TITLE
C****
WRITE (I02, 90002)
WRITE (I02, 90006)
WRITE (I02, 90007)
WRITE (I02, 90008) ZVERS, ZVERSD
WRITE (I02, 90009) ZPROG, ZPROG
WRITE (I02, 90010) ZDATE, ZCOMPL
CBE** ********************** BBCHED0A **********************************
CBB** ********************** BBCHED0B **********************************
C**** WRITE DETAIL REPORT HEADERS
C****
WRITE (I02,90004)
WRITE (I02,90004)
WRITE (I02,90013)
WRITE (I02,90014)
WRITE (I02,90015) IVTOTL
CBE** ********************** BBCHED0B **********************************
C
C TESTS 1-2 - SUBSCRIPT EXPRESSION TO IDENTIFY VARIOUS
C ARRAY ELEMENTS
C
C
CT001* TEST 001 **** FCVS PROGRAM 710 ****
C
C TEST 001 ARRAY ELEMENT REFERENCE
C
IVTNUM = 1
IVCOMP = 0
IVCORR = 34
IVCOMP = I2N002(I2N001(1,2),I2N001(2,3)/2 + 1)
40010 IF (IVCOMP - 34) 20010, 10010, 20010
10010 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0011
20010 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0011 CONTINUE
C
CT002* TEST 002 **** FCVS PROGRAM 710 ****
C
C TEST 002 FUNCTION REFERENCE
C
IVTNUM = 2
RVD001 = 2.64
IVCOMP = 0
IVCORR = 25
IVCOMP = I2N002(INT(RVD001), 19 - IABS(-7)*2)
40020 IF (IVCOMP - 25) 20020, 10020, 20020
10020 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0021
20020 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0021 CONTINUE
C
C TESTS 3-7 - TEST SUBSCRIPT VALUE IN IDENTIFYING
C ARRAY ELEMENTS
C
CT003* TEST 003 **** FCVS PROGRAM 710 ****
C
C TEST 003 RANGE
C
IVTNUM = 3
WRITE (I02, 80004) IVTNUM
WRITE (I02, 80020)
WRITE (I02, 70030) (I1N003(IVN001), IVN001=5,8)
70030 FORMAT (1H ,26X,4I4)
IVINSP = IVINSP + 1
WRITE (I02, 80022)
WRITE (I02, 70031)
70031 FORMAT (1H ,26X,16H 7 8 9 10)
C
CT004* TEST 004 **** FCVS PROGRAM 710 ****
C
C TEST 004 SINGLE ELEMENT
C
IVTNUM = 4
IVCOMP = 0
IVCORR = 4
IVCOMP = I1N003(2)
40040 IF (IVCOMP - 4) 20040, 10040, 20040
10040 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0041
20040 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0041 CONTINUE
C
CT005* TEST 005 **** FCVS PROGRAM 710 ****
C
C TEST 005 EXPRESSION
C
IVTNUM = 5
IVN001 = -3
IVCOMP = 0
IVCORR = 1
IVCOMP = I1N003((IVN001+5)*3 - 7)
40050 IF (IVCOMP - 1) 20050, 10050, 20050
10050 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0051
20050 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0051 CONTINUE
C
CT006* TEST 006 **** FCVS PROGRAM 710 ****
C
C TEST 006 31ST ELEMENT IN 2 DIMENSIONAL, 40 ELEMENT ARRAY
C
IVTNUM = 6
IVCOMP = 0
IVCORR = -10
IVCOMP = I2N004(1,4)
40060 IF (IVCOMP + 10) 20060, 10060, 20060
10060 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0061
20060 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0061 CONTINUE
C
CT007* TEST 007 **** FCVS PROGRAM 710 ****
C
C TEST 007 4TH ELEMENT OF FIRST ARRAY EQUAL TO
C 11TH ELEMENT OF SECOND ARRAY
C
IVTNUM = 7
IVCOMP = 0
IVCORR = 1
IF (I1N003(2).EQ.I2N004(1,2)) IVCOMP = 1
40070 IF (IVCOMP - 1) 20070, 10070, 20070
10070 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0071
20070 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0071 CONTINUE
C
C TESTS 8-15 - CHARACTER SUBSTRING NAME
C
C
CT008* TEST 008 **** FCVS PROGRAM 710 ****
C
C TEST 008 USING LEFT AND RIGHT POSITION OF SUBSTRING
C
IVTNUM = 8
CVCOMP = ' '
IVCOMP = 0
CVN001 = 'THIS IS IT'
CVCORR = 'HIS '
CVCOMP = CVN001(2:4)
IF (CVCOMP .EQ. 'HIS ') IVCOMP = 1
IF (IVCOMP - 1) 20080, 10080, 20080
10080 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0081
20080 IVFAIL = IVFAIL + 1
WRITE (I02,80018) IVTNUM, CVCOMP, CVCORR
0081 CONTINUE
C
CT009* TEST 009 **** FCVS PROGRAM 710 ****
C
C TEST 009 LEFT POSITION OMITTED, VALUE OF 1 ASSUMED
C
IVTNUM = 9
CVCOMP = ' '
IVCOMP = 0
CVCORR = 'THIS '
CVCOMP = CVN001(:4)
IF (CVCOMP .EQ. 'THIS ') IVCOMP = 1
IF (IVCOMP - 1) 20090, 10090, 20090
10090 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0091
20090 IVFAIL = IVFAIL + 1
WRITE (I02,80018) IVTNUM, CVCOMP, CVCORR
0091 CONTINUE
C
CT010* TEST 010 **** FCVS PROGRAM 710 ****
C
C TEST 010 RIGHT POSITION OMITTED, RIGHT-HAND END OF STRING ASSUMED
C
IVTNUM = 10
CVCOMP = ' '
IVCOMP = 0
CVCORR = 'S IS IT '
CVCOMP = CVN001(4:)
IF (CVCOMP .EQ. 'S IS IT ') IVCOMP = 1
IF (IVCOMP - 1) 20100, 10100, 20100
10100 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0101
20100 IVFAIL = IVFAIL + 1
WRITE (I02,80018) IVTNUM, CVCOMP, CVCORR
0101 CONTINUE
C
CT011* TEST 011 **** FCVS PROGRAM 710 ****
C
C TEST 011 EXTRACT SUBSTRING FROM ARRAY
C
IVTNUM = 11
CVCOMP = ' '
IVCOMP = 0
CVCORR = '12THIR '
CVCOMP = C2N001(1,2)(1:6)
IF (CVCOMP .EQ. '12THIR ') IVCOMP = 1
IF (IVCOMP - 1) 20110, 10110, 20110
10110 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0111
20110 IVFAIL = IVFAIL + 1
WRITE (I02,80018) IVTNUM, CVCOMP, CVCORR
0111 CONTINUE
C
CT012* TEST 012 **** FCVS PROGRAM 710 ****
C
C TEST 012 ENTIRE SUBSTRING
C
IVTNUM = 12
CVCOMP = ' '
IVCOMP = 0
CVCORR = 'THIS IS IT'
CVCOMP = CVN001(:)
IF (CVCOMP .EQ. 'THIS IS IT') IVCOMP = 1
IF (IVCOMP - 1) 20120, 10120, 20120
10120 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0121
20120 IVFAIL = IVFAIL + 1
WRITE (I02,80018) IVTNUM, CVCOMP, CVCORR
0121 CONTINUE
C
CT013* TEST 013 **** FCVS PROGRAM 710 ****
C
C TEST 013 ENTIRE SUBSTRING FROM ARRAY
C
IVTNUM = 13
CVCOMP = ' '
IVCOMP = 0
CVCORR = '23SIXTHIJK'
CVCOMP = C2N001(2,3)(:)
IF (CVCOMP .EQ. '23SIXTHIJK') IVCOMP = 1
IF (IVCOMP - 1) 20130, 10130, 20130
10130 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0131
20130 IVFAIL = IVFAIL + 1
WRITE (I02,80018) IVTNUM, CVCOMP, CVCORR
0131 CONTINUE
C
CT014* TEST 014 **** FCVS PROGRAM 710 ****
C
C RIGHT POSITION OMITTED USING ARRAY
C
IVTNUM = 14
CVCOMP = ' '
IVCOMP = 0
CVCORR = 'EVENTHH '
CVCOMP = C2N001(1,4)(4:)
IF (CVCOMP .EQ. 'EVENTHH ') IVCOMP = 1
IF (IVCOMP - 1) 20140, 10140, 20140
10140 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0141
20140 IVFAIL = IVFAIL + 1
WRITE (I02,80018) IVTNUM, CVCOMP, CVCORR
0141 CONTINUE
C
CT015* TEST 015 **** FCVS PROGRAM 710 ****
C
C LEFT POSITION OMITTED
C
IVTNUM = 15
CVCOMP = ' '
IVCOMP = 0
CVCORR = '24EI '
CVCOMP = C2N001(2,4)(:4)
IF (CVCOMP .EQ. '24EI ') IVCOMP = 1
IF (IVCOMP - 1) 20150, 10150, 20150
10150 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0151
20150 IVFAIL = IVFAIL + 1
WRITE (I02,80018) IVTNUM, CVCOMP, CVCORR
0151 CONTINUE
C
C TESTS 16-19 - SUBSTRING EXPRESSION
C
C
CT016* TEST 016 **** FCVS PROGRAM 710 ****
C
C TEST 016 ARITHMETIC EXPRESSION
C
IVTNUM = 16
CVCOMP = ' '
IVCOMP = 0
CVCORR = 'HIS IS IT '
CVCOMP = CVN001(2:5*2)
IF (CVCOMP .EQ. 'HIS IS IT ') IVCOMP = 1
IF (IVCOMP - 1) 20160, 10160, 20160
10160 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0161
20160 IVFAIL = IVFAIL + 1
WRITE (I02,80018) IVTNUM, CVCOMP, CVCORR
0161 CONTINUE
C
CT017* TEST 017 **** FCVS PROGRAM 710 ****
C
C TEST 017 SUBSTRING EXPRESSION IN AN ASSIGNMENT STATEMENT
C
IVTNUM = 17
IVN001 = 5
IVN002 = 8
CVCOMP = ' '
IVCOMP = 0
CVCORR = 'THISLIKEIT'
CVN001(IVN001:IVN002) = 'LIKE'
CVCOMP = CVN001
IF (CVCOMP .EQ. 'THISLIKEIT') IVCOMP = 1
IF (IVCOMP - 1) 20170, 10170, 20170
10170 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0171
20170 IVFAIL = IVFAIL + 1
WRITE (I02,80018) IVTNUM, CVCOMP, CVCORR
0171 CONTINUE
C
CT018* TEST 018 **** FCVS PROGRAM 710 ****
C
C TEST 018 SUBSTRING EXPRESSION CONTAINING ARRAY ELEMENT REFERENCE
C
IVTNUM = 18
CVCOMP = ' '
IVCOMP = 0
CVCORR = 'HISLIKE '
CVCOMP = CVN001(I2N001(2,1):I2N002(3,5)-27)
IF (CVCOMP .EQ. 'HISLIKE ') IVCOMP = 1
IF (IVCOMP - 1) 20180, 10180, 20180
10180 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0181
20180 IVFAIL = IVFAIL + 1
WRITE (I02,80018) IVTNUM, CVCOMP, CVCORR
0181 CONTINUE
C
CT019* TEST 019 **** FCVS PROGRAM 710 ****
C
C TEST 019 SUBSTRING EXPRESSION CONTAINING FUNCTION REFERENCES
C
IVTNUM = 19
RVD001 = 1.475
IVN001 = 1
CVCOMP = ' '
IVCOMP = 0
CVCORR = 'IFTHABC '
CVCOMP = C2N001(1,3)(INT(RVD001)+3 : (IVN001*5 + 7)/IABS(-6) + 8)
IF (CVCOMP .EQ. 'IFTHABC ') IVCOMP = 1
IF (IVCOMP - 1) 20190, 10190, 20190
10190 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0191
20190 IVFAIL = IVFAIL + 1
WRITE (I02,80018) IVTNUM, CVCOMP, CVCORR
0191 CONTINUE
C
CBB** ********************** BBCSUM0 **********************************
C**** WRITE OUT TEST SUMMARY
C****
IVTOTN = IVPASS + IVFAIL + IVDELE + IVINSP
WRITE (I02, 90004)
WRITE (I02, 90014)
WRITE (I02, 90004)
WRITE (I02, 90020) IVPASS
WRITE (I02, 90022) IVFAIL
WRITE (I02, 90024) IVDELE
WRITE (I02, 90026) IVINSP
WRITE (I02, 90028) IVTOTN, IVTOTL
CBE** ********************** BBCSUM0 **********************************
CBB** ********************** BBCFOOT0 **********************************
C**** WRITE OUT REPORT FOOTINGS
C****
WRITE (I02,90016) ZPROG, ZPROG
WRITE (I02,90018) ZPROJ, ZNAME, ZTAPE, ZTAPED
WRITE (I02,90019)
CBE** ********************** BBCFOOT0 **********************************
90001 FORMAT (1H ,56X,5HFM710)
90000 FORMAT (1H ,50X,20HEND OF PROGRAM FM710)
CBB** ********************** BBCFMT0A **********************************
C**** FORMATS FOR TEST DETAIL LINES
C****
80000 FORMAT (1H ,2X,I3,4X,7HDELETED,32X,A31)
80002 FORMAT (1H ,2X,I3,4X,7H PASS ,32X,A31)
80004 FORMAT (1H ,2X,I3,4X,7HINSPECT,32X,A31)
80008 FORMAT (1H ,2X,I3,4X,7H FAIL ,32X,A31)
80010 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,15X,10HCOMPUTED= ,
1I6,/,1H ,15X,10HCORRECT= ,I6)
80012 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
1E12.5,/,1H ,16X,10HCORRECT= ,E12.5)
80018 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
1A21,/,1H ,16X,10HCORRECT= ,A21)
80020 FORMAT (1H ,16X,10HCOMPUTED= ,A21,1X,A31)
80022 FORMAT (1H ,16X,10HCORRECT= ,A21,1X,A31)
80024 FORMAT (1H ,16X,10HCOMPUTED= ,I6,16X,A31)
80026 FORMAT (1H ,16X,10HCORRECT= ,I6,16X,A31)
80028 FORMAT (1H ,16X,10HCOMPUTED= ,E12.5,10X,A31)
80030 FORMAT (1H ,16X,10HCORRECT= ,E12.5,10X,A31)
80050 FORMAT (1H ,48X,A31)
CBE** ********************** BBCFMT0A **********************************
CBB** ********************** BBCFMAT1 **********************************
C**** FORMATS FOR TEST DETAIL LINES - FULL LANGUAGE
C****
80031 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
1D17.10,/,1H ,16X,10HCORRECT= ,D17.10)
80033 FORMAT (1H ,16X,10HCOMPUTED= ,D17.10,10X,A31)
80035 FORMAT (1H ,16X,10HCORRECT= ,D17.10,10X,A31)
80037 FORMAT (1H ,16X,10HCOMPUTED= ,1H(,E12.5,2H, ,E12.5,1H),6X,A31)
80039 FORMAT (1H ,16X,10HCORRECT= ,1H(,E12.5,2H, ,E12.5,1H),6X,A31)
80041 FORMAT (1H ,16X,10HCOMPUTED= ,1H(,F12.5,2H, ,F12.5,1H),6X,A31)
80043 FORMAT (1H ,16X,10HCORRECT= ,1H(,F12.5,2H, ,F12.5,1H),6X,A31)
80045 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
11H(,F12.5,2H, ,F12.5,1H)/,1H ,16X,10HCORRECT= ,
21H(,F12.5,2H, ,F12.5,1H))
CBE** ********************** BBCFMAT1 **********************************
CBB** ********************** BBCFMT0B **********************************
C**** FORMAT STATEMENTS FOR PAGE HEADERS
C****
90002 FORMAT (1H1)
90004 FORMAT (1H )
90006 FORMAT (1H ,20X,31HFEDERAL SOFTWARE TESTING CENTER)
90007 FORMAT (1H ,19X,34HFORTRAN COMPILER VALIDATION SYSTEM)
90008 FORMAT (1H ,21X,A13,A17)
90009 FORMAT (1H ,/,2H *,A5,6HBEGIN*,12X,15HTEST RESULTS - ,A5,/)
90010 FORMAT (1H ,8X,16HTEST DATE*TIME= ,A17,15H - COMPILER= ,A20)
90013 FORMAT (1H ,8H TEST ,10HPASS/FAIL ,6X,17HDISPLAYED RESULTS,
1 7X,7HREMARKS,24X)
90014 FORMAT (1H ,46H----------------------------------------------,
1 33H---------------------------------)
90015 FORMAT (1H ,48X,17HTHIS PROGRAM HAS ,I3,6H TESTS,/)
C****
C**** FORMAT STATEMENTS FOR REPORT FOOTINGS
C****
90016 FORMAT (1H ,/,2H *,A5,4HEND*,14X,14HEND OF TEST - ,A5,/)
90018 FORMAT (1H ,A13,13X,A20,7H * ,A10,1H/,
1 A13)
90019 FORMAT (1H ,26HFOR OFFICIAL USE ONLY ,35X,15HCOPYRIGHT 1982)
C****
C**** FORMAT STATEMENTS FOR RUN SUMMARY
C****
90020 FORMAT (1H ,21X,I5,13H TESTS PASSED)
90022 FORMAT (1H ,21X,I5,13H TESTS FAILED)
90024 FORMAT (1H ,21X,I5,14H TESTS DELETED)
90026 FORMAT (1H ,21X,I5,25H TESTS REQUIRE INSPECTION)
90028 FORMAT (1H ,21X,I5,4H OF ,I3,15H TESTS EXECUTED)
CBE** ********************** BBCFMT0B **********************************
END
*END-OF,FM710
FM711.f 481036431 170 2 100666 12543 `
*HEADER,FORTR,FM711
*FILES1,FORTR,FM711
PROGRAM FM711
C
C THIS ROUTINE TESTS ADJUSTABLE ARRAYS AND ADJUSTABLE ANS REF.
C DIMENSIONS, AND THE USE OF ARRAY 5.5.1
C NAMES. 5.6
C
C THIS ROUTINE USES ROUTINES 712-714 AS SUBROUTINES.
C
CBB** ********************** BBCCOMNT **********************************
C****
C**** 1978 FORTRAN COMPILER VALIDATION SYSTEM
C**** VERSION 2.0
C****
C****
C**** SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO
C**** GENERAL SERVICES ADMINISTRATION
C**** FEDERAL SOFTWARE TESTING CENTER
C**** 5203 LEESBURG PIKE, SUITE 1100
C**** FALLS CHURCH, VA. 22041
C****
C**** (703) 756-6153
C****
CBE** ********************** BBCCOMNT **********************************
IMPLICIT DOUBLE PRECISION (D), COMPLEX (Z), LOGICAL (L)
IMPLICIT CHARACTER*27 (C)
CBB** ********************** BBCINITA **********************************
C**** SPECIFICATION STATEMENTS
C****
CHARACTER ZVERS*13, ZVERSD*17, ZDATE*17, ZPROG*5, ZCOMPL*20,
1 ZNAME*20, ZTAPE*10, ZPROJ*13, REMRKS*31, ZTAPED*13
CBE** ********************** BBCINITA **********************************
C
INTEGER I2D001(3,5)
CHARACTER CVCOMP*20,CVCORR*20,C1N001(3)*5,C1N002(4)*5,CVN001*10
COMMON ICC001, ICC002
DATA I2D001 / 11,21,31,12,22,32,13,23,33,14,24,34,15,25,35 /
DATA C1N001 / '-3412', ' 108', '+9792' /
DATA C1N002 / '(10HI', '/O TE', 'ST: ,', ' A10)' /
C
C
CBB** ********************** BBCINITB **********************************
C**** INITIALIZE SECTION
DATA ZVERS, ZVERSD, ZDATE
1 /'VERSION 2.0 ', '82/08/02*18.33.46', '*NO DATE*TIME'/
DATA ZCOMPL, ZNAME, ZTAPE
1 /'*NONE SPECIFIED*', '*NO COMPANY NAME*', '*NO TAPE*'/
DATA ZPROJ, ZTAPED, ZPROG
1 /'*NO PROJECT*', '*NO TAPE DATE', 'XXXXX'/
DATA REMRKS /' '/
C**** THE FOLLOWING 9 COMMENT LINES (CZ01, CZ02, ...) CAN BE REPLACED
C**** FOR IDENTIFYING THE TEST ENVIRONMENT
C****
CZ01 ZVERS = 'VERSION OF THE COMPILER VALIDATION SYSTEM'
CZ02 ZVERSD = 'CREATION DATE/TIME OF THE COMPILER VALIDATION SYSTEM'
CZ03 ZPROG = 'PROGRAM NAME'
CZ04 ZDATE = 'DATE OF TEST'
CZ05 ZCOMPL = 'COMPILER IDENTIFICATION'
CZ06 ZPROJ = 'PROJECT NUMBER/IDENTIFICATION'
CZ07 ZNAME = 'NAME OF USER'
CZ08 ZTAPE = 'TAPE OWNER/ID'
CZ09 ZTAPED = 'DATE TAPE COPIED'
C
IVPASS = 0
IVFAIL = 0
IVDELE = 0
IVINSP = 0
IVTOTL = 0
IVTOTN = 0
ICZERO = 0
C
C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER.
I01 = 05
C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER.
I02 = 06
C
CX010 REPLACED BY FEXEC X-010 CONTROL CARD (CARD-READER UNIT NUMBER).
C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5
CX011 REPLACED BY FEXEC X-011 CONTROL CARD. CX011 IS FOR SYSTEMS
C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX010.
C
CX020 REPLACED BY FEXEC X-020 CONTROL CARD (PRINTER UNIT NUMBER).
C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02= 6
CX021 REPLACED BY FEXEC X-021 CONTROL CARD. CX021 IS FOR SYSTEMS
C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX020.
C
CBE** ********************** BBCINITB **********************************
ZPROG='FM711'
IVTOTL = 5
CBB** ********************** BBCHED0A **********************************
C****
C**** WRITE REPORT TITLE
C****
WRITE (I02, 90002)
WRITE (I02, 90006)
WRITE (I02, 90007)
WRITE (I02, 90008) ZVERS, ZVERSD
WRITE (I02, 90009) ZPROG, ZPROG
WRITE (I02, 90010) ZDATE, ZCOMPL
CBE** ********************** BBCHED0A **********************************
CBB** ********************** BBCHED0B **********************************
C**** WRITE DETAIL REPORT HEADERS
C****
WRITE (I02,90004)
WRITE (I02,90004)
WRITE (I02,90013)
WRITE (I02,90014)
WRITE (I02,90015) IVTOTL
CBE** ********************** BBCHED0B **********************************
ICC001 = 3
ICC002 = 4
C
C TESTS 1-2 - TEST ADJUSTABLE ARRAYS WHERE THE LOWER AND/OR UPPER
C BOUNDS ARE ARGUMENTS OF A SUBROUTINE OR IN COMMON.
C
C
CT001* TEST 001 **** FCVS PROGRAM 711 ****
C
IVTNUM = 1
IVCOMP = 0
IVCORR = 24
CALL SN712(3,5,I2D001,IVCOMP)
40010 IF (IVCOMP - 24) 20010, 10010, 20010
10010 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0011
20010 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0011 CONTINUE
C
CT002* TEST 002 **** FCVS PROGRAM 711 ****
C
IVTNUM = 2
IVCOMP = 0
IVCORR = 113
CALL SN713(1,I2D001,IVCOMP)
40020 IF (IVCOMP - 113) 20020, 10020, 20020
10020 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0021
20020 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0021 CONTINUE
C
CT003* TEST 003 **** FCVS PROGRAM 711 ****
C
C TEST THE ABILITY TO USE AN ARRAY ELEMENT NAME
C AS A UNIT IDENTIFIER FOR AN INTERNAL FILE
C IN AN INPUT/OUTPUT STATEMENT
C
IVTNUM = 3
IVCOMP = 0
IVCORR = 9792
READ (UNIT=C1N001(3),FMT=70010) IVCOMP
70010 FORMAT (I5)
40030 IF (IVCOMP - 9792) 20030, 10030, 20030
10030 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0031
20030 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0031 CONTINUE
C
CT004* TEST 004 **** FCVS PROGRAM 711 ****
C TEST THE ABILITY TO USE AN ARRAY NAME
C AS A FORMAT IDENTIFIER IN AN INPUT/OUTPUT
C STATEMENT
C
IVTNUM = 4
CVCOMP = ' '
CVCORR = 'I/O TEST: THIS IS IT'
CVN001 = 'THIS IS IT'
WRITE (UNIT=CVCOMP, FMT=C1N002) CVN001
IVCOMP = 0
IF (CVCOMP .EQ. 'I/O TEST: THIS IS IT') IVCOMP = 1
IF (IVCOMP - 1) 20040, 10040, 20040
10040 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0041
20040 IVFAIL = IVFAIL + 1
WRITE (I02,80018) IVTNUM, CVCOMP, CVCORR
0041 CONTINUE
C
CT005* TEST 005 **** FCVS PROGRAM 711 ****
C TEST THE ABILITY TO USE AN ARRAY NAME
C IN A SAVE STATMENT
C
IVTNUM = 5
IVCOMP = 0
IVCORR = 174
CALL SN714(1,IVD001)
CALL SN714(2,IVCOMP)
40050 IF (IVCOMP - 174) 20050, 10050, 20050
10050 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0051
20050 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0051 CONTINUE
C
CBB** ********************** BBCSUM0 **********************************
C**** WRITE OUT TEST SUMMARY
C****
IVTOTN = IVPASS + IVFAIL + IVDELE + IVINSP
WRITE (I02, 90004)
WRITE (I02, 90014)
WRITE (I02, 90004)
WRITE (I02, 90020) IVPASS
WRITE (I02, 90022) IVFAIL
WRITE (I02, 90024) IVDELE
WRITE (I02, 90026) IVINSP
WRITE (I02, 90028) IVTOTN, IVTOTL
CBE** ********************** BBCSUM0 **********************************
CBB** ********************** BBCFOOT0 **********************************
C**** WRITE OUT REPORT FOOTINGS
C****
WRITE (I02,90016) ZPROG, ZPROG
WRITE (I02,90018) ZPROJ, ZNAME, ZTAPE, ZTAPED
WRITE (I02,90019)
CBE** ********************** BBCFOOT0 **********************************
90001 FORMAT (1H ,56X,5HFM711)
90000 FORMAT (1H ,50X,20HEND OF PROGRAM FM711)
CBB** ********************** BBCFMT0A **********************************
C**** FORMATS FOR TEST DETAIL LINES
C****
80000 FORMAT (1H ,2X,I3,4X,7HDELETED,32X,A31)
80002 FORMAT (1H ,2X,I3,4X,7H PASS ,32X,A31)
80004 FORMAT (1H ,2X,I3,4X,7HINSPECT,32X,A31)
80008 FORMAT (1H ,2X,I3,4X,7H FAIL ,32X,A31)
80010 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,15X,10HCOMPUTED= ,
1I6,/,1H ,15X,10HCORRECT= ,I6)
80012 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
1E12.5,/,1H ,16X,10HCORRECT= ,E12.5)
80018 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
1A21,/,1H ,16X,10HCORRECT= ,A21)
80020 FORMAT (1H ,16X,10HCOMPUTED= ,A21,1X,A31)
80022 FORMAT (1H ,16X,10HCORRECT= ,A21,1X,A31)
80024 FORMAT (1H ,16X,10HCOMPUTED= ,I6,16X,A31)
80026 FORMAT (1H ,16X,10HCORRECT= ,I6,16X,A31)
80028 FORMAT (1H ,16X,10HCOMPUTED= ,E12.5,10X,A31)
80030 FORMAT (1H ,16X,10HCORRECT= ,E12.5,10X,A31)
80050 FORMAT (1H ,48X,A31)
CBE** ********************** BBCFMT0A **********************************
CBB** ********************** BBCFMAT1 **********************************
C**** FORMATS FOR TEST DETAIL LINES - FULL LANGUAGE
C****
80031 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
1D17.10,/,1H ,16X,10HCORRECT= ,D17.10)
80033 FORMAT (1H ,16X,10HCOMPUTED= ,D17.10,10X,A31)
80035 FORMAT (1H ,16X,10HCORRECT= ,D17.10,10X,A31)
80037 FORMAT (1H ,16X,10HCOMPUTED= ,1H(,E12.5,2H, ,E12.5,1H),6X,A31)
80039 FORMAT (1H ,16X,10HCORRECT= ,1H(,E12.5,2H, ,E12.5,1H),6X,A31)
80041 FORMAT (1H ,16X,10HCOMPUTED= ,1H(,F12.5,2H, ,F12.5,1H),6X,A31)
80043 FORMAT (1H ,16X,10HCORRECT= ,1H(,F12.5,2H, ,F12.5,1H),6X,A31)
80045 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
11H(,F12.5,2H, ,F12.5,1H)/,1H ,16X,10HCORRECT= ,
21H(,F12.5,2H, ,F12.5,1H))
CBE** ********************** BBCFMAT1 **********************************
CBB** ********************** BBCFMT0B **********************************
C**** FORMAT STATEMENTS FOR PAGE HEADERS
C****
90002 FORMAT (1H1)
90004 FORMAT (1H )
90006 FORMAT (1H ,20X,31HFEDERAL SOFTWARE TESTING CENTER)
90007 FORMAT (1H ,19X,34HFORTRAN COMPILER VALIDATION SYSTEM)
90008 FORMAT (1H ,21X,A13,A17)
90009 FORMAT (1H ,/,2H *,A5,6HBEGIN*,12X,15HTEST RESULTS - ,A5,/)
90010 FORMAT (1H ,8X,16HTEST DATE*TIME= ,A17,15H - COMPILER= ,A20)
90013 FORMAT (1H ,8H TEST ,10HPASS/FAIL ,6X,17HDISPLAYED RESULTS,
1 7X,7HREMARKS,24X)
90014 FORMAT (1H ,46H----------------------------------------------,
1 33H---------------------------------)
90015 FORMAT (1H ,48X,17HTHIS PROGRAM HAS ,I3,6H TESTS,/)
C****
C**** FORMAT STATEMENTS FOR REPORT FOOTINGS
C****
90016 FORMAT (1H ,/,2H *,A5,4HEND*,14X,14HEND OF TEST - ,A5,/)
90018 FORMAT (1H ,A13,13X,A20,7H * ,A10,1H/,
1 A13)
90019 FORMAT (1H ,26HFOR OFFICIAL USE ONLY ,35X,15HCOPYRIGHT 1982)
C****
C**** FORMAT STATEMENTS FOR RUN SUMMARY
C****
90020 FORMAT (1H ,21X,I5,13H TESTS PASSED)
90022 FORMAT (1H ,21X,I5,13H TESTS FAILED)
90024 FORMAT (1H ,21X,I5,14H TESTS DELETED)
90026 FORMAT (1H ,21X,I5,25H TESTS REQUIRE INSPECTION)
90028 FORMAT (1H ,21X,I5,4H OF ,I3,15H TESTS EXECUTED)
CBE** ********************** BBCFMT0B **********************************
END
*HEADER,FORTR,FM711,SUBRTN,FM712
C THIS SUBROUTINE IS TO BE RUN WITH ROUTINE 711.
C
C THIS SUBROUTINE TESTS ADJUSTABLE ARRAYS AND ADJUSTABLE
C DIMENSIONS WHERE THE UPPER BOUND
C IS A DUMMY ARGUMENT.
C
SUBROUTINE SN712(IVD001,IVD002,I2D001,IVD003)
INTEGER I2D001(1:IVD001,1:IVD002)
IVD003 = I2D001(2,4)
RETURN
END
*HEADER,FORTR,FM711,SUBRTN,FM713
C THIS SUBROUTINE IS TO BE RUN WITH ROUTINE 711.
C
C THIS SUBROUTINE TESTS ADJUSTABLE ARRAYS AND ADJUSTABLE
C DIMENSIONS WHERE THE LOWER AND
C UPPER BOUND MAY BE A DUMMY ARGUMENT
C AND/OR IN COMMON.
C
SUBROUTINE SN713(IVD001,I2D001,IVD002)
COMMON ICC001, ICC002
INTEGER I2D001(IVD001:ICC001,2:ICC002)
I2D001(3,4) = 113
IVD002 = I2D001(3,4)
RETURN
END
*HEADER,FORTR,FM711,SUBRTN,FM714
C THIS SUBROUTINE IS TO BE RUN WITH ROUTINE 711.
C
C THIS SUBROUTINE TESTS THE USE OF ARRAY NAMES IN A
C SAVE STATEMENT.
C
SUBROUTINE SN714(IVD001, IVD002)
INTEGER I2N001(2,2)
SAVE I2N001
IF (IVD001.GT.1) GO TO 70010
I2N001(1,1) = -12
I2N001(1,2) = 137
I2N001(2,1) = 69
I2N001(2,2) = 102
70010 IVD002 = I2N001(1,2)+I2N001(2,2)/17-(2*I2N001(1,1)-I2N001(2,1))/3
RETURN
END
*END-OF,FM711
FM715.f 481036436 170 2 100666 28400 `
*HEADER,FORTR,FM715
*FILES1,FORTR,FM715
PROGRAM FM715
C
C THIS ROUTINE TESTS CHARACTER EXPRESSIONS ANS REF.
C AND CONCATENATION OPERATIONS USING 6.2, 6.2.1,
C ASSIGNMENT STATEMENTS AND RELATIONAL 6.2.2, 6.2.2.2,
C EXPRESSIONS. 6.6.5
C
C THIS ROUTINE USES ROUTINES CF716-CF717 AS FUNCTION SUBPROGRAMS.
C
C THE FUNCTION LEN IS ASSUMED WORKING.
C
CBB** ********************** BBCCOMNT **********************************
C****
C**** 1978 FORTRAN COMPILER VALIDATION SYSTEM
C**** VERSION 2.0
C****
C****
C**** SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO
C**** GENERAL SERVICES ADMINISTRATION
C**** FEDERAL SOFTWARE TESTING CENTER
C**** 5203 LEESBURG PIKE, SUITE 1100
C**** FALLS CHURCH, VA. 22041
C****
C**** (703) 756-6153
C****
CBE** ********************** BBCCOMNT **********************************
IMPLICIT DOUBLE PRECISION (D), COMPLEX (Z), LOGICAL (L)
IMPLICIT CHARACTER*27 (C)
CBB** ********************** BBCINITA **********************************
C**** SPECIFICATION STATEMENTS
C****
CHARACTER ZVERS*13, ZVERSD*17, ZDATE*17, ZPROG*5, ZCOMPL*20,
1 ZNAME*20, ZTAPE*10, ZPROJ*13, REMRKS*31, ZTAPED*13
CBE** ********************** BBCINITA **********************************
C
CHARACTER CVCOMP*65, CVCORR*65, CPN001*5, CPN002*10
CHARACTER CVN001*7, CVN002*35, C2N001(2,2)*6, CF716*10
CHARACTER*(*) CPN003
CHARACTER*2 CVN003, CVN004, CVD005, CF717
PARAMETER (CPN001='PQRST', CPN002='EXPRESSION')
PARAMETER (CPN003='NOW IS THE TIME FOR ALL GOOD MEN')
DATA CVN001 / 'ONE+TWO' /
DATA CVN002 / 'THIS-IS-A-LONG-CHARACTER-STRING' /
DATA C2N001 / 'ABCDEF', 'GHIJKL', 'MNOPQR', 'STUVWX' /
C
C
CBB** ********************** BBCINITB **********************************
C**** INITIALIZE SECTION
DATA ZVERS, ZVERSD, ZDATE
1 /'VERSION 2.0 ', '82/08/02*18.33.46', '*NO DATE*TIME'/
DATA ZCOMPL, ZNAME, ZTAPE
1 /'*NONE SPECIFIED*', '*NO COMPANY NAME*', '*NO TAPE*'/
DATA ZPROJ, ZTAPED, ZPROG
1 /'*NO PROJECT*', '*NO TAPE DATE', 'XXXXX'/
DATA REMRKS /' '/
C**** THE FOLLOWING 9 COMMENT LINES (CZ01, CZ02, ...) CAN BE REPLACED
C**** FOR IDENTIFYING THE TEST ENVIRONMENT
C****
CZ01 ZVERS = 'VERSION OF THE COMPILER VALIDATION SYSTEM'
CZ02 ZVERSD = 'CREATION DATE/TIME OF THE COMPILER VALIDATION SYSTEM'
CZ03 ZPROG = 'PROGRAM NAME'
CZ04 ZDATE = 'DATE OF TEST'
CZ05 ZCOMPL = 'COMPILER IDENTIFICATION'
CZ06 ZPROJ = 'PROJECT NUMBER/IDENTIFICATION'
CZ07 ZNAME = 'NAME OF USER'
CZ08 ZTAPE = 'TAPE OWNER/ID'
CZ09 ZTAPED = 'DATE TAPE COPIED'
C
IVPASS = 0
IVFAIL = 0
IVDELE = 0
IVINSP = 0
IVTOTL = 0
IVTOTN = 0
ICZERO = 0
C
C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER.
I01 = 05
C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER.
I02 = 06
C
CX010 REPLACED BY FEXEC X-010 CONTROL CARD (CARD-READER UNIT NUMBER).
C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5
CX011 REPLACED BY FEXEC X-011 CONTROL CARD. CX011 IS FOR SYSTEMS
C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX010.
C
CX020 REPLACED BY FEXEC X-020 CONTROL CARD (PRINTER UNIT NUMBER).
C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02= 6
CX021 REPLACED BY FEXEC X-021 CONTROL CARD. CX021 IS FOR SYSTEMS
C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX020.
C
CBE** ********************** BBCINITB **********************************
ZPROG='FM715'
IVTOTL = 34
CBB** ********************** BBCHED0A **********************************
C****
C**** WRITE REPORT TITLE
C****
WRITE (I02, 90002)
WRITE (I02, 90006)
WRITE (I02, 90007)
WRITE (I02, 90008) ZVERS, ZVERSD
WRITE (I02, 90009) ZPROG, ZPROG
WRITE (I02, 90010) ZDATE, ZCOMPL
CBE** ********************** BBCHED0A **********************************
CBB** ********************** BBCHED0B **********************************
C**** WRITE DETAIL REPORT HEADERS
C****
WRITE (I02,90004)
WRITE (I02,90004)
WRITE (I02,90013)
WRITE (I02,90014)
WRITE (I02,90015) IVTOTL
CBE** ********************** BBCHED0B **********************************
C
C TESTS 1-12 - CHARACTER EXPRESSIONS
C
C
CT001* TEST 001 **** FCVS PROGRAM 715 ****
C
C CHARACTER CONSTANT IN AN ASSIGNMENT STATEMENT
C
IVTNUM = 1
CVCOMP = ' '
IVCOMP = 0
CVCORR = 'CONSTANT'
CVCOMP = 'CONSTANT'
IF (CVCOMP .EQ. 'CONSTANT') IVCOMP = 1
IF (IVCOMP - 1) 20010, 10010, 20010
10010 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0011
20010 IVFAIL = IVFAIL + 1
WRITE (I02,80018) IVTNUM, CVCOMP, CVCORR
0011 CONTINUE
C
CT002* TEST 002 **** FCVS PROGRAM 715 ****
C
C CHARACTER CONSTANT IN AN IF STATEMENT
C
IVTNUM = 2
IVCOMP = 0
CVCOMP = ' '
IVCORR = 1
CVCOMP = 'RELATIONAL'
IF (CVCOMP.EQ.'RELATIONAL') IVCOMP = 1
40020 IF (IVCOMP - 1) 20020, 10020, 20020
10020 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0021
20020 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0021 CONTINUE
C
CT003* TEST 003 **** FCVS PROGRAM 715 ****
C
C SYMBOLIC NAME OF A CHARACTER CONSTANT IN AN ASSIGNMENT STATEMENT
C
IVTNUM = 3
CVCOMP = ' '
IVCOMP = 0
CVCORR = 'PQRST'
CVCOMP = CPN001
IF (CVCOMP .EQ. 'PQRST') IVCOMP = 1
IF (IVCOMP - 1) 20030, 10030, 20030
10030 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0031
20030 IVFAIL = IVFAIL + 1
WRITE (I02,80018) IVTNUM, CVCOMP, CVCORR
0031 CONTINUE
C
CT004* TEST 004 **** FCVS PROGRAM 715 ****
C
C SYMBOLIC NAME OF A CHARACTER CONSTANT IN AN IF STATEMENT
C
IVTNUM = 4
IVCOMP = 0
CVCOMP = ' '
IVCORR = 1
CVCOMP = 'EXPRESSION'
IF (CVCOMP.EQ.CPN002) IVCOMP = 1
40040 IF (IVCOMP - 1) 20040, 10040, 20040
10040 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0041
20040 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0041 CONTINUE
C
CT005* TEST 005 **** FCVS PROGRAM 715 ****
C
C CHARACTER VARIABLE IN AN ASSIGNMENT STATEMENT
C
IVTNUM = 5
CVCOMP = ' '
IVCOMP = 0
CVCORR = 'ONE+TWO'
CVCOMP = CVN001
IF (CVCOMP .EQ. 'ONE+TWO') IVCOMP = 1
IF (IVCOMP - 1) 20050, 10050, 20050
10050 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0051
20050 IVFAIL = IVFAIL + 1
WRITE (I02,80018) IVTNUM, CVCOMP, CVCORR
0051 CONTINUE
C
CT006* TEST 006 **** FCVS PROGRAM 715 ****
C
C CHARACTER VARIABLE IN AN IF STATEMENT
C
IVTNUM = 6
IVCOMP = 0
CVCOMP = ' '
IVCORR = 1
CVCOMP = 'THIS-IS-A-LONG-CHARACTER-STRING'
IF (CVCOMP.EQ.CVN002) IVCOMP = 1
40060 IF (IVCOMP - 1) 20060, 10060, 20060
10060 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0061
20060 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0061 CONTINUE
C
CT007* TEST 007 **** FCVS PROGRAM 715 ****
C
C CHARACTER ARRAY ELEMENT REFERENCE IN AN ASSIGNMENT STATEMENT
C
IVTNUM = 7
CVCOMP = ' '
CVCORR = 'GHIJKL'
IVCOMP = 0
CVCOMP = C2N001(2,1)
IF (CVCOMP .EQ. 'GHIJKL') IVCOMP = 1
IF (IVCOMP - 1) 20070, 10070, 20070
10070 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0071
20070 IVFAIL = IVFAIL + 1
WRITE (I02,80018) IVTNUM, CVCOMP, CVCORR
0071 CONTINUE
C
CT008* TEST 008 **** FCVS PROGRAM 715 ****
C
C CHARACTER ARRAY ELEMENT REFERENCE IN AN IF STATEMENT
C
IVTNUM = 8
CVCOMP = ' '
IVCOMP = 0
IVCORR = 1
CVCOMP = 'MNOPQR'
IF (CVCOMP.EQ.C2N001(1,2)) IVCOMP = 1
40080 IF (IVCOMP - 1) 20080, 10080, 20080
10080 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0081
20080 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0081 CONTINUE
C
CT009* TEST 009 **** FCVS PROGRAM 715 ****
C
C SUBSTRING REFERENCE IN AN ASSIGNMENT STATEMENT
C
IVTNUM = 9
CVCOMP = ' '
IVCOMP = 0
CVCORR = 'CTER-STRIN'
CVCOMP = CVN002(21:30)
IF (CVCOMP .EQ. 'CTER-STRIN') IVCOMP = 1
IF (IVCOMP - 1) 20090, 10090, 20090
10090 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0091
20090 IVFAIL = IVFAIL + 1
WRITE (I02,80018) IVTNUM, CVCOMP, CVCORR
0091 CONTINUE
C
CT010* TEST 010 **** FCVS PROGRAM 715 ****
C
C SUBSTRING REFERENCE IN AN IF STATEMENT
C
IVTNUM = 10
IVCOMP = 0
CVCOMP = ' '
IVCORR = 1
CVCOMP = 'A-LONG-CHA'
IF (CVCOMP.EQ.CVN002(9:18)) IVCOMP = 1
40100 IF (IVCOMP - 1) 20100, 10100, 20100
10100 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0101
20100 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0101 CONTINUE
C
CT011* TEST 011 **** FCVS PROGRAM 715 ****
C
C CHARACTER FUNCTION REFERENCE IN AN ASSIGNMENT STATEMENT
C
IVTNUM = 11
CVCOMP = ' '
IVCOMP = 0
CVCORR = 'FIRST AID'
CVCOMP = CF716(1)
IF (CVCOMP .EQ. 'FIRST AID') IVCOMP = 1
IF (IVCOMP - 1) 20110, 10110, 20110
10110 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0111
20110 IVFAIL = IVFAIL + 1
WRITE (I02,80018) IVTNUM, CVCOMP, CVCORR
0111 CONTINUE
C
CT012* TEST 012 **** FCVS PROGRAM 715 ****
C
C CHARACTER FUNCTION REFERENCE IN AN IF STATEMENT
C
IVTNUM = 12
IVCOMP = 0
CVCOMP = ' '
IVCORR = 1
CVCOMP = 'SECONDRATE'
IF (CVCOMP.EQ.CF716(2)) IVCOMP = 1
40120 IF (IVCOMP - 1) 20120, 10120, 20120
10120 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0121
20120 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0121 CONTINUE
C
C TESTS 13-30 CONCATENATION OPERATIONS
C
C
CT013* TEST 013 **** FCVS PROGRAM 715 ****
C
C CONCATENATE TWO CHARACTER CONSTANTS IN AN ASSIGNMENT STATEMENT
C
IVTNUM = 13
CVCOMP = ' '
IVCOMP = 0
CVCORR = 'ABCUVWXYZ'
CVCOMP = 'ABC'//'UVWXYZ'
IF (CVCOMP .EQ. 'ABCUVWXYZ') IVCOMP = 1
IF (IVCOMP - 1) 20130, 10130, 20130
10130 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0131
20130 IVFAIL = IVFAIL + 1
WRITE (I02,80018) IVTNUM, CVCOMP, CVCORR
0131 CONTINUE
C
CT014* TEST 014 **** FCVS PROGRAM 715 ****
C
C CONCATENATE TWO CHARACTER CONSTANTS IN AN IF STATEMENT
C
IVTNUM = 14
IVCOMP = 0
CVCOMP = ' '
IVCORR = 1
CVCOMP = 'THIS-IS-IT'
IF (CVCOMP .EQ.'THIS-I'//'S-IT') IVCOMP = 1
40140 IF (IVCOMP - 1) 20140, 10140, 20140
10140 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0141
20140 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0141 CONTINUE
C
CT015* TEST 015 **** FCVS PROGRAM 715 ****
C
C CONCATENATE A SYMBOLIC NAME OF A CHARACTER CONSTANT WITH A LITERAL
C STRING IN AN ASSIGNMENT STATEMENT
C
IVTNUM = 15
CVCOMP = ' '
IVCOMP = 0
CVCORR = 'PQRSTUVWXYZ'
CVCOMP = CPN001//'UVWXYZ'
IF (CVCOMP .EQ. 'PQRSTUVWXYZ') IVCOMP = 1
IF (IVCOMP - 1) 20150, 10150, 20150
10150 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0151
20150 IVFAIL = IVFAIL + 1
WRITE (I02,80018) IVTNUM, CVCOMP, CVCORR
0151 CONTINUE
C
CT016* TEST 016 **** FCVS PROGRAM 715 ****
C
C CONCATENATE A SYMBOLIC NAME OF A CHARACTER CONSTANT WITH A LITERAL
C STRING IN AN IF STATEMENT
C
IVTNUM = 16
CVCOMP = ' '
IVCOMP = 0
IVCORR = 1
CVCOMP = 'USEFUL-EXPRESSION'
IF (CVCOMP.EQ.'USEFUL-'//CPN002) IVCOMP = 1
40160 IF (IVCOMP - 1) 20160, 10160, 20160
10160 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0161
20160 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0161 CONTINUE
C
CT017* TEST 017 **** FCVS PROGRAM 715 ****
C
C CONCATENATE A CHARACTER VARIABLE WITH A LITERAL STRING IN AN
C ASSIGNMENT STATEMENT
C
IVTNUM = 17
CVCOMP = ' '
IVCOMP = 0
CVCORR = 'ONE+TWO+THREE'
CVCOMP = CVN001//'+THREE'
IF (CVCOMP .EQ. 'ONE+TWO+THREE') IVCOMP = 1
IF (IVCOMP - 1) 20170, 10170, 20170
10170 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0171
20170 IVFAIL = IVFAIL + 1
WRITE (I02,80018) IVTNUM, CVCOMP, CVCORR
0171 CONTINUE
C
CT018* TEST 018 **** FCVS PROGRAM 715 ****
C
C CONCATENATE A CHARACTER VARIABLE WITH A LITERAL STRING IN AN
C IF STATEMENT
C
IVTNUM = 18
CVCOMP = ' '
IVCOMP = 0
IVCORR = 1
CVCOMP = 'ZERO+ONE+TWO'
IF (CVCOMP.EQ.'ZERO+'//CVN001) IVCOMP = 1
40180 IF (IVCOMP - 1) 20180, 10180, 20180
10180 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0181
20180 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0181 CONTINUE
C
CT019* TEST 019 **** FCVS PROGRAM 715 ****
C
C CONCATENATE A CHARACTER ARRAY ELEMENT WITH A LITERAL STRING IN AN
C ASSIGNMENT STATEMENT
C
IVTNUM = 19
CVCOMP = ' '
IVCOMP = 0
CVCORR = 'STUVWXYZ-END'
CVCOMP = C2N001(2,2)//'YZ-END'
IF (CVCOMP .EQ. 'STUVWXYZ-END') IVCOMP = 1
IF (IVCOMP - 1) 20190, 10190, 20190
10190 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0191
20190 IVFAIL = IVFAIL + 1
WRITE (I02,80018) IVTNUM, CVCOMP, CVCORR
0191 CONTINUE
C
CT020* TEST 020 **** FCVS PROGRAM 715 ****
C
C CONCATENATE A CHARACTER ARRAY ELEMENT WITH A LITERAL STRING IN AN
C IF STATEMENT
C
IVTNUM = 20
CVCOMP = ' '
IVCOMP = 0
IVCORR = 1
CVCOMP = 'BEGIN-ABCDEF'
IF (CVCOMP.EQ.'BEGIN-'//C2N001(1,1)) IVCOMP = 1
40200 IF (IVCOMP - 1) 20200, 10200, 20200
10200 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0201
20200 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0201 CONTINUE
C
CT021* TEST 021 **** FCVS PROGRAM 715 ****
C
C CONCATENATE SPECIAL CHARACTERS IN AN ASSIGNMENT STATEMENT
C
IVTNUM = 21
CVCOMP = ' '
IVCOMP = 0
CVCORR = '=+-*/(),.$'':'
CVCOMP = '=+-*/('//'),.$'':'
IF (CVCOMP .EQ. '=+-*/(),.$'':') IVCOMP = 1
IF (IVCOMP - 1) 20210, 10210, 20210
10210 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0211
20210 IVFAIL = IVFAIL + 1
WRITE (I02,80018) IVTNUM, CVCOMP, CVCORR
0211 CONTINUE
C
CT022* TEST 022 **** FCVS PROGRAM 715 ****
C
C CONCATENATE SPECIAL CHARACTERS IN AN IF STATEMENT
C
IVTNUM = 22
IVCOMP = 0
CVCOMP = ' '
IVCORR = 1
CVCOMP = '$X=(A/B+C):(-''D'')'
IF (CVCOMP.EQ.'$X=(A/'//'B+C):(-''D'')') IVCOMP = 1
40220 IF (IVCOMP - 1) 20220, 10220, 20220
10220 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0221
20220 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0221 CONTINUE
C
C TESTS 23-24 - TESTS THE INTRINSIC FUNCTION LEN(E) WHERE THE
C ARGUMENT IS A CHARACTER EXPRESSION
C
C
CT023* TEST 023 **** FCVS PROGRAM 715 ****
C
C
IVTNUM = 23
IVCOMP = 0
IVCORR = 15
IVCOMP = LEN(CVN001//'EIGHTEEN')
40230 IF (IVCOMP - 15) 20230, 10230, 20230
10230 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0231
20230 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0231 CONTINUE
C
CT024* TEST 024 **** FCVS PROGRAM 715 ****
C
C
IVTNUM = 24
IVCOMP = 0
IVCORR = 30
IVCOMP = LEN('THIS-IS-A-LITERAL-STRING'//C2N001(1,2))
40240 IF (IVCOMP - 30) 20240, 10240, 20240
10240 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0241
20240 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0241 CONTINUE
C
CT025* TEST 025 **** FCVS PROGRAM 715 ****
C
C CONCATENATE A SUBSTRING WITH A LITERAL STRING IN AN ASSIGNMENT
C STATEMENT
C
IVTNUM = 25
CVCOMP = ' '
IVCOMP = 0
CVCORR = 'IS-A-LONG-ARRAY'
CVCOMP = CVN002(6:15)//'ARRAY'
IF (CVCOMP .EQ. 'IS-A-LONG-ARRAY') IVCOMP = 1
IF (IVCOMP - 1) 20250, 10250, 20250
10250 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0251
20250 IVFAIL = IVFAIL + 1
WRITE (I02,80018) IVTNUM, CVCOMP, CVCORR
0251 CONTINUE
C
CT026* TEST 026 **** FCVS PROGRAM 715 ****
C
C CONCATENATE A SUBSTRING WITH A LITERAL STRING IN AN IF
C STATEMENT
C
IVTNUM = 26
IVCOMP = 0
CVCOMP = ' '
IVCORR = 1
CVCOMP = 'A-LONG-CHARTER-PLANE'
IF (CVCOMP.EQ.CVN002(9:19)//'TER-PLANE') IVCOMP = 1
40260 IF (IVCOMP - 1) 20260, 10260, 20260
10260 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0261
20260 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0261 CONTINUE
C
CT027* TEST 027 **** FCVS PROGRAM 715 ****
C
C CONCATENATE A CHARACTER FUNCTION REFERENCE WITH A LITERAL STRING
C
IVTNUM = 27
CVCOMP = ' '
IVCOMP = 0
CVCORR = 'THIRDCLASSMAIL'
CVCOMP = CF716(3)//'MAIL'
IF (CVCOMP .EQ. 'THIRDCLASSMAIL') IVCOMP = 1
IF (IVCOMP - 1) 20270, 10270, 20270
10270 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0271
20270 IVFAIL = IVFAIL + 1
WRITE (I02,80018) IVTNUM, CVCOMP, CVCORR
0271 CONTINUE
C
CT028* TEST 028 **** FCVS PROGRAM 715 ****
C
C CONCATENATE A CHARACTER ARRAY ELEMENT WITH A CHARACTER FUNCTION RE
C
IVTNUM = 28
CVCOMP = ' '
IVCOMP = 0
CVCORR = 'MNOPQRFIRST AID'
CVCOMP = C2N001(1,2)//CF716(1)
IF (CVCOMP .EQ. 'MNOPQRFIRST AID') IVCOMP = 1
IF (IVCOMP - 1) 20280, 10280, 20280
10280 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0281
20280 IVFAIL = IVFAIL + 1
WRITE (I02,80018) IVTNUM, CVCOMP, CVCORR
0281 CONTINUE
C
CT029* TEST 029 **** FCVS PROGRAM 715 ****
C
C CONCATENATE A CHARACTER SUBSTRING WITH A CHARACTER FUNCTION REFERE
C
IVTNUM = 29
CVCOMP = ' '
IVCOMP = 0
CVCORR = 'G-CHARACSECONDRATE'
CVCOMP = CVN002(14:21)//CF716(2)
IF (CVCOMP .EQ. 'G-CHARACSECONDRATE') IVCOMP = 1
IF (IVCOMP - 1) 20290, 10290, 20290
10290 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0291
20290 IVFAIL = IVFAIL + 1
WRITE (I02,80018) IVTNUM, CVCOMP, CVCORR
0291 CONTINUE
C
CT030* TEST 030 **** FCVS PROGRAM 715 ****
C
C CONCATENATIONS ON BOTH SIDES OF ".EQ." IN AN IF STATEMENT
C
IVTNUM = 30
IVCOMP = 0
IVCORR = 1
CVN002 = 'STTHIRDCLASS'
IF (CPN001//CF716(3).EQ.C2N001(1,2)(4:6)//CVN002) IVCOMP = 1
40300 IF (IVCOMP - 1) 20300, 10300, 20300
10300 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0301
20300 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0301 CONTINUE
C
CT031* TEST 031 **** FCVS PROGRAM 715 ****
C
C CONCATENATE A LITERAL WITH A SYMBOLIC NAME OF A CHARACTER CONSTANT
C LENGTH IS SPECIFIED BY AN ASTERISK WITH A LITERAL
C
IVTNUM = 31
IVCOMP = 0
CVCOMP = ' '
IVCORR = 1
CVCOMP = 'NOW IS THE TIME FOR ALL GOOD MENTO COME TO THE AID OF TH
1EIR PARTY'
IF (CVCOMP.EQ.CPN003//'TO COME TO THE AID OF THEIR PARTY')
1 IVCOMP = 1
40310 IF (IVCOMP - 1) 20310, 10310, 20310
10310 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0311
20310 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0311 CONTINUE
C
CT032* TEST 032 **** FCVS PROGRAM 715 ****
C
C CHARACTER EXPRESSION CONCATENATED WITH CHARACTER PRIMARY
C
IVTNUM = 32
IVCOMP = 0
CVCOMP = ' '
CVCORR = ' '
IVCORR = 1
CVCOMP = ('ONE'//'TWO')//'THREE'
CVCORR = 'ONE'//'TWO'//'THREE'
IF (CVCOMP.EQ.CVCORR) IVCOMP = 1
40320 IF (IVCOMP - 1) 20320, 10320, 20320
10320 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0321
20320 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0321 CONTINUE
C
C TESTS 33-34 - EVALUATION OF CHARACTER EXPRESSIONS
C (PROCESSOR NEEDS TO EVALUATE ONLY AS MUCH OF THE CHARACTER
C EXPRESSION AS IS REQUIRED BY THE CONTEXT IN WHICH THE
C EXPRESSION APPEARS)
C
C
CT033* TEST 033 **** FCVS PROGRAM 715 ****
C
C
IVTNUM = 33
CVCOMP = ' '
IVCOMP = 0
CVCORR = 'AB'
CVN003 = 'ABC'
CVCOMP = CVN003
IF (CVCOMP .EQ. 'AB') IVCOMP = 1
IF (IVCOMP - 1) 20330, 10330, 20330
10330 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0331
20330 IVFAIL = IVFAIL + 1
WRITE (I02,80018) IVTNUM, CVCOMP, CVCORR
0331 CONTINUE
C
CT034* TEST 034 **** FCVS PROGRAM 715 ****
C
C
IVTNUM = 34
CVCOMP = ' '
IVCOMP = 0
CVCORR = 'LO'
CVN004 = 'LONG'
CVD005 = 'SHORT'
CVN003 = CVN004//CF717(CVD005)
CVCOMP = CVN003
IF (CVCOMP .EQ. 'LO') IVCOMP = 1
IF (IVCOMP - 1) 20340, 10340, 20340
10340 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0341
20340 IVFAIL = IVFAIL + 1
WRITE (I02,80018) IVTNUM, CVCOMP, CVCORR
0341 CONTINUE
C
CBB** ********************** BBCSUM0 **********************************
C**** WRITE OUT TEST SUMMARY
C****
IVTOTN = IVPASS + IVFAIL + IVDELE + IVINSP
WRITE (I02, 90004)
WRITE (I02, 90014)
WRITE (I02, 90004)
WRITE (I02, 90020) IVPASS
WRITE (I02, 90022) IVFAIL
WRITE (I02, 90024) IVDELE
WRITE (I02, 90026) IVINSP
WRITE (I02, 90028) IVTOTN, IVTOTL
CBE** ********************** BBCSUM0 **********************************
CBB** ********************** BBCFOOT0 **********************************
C**** WRITE OUT REPORT FOOTINGS
C****
WRITE (I02,90016) ZPROG, ZPROG
WRITE (I02,90018) ZPROJ, ZNAME, ZTAPE, ZTAPED
WRITE (I02,90019)
CBE** ********************** BBCFOOT0 **********************************
90001 FORMAT (1H ,56X,5HFM715)
90000 FORMAT (1H ,50X,20HEND OF PROGRAM FM715)
CBB** ********************** BBCFMT0A **********************************
C**** FORMATS FOR TEST DETAIL LINES
C****
80000 FORMAT (1H ,2X,I3,4X,7HDELETED,32X,A31)
80002 FORMAT (1H ,2X,I3,4X,7H PASS ,32X,A31)
80004 FORMAT (1H ,2X,I3,4X,7HINSPECT,32X,A31)
80008 FORMAT (1H ,2X,I3,4X,7H FAIL ,32X,A31)
80010 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,15X,10HCOMPUTED= ,
1I6,/,1H ,15X,10HCORRECT= ,I6)
80012 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
1E12.5,/,1H ,16X,10HCORRECT= ,E12.5)
80018 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
1A21,/,1H ,16X,10HCORRECT= ,A21)
80020 FORMAT (1H ,16X,10HCOMPUTED= ,A21,1X,A31)
80022 FORMAT (1H ,16X,10HCORRECT= ,A21,1X,A31)
80024 FORMAT (1H ,16X,10HCOMPUTED= ,I6,16X,A31)
80026 FORMAT (1H ,16X,10HCORRECT= ,I6,16X,A31)
80028 FORMAT (1H ,16X,10HCOMPUTED= ,E12.5,10X,A31)
80030 FORMAT (1H ,16X,10HCORRECT= ,E12.5,10X,A31)
80050 FORMAT (1H ,48X,A31)
CBE** ********************** BBCFMT0A **********************************
CBB** ********************** BBCFMAT1 **********************************
C**** FORMATS FOR TEST DETAIL LINES - FULL LANGUAGE
C****
80031 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
1D17.10,/,1H ,16X,10HCORRECT= ,D17.10)
80033 FORMAT (1H ,16X,10HCOMPUTED= ,D17.10,10X,A31)
80035 FORMAT (1H ,16X,10HCORRECT= ,D17.10,10X,A31)
80037 FORMAT (1H ,16X,10HCOMPUTED= ,1H(,E12.5,2H, ,E12.5,1H),6X,A31)
80039 FORMAT (1H ,16X,10HCORRECT= ,1H(,E12.5,2H, ,E12.5,1H),6X,A31)
80041 FORMAT (1H ,16X,10HCOMPUTED= ,1H(,F12.5,2H, ,F12.5,1H),6X,A31)
80043 FORMAT (1H ,16X,10HCORRECT= ,1H(,F12.5,2H, ,F12.5,1H),6X,A31)
80045 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
11H(,F12.5,2H, ,F12.5,1H)/,1H ,16X,10HCORRECT= ,
21H(,F12.5,2H, ,F12.5,1H))
CBE** ********************** BBCFMAT1 **********************************
CBB** ********************** BBCFMT0B **********************************
C**** FORMAT STATEMENTS FOR PAGE HEADERS
C****
90002 FORMAT (1H1)
90004 FORMAT (1H )
90006 FORMAT (1H ,20X,31HFEDERAL SOFTWARE TESTING CENTER)
90007 FORMAT (1H ,19X,34HFORTRAN COMPILER VALIDATION SYSTEM)
90008 FORMAT (1H ,21X,A13,A17)
90009 FORMAT (1H ,/,2H *,A5,6HBEGIN*,12X,15HTEST RESULTS - ,A5,/)
90010 FORMAT (1H ,8X,16HTEST DATE*TIME= ,A17,15H - COMPILER= ,A20)
90013 FORMAT (1H ,8H TEST ,10HPASS/FAIL ,6X,17HDISPLAYED RESULTS,
1 7X,7HREMARKS,24X)
90014 FORMAT (1H ,46H----------------------------------------------,
1 33H---------------------------------)
90015 FORMAT (1H ,48X,17HTHIS PROGRAM HAS ,I3,6H TESTS,/)
C****
C**** FORMAT STATEMENTS FOR REPORT FOOTINGS
C****
90016 FORMAT (1H ,/,2H *,A5,4HEND*,14X,14HEND OF TEST - ,A5,/)
90018 FORMAT (1H ,A13,13X,A20,7H * ,A10,1H/,
1 A13)
90019 FORMAT (1H ,26HFOR OFFICIAL USE ONLY ,35X,15HCOPYRIGHT 1982)
C****
C**** FORMAT STATEMENTS FOR RUN SUMMARY
C****
90020 FORMAT (1H ,21X,I5,13H TESTS PASSED)
90022 FORMAT (1H ,21X,I5,13H TESTS FAILED)
90024 FORMAT (1H ,21X,I5,14H TESTS DELETED)
90026 FORMAT (1H ,21X,I5,25H TESTS REQUIRE INSPECTION)
90028 FORMAT (1H ,21X,I5,4H OF ,I3,15H TESTS EXECUTED)
CBE** ********************** BBCFMT0B **********************************
END
*HEADER,FORTR,FM715,SUBRTN,FM716
C THIS FUNCTION SUBPROGRAM IS TO BE RUN WITH ROUTINE 715.
C
C THIS FUNCTION SUBPROGRAM IS USED TO TEST CHARACTER FUNCTION
C REFERENCES IN CHARACTER EXPRESSIONS
C
CHARACTER*10 FUNCTION CF716(IVD001)
IF (IVD001 - 2) 70010, 70020, 70030
70010 CF716 = 'FIRST AID'
RETURN
70020 CF716 = 'SECONDRATE'
RETURN
70030 CF716 = 'THIRDCLASS'
RETURN
END
*HEADER,FORTR,FM715,SUBRTN,FM717
C THIS FUNCTION SUBPROGRAM IS TO BE RUN WITH ROUTINE 715.
C
C THIS FUNCTION SUBPROGRAM IS USED TO TEST CHARACTER FUNCTION
C REFERENCES IN CHARACTER EXPRESSIONS
C
CHARACTER*(*) FUNCTION CF717(CVD001)
CHARACTER*(*) CVD001
CF717 = CVD001
RETURN
END
*END-OF,FM715
FM718.f 481036441 170 2 100666 21716 `
*HEADER,FORTR,FM718
*FILES1,FORTR,FM718,X
PROGRAM FM718
C
C THIS ROUTINE TESTS LOGICAL EXPRESSIONS AND ANS REF.
C USE OF THE LOGICAL OPERATORS .NOT., .AND., .OR., 6.4, 6.4.2,
C .EQV., AND .NEQV. 6.4.3, 6.4.4
C
CBB** ********************** BBCCOMNT **********************************
C****
C**** 1978 FORTRAN COMPILER VALIDATION SYSTEM
C**** VERSION 2.0
C****
C****
C**** SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO
C**** GENERAL SERVICES ADMINISTRATION
C**** FEDERAL SOFTWARE TESTING CENTER
C**** 5203 LEESBURG PIKE, SUITE 1100
C**** FALLS CHURCH, VA. 22041
C****
C**** (703) 756-6153
C****
CBE** ********************** BBCCOMNT **********************************
IMPLICIT DOUBLE PRECISION (D), COMPLEX (Z), LOGICAL (L)
IMPLICIT CHARACTER*27 (C)
CBB** ********************** BBCINITA **********************************
C**** SPECIFICATION STATEMENTS
C****
CHARACTER ZVERS*13, ZVERSD*17, ZDATE*17, ZPROG*5, ZCOMPL*20,
1 ZNAME*20, ZTAPE*10, ZPROJ*13, REMRKS*31, ZTAPED*13
CBE** ********************** BBCINITA **********************************
C
LOGICAL LPN001, LPN002, LPN003, LPN004
LOGICAL LVCOMP, LVCORR, LVN001
PARAMETER (LPN001 = .TRUE., LPN002 = .FALSE.,
1 LPN003 = .TRUE., LPN004 = .FALSE.)
C
C
CBB** ********************** BBCINITB **********************************
C**** INITIALIZE SECTION
DATA ZVERS, ZVERSD, ZDATE
1 /'VERSION 2.0 ', '82/08/02*18.33.46', '*NO DATE*TIME'/
DATA ZCOMPL, ZNAME, ZTAPE
1 /'*NONE SPECIFIED*', '*NO COMPANY NAME*', '*NO TAPE*'/
DATA ZPROJ, ZTAPED, ZPROG
1 /'*NO PROJECT*', '*NO TAPE DATE', 'XXXXX'/
DATA REMRKS /' '/
C**** THE FOLLOWING 9 COMMENT LINES (CZ01, CZ02, ...) CAN BE REPLACED
C**** FOR IDENTIFYING THE TEST ENVIRONMENT
C****
CZ01 ZVERS = 'VERSION OF THE COMPILER VALIDATION SYSTEM'
CZ02 ZVERSD = 'CREATION DATE/TIME OF THE COMPILER VALIDATION SYSTEM'
CZ03 ZPROG = 'PROGRAM NAME'
CZ04 ZDATE = 'DATE OF TEST'
CZ05 ZCOMPL = 'COMPILER IDENTIFICATION'
CZ06 ZPROJ = 'PROJECT NUMBER/IDENTIFICATION'
CZ07 ZNAME = 'NAME OF USER'
CZ08 ZTAPE = 'TAPE OWNER/ID'
CZ09 ZTAPED = 'DATE TAPE COPIED'
C
IVPASS = 0
IVFAIL = 0
IVDELE = 0
IVINSP = 0
IVTOTL = 0
IVTOTN = 0
ICZERO = 0
C
C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER.
I01 = 05
C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER.
I02 = 06
C
CX010 REPLACED BY FEXEC X-010 CONTROL CARD (CARD-READER UNIT NUMBER).
C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5
CX011 REPLACED BY FEXEC X-011 CONTROL CARD. CX011 IS FOR SYSTEMS
C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX010.
C
CX020 REPLACED BY FEXEC X-020 CONTROL CARD (PRINTER UNIT NUMBER).
C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02= 6
CX021 REPLACED BY FEXEC X-021 CONTROL CARD. CX021 IS FOR SYSTEMS
C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX020.
C
CBE** ********************** BBCINITB **********************************
ZPROG='FM718'
IVTOTL = 29
CBB** ********************** BBCHED0A **********************************
C****
C**** WRITE REPORT TITLE
C****
WRITE (I02, 90002)
WRITE (I02, 90006)
WRITE (I02, 90007)
WRITE (I02, 90008) ZVERS, ZVERSD
WRITE (I02, 90009) ZPROG, ZPROG
WRITE (I02, 90010) ZDATE, ZCOMPL
CBE** ********************** BBCHED0A **********************************
CBB** ********************** BBCHED0B **********************************
C**** WRITE DETAIL REPORT HEADERS
C****
WRITE (I02,90004)
WRITE (I02,90004)
WRITE (I02,90013)
WRITE (I02,90014)
WRITE (I02,90015) IVTOTL
CBE** ********************** BBCHED0B **********************************
C
CT001* TEST 001 **** FCVS PROGRAM 718 ****
C
C LOGICAL EXPRESSION CONTAINING SYMBOLIC NAME OF A LOGICAL CONSTANT
C
IVTNUM = 1
LVCORR = .TRUE.
LVCOMP = LPN001
IVCOMP = 0
IF (LVCOMP) IVCOMP = 1
IF (IVCOMP - 1) 20010, 10010, 20010
10010 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0011
20010 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0011 CONTINUE
C
C TESTS 2-3 - TEST LOGICAL EXPRESSIONS INVOLVING .NOT.
C
C
CT002* TEST 002 **** FCVS PROGRAM 718 ****
C
C
IVTNUM = 2
LVCORR = .TRUE.
LVCOMP = .NOT..FALSE.
IVCOMP = 0
IF (LVCOMP) IVCOMP = 1
IF (IVCOMP - 1) 20020, 10020, 20020
10020 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0021
20020 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0021 CONTINUE
C
CT003* TEST 003 **** FCVS PROGRAM 718 ****
C
C
IVTNUM = 3
IVCORR = 1
IVCOMP = 0
IF (.NOT. LPN002) IVCOMP = 1
40030 IF (IVCOMP - 1) 20030, 10030, 20030
10030 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0031
20030 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0031 CONTINUE
C
C TESTS 4-5 - TEST LOGICAL EXPRESSIONS INVOLVING .AND.
C
C
CT004* TEST 004 **** FCVS PROGRAM 718 ****
C
C
IVTNUM = 4
LVCORR = .TRUE.
LVCOMP = .TRUE..AND.LPN003
IVCOMP = 0
IF (LVCOMP) IVCOMP = 1
IF (IVCOMP - 1) 20040, 10040, 20040
10040 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0041
20040 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0041 CONTINUE
C
CT005* TEST 005 **** FCVS PROGRAM 718 ****
C
C
IVTNUM = 5
IVCORR = 1
IVCOMP = 0
IF (LPN003.AND..TRUE.) IVCOMP = 1
40050 IF (IVCOMP - 1) 20050, 10050, 20050
10050 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0051
20050 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0051 CONTINUE
C
C TESTS 6-7 - TEST LOGICAL EXPRESSIONS INVOLVING .OR.
C
C
CT006* TEST 006 **** FCVS PROGRAM 718 ****
C
C
IVTNUM = 6
LVCORR = .TRUE.
LVCOMP = .TRUE..OR.LPN004
IVCOMP = 0
IF (LVCOMP) IVCOMP = 1
IF (IVCOMP - 1) 20060, 10060, 20060
10060 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0061
20060 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0061 CONTINUE
C
CT007* TEST 007 **** FCVS PROGRAM 718 ****
C
C
IVTNUM = 7
IVCORR = 1
IVCOMP = 0
IF (LPN001.OR..FALSE.) IVCOMP = 1
40070 IF (IVCOMP - 1) 20070, 10070, 20070
10070 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0071
20070 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0071 CONTINUE
C
C TESTS 8-9 - TEST LOGICAL EXPRESSIONS INVOLVING .EQV.
C
C
CT008* TEST 008 **** FCVS PROGRAM 718 ****
C
C
IVTNUM = 8
LVCORR = .TRUE.
LVCOMP = .FALSE..EQV.LPN002
IVCOMP = 0
IF (LVCOMP) IVCOMP = 1
IF (IVCOMP - 1) 20080, 10080, 20080
10080 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0081
20080 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0081 CONTINUE
C
CT009* TEST 009 **** FCVS PROGRAM 718 ****
C
C
IVTNUM = 9
IVCORR = 1
IVCOMP = 0
IF (LPN003.EQV..TRUE.) IVCOMP = 1
40090 IF (IVCOMP - 1) 20090, 10090, 20090
10090 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0091
20090 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0091 CONTINUE
C
C TESTS 10-11 - TEST LOGICAL EXPRESSIONS INVOLVING .NEQV.
C
C
CT010* TEST 010 **** FCVS PROGRAM 718 ****
C
C
IVTNUM = 10
LVCORR = .TRUE.
LVCOMP = .FALSE..NEQV.LPN001
IVCOMP = 0
IF (LVCOMP) IVCOMP = 1
IF (IVCOMP - 1) 20100, 10100, 20100
10100 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0101
20100 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0101 CONTINUE
C
CT011* TEST 011 **** FCVS PROGRAM 718 ****
C
C
IVTNUM = 11
IVCORR = 1
IVCOMP = 0
IF (LPN003.NEQV..FALSE.) IVCOMP = 1
40110 IF (IVCOMP - 1) 20110, 10110, 20110
10110 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0111
20110 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0111 CONTINUE
C
C TESTS 12-17 - TEST LOGICAL EXPRESSIONS INVOLVING VARIOUS COMBINA-
C TIONS OF LOGICAL OPERATORS AND ALSO TEST PRECEDENCE AMONG THE
C LOGICAL OPERATORS WITH OR WITHOUT PARENTHESES
C
C
CT012* TEST 012 **** FCVS PROGRAM 718 ****
C
C
IVTNUM = 12
LVCORR = .TRUE.
LVN001 = .TRUE.
LVCOMP = LVN001.EQV.LPN002.AND..TRUE..NEQV.LPN003
IVCOMP = 0
IF (LVCOMP) IVCOMP = 1
IF (IVCOMP - 1) 20120, 10120, 20120
10120 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0121
20120 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0121 CONTINUE
C
CT013* TEST 013 **** FCVS PROGRAM 718 ****
C
C
IVTNUM = 13
LVCORR = .FALSE.
LVCOMP = (.TRUE..EQV..FALSE.).AND.(LVN001.NEQV.LPN003)
IVCOMP = 0
IF (LVCOMP) IVCOMP = 1
IF (IVCOMP - 0) 20130, 10130, 20130
10130 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0131
20130 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0131 CONTINUE
C
CT014* TEST 014 **** FCVS PROGRAM 718 ****
C
C
IVTNUM = 14
LVCORR = .TRUE.
LVN001 = .FALSE.
LVCOMP = LVN001.EQV.LPN002.AND..NOT.LPN001.OR..FALSE.
IVCOMP = 0
IF (LVCOMP) IVCOMP = 1
IF (IVCOMP - 1) 20140, 10140, 20140
10140 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0141
20140 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0141 CONTINUE
C
CT015* TEST 015 **** FCVS PROGRAM 718 ****
C
C
IVTNUM = 15
LVCORR = .FALSE.
LVCOMP = (LVN001.EQV.LPN002).AND.(.NOT.LPN001.OR..FALSE.)
IVCOMP = 0
IF (LVCOMP) IVCOMP = 1
IF (IVCOMP - 0) 20150, 10150, 20150
10150 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0151
20150 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0151 CONTINUE
C
CT016* TEST 016 **** FCVS PROGRAM 718 ****
C
C
IVTNUM = 16
LVCORR = .TRUE.
LVCOMP = LPN001.EQV.LVN001.OR..NOT.LPN003.NEQV..TRUE.
IVCOMP = 0
IF (LVCOMP) IVCOMP = 1
IF (IVCOMP - 1) 20160, 10160, 20160
10160 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0161
20160 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0161 CONTINUE
C
CT017* TEST 017 **** FCVS PROGRAM 718 ****
C
C
IVTNUM = 17
LVCORR = .TRUE.
LVCOMP = LPN001.AND.(LVN001.OR..NOT.(LPN002.EQV.(LPN003.NEQV.
1 LPN004)))
IVCOMP = 0
IF (LVCOMP) IVCOMP = 1
IF (IVCOMP - 1) 20170, 10170, 20170
10170 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0171
20170 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0171 CONTINUE
C
C TESTS 18-21 - TEST LOGICAL EXPRESSIONS INVOLOVING .EQV.
C
C
CT018* TEST 018 **** FCVS PROGRAM 718 ****
C
C
IVTNUM = 18
LVCORR = .TRUE.
LVCOMP = LPN001.EQV.LPN003
IVCOMP = 0
IF (LVCOMP) IVCOMP = 1
IF (IVCOMP - 1) 20180, 10180, 20180
10180 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0181
20180 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0181 CONTINUE
C
CT019* TEST 019 **** FCVS PROGRAM 718 ****
C
C
IVTNUM = 19
LVCORR = .FALSE.
LVCOMP = LPN001.EQV.LPN002
IVCOMP = 0
IF (LVCOMP) IVCOMP = 1
IF (IVCOMP - 0) 20190, 10190, 20190
10190 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0191
20190 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0191 CONTINUE
C
CT020* TEST 020 **** FCVS PROGRAM 718 ****
C
C
IVTNUM = 20
LVCORR = .FALSE.
LVCOMP = LPN002.EQV.LPN003
IVCOMP = 0
IF (LVCOMP) IVCOMP = 1
IF (IVCOMP - 0) 20200, 10200, 20200
10200 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0201
20200 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0201 CONTINUE
C
CT021* TEST 021 **** FCVS PROGRAM 718 ****
C
C
IVTNUM = 21
LVCORR = .TRUE.
LVCOMP = LPN002.EQV.LPN004
IVCOMP = 0
IF (LVCOMP) IVCOMP = 1
IF (IVCOMP - 1) 20210, 10210, 20210
10210 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0211
20210 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0211 CONTINUE
C
C TESTS 22-25 - TEST LOGICAL EXPRESSIONS INVOLVING .NEQV.
C
C
CT022* TEST 022 **** FCVS PROGRAM 718 ****
C
C
IVTNUM = 22
LVCORR = .FALSE.
LVCOMP = LPN001.NEQV.LPN003
IVCOMP = 0
IF (LVCOMP) IVCOMP = 1
IF (IVCOMP - 0) 20220, 10220, 20220
10220 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0221
20220 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0221 CONTINUE
C
CT023* TEST 023 **** FCVS PROGRAM 718 ****
C
C
IVTNUM = 23
LVCORR = .TRUE.
LVCOMP = LPN001.NEQV.LPN002
IVCOMP = 0
IF (LVCOMP) IVCOMP = 1
IF (IVCOMP - 1) 20230, 10230, 20230
10230 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0231
20230 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0231 CONTINUE
C
CT024* TEST 024 **** FCVS PROGRAM 718 ****
C
C
IVTNUM = 24
LVCORR = .TRUE.
LVCOMP = LPN002.NEQV.LPN003
IVCOMP = 0
IF (LVCOMP) IVCOMP = 1
IF (IVCOMP - 1) 20240, 10240, 20240
10240 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0241
20240 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0241 CONTINUE
C
CT025* TEST 025 **** FCVS PROGRAM 718 ****
C
C
IVTNUM = 25
LVCORR = .FALSE.
LVCOMP = LPN002.NEQV.LPN004
IVCOMP = 0
IF (LVCOMP) IVCOMP = 1
IF (IVCOMP - 0) 20250, 10250, 20250
10250 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0251
20250 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0251 CONTINUE
C
C TESTS 26-29 TEST LOGICAL CONSTANT EXPRESSIONS USING SYMBOLIC NAMES
C OF LOGICAL CONSTANTS
C
C
CT026* TEST 026 **** FCVS PROGRAM 718 ****
C
C
IVTNUM = 26
LVCORR = .FALSE.
LVCOMP = LPN001.EQV.LPN002.NEQV.LPN004
IVCOMP = 0
IF (LVCOMP) IVCOMP = 1
IF (IVCOMP - 0) 20260, 10260, 20260
10260 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0261
20260 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0261 CONTINUE
C
CT027* TEST 027 **** FCVS PROGRAM 718 ****
C
C
IVTNUM = 27
LVCORR = .TRUE.
LVCOMP = LPN003.NEQV.LPN001.AND.LPN002
IVCOMP = 0
IF (LVCOMP) IVCOMP = 1
IF (IVCOMP - 1) 20270, 10270, 20270
10270 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0271
20270 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0271 CONTINUE
C
CT028* TEST 028 **** FCVS PROGRAM 718 ****
C
C
IVTNUM = 28
LVCORR = .FALSE.
LVCOMP = (LPN003.NEQV.LPN001).AND.LPN002
IVCOMP = 0
IF (LVCOMP) IVCOMP = 1
IF (IVCOMP - 0) 20280, 10280, 20280
10280 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0281
20280 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0281 CONTINUE
C
CT029* TEST 029 **** FCVS PROGRAM 718 ****
C
C
IVTNUM = 29
LVCORR = .TRUE.
LVCOMP = .NOT.(LPN002.EQV.LPN004.AND.LPN001.OR.LPN003)
IVCOMP = 0
IF (LVCOMP) IVCOMP = 1
IF (IVCOMP - 1) 20290, 10290, 20290
10290 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0291
20290 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0291 CONTINUE
C
CBB** ********************** BBCSUM0 **********************************
C**** WRITE OUT TEST SUMMARY
C****
IVTOTN = IVPASS + IVFAIL + IVDELE + IVINSP
WRITE (I02, 90004)
WRITE (I02, 90014)
WRITE (I02, 90004)
WRITE (I02, 90020) IVPASS
WRITE (I02, 90022) IVFAIL
WRITE (I02, 90024) IVDELE
WRITE (I02, 90026) IVINSP
WRITE (I02, 90028) IVTOTN, IVTOTL
CBE** ********************** BBCSUM0 **********************************
CBB** ********************** BBCFOOT0 **********************************
C**** WRITE OUT REPORT FOOTINGS
C****
WRITE (I02,90016) ZPROG, ZPROG
WRITE (I02,90018) ZPROJ, ZNAME, ZTAPE, ZTAPED
WRITE (I02,90019)
CBE** ********************** BBCFOOT0 **********************************
90001 FORMAT (1H ,56X,5HFM718)
90000 FORMAT (1H ,50X,20HEND OF PROGRAM FM718)
CBB** ********************** BBCFMT0A **********************************
C**** FORMATS FOR TEST DETAIL LINES
C****
80000 FORMAT (1H ,2X,I3,4X,7HDELETED,32X,A31)
80002 FORMAT (1H ,2X,I3,4X,7H PASS ,32X,A31)
80004 FORMAT (1H ,2X,I3,4X,7HINSPECT,32X,A31)
80008 FORMAT (1H ,2X,I3,4X,7H FAIL ,32X,A31)
80010 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,15X,10HCOMPUTED= ,
1I6,/,1H ,15X,10HCORRECT= ,I6)
80012 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
1E12.5,/,1H ,16X,10HCORRECT= ,E12.5)
80018 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
1A21,/,1H ,16X,10HCORRECT= ,A21)
80020 FORMAT (1H ,16X,10HCOMPUTED= ,A21,1X,A31)
80022 FORMAT (1H ,16X,10HCORRECT= ,A21,1X,A31)
80024 FORMAT (1H ,16X,10HCOMPUTED= ,I6,16X,A31)
80026 FORMAT (1H ,16X,10HCORRECT= ,I6,16X,A31)
80028 FORMAT (1H ,16X,10HCOMPUTED= ,E12.5,10X,A31)
80030 FORMAT (1H ,16X,10HCORRECT= ,E12.5,10X,A31)
80050 FORMAT (1H ,48X,A31)
CBE** ********************** BBCFMT0A **********************************
CBB** ********************** BBCFMAT1 **********************************
C**** FORMATS FOR TEST DETAIL LINES - FULL LANGUAGE
C****
80031 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
1D17.10,/,1H ,16X,10HCORRECT= ,D17.10)
80033 FORMAT (1H ,16X,10HCOMPUTED= ,D17.10,10X,A31)
80035 FORMAT (1H ,16X,10HCORRECT= ,D17.10,10X,A31)
80037 FORMAT (1H ,16X,10HCOMPUTED= ,1H(,E12.5,2H, ,E12.5,1H),6X,A31)
80039 FORMAT (1H ,16X,10HCORRECT= ,1H(,E12.5,2H, ,E12.5,1H),6X,A31)
80041 FORMAT (1H ,16X,10HCOMPUTED= ,1H(,F12.5,2H, ,F12.5,1H),6X,A31)
80043 FORMAT (1H ,16X,10HCORRECT= ,1H(,F12.5,2H, ,F12.5,1H),6X,A31)
80045 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
11H(,F12.5,2H, ,F12.5,1H)/,1H ,16X,10HCORRECT= ,
21H(,F12.5,2H, ,F12.5,1H))
CBE** ********************** BBCFMAT1 **********************************
CBB** ********************** BBCFMT0B **********************************
C**** FORMAT STATEMENTS FOR PAGE HEADERS
C****
90002 FORMAT (1H1)
90004 FORMAT (1H )
90006 FORMAT (1H ,20X,31HFEDERAL SOFTWARE TESTING CENTER)
90007 FORMAT (1H ,19X,34HFORTRAN COMPILER VALIDATION SYSTEM)
90008 FORMAT (1H ,21X,A13,A17)
90009 FORMAT (1H ,/,2H *,A5,6HBEGIN*,12X,15HTEST RESULTS - ,A5,/)
90010 FORMAT (1H ,8X,16HTEST DATE*TIME= ,A17,15H - COMPILER= ,A20)
90013 FORMAT (1H ,8H TEST ,10HPASS/FAIL ,6X,17HDISPLAYED RESULTS,
1 7X,7HREMARKS,24X)
90014 FORMAT (1H ,46H----------------------------------------------,
1 33H---------------------------------)
90015 FORMAT (1H ,48X,17HTHIS PROGRAM HAS ,I3,6H TESTS,/)
C****
C**** FORMAT STATEMENTS FOR REPORT FOOTINGS
C****
90016 FORMAT (1H ,/,2H *,A5,4HEND*,14X,14HEND OF TEST - ,A5,/)
90018 FORMAT (1H ,A13,13X,A20,7H * ,A10,1H/,
1 A13)
90019 FORMAT (1H ,26HFOR OFFICIAL USE ONLY ,35X,15HCOPYRIGHT 1982)
C****
C**** FORMAT STATEMENTS FOR RUN SUMMARY
C****
90020 FORMAT (1H ,21X,I5,13H TESTS PASSED)
90022 FORMAT (1H ,21X,I5,13H TESTS FAILED)
90024 FORMAT (1H ,21X,I5,14H TESTS DELETED)
90026 FORMAT (1H ,21X,I5,25H TESTS REQUIRE INSPECTION)
90028 FORMAT (1H ,21X,I5,4H OF ,I3,15H TESTS EXECUTED)
CBE** ********************** BBCFMT0B **********************************
END
*END-OF,FM718
FM719.f 481036446 170 2 100666 17134 `
*HEADER,FORTR,FM719
*FILES1,FORTR,FM719
PROGRAM FM719
C
C THIS ROUTINE TESTS DO STATEMENTS USING REAL, ANS REF.
C DOUBLE PRECISION, OR MIXED TYPE DO-VARIABLES. 11.10
C ALSO TESTED ARE ACTIVE AND INACTIVE 11.10.2
C DO LOOPS. 11.10.3
C
C THIS ROUTINE USES FUNCTION SUBPROGRAM IF720 AND
C SUBROUTINE SUBPROGRAM SN721.
C
CBB** ********************** BBCCOMNT **********************************
C****
C**** 1978 FORTRAN COMPILER VALIDATION SYSTEM
C**** VERSION 2.0
C****
C****
C**** SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO
C**** GENERAL SERVICES ADMINISTRATION
C**** FEDERAL SOFTWARE TESTING CENTER
C**** 5203 LEESBURG PIKE, SUITE 1100
C**** FALLS CHURCH, VA. 22041
C****
C**** (703) 756-6153
C****
CBE** ********************** BBCCOMNT **********************************
IMPLICIT DOUBLE PRECISION (D), COMPLEX (Z), LOGICAL (L)
IMPLICIT CHARACTER*27 (C)
CBB** ********************** BBCINITA **********************************
C**** SPECIFICATION STATEMENTS
C****
CHARACTER ZVERS*13, ZVERSD*17, ZDATE*17, ZPROG*5, ZCOMPL*20,
1 ZNAME*20, ZTAPE*10, ZPROJ*13, REMRKS*31, ZTAPED*13
CBE** ********************** BBCINITA **********************************
C
DOUBLE PRECISION DVCOMP, DVCORR, DVN001
C
C
CBB** ********************** BBCINITB **********************************
C**** INITIALIZE SECTION
DATA ZVERS, ZVERSD, ZDATE
1 /'VERSION 2.0 ', '82/08/02*18.33.46', '*NO DATE*TIME'/
DATA ZCOMPL, ZNAME, ZTAPE
1 /'*NONE SPECIFIED*', '*NO COMPANY NAME*', '*NO TAPE*'/
DATA ZPROJ, ZTAPED, ZPROG
1 /'*NO PROJECT*', '*NO TAPE DATE', 'XXXXX'/
DATA REMRKS /' '/
C**** THE FOLLOWING 9 COMMENT LINES (CZ01, CZ02, ...) CAN BE REPLACED
C**** FOR IDENTIFYING THE TEST ENVIRONMENT
C****
CZ01 ZVERS = 'VERSION OF THE COMPILER VALIDATION SYSTEM'
CZ02 ZVERSD = 'CREATION DATE/TIME OF THE COMPILER VALIDATION SYSTEM'
CZ03 ZPROG = 'PROGRAM NAME'
CZ04 ZDATE = 'DATE OF TEST'
CZ05 ZCOMPL = 'COMPILER IDENTIFICATION'
CZ06 ZPROJ = 'PROJECT NUMBER/IDENTIFICATION'
CZ07 ZNAME = 'NAME OF USER'
CZ08 ZTAPE = 'TAPE OWNER/ID'
CZ09 ZTAPED = 'DATE TAPE COPIED'
C
IVPASS = 0
IVFAIL = 0
IVDELE = 0
IVINSP = 0
IVTOTL = 0
IVTOTN = 0
ICZERO = 0
C
C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER.
I01 = 05
C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER.
I02 = 06
C
CX010 REPLACED BY FEXEC X-010 CONTROL CARD (CARD-READER UNIT NUMBER).
C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5
CX011 REPLACED BY FEXEC X-011 CONTROL CARD. CX011 IS FOR SYSTEMS
C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX010.
C
CX020 REPLACED BY FEXEC X-020 CONTROL CARD (PRINTER UNIT NUMBER).
C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02= 6
CX021 REPLACED BY FEXEC X-021 CONTROL CARD. CX021 IS FOR SYSTEMS
C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX020.
C
CBE** ********************** BBCINITB **********************************
ZPROG = 'FM719'
IVTOTL = 14
CBB** ********************** BBCHED0A **********************************
C****
C**** WRITE REPORT TITLE
C****
WRITE (I02, 90002)
WRITE (I02, 90006)
WRITE (I02, 90007)
WRITE (I02, 90008) ZVERS, ZVERSD
WRITE (I02, 90009) ZPROG, ZPROG
WRITE (I02, 90010) ZDATE, ZCOMPL
CBE** ********************** BBCHED0A **********************************
CBB** ********************** BBCHED0B **********************************
C**** WRITE DETAIL REPORT HEADERS
C****
WRITE (I02,90004)
WRITE (I02,90004)
WRITE (I02,90013)
WRITE (I02,90014)
WRITE (I02,90015) IVTOTL
CBE** ********************** BBCHED0B **********************************
C
CT001* TEST 001 **** FCVS PROGRAM 719 ****
C REAL DO-VARIABLE
C
IVTNUM = 1
RVCOMP = 0.0
RVCORR = 3.0
DO 0010 RVN001 = 1.1, 2.4, 0.5
RVCOMP = RVCOMP + 1.0
0010 CONTINUE
IF (RVCOMP - 0.29998E+01) 20010, 10010, 40010
40010 IF (RVCOMP - 0.30002E+01) 10010, 10010, 20010
10010 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0011
20010 IVFAIL = IVFAIL + 1
WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR
0011 CONTINUE
C
CT002* TEST 002 **** FCVS PROGRAM 719 ****
C DOUBLE PRECISION DO-VARIABLE
C
IVTNUM = 2
DVCOMP = 0.0D0
DVCORR = 6.0D0
DO 0020 DVN001 = 1.0D-2, 12.0D-2, 2.0D-2
DVCOMP = DVCOMP + 1.0D0
0020 CONTINUE
IF (DVCOMP - 0.5999999997D+01) 20020, 10020, 40020
40020 IF (DVCOMP - 0.6000000003D+01) 10020, 10020, 20020
10020 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0021
20020 IVFAIL = IVFAIL + 1
WRITE (I02,80031) IVTNUM, DVCOMP, DVCORR
0021 CONTINUE
C
C TESTS 3 THRU 10 TEST ACTIVE AND INACTIVE DO-LOOPS
C
C
C
CT003* TEST 003 **** FCVS PROGRAM 719 ****
C RETURN IS FROM A FUNCTION BACK TO LOOP
C
IVTNUM = 3
IVCOMP = 0
IVCORR = 9
DO 0032 IVN001 = 1, 3
IVCOMP = IVCOMP + IF720(IVN001)
0032 CONTINUE
40030 IF (IVCOMP - 9) 20030, 10030, 20030
10030 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0031
20030 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0031 CONTINUE
C
CT004* TEST 004 **** FCVS PROGRAM 719 ****
C RETURN IS FROM A SUBROUTINE TO A STATEMENT OUTSIDE LOOP
C
IVTNUM = 4
IVCOMP = 0
IVCORR = -59
IVN002 = 0
DO 0042 IVN001 = 1, 5
CALL SN721(IVN002,*0043)
0042 CONTINUE
0043 IVCOMP = IVN002 - 60
40040 IF (IVCOMP + 59) 20040, 10040, 20040
10040 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0041
20040 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0041 CONTINUE
C
CT005* TEST 005 **** FCVS PROGRAM 719 ****
C RETURN IS FROM A SUBROUTINE TO A STATEMENT INSIDE LOOP
C
IVTNUM = 5
IVCOMP = 0
IVCORR = 1
IVN002 = 1
DO 0053 IVN001 = 1, 8
CALL SN721(IVN002,*0052)
GO TO 20050
0052 IVN002 = IVN002 - 1
0053 CONTINUE
IVCOMP = IVN002
40050 IF (IVCOMP - 1) 20050, 10050, 20050
10050 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0051
20050 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0051 CONTINUE
C
CT006* TEST 006 **** FCVS PROGRAM 719 ****
C RETURN IS FROM AN ENTRY TO A STATEMENT OUTSIDE LOOP
C
IVTNUM = 6
IVCOMP = 0
IVCORR = -34
IVN002 = -17
DO 0062 IVN001 = 1, 4
CALL EN721(IVN002,*0063)
0062 CONTINUE
0063 IVCOMP = IVN002
40060 IF (IVCOMP + 34) 20060, 10060, 20060
10060 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0061
20060 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0061 CONTINUE
C
CT007* TEST 007 **** FCVS PROGRAM 719 ****
C RETURN IS FROM AN ENTRY TO A STATEMENT INSIDE LOOP
C
IVTNUM = 7
IVCOMP = 0
IVCORR = 63
IVN002 = 7
DO 0073 IVN001 = 1, 3
CALL EN721(IVN002,*0072)
GO TO 20070
0072 IVN002 = IVN002 + 1
0073 CONTINUE
IVCOMP = IVN002
40070 IF (IVCOMP - 63) 20070, 10070, 20070
10070 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0071
20070 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0071 CONTINUE
C
CT008* TEST 008 **** FCVS PROGRAM 719 ****
C RETURN IS FROM AN ENTRY TO A STATEMENT OUTSIDE INNER LOOP OF A
C NESTED DO-LOOP
C
IVTNUM = 8
IVCOMP = 0
IVCORR = 3
IVN003 = 0
DO 0084 IVN001 = 1, 3
IVN003 = IVN003 + 1
DO 0082 IVN002 = IVN001, 4
CALL EN722(1,*0083,*0084)
0082 CONTINUE
0083 IVCOMP = IVN003
0084 CONTINUE
40080 IF (IVCOMP - 3) 20080, 10080, 20080
10080 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0081
20080 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0081 CONTINUE
C
CT009* TEST 009 **** FCVS PROGRAM 719 ****
C RETURN IS FROM AN ENTRY TO A STATEMENT INSIDE INNER LOOP OF A
C NESTED DO-LOOP
C
IVTNUM = 9
IVCOMP = 0
IVCORR = 12
IVN003 = 0
DO 0095 IVN001 = 1, 3
IVN003 = IVN003 + 1
DO 0093 IVN002 = IVN001, IVN001 + 1
CALL EN722(2,*0094,*0092)
IVN004 = 10
0092 IVN004 = IVN002*IVN003
0093 CONTINUE
0094 IVCOMP = IVN004
0095 CONTINUE
40090 IF (IVCOMP - 12) 20090, 10090, 20090
10090 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0091
20090 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0091 CONTINUE
C
CT010* TEST 010 **** FCVS PROGRAM 719 ****
C RETURN IS FROM AN ENTRY TO A STATEMENT EITHER INSIDE OR OUTSIDE
C INNER LOOP OF A NESTED DO-LOOP
C
IVTNUM = 10
IVCOMP = 0
IVCORR = 9
IVN003 = 0
IVN004 = 0
DO 0105 IVN001 = 1, 3
IVN003 = IVN003 + 1
IVN005 = (3 + (-1)**IVN001)/2
DO 0103 IVN002 = IVN001, IVN001 + 1
CALL EN722(IVN005,*0104,*0102)
IVN004 = 10
0102 IVN004 = IVN004 + IVN002 + IVN003
0103 CONTINUE
0104 IVCOMP = IVN004
0105 CONTINUE
40100 IF (IVCOMP - 9) 20100, 10100, 20100
10100 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0101
20100 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0101 CONTINUE
C TESTS 11 THRU 14 TEST DO STATEMENTS WITH MIXED INTEGER, REAL,
C AND DOUBLE PRECISION.
C
C
C
CT011* TEST 011 **** FCVS PROGRAM 719 ****
C
IVTNUM = 11
IVCOMP = 0
IVCORR = 30
DO 0112 IVN001 = 6.7, 0.9325D+1
IVCOMP = IVCOMP + IVN001
0112 CONTINUE
40110 IF (IVCOMP - 30) 20110, 10110, 20110
10110 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0111
20110 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0111 CONTINUE
C
CT012* TEST 012 **** FCVS PROGRAM 719 ****
C
IVTNUM = 12
IVCOMP = 0
IVCORR = -26
DVN001 = 3.54D0
DO 0122 IVN001 = -5.3, 2*(DVN001 - 8), -1.46
IVCOMP = IVCOMP + IVN001
0122 CONTINUE
40120 IF (IVCOMP + 26) 20120, 10120, 20120
10120 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0121
20120 IVFAIL = IVFAIL + 1
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR
0121 CONTINUE
C
CT013* TEST 013 **** FCVS PROGRAM 719 ****
C
IVTNUM = 13
RVCOMP = 0.0
RVCORR = 4.84E-6
IVN001 = 1
DVN001 = 2.0D-7
DO 0132 RVN001 = (IVN001 + .12)*1.0E-6, DVN001*(6 + 0.7), 6.0E-8
RVCOMP = RVCOMP + RVN001
0132 CONTINUE
IF (RVCOMP - 0.48397E-05) 20130, 10130, 40130
40130 IF (RVCOMP - 0.48403E-05) 10130, 10130, 20130
10130 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0131
20130 IVFAIL = IVFAIL + 1
WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR
0131 CONTINUE
C
CT014* TEST 014 **** FCVS PROGRAM 719 ****
C
IVTNUM = 14
DVCOMP = 0.0D0
DVCORR = 1.8D3
IVN001 = 1
DO 0142 DVN001 = 2.25E+2, 300*(1.65 + IVN001), 150
DVCOMP = DVCOMP + DVN001
0142 CONTINUE
IF (DVCOMP - 0.1799999999D+04) 20140, 10140, 40140
40140 IF (DVCOMP - 0.1800000001D+04) 10140, 10140, 20140
10140 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0141
20140 IVFAIL = IVFAIL + 1
WRITE (I02,80031) IVTNUM, DVCOMP, DVCORR
0141 CONTINUE
C
CBB** ********************** BBCSUM0 **********************************
C**** WRITE OUT TEST SUMMARY
C****
IVTOTN = IVPASS + IVFAIL + IVDELE + IVINSP
WRITE (I02, 90004)
WRITE (I02, 90014)
WRITE (I02, 90004)
WRITE (I02, 90020) IVPASS
WRITE (I02, 90022) IVFAIL
WRITE (I02, 90024) IVDELE
WRITE (I02, 90026) IVINSP
WRITE (I02, 90028) IVTOTN, IVTOTL
CBE** ********************** BBCSUM0 **********************************
CBB** ********************** BBCFOOT0 **********************************
C**** WRITE OUT REPORT FOOTINGS
C****
WRITE (I02,90016) ZPROG, ZPROG
WRITE (I02,90018) ZPROJ, ZNAME, ZTAPE, ZTAPED
WRITE (I02,90019)
CBE** ********************** BBCFOOT0 **********************************
90001 FORMAT (1H ,56X,5HFM719)
90000 FORMAT (1H ,50X,20HEND OF PROGRAM FM719)
CBB** ********************** BBCFMT0A **********************************
C**** FORMATS FOR TEST DETAIL LINES
C****
80000 FORMAT (1H ,2X,I3,4X,7HDELETED,32X,A31)
80002 FORMAT (1H ,2X,I3,4X,7H PASS ,32X,A31)
80004 FORMAT (1H ,2X,I3,4X,7HINSPECT,32X,A31)
80008 FORMAT (1H ,2X,I3,4X,7H FAIL ,32X,A31)
80010 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,15X,10HCOMPUTED= ,
1I6,/,1H ,15X,10HCORRECT= ,I6)
80012 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
1E12.5,/,1H ,16X,10HCORRECT= ,E12.5)
80018 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
1A21,/,1H ,16X,10HCORRECT= ,A21)
80020 FORMAT (1H ,16X,10HCOMPUTED= ,A21,1X,A31)
80022 FORMAT (1H ,16X,10HCORRECT= ,A21,1X,A31)
80024 FORMAT (1H ,16X,10HCOMPUTED= ,I6,16X,A31)
80026 FORMAT (1H ,16X,10HCORRECT= ,I6,16X,A31)
80028 FORMAT (1H ,16X,10HCOMPUTED= ,E12.5,10X,A31)
80030 FORMAT (1H ,16X,10HCORRECT= ,E12.5,10X,A31)
80050 FORMAT (1H ,48X,A31)
CBE** ********************** BBCFMT0A **********************************
CBB** ********************** BBCFMAT1 **********************************
C**** FORMATS FOR TEST DETAIL LINES - FULL LANGUAGE
C****
80031 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
1D17.10,/,1H ,16X,10HCORRECT= ,D17.10)
80033 FORMAT (1H ,16X,10HCOMPUTED= ,D17.10,10X,A31)
80035 FORMAT (1H ,16X,10HCORRECT= ,D17.10,10X,A31)
80037 FORMAT (1H ,16X,10HCOMPUTED= ,1H(,E12.5,2H, ,E12.5,1H),6X,A31)
80039 FORMAT (1H ,16X,10HCORRECT= ,1H(,E12.5,2H, ,E12.5,1H),6X,A31)
80041 FORMAT (1H ,16X,10HCOMPUTED= ,1H(,F12.5,2H, ,F12.5,1H),6X,A31)
80043 FORMAT (1H ,16X,10HCORRECT= ,1H(,F12.5,2H, ,F12.5,1H),6X,A31)
80045 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
11H(,F12.5,2H, ,F12.5,1H)/,1H ,16X,10HCORRECT= ,
21H(,F12.5,2H, ,F12.5,1H))
CBE** ********************** BBCFMAT1 **********************************
CBB** ********************** BBCFMT0B **********************************
C**** FORMAT STATEMENTS FOR PAGE HEADERS
C****
90002 FORMAT (1H1)
90004 FORMAT (1H )
90006 FORMAT (1H ,20X,31HFEDERAL SOFTWARE TESTING CENTER)
90007 FORMAT (1H ,19X,34HFORTRAN COMPILER VALIDATION SYSTEM)
90008 FORMAT (1H ,21X,A13,A17)
90009 FORMAT (1H ,/,2H *,A5,6HBEGIN*,12X,15HTEST RESULTS - ,A5,/)
90010 FORMAT (1H ,8X,16HTEST DATE*TIME= ,A17,15H - COMPILER= ,A20)
90013 FORMAT (1H ,8H TEST ,10HPASS/FAIL ,6X,17HDISPLAYED RESULTS,
1 7X,7HREMARKS,24X)
90014 FORMAT (1H ,46H----------------------------------------------,
1 33H---------------------------------)
90015 FORMAT (1H ,48X,17HTHIS PROGRAM HAS ,I3,6H TESTS,/)
C****
C**** FORMAT STATEMENTS FOR REPORT FOOTINGS
C****
90016 FORMAT (1H ,/,2H *,A5,4HEND*,14X,14HEND OF TEST - ,A5,/)
90018 FORMAT (1H ,A13,13X,A20,7H * ,A10,1H/,
1 A13)
90019 FORMAT (1H ,26HFOR OFFICIAL USE ONLY ,35X,15HCOPYRIGHT 1982)
C****
C**** FORMAT STATEMENTS FOR RUN SUMMARY
C****
90020 FORMAT (1H ,21X,I5,13H TESTS PASSED)
90022 FORMAT (1H ,21X,I5,13H TESTS FAILED)
90024 FORMAT (1H ,21X,I5,14H TESTS DELETED)
90026 FORMAT (1H ,21X,I5,25H TESTS REQUIRE INSPECTION)
90028 FORMAT (1H ,21X,I5,4H OF ,I3,15H TESTS EXECUTED)
CBE** ********************** BBCFMT0B **********************************
STOP
END
*HEADER,FORTR,FM719,SUBRTN,FM720
C THIS FUNCTION IS TO BE RUN WITH ROUTINE 719.
C
C THIS FUNCTION IS REFERENCED IN THE RANGE OF A DO-LOOP TO TEST
C LOOP CONTROL PROCESSING.
FUNCTION IF720(IVN001)
IF720 = 2*IVN001 - 1
RETURN
END
*HEADER,FORTR,FM719,SUBRTN,FM721
C THIS ROUTINE IS TO BE RUN WITH ROUTINE 719.
C
C THIS SUBROUTINE IS CALLED IN THE RANGE OF A DO-LOOP TO TEST
C ALTERNATE RETURN CONTROL.
SUBROUTINE SN721(IVN001,*)
IVN001 = IVN001 + 1
RETURN 1
ENTRY EN721(IVN002,*)
IVN002 = 2*IVN002
RETURN 1
ENTRY EN722(IVN003,*,*)
RETURN IVN003
END
*END-OF,FM719
FM722.f 481036450 170 2 100666 18029 `
*HEADER,FORTR,FM722
*FILES1,FORTR,FM722
PROGRAM FM722
C
C *************************************************************
C THE FULL LANGUAGE SET ALLOWS DATA TYPES TO BE DECLARED DOUBLE
C PRECISION AND COMPLEX.
C (FSTC TEST/PROGRAM IDENTIFICATION S04AF-2P)
C *************************************************************
C REFERENCES.
C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN,
C X3.9-1978
C
C SECTION 4 DATA TYPES AND CONSTANTS
C PARAGRAPHS:
C
C 4.1
C 4.1.2
C
C SECTION 8 SPECIFICATION STATEMENTS
C PARAGRAPHS:
C 8.4.1
C 8.6
C
C TEST DATA TYPES DOUBLE PRECISION AND COMPLEX USING:
C
C TYP V [,V1]
C
C TYP = DOUBLE PRECISION OR COMPLEX
C V = VARIABLE NAME, ARRAY NAME, ARRAY DECLARATOR,
C SYMBOLIC NAME OF A CONSTANT, FUNCTION NAME,
C OR DUMMY PROCEDURE NAME
C
C FM722 USES FUNCTIONS DF723, ZF724 AND SUBROUTINE SN725
C ****************************************************************
C
CBB** ********************** BBCCOMNT **********************************
C****
C**** 1978 FORTRAN COMPILER VALIDATION SYSTEM
C**** VERSION 2.0
C****
C****
C**** SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO
C**** GENERAL SERVICES ADMINISTRATION
C**** FEDERAL SOFTWARE TESTING CENTER
C**** 5203 LEESBURG PIKE, SUITE 1100
C**** FALLS CHURCH, VA. 22041
C****
C**** (703) 756-6153
C****
CBE** ********************** BBCCOMNT **********************************
IMPLICIT DOUBLE PRECISION (D), COMPLEX (Z), LOGICAL (L)
IMPLICIT CHARACTER*27 (C)
C
CBB** ********************** BBCINITA **********************************
C**** SPECIFICATION STATEMENTS
C****
CHARACTER ZVERS*13, ZVERSD*17, ZDATE*17, ZPROG*5, ZCOMPL*20,
1 ZNAME*20, ZTAPE*10, ZPROJ*13, REMRKS*31, ZTAPED*13
CBE** ********************** BBCINITA **********************************
DOUBLE PRECISION NVCOMP,DF723
COMPLEX ICP001,I2N002(2),ZF724
REAL R2NN02(2)
EQUIVALENCE (ZVCOMP,R2NN02)
PARAMETER (DPN001=5.834D6,IPN001=2,DCN004=1.456D3)
PARAMETER (ICP001=(3.2, 2.3))
DIMENSION D2N001(IPN001)
EXTERNAL DF723,ZF724
COMMON /BVN001/ DVC006
DATA D2N001(1),D2N001(2) / IPN001*DCN004 /
DATA I2N002(1),I2N002(2) / IPN001*(3.2, 2.3) /
DSN001(DVN003,DVN004) = DVN003 + DVN004
DSN006(DVN007,DVN008) = (DSN001(DVN007,DVN007) + DVN008)
ZSN001(RVN001,RVN002) = CMPLX(RVN001,RVN002) +
1CMPLX(RVN002,RVN002)
C
C
CBB** ********************** BBCINITB **********************************
C**** INITIALIZE SECTION
DATA ZVERS, ZVERSD, ZDATE
1 /'VERSION 2.0 ', '82/08/02*18.33.46', '*NO DATE*TIME'/
DATA ZCOMPL, ZNAME, ZTAPE
1 /'*NONE SPECIFIED*', '*NO COMPANY NAME*', '*NO TAPE*'/
DATA ZPROJ, ZTAPED, ZPROG
1 /'*NO PROJECT*', '*NO TAPE DATE', 'XXXXX'/
DATA REMRKS /' '/
C**** THE FOLLOWING 9 COMMENT LINES (CZ01, CZ02, ...) CAN BE REPLACED
C**** FOR IDENTIFYING THE TEST ENVIRONMENT
C****
CZ01 ZVERS = 'VERSION OF THE COMPILER VALIDATION SYSTEM'
CZ02 ZVERSD = 'CREATION DATE/TIME OF THE COMPILER VALIDATION SYSTEM'
CZ03 ZPROG = 'PROGRAM NAME'
CZ04 ZDATE = 'DATE OF TEST'
CZ05 ZCOMPL = 'COMPILER IDENTIFICATION'
CZ06 ZPROJ = 'PROJECT NUMBER/IDENTIFICATION'
CZ07 ZNAME = 'NAME OF USER'
CZ08 ZTAPE = 'TAPE OWNER/ID'
CZ09 ZTAPED = 'DATE TAPE COPIED'
C
IVPASS = 0
IVFAIL = 0
IVDELE = 0
IVINSP = 0
IVTOTL = 0
IVTOTN = 0
ICZERO = 0
C
C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER.
I01 = 05
C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER.
I02 = 06
C
CX010 REPLACED BY FEXEC X-010 CONTROL CARD (CARD-READER UNIT NUMBER).
C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5
CX011 REPLACED BY FEXEC X-011 CONTROL CARD. CX011 IS FOR SYSTEMS
C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX010.
C
CX020 REPLACED BY FEXEC X-020 CONTROL CARD (PRINTER UNIT NUMBER).
C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02= 6
CX021 REPLACED BY FEXEC X-021 CONTROL CARD. CX021 IS FOR SYSTEMS
C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX020.
C
CBE** ********************** BBCINITB **********************************
ZPROG='FM722'
IVTOTL = 12
CBB** ********************** BBCHED0A **********************************
C****
C**** WRITE REPORT TITLE
C****
WRITE (I02, 90002)
WRITE (I02, 90006)
WRITE (I02, 90007)
WRITE (I02, 90008) ZVERS, ZVERSD
WRITE (I02, 90009) ZPROG, ZPROG
WRITE (I02, 90010) ZDATE, ZCOMPL
CBE** ********************** BBCHED0A **********************************
CBB** ********************** BBCHED0B **********************************
C**** WRITE DETAIL REPORT HEADERS
C****
WRITE (I02,90004)
WRITE (I02,90004)
WRITE (I02,90013)
WRITE (I02,90014)
WRITE (I02,90015) IVTOTL
CBE** ********************** BBCHED0B **********************************
C
CT001* TEST 001 **** FCVS PROGRAM 722 ****
C
C TEST 001 IS DESIGNED TO TEST A DOUBLE PRECISION CONSTANT
C VALUE SET WITH PARAMETER STATEMENT
C
IVTNUM = 1
DVCOMP=0.0D0
DVCOMP=DPN001
DVCORR=5.834D6
IF (DPN001 - 5.833999997D6) 20010,10010,40010
40010 IF (DPN001 - 5.834000003D6) 10010,10010,20010
10010 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0011
20010 IVFAIL = IVFAIL + 1
WRITE (I02,80031) IVTNUM, DVCOMP, DVCORR
0011 CONTINUE
C
CT002* TEST 002 **** FCVS PROGRAM 722 ****
C
C TEST 002 IS DESIGNED TO TEST A DOUBLE PRECISION VARIABLE
C
IVTNUM = 2
DVCOMP=0.0D0
NVCOMP=.1212345D2
DVCOMP=NVCOMP
DVCORR=.1212345D2
IF (NVCOMP - .1212344999D2) 20020,40021,40020
40020 IF (NVCOMP - .1212345001D2) 40021,40021,20020
40021 DVCOMP = DVCOMP + .1212345D2
DVCORR=.2424690D2
IF (DVCOMP - .2424689998D2) 20020,10020,40022
40022 IF (DVCOMP - .2424690002D2) 10020,10020,20020
10020 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0021
20020 IVFAIL = IVFAIL + 1
WRITE (I02,80031) IVTNUM, DVCOMP, DVCORR
0021 CONTINUE
C
CT003* TEST 003 **** FCVS PROGRAM 722 ****
C
C TEST 003 A DOUBLE PRECISION ARRAY
C
IVTNUM = 3
DVCOMP=0.0D0
DVCORR=2.912D3
DVCOMP=D2N001(1) + D2N001(2)
IF (DVCOMP - 2.911999998D3) 20030,10030,40030
40030 IF (DVCOMP - 2.912000002D3) 10030,10030,20030
10030 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0031
20030 IVFAIL = IVFAIL + 1
WRITE (I02,80031) IVTNUM, DVCOMP, DVCORR
0031 CONTINUE
C
CT004* TEST 004 **** FCVS PROGRAM 722 ****
C
C TEST 004 IS DESIGNED TO TEST A DOUBLE PRECISION FUNCTION
C DF723
C
IVTNUM = 4
DVCOMP=0.0D0
DVN009=.1211D2
DVCOMP=DF723(DVN009)
DVCORR=1.001211D4
IF (DVCOMP - 1.001210999D4) 20040,10040,40040
40040 IF (DVCOMP - 1.001211001D4) 10040,10040,20040
10040 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0041
20040 IVFAIL = IVFAIL + 1
WRITE (I02,80031) IVTNUM, DVCOMP, DVCORR
0041 CONTINUE
C
CT005* TEST 005 **** FCVS PROGRAM 722 ****
C
C TEST 005 IS DESIGNED TO TEST A DOUBLE PRECISION DUMMY
C PROCEDURE (DF723 USED AS DUMMY ARGUMENT FOR SUBROUTINE
C FS528
C
IVTNUM = 5
DVCOMP=0.0D0
DVCORR=1200000.0D-2
DVN009=0.0D0
DVN009=10D2
CALL SN725(DF723,DVN009)
DVCOMP=DVC006
IF (DVCOMP - .1199999999D5) 20050,10050,40050
40050 IF (DVCOMP - .1200000001D5) 10050,10050,20050
10050 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0051
20050 IVFAIL = IVFAIL + 1
WRITE (I02,80031) IVTNUM, DVCOMP, DVCORR
0051 CONTINUE
C
CT006* TEST 006 **** FCVS PROGRAM 722 ****
C
C TEST 006 DOUBLE PRECISION FUNCTION NAME USING
C STATEMENT FUNCTION STATEMENT
C
IVTNUM = 6
DVCOMP=0.0D0
DVCORR=20D2
DVN009=10D2
DVN010=10D2
DVCOMP=DSN001(DVN009,DVN010)
IF (DVCOMP - 19.99999999D2) 20060,10060,40060
40060 IF (DVCOMP - 20.00000001D2) 10060,10060,20060
10060 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0061
20060 IVFAIL = IVFAIL + 1
WRITE (I02,80031) IVTNUM, DVCOMP, DVCORR
0061 CONTINUE
C
CT007* TEST 007 **** FCVS PROGRAM 722 ****
C
C TEST 007 DOUBLE PRECISION FUNCTION NAME USED IN
C A STATEMENT FUNCTION STATEMENT AS A DUMMY ARGUMENT
C
IVTNUM = 7
DVCOMP=0.0D0
DVCORR=30D2
DVN009=10D2
DVN010=10D2
DVCOMP=DSN006(DVN009,DVN010)
IF (DVCOMP - 29.99999998D2) 20070,10070,40070
40070 IF (DVCOMP - 30.00000002D2) 10070,10070,20070
10070 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0071
20070 IVFAIL = IVFAIL + 1
WRITE (I02,80031) IVTNUM, DVCOMP, DVCORR
0071 CONTINUE
C
C THE FOLLOWING GROUP OF TESTS ARE DESIGNED TO
C TEST COMPLEX DATA TYPES
C
C
CT008* TEST 008 **** FCVS PROGRAM 722 ****
C
C TEST 008 DATA TYPE CAN BE A COMPLEX VARIABLE
C
IVTNUM = 8
ZVCOMP=(0.0, 0.0)
ZVCORR=(1.0, 1.0)
ZVN001=(6.5, 2.2)
ZVN002=(5.5, 1.2)
ZVCOMP=ZVN001-ZVN002
IF (R2NN02(1) - 0.9995) 20080,40081,40080
40080 IF (R2NN02(1) - 1.0001) 40081,40081,20080
40081 IF (R2NN02(2) - 0.9995) 20080,10080,40082
40082 IF (R2NN02(2) - 1.0001) 10080,10080,20080
10080 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0081
20080 IVFAIL = IVFAIL + 1
WRITE (I02,80045) IVTNUM, ZVCOMP, ZVCORR
0081 CONTINUE
C
CT009* TEST 009 **** FCVS PROGRAM 722 ****
C
C TEST 009 COMPLEX CONSTANT
C
IVTNUM = 9
ZVCOMP=(0.0, 0.0)
ZVCORR=(6.4, 4.6)
ZVCOMP=ICP001+ICP001
IF (R2NN02(1) - 6.3996) 20090,10090,40090
40090 IF (R2NN02(1) - 6.4004) 40091,40091,20090
40091 IF (R2NN02(2) - 4.5997) 20090,10090,40092
40092 IF (R2NN02(2) - 4.6003) 10090,10090,20090
10090 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0091
20090 IVFAIL = IVFAIL + 1
WRITE (I02,80045) IVTNUM, ZVCOMP, ZVCORR
0091 CONTINUE
C
CT010* TEST 010 **** FCVS PROGRAM 722 ****
C
C TEST 010 COMPLEX ARRAY
C
IVTNUM = 10
ZVCOMP=(0.0, 0.0)
ZVCORR=(6.4, 4.6)
ZVCOMP=I2N002(1)+I2N002(2)
IF (R2NN02(1) - 6.3996) 20100,10100,40100
40100 IF (R2NN02(1) - 6.4004) 40101,40101,20100
40101 IF (R2NN02(2) - 4.5997) 20100,10100,40102
40102 IF (R2NN02(2) - 4.6003) 10100,10100,20100
10100 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0101
20100 IVFAIL = IVFAIL + 1
WRITE (I02,80045) IVTNUM, ZVCOMP, ZVCORR
0101 CONTINUE
C
CT011* TEST 011 **** FCVS PROGRAM 722 ****
C
C TEST 011 COMPLEX FUNCTION NAME (USING STATEMENT FUNCTION)
C FUNCTION NAME CAN BE COMPLEX
C
IVTNUM = 11
ZVCORR=(3.0, 4.0)
ZVCOMP=(0.0, 0.0)
RVN004=1.0
RVN005=2.0
ZVCOMP=(ZSN001(RVN004,RVN005))
IF (R2NN02(1) - 2.9998) 20110,10110,40110
40110 IF (R2NN02(1) - 3.0002) 40111,40111,20110
40111 IF (R2NN02(2) - 3.9998) 20110,10110,40112
40112 IF (R2NN02(2) - 4.0002) 10110,10110,20110
10110 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0111
20110 IVFAIL = IVFAIL + 1
WRITE (I02,80045) IVTNUM, ZVCOMP, ZVCORR
0111 CONTINUE
C
CT012* TEST 012 **** FCVS PROGRAM 722 ****
C
C TEST 012 TEST COMPLEX FUNCTION NAME IN A FUNCTION SUBPROGRAM
C
IVTNUM = 12
ZVCORR=(3.0, 4.0)
ZVCOMP=(0.0, 0.0)
RVN004=1.0
RVN005=2.0
ZVCOMP=ZF724(RVN004,RVN005)
IF (R2NN02(1) - 2.9998) 20120,10120,40120
40120 IF (R2NN02(1) - 3.0002) 40121,40121,20120
40121 IF (R2NN02(2) - 3.9998) 20120,10120,40122
40122 IF (R2NN02(2) - 4.0002) 10120,10120,20120
10120 IVPASS = IVPASS + 1
WRITE (I02,80002) IVTNUM
GO TO 0121
20120 IVFAIL = IVFAIL + 1
WRITE (I02,80045) IVTNUM, ZVCOMP, ZVCORR
0121 CONTINUE
C
CBB** ********************** BBCSUM0 **********************************
C**** WRITE OUT TEST SUMMARY
C****
IVTOTN = IVPASS + IVFAIL + IVDELE + IVINSP
WRITE (I02, 90004)
WRITE (I02, 90014)
WRITE (I02, 90004)
WRITE (I02, 90020) IVPASS
WRITE (I02, 90022) IVFAIL
WRITE (I02, 90024) IVDELE
WRITE (I02, 90026) IVINSP
WRITE (I02, 90028) IVTOTN, IVTOTL
CBE** ********************** BBCSUM0 **********************************
CBB** ********************** BBCFOOT0 **********************************
C**** WRITE OUT REPORT FOOTINGS
C****
WRITE (I02,90016) ZPROG, ZPROG
WRITE (I02,90018) ZPROJ, ZNAME, ZTAPE, ZTAPED
WRITE (I02,90019)
CBE** ********************** BBCFOOT0 **********************************
90001 FORMAT (1H ,56X,5HFM722)
90000 FORMAT (1H ,50X,20HEND OF PROGRAM FM722)
CBB** ********************** BBCFMT0A **********************************
C**** FORMATS FOR TEST DETAIL LINES
C****
80000 FORMAT (1H ,2X,I3,4X,7HDELETED,32X,A31)
80002 FORMAT (1H ,2X,I3,4X,7H PASS ,32X,A31)
80004 FORMAT (1H ,2X,I3,4X,7HINSPECT,32X,A31)
80008 FORMAT (1H ,2X,I3,4X,7H FAIL ,32X,A31)
80010 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,15X,10HCOMPUTED= ,
1I6,/,1H ,15X,10HCORRECT= ,I6)
80012 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
1E12.5,/,1H ,16X,10HCORRECT= ,E12.5)
80018 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
1A21,/,1H ,16X,10HCORRECT= ,A21)
80020 FORMAT (1H ,16X,10HCOMPUTED= ,A21,1X,A31)
80022 FORMAT (1H ,16X,10HCORRECT= ,A21,1X,A31)
80024 FORMAT (1H ,16X,10HCOMPUTED= ,I6,16X,A31)
80026 FORMAT (1H ,16X,10HCORRECT= ,I6,16X,A31)
80028 FORMAT (1H ,16X,10HCOMPUTED= ,E12.5,10X,A31)
80030 FORMAT (1H ,16X,10HCORRECT= ,E12.5,10X,A31)
80050 FORMAT (1H ,48X,A31)
CBE** ********************** BBCFMT0A **********************************
CBB** ********************** BBCFMAT1 **********************************
C**** FORMATS FOR TEST DETAIL LINES - FULL LANGUAGE
C****
80031 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
1D17.10,/,1H ,16X,10HCORRECT= ,D17.10)
80033 FORMAT (1H ,16X,10HCOMPUTED= ,D17.10,10X,A31)
80035 FORMAT (1H ,16X,10HCORRECT= ,D17.10,10X,A31)
80037 FORMAT (1H ,16X,10HCOMPUTED= ,1H(,E12.5,2H, ,E12.5,1H),6X,A31)
80039 FORMAT (1H ,16X,10HCORRECT= ,1H(,E12.5,2H, ,E12.5,1H),6X,A31)
80041 FORMAT (1H ,16X,10HCOMPUTED= ,1H(,F12.5,2H, ,F12.5,1H),6X,A31)
80043 FORMAT (1H ,16X,10HCORRECT= ,1H(,F12.5,2H, ,F12.5,1H),6X,A31)
80045 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
11H(,F12.5,2H, ,F12.5,1H)/,1H ,16X,10HCORRECT= ,
21H(,F12.5,2H, ,F12.5,1H))
CBE** ********************** BBCFMAT1 **********************************
CBB** ********************** BBCFMT0B **********************************
C**** FORMAT STATEMENTS FOR PAGE HEADERS
C****
90002 FORMAT (1H1)
90004 FORMAT (1H )
90006 FORMAT (1H ,20X,31HFEDERAL SOFTWARE TESTING CENTER)
90007 FORMAT (1H ,19X,34HFORTRAN COMPILER VALIDATION SYSTEM)
90008 FORMAT (1H ,21X,A13,A17)
90009 FORMAT (1H ,/,2H *,A5,6HBEGIN*,12X,15HTEST RESULTS - ,A5,/)
90010 FORMAT (1H ,8X,16HTEST DATE*TIME= ,A17,15H - COMPILER= ,A20)
90013 FORMAT (1H ,8H TEST ,10HPASS/FAIL ,6X,17HDISPLAYED RESULTS,
1 7X,7HREMARKS,24X)
90014 FORMAT (1H ,46H----------------------------------------------,
1 33H---------------------------------)
90015 FORMAT (1H ,48X,17HTHIS PROGRAM HAS ,I3,6H TESTS,/)
C****
C**** FORMAT STATEMENTS FOR REPORT FOOTINGS
C****
90016 FORMAT (1H ,/,2H *,A5,4HEND*,14X,14HEND OF TEST - ,A5,/)
90018 FORMAT (1H ,A13,13X,A20,7H * ,A10,1H/,
1 A13)
90019 FORMAT (1H ,26HFOR OFFICIAL USE ONLY ,35X,15HCOPYRIGHT 1982)
C****
C**** FORMAT STATEMENTS FOR RUN SUMMARY
C****
90020 FORMAT (1H ,21X,I5,13H TESTS PASSED)
90022 FORMAT (1H ,21X,I5,13H TESTS FAILED)
90024 FORMAT (1H ,21X,I5,14H TESTS DELETED)
90026 FORMAT (1H ,21X,I5,25H TESTS REQUIRE INSPECTION)
90028 FORMAT (1H ,21X,I5,4H OF ,I3,15H TESTS EXECUTED)
CBE** ********************** BBCFMT0B **********************************
END
*HEADER,FORTR,FM722,SUBRTN,FM723
DOUBLE PRECISION FUNCTION DF723(DVN008)
C THIS FUNCTION IS USED BY PROGRAM FM722 TO TEST
C DOUBLE PRECISION FUNCTIONS
IMPLICIT DOUBLE PRECISION (D)
DF723=DVN008 + 100D2
RETURN
END
*HEADER,FORTR,FM722,SUBRTN,FM724
COMPLEX FUNCTION ZF724(RVN006,RVN007)
C THIS FUNCTION IS USED BY PROGRAM FM722 TO TEST
C COMPLEX FUNCTION NAME
IMPLICIT COMPLEX (Z)
ZF724= CMPLX(RVN006,RVN007) + CMPLX(RVN007,RVN007)
RETURN
END
*HEADER,FORTR,FM722,SUBRTN,FM725
SUBROUTINE SN725(DTINT, DVN008)
C THIS ROUTINE IS USED BY PROGRAM FM722
C TO TEST A DOUBLE PRECISION FUNCTION NAME USED AS AN
C ACTUAL ARGUMENT
IMPLICIT DOUBLE PRECISION (D)
COMMON /BVN001/ DVC006
DVC006=DTINT(DVN008) + 10D2
RETURN
END
*END-OF,FM722
FM800.f 481036454 170 2 100666 13447 `
*HEADER,FORTR,FM800
*FILES1,FORTR,FM800,X
C***********************************************************************
C***** FORTRAN 77
C***** FM800 YIDINT - (151)
C*****
C***********************************************************************
C***** GENERAL PURPOSE ANS REF
C***** TEST INTRINSIC FUNCTION IDINT -- 15.3
C***** TRUNCATION (SIGN OF A * LARGEST INTEGER LE ABS(A) ) (TABLE 5)
C*****
CBB** ********************** BBCCOMNT **********************************
C****
C**** 1978 FORTRAN COMPILER VALIDATION SYSTEM
C**** VERSION 2.0
C****
C****
C**** SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO
C**** GENERAL SERVICES ADMINISTRATION
C**** FEDERAL SOFTWARE TESTING CENTER
C**** 5203 LEESBURG PIKE, SUITE 1100
C**** FALLS CHURCH, VA. 22041
C****
C**** (703) 756-6153
C****
CBE** ********************** BBCCOMNT **********************************
C***** S P E C I F I C A T I O N S SEGMENT 151
C*****
DOUBLE PRECISION DLAVD, DLBVD
C*****
CBB** ********************** BBCINITA **********************************
C**** SPECIFICATION STATEMENTS
C****
CHARACTER ZVERS*13, ZVERSD*17, ZDATE*17, ZPROG*5, ZCOMPL*20,
1 ZNAME*20, ZTAPE*10, ZPROJ*13, REMRKS*31, ZTAPED*13
CBE** ********************** BBCINITA **********************************
CBB** ********************** BBCINITB **********************************
C**** INITIALIZE SECTION
DATA ZVERS, ZVERSD, ZDATE
1 /'VERSION 2.0 ', '82/08/02*18.33.46', '*NO DATE*TIME'/
DATA ZCOMPL, ZNAME, ZTAPE
1 /'*NONE SPECIFIED*', '*NO COMPANY NAME*', '*NO TAPE*'/
DATA ZPROJ, ZTAPED, ZPROG
1 /'*NO PROJECT*', '*NO TAPE DATE', 'XXXXX'/
DATA REMRKS /' '/
C**** THE FOLLOWING 9 COMMENT LINES (CZ01, CZ02, ...) CAN BE REPLACED
C**** FOR IDENTIFYING THE TEST ENVIRONMENT
C****
CZ01 ZVERS = 'VERSION OF THE COMPILER VALIDATION SYSTEM'
CZ02 ZVERSD = 'CREATION DATE/TIME OF THE COMPILER VALIDATION SYSTEM'
CZ03 ZPROG = 'PROGRAM NAME'
CZ04 ZDATE = 'DATE OF TEST'
CZ05 ZCOMPL = 'COMPILER IDENTIFICATION'
CZ06 ZPROJ = 'PROJECT NUMBER/IDENTIFICATION'
CZ07 ZNAME = 'NAME OF USER'
CZ08 ZTAPE = 'TAPE OWNER/ID'
CZ09 ZTAPED = 'DATE TAPE COPIED'
C
IVPASS = 0
IVFAIL = 0
IVDELE = 0
IVINSP = 0
IVTOTL = 0
IVTOTN = 0
ICZERO = 0
C
C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER.
I01 = 05
C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER.
I02 = 06
C
CX010 REPLACED BY FEXEC X-010 CONTROL CARD (CARD-READER UNIT NUMBER).
C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5
CX011 REPLACED BY FEXEC X-011 CONTROL CARD. CX011 IS FOR SYSTEMS
C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX010.
C
CX020 REPLACED BY FEXEC X-020 CONTROL CARD (PRINTER UNIT NUMBER).
C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02= 6
CX021 REPLACED BY FEXEC X-021 CONTROL CARD. CX021 IS FOR SYSTEMS
C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX020.
C
CBE** ********************** BBCINITB **********************************
NUVI = I02
IVTOTL = 12
ZPROG = 'FM800'
CBB** ********************** BBCHED0A **********************************
C****
C**** WRITE REPORT TITLE
C****
WRITE (I02, 90002)
WRITE (I02, 90006)
WRITE (I02, 90007)
WRITE (I02, 90008) ZVERS, ZVERSD
WRITE (I02, 90009) ZPROG, ZPROG
WRITE (I02, 90010) ZDATE, ZCOMPL
CBE** ********************** BBCHED0A **********************************
C*****
C***** HEADER FOR SEGMENT 151 WRITTEN
WRITE (NUVI,15101)
15101 FORMAT (1H , // 1X,35HYIDINT - (151) INTRINSIC FUNCTION--//17X,
1 23HIDINT (TYPE CONVERSION)//17H ANS REF. - 15.3)
CBB** ********************** BBCHED0B **********************************
C**** WRITE DETAIL REPORT HEADERS
C****
WRITE (I02,90004)
WRITE (I02,90004)
WRITE (I02,90013)
WRITE (I02,90014)
WRITE (I02,90015) IVTOTL
CBE** ********************** BBCHED0B **********************************
C*****
CT001* TEST 1 THE VALUE ZERO
IVTNUM = 1
DLBVD = 0.0D0
ILAVI = IDINT(DLBVD)
IF (ILAVI - 0) 20010, 10010, 20010
10010 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0011
20010 IVFAIL = IVFAIL + 1
IVCORR = 0
WRITE (NUVI, 80010) IVTNUM, ILAVI, IVCORR
0011 CONTINUE
CT002* TEST 2 A VALUE IN (0,1)
IVTNUM = 2
DLBVD = 3.57D-1
ILAVI = IDINT(DLBVD)
IF (ILAVI - 0) 20020, 10020, 20020
10020 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0021
20020 IVFAIL = IVFAIL + 1
IVCORR = 0
WRITE (NUVI, 80010) IVTNUM, ILAVI, IVCORR
0021 CONTINUE
CT003* TEST 3 THE VALUE ONE
IVTNUM = 3
DLBVD = 1.00001D0
ILAVI = IDINT(DLBVD)
IF (ILAVI - 1) 20030, 10030, 20030
10030 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0031
20030 IVFAIL = IVFAIL + 1
IVCORR = 1
WRITE (NUVI, 80010) IVTNUM, ILAVI, IVCORR
0031 CONTINUE
CT004* TEST 4 A INTEGRAL VALUE OTHER THAN O, 1
IVTNUM = 4
DLBVD = 6.00001D0
ILAVI = IDINT(DLBVD)
IF (ILAVI - 6) 20040, 10040, 20040
10040 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0041
20040 IVFAIL = IVFAIL + 1
IVCORR = 6
WRITE (NUVI, 80010) IVTNUM, ILAVI, IVCORR
0041 CONTINUE
CT005* TEST 5 A VALUE IN (X,X+1)
IVTNUM = 5
DLBVD = 0.375D1
ILAVI = IDINT(DLBVD)
IF (ILAVI - 3) 20050, 10050, 20050
10050 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0051
20050 IVFAIL = IVFAIL + 1
IVCORR = 3
WRITE (NUVI, 80010) IVTNUM, ILAVI, IVCORR
0051 CONTINUE
CT006* TEST 6 A NEGATIVE VALUE WITH MAGNITUDE IN (0,1)
IVTNUM = 6
DLBVD = -0.375D0
ILAVI = IDINT(DLBVD)
IF (ILAVI - 0) 20060, 10060, 20060
10060 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0061
20060 IVFAIL = IVFAIL + 1
IVCORR = 0
WRITE (NUVI, 80010) IVTNUM, ILAVI, IVCORR
0061 CONTINUE
CT007* TEST 7 THE VALUE -1
IVTNUM = 7
DLBVD = -0.100001D1
ILAVI = IDINT(DLBVD)
IF (ILAVI + 1) 20070, 10070, 20070
10070 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0071
20070 IVFAIL = IVFAIL + 1
IVCORR = -1
WRITE (NUVI, 80010) IVTNUM, ILAVI, IVCORR
0071 CONTINUE
CT008* TEST 8 A NEGATIVE INTEGRAL VALUE
IVTNUM = 8
DLBVD = -6.00001D0
ILAVI = IDINT(DLBVD)
IF (ILAVI + 6) 20080, 10080, 20080
10080 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0081
20080 IVFAIL = IVFAIL + 1
IVCORR = -6
WRITE (NUVI, 80010) IVTNUM, ILAVI, IVCORR
0081 CONTINUE
CT009* TEST 9 A NEGATIVE VALUE WITH MAGNITUDE IN (X,X+1)
IVTNUM = 9
DLBVD = -0.375D1
ILAVI = IDINT(DLBVD)
IF (ILAVI + 3) 20090, 10090, 20090
10090 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0091
20090 IVFAIL = IVFAIL + 1
IVCORR = -3
WRITE (NUVI, 80010) IVTNUM, ILAVI, IVCORR
0091 CONTINUE
CT010* TEST 10 ZERO PREFIXED WITH A MINUS SIGN
IVTNUM = 10
DLAVD = 0.0D0
ILAVI = IDINT(-DLAVD)
IF (ILAVI + 0) 20100, 10100, 20100
10100 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0101
20100 IVFAIL = IVFAIL + 1
IVCORR = 0
WRITE (NUVI, 80010) IVTNUM, ILAVI, IVCORR
0101 CONTINUE
CT011* TEST 11 AN ARITHMETIC EXPRESSION PRESENTED TO IDINT
IVTNUM = 11
DLAVD = 0.375D1
DLBVD = 3.5D0
ILAVI = (IDINT(DLAVD + DLBVD * 0.5D1))
IF (ILAVI - 21) 20110, 10110, 20110
10110 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0111
20110 IVFAIL = IVFAIL + 1
IVCORR = 21
WRITE (NUVI, 80010) IVTNUM, ILAVI, IVCORR
0111 CONTINUE
CT012* TEST 12 COMPARE AUTOMATIC TYPE CONVERSION TO EXPLICIT
IVTNUM = 12
DLAVD = 3.5D0
ILAVI = IDINT(DLAVD ** 2.5)
ILBVI = DLAVD ** 2.5
IF (ILAVI - ILBVI) 20120, 10120, 20120
10120 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0121
20120 IVFAIL = IVFAIL + 1
IVCORR = ILBVI
WRITE (NUVI, 80010) IVTNUM, ILAVI, IVCORR
0121 CONTINUE
CBB** ********************** BBCSUM0 **********************************
C**** WRITE OUT TEST SUMMARY
C****
IVTOTN = IVPASS + IVFAIL + IVDELE + IVINSP
WRITE (I02, 90004)
WRITE (I02, 90014)
WRITE (I02, 90004)
WRITE (I02, 90020) IVPASS
WRITE (I02, 90022) IVFAIL
WRITE (I02, 90024) IVDELE
WRITE (I02, 90026) IVINSP
WRITE (I02, 90028) IVTOTN, IVTOTL
CBE** ********************** BBCSUM0 **********************************
CBB** ********************** BBCFOOT0 **********************************
C**** WRITE OUT REPORT FOOTINGS
C****
WRITE (I02,90016) ZPROG, ZPROG
WRITE (I02,90018) ZPROJ, ZNAME, ZTAPE, ZTAPED
WRITE (I02,90019)
CBE** ********************** BBCFOOT0 **********************************
CBB** ********************** BBCFMT0A **********************************
C**** FORMATS FOR TEST DETAIL LINES
C****
80000 FORMAT (1H ,2X,I3,4X,7HDELETED,32X,A31)
80002 FORMAT (1H ,2X,I3,4X,7H PASS ,32X,A31)
80004 FORMAT (1H ,2X,I3,4X,7HINSPECT,32X,A31)
80008 FORMAT (1H ,2X,I3,4X,7H FAIL ,32X,A31)
80010 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,15X,10HCOMPUTED= ,
1I6,/,1H ,15X,10HCORRECT= ,I6)
80012 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
1E12.5,/,1H ,16X,10HCORRECT= ,E12.5)
80018 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
1A21,/,1H ,16X,10HCORRECT= ,A21)
80020 FORMAT (1H ,16X,10HCOMPUTED= ,A21,1X,A31)
80022 FORMAT (1H ,16X,10HCORRECT= ,A21,1X,A31)
80024 FORMAT (1H ,16X,10HCOMPUTED= ,I6,16X,A31)
80026 FORMAT (1H ,16X,10HCORRECT= ,I6,16X,A31)
80028 FORMAT (1H ,16X,10HCOMPUTED= ,E12.5,10X,A31)
80030 FORMAT (1H ,16X,10HCORRECT= ,E12.5,10X,A31)
80050 FORMAT (1H ,48X,A31)
CBE** ********************** BBCFMT0A **********************************
CBB** ********************** BBCFMAT1 **********************************
C**** FORMATS FOR TEST DETAIL LINES - FULL LANGUAGE
C****
80031 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
1D17.10,/,1H ,16X,10HCORRECT= ,D17.10)
80033 FORMAT (1H ,16X,10HCOMPUTED= ,D17.10,10X,A31)
80035 FORMAT (1H ,16X,10HCORRECT= ,D17.10,10X,A31)
80037 FORMAT (1H ,16X,10HCOMPUTED= ,1H(,E12.5,2H, ,E12.5,1H),6X,A31)
80039 FORMAT (1H ,16X,10HCORRECT= ,1H(,E12.5,2H, ,E12.5,1H),6X,A31)
80041 FORMAT (1H ,16X,10HCOMPUTED= ,1H(,F12.5,2H, ,F12.5,1H),6X,A31)
80043 FORMAT (1H ,16X,10HCORRECT= ,1H(,F12.5,2H, ,F12.5,1H),6X,A31)
80045 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
11H(,F12.5,2H, ,F12.5,1H)/,1H ,16X,10HCORRECT= ,
21H(,F12.5,2H, ,F12.5,1H))
CBE** ********************** BBCFMAT1 **********************************
CBB** ********************** BBCFMT0B **********************************
C**** FORMAT STATEMENTS FOR PAGE HEADERS
C****
90002 FORMAT (1H1)
90004 FORMAT (1H )
90006 FORMAT (1H ,20X,31HFEDERAL SOFTWARE TESTING CENTER)
90007 FORMAT (1H ,19X,34HFORTRAN COMPILER VALIDATION SYSTEM)
90008 FORMAT (1H ,21X,A13,A17)
90009 FORMAT (1H ,/,2H *,A5,6HBEGIN*,12X,15HTEST RESULTS - ,A5,/)
90010 FORMAT (1H ,8X,16HTEST DATE*TIME= ,A17,15H - COMPILER= ,A20)
90013 FORMAT (1H ,8H TEST ,10HPASS/FAIL ,6X,17HDISPLAYED RESULTS,
1 7X,7HREMARKS,24X)
90014 FORMAT (1H ,46H----------------------------------------------,
1 33H---------------------------------)
90015 FORMAT (1H ,48X,17HTHIS PROGRAM HAS ,I3,6H TESTS,/)
C****
C**** FORMAT STATEMENTS FOR REPORT FOOTINGS
C****
90016 FORMAT (1H ,/,2H *,A5,4HEND*,14X,14HEND OF TEST - ,A5,/)
90018 FORMAT (1H ,A13,13X,A20,7H * ,A10,1H/,
1 A13)
90019 FORMAT (1H ,26HFOR OFFICIAL USE ONLY ,35X,15HCOPYRIGHT 1982)
C****
C**** FORMAT STATEMENTS FOR RUN SUMMARY
C****
90020 FORMAT (1H ,21X,I5,13H TESTS PASSED)
90022 FORMAT (1H ,21X,I5,13H TESTS FAILED)
90024 FORMAT (1H ,21X,I5,14H TESTS DELETED)
90026 FORMAT (1H ,21X,I5,25H TESTS REQUIRE INSPECTION)
90028 FORMAT (1H ,21X,I5,4H OF ,I3,15H TESTS EXECUTED)
CBE** ********************** BBCFMT0B **********************************
C*****
C***** END OF TEST SEGMENT 151
STOP
END
*END-OF,FM800
FM801.f 481036459 170 2 100666 29712 `
*HEADER,FORTR,FM801
*FILES1,FORTR,FM801,X
C***********************************************************************
C***** FORTRAN 77
C***** FM801 YDINT - (155)
C*****
C***********************************************************************
C***** GENERAL PURPOSE ANS REF
C***** TEST INTRINSIC FUNCTIONS DINT, DNINT, IDNINT 15.3
C***** TRUNCATION (SIGN OF A * LARGEST INTEGER LE ABS(A) ) (TABLE 5)
C*****
C***** GENERAL COMMENTS
C***** FLOAT FUNCTION ASSUMED WORKING
C*****
CBB** ********************** BBCCOMNT **********************************
C****
C**** 1978 FORTRAN COMPILER VALIDATION SYSTEM
C**** VERSION 2.0
C****
C****
C**** SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO
C**** GENERAL SERVICES ADMINISTRATION
C**** FEDERAL SOFTWARE TESTING CENTER
C**** 5203 LEESBURG PIKE, SUITE 1100
C**** FALLS CHURCH, VA. 22041
C****
C**** (703) 756-6153
C****
CBE** ********************** BBCCOMNT **********************************
C*****
C***** S P E C I F I C A T I O N S SEGMENT 155
DOUBLE PRECISION DNAVD, DNBVD, DNDVD
C*****
CBB** ********************** BBCINITA **********************************
C**** SPECIFICATION STATEMENTS
C****
CHARACTER ZVERS*13, ZVERSD*17, ZDATE*17, ZPROG*5, ZCOMPL*20,
1 ZNAME*20, ZTAPE*10, ZPROJ*13, REMRKS*31, ZTAPED*13
CBE** ********************** BBCINITA **********************************
CBB** ********************** BBCINITB **********************************
C**** INITIALIZE SECTION
DATA ZVERS, ZVERSD, ZDATE
1 /'VERSION 2.0 ', '82/08/02*18.33.46', '*NO DATE*TIME'/
DATA ZCOMPL, ZNAME, ZTAPE
1 /'*NONE SPECIFIED*', '*NO COMPANY NAME*', '*NO TAPE*'/
DATA ZPROJ, ZTAPED, ZPROG
1 /'*NO PROJECT*', '*NO TAPE DATE', 'XXXXX'/
DATA REMRKS /' '/
C**** THE FOLLOWING 9 COMMENT LINES (CZ01, CZ02, ...) CAN BE REPLACED
C**** FOR IDENTIFYING THE TEST ENVIRONMENT
C****
CZ01 ZVERS = 'VERSION OF THE COMPILER VALIDATION SYSTEM'
CZ02 ZVERSD = 'CREATION DATE/TIME OF THE COMPILER VALIDATION SYSTEM'
CZ03 ZPROG = 'PROGRAM NAME'
CZ04 ZDATE = 'DATE OF TEST'
CZ05 ZCOMPL = 'COMPILER IDENTIFICATION'
CZ06 ZPROJ = 'PROJECT NUMBER/IDENTIFICATION'
CZ07 ZNAME = 'NAME OF USER'
CZ08 ZTAPE = 'TAPE OWNER/ID'
CZ09 ZTAPED = 'DATE TAPE COPIED'
C
IVPASS = 0
IVFAIL = 0
IVDELE = 0
IVINSP = 0
IVTOTL = 0
IVTOTN = 0
ICZERO = 0
C
C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER.
I01 = 05
C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER.
I02 = 06
C
CX010 REPLACED BY FEXEC X-010 CONTROL CARD (CARD-READER UNIT NUMBER).
C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5
CX011 REPLACED BY FEXEC X-011 CONTROL CARD. CX011 IS FOR SYSTEMS
C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX010.
C
CX020 REPLACED BY FEXEC X-020 CONTROL CARD (PRINTER UNIT NUMBER).
C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02= 6
CX021 REPLACED BY FEXEC X-021 CONTROL CARD. CX021 IS FOR SYSTEMS
C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX020.
C
CBE** ********************** BBCINITB **********************************
NUVI = I02
IVTOTL = 45
ZPROG = 'FM801'
CBB** ********************** BBCHED0A **********************************
C****
C**** WRITE REPORT TITLE
C****
WRITE (I02, 90002)
WRITE (I02, 90006)
WRITE (I02, 90007)
WRITE (I02, 90008) ZVERS, ZVERSD
WRITE (I02, 90009) ZPROG, ZPROG
WRITE (I02, 90010) ZDATE, ZCOMPL
CBE** ********************** BBCHED0A **********************************
C*****
C***** HEADER FOR SEGMENT 155
WRITE (NUVI,15501)
15501 FORMAT (1H , // 1X,35HYDINT - (155) INTRINSIC FUNCTIONS--//16X,
1 38HDINT, DNINT, IDNINT (TYPE CONVERSION) //
2 17H ANS REF. - 15.3)
CBB** ********************** BBCHED0B **********************************
C**** WRITE DETAIL REPORT HEADERS
C****
WRITE (I02,90004)
WRITE (I02,90004)
WRITE (I02,90013)
WRITE (I02,90014)
WRITE (I02,90015) IVTOTL
CBE** ********************** BBCHED0B **********************************
C*****
C***** TEST OF DINT
C*****
WRITE(NUVI, 15502)
15502 FORMAT(// 8X, 12HTEST OF DINT)
CT001* TEST 1 THE VALUE ZERO
IVTNUM = 1
DNBVD = 0.0D0
DNAVD = DINT(DNBVD)
IF (DNAVD + 5.0D-10) 20010, 10010, 40010
40010 IF (DNAVD - 5.0D-10) 10010, 10010, 20010
10010 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0011
20010 IVFAIL = IVFAIL + 1
DVCORR = 0.0D0
WRITE (NUVI, 80031) IVTNUM, DNAVD, DVCORR
0011 CONTINUE
CT002* TEST 2 A VALUE IN (0,1)
IVTNUM = 2
DNBVD = 0.375D0
DNAVD = DINT(DNBVD)
IF (DNAVD + 5.0D-10) 20020, 10020, 40020
40020 IF (DNAVD - 5.0D-10) 10020, 10020, 20020
10020 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0021
20020 IVFAIL = IVFAIL + 1
DVCORR = 0.0D0
WRITE (NUVI, 80031) IVTNUM, DNAVD, DVCORR
0021 CONTINUE
CT003* TEST 3 THE VALUE 1
IVTNUM = 3
DNBVD = FLOAT(1)
DNAVD = DINT(DNBVD)
IF (DNAVD - 0.9999999995D0) 20030, 10030, 40030
40030 IF (DNAVD - 1.000000001D0) 10030, 10030, 20030
10030 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0031
20030 IVFAIL = IVFAIL + 1
DVCORR = 1.0D0
WRITE (NUVI, 80031) IVTNUM, DNAVD, DVCORR
0031 CONTINUE
CT004* TEST 4 AN INTEGRAL VALUE OTHER THAN 0, 1
IVTNUM = 4
DNBVD = FLOAT(6)
DNAVD = DINT(DNBVD)
IF (DNAVD - 5.999999997D0) 20040, 10040, 40040
40040 IF (DNAVD - 6.000000003D0) 10040, 10040, 20040
10040 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0041
20040 IVFAIL = IVFAIL + 1
DVCORR = 6.0D0
WRITE (NUVI, 80031) IVTNUM, DNAVD, DVCORR
0041 CONTINUE
CT005* TEST 5 A VALUE IN (X,X+1)
IVTNUM = 5
DNBVD = 0.375D1
DNAVD = DINT(DNBVD)
IF (DNAVD - 2.999999998D0) 20050, 10050, 40050
40050 IF (DNAVD - 3.000000002D0) 10050, 10050, 20050
10050 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0051
20050 IVFAIL = IVFAIL + 1
DVCORR = 0.3D1
WRITE (NUVI, 80031) IVTNUM, DNAVD, DVCORR
0051 CONTINUE
CT006* TEST 6 A NEGATIVE VALUE WITH MAGNITUDE IN (0,1)
IVTNUM = 6
DNBVD = -0.375D0
DNAVD = DINT(DNBVD)
IF (DNAVD + 5.0D-10) 20060, 10060, 40060
40060 IF (DNAVD - 5.0D-10) 10060, 10060, 20060
10060 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0061
20060 IVFAIL = IVFAIL + 1
DVCORR = 0.0D0
WRITE (NUVI, 80031) IVTNUM, DNAVD, DVCORR
0061 CONTINUE
CT007* TEST 7 THE VALUE -1
IVTNUM = 7
DNBVD = FLOAT(-1)
DNAVD = DINT(DNBVD)
IF (DNAVD + 1.000000001D0) 20070, 10070, 40070
40070 IF (DNAVD + 0.9999999995D0) 10070, 10070, 20070
10070 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0071
20070 IVFAIL = IVFAIL + 1
DVCORR = -1.0D0
WRITE (NUVI, 80031) IVTNUM, DNAVD, DVCORR
0071 CONTINUE
CT008* TEST 8 A NEGATIVE INTEGRAL VALUE
IVTNUM = 8
DNBVD = FLOAT(-6)
DNAVD = DINT(DNBVD)
IF (DNAVD + 6.000000003D0) 20080, 10080, 40080
40080 IF (DNAVD + 5.999999997D0) 10080, 10080, 20080
10080 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0081
20080 IVFAIL = IVFAIL + 1
DVCORR = -6.0D0
WRITE (NUVI, 80031) IVTNUM, DNAVD, DVCORR
0081 CONTINUE
CT009* TEST 9 A NEGATIVE VALUE WITH MAGNITUDE IN (X,X+1)
IVTNUM = 9
DNBVD = -0.375D1
DNAVD = DINT(DNBVD)
IF (DNAVD + 3.000000002D0) 20090, 10090, 40090
40090 IF (DNAVD + 2.999999998D0) 10090, 10090, 20090
10090 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0091
20090 IVFAIL = IVFAIL + 1
DVCORR = -0.3D1
WRITE (NUVI, 80031) IVTNUM, DNAVD, DVCORR
0091 CONTINUE
CT010* TEST 10 ZERO PREFIXED WITH A MINUS SIGN
IVTNUM = 10
DNBVD = 0.0D0
DNAVD = DINT(-DNBVD)
IF (DNAVD + 5.0D-10) 20100, 10100, 40100
40100 IF (DNAVD - 5.0D-10) 10100, 10100, 20100
10100 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0101
20100 IVFAIL = IVFAIL + 1
DVCORR = 0.0D0
WRITE (NUVI, 80031) IVTNUM, DNAVD, DVCORR
0101 CONTINUE
CT011* TEST 11 AN ARITHMETIC EXPRESSION PRESENTED TO FUNCTION
IVTNUM = 11
DNBVD = 0.375D1
DNAVD = DINT(DNBVD/0.375D0)
IF (DNAVD - 0.9999999995D1) 20110, 10110, 40110
40110 IF (DNAVD - 1.000000001D1) 10110, 10110, 20110
10110 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0111
20110 IVFAIL = IVFAIL + 1
DVCORR = 1.0D1
WRITE (NUVI, 80031) IVTNUM, DNAVD, DVCORR
0111 CONTINUE
C*****
WRITE (NUVI, 90002)
WRITE (NUVI, 90013)
WRITE (NUVI, 90014)
C*****
C***** TEST OF DNINT
C*****
WRITE(NUVI, 15504)
15504 FORMAT( // 8X, 13HTEST OF DNINT)
CT012* TEST 12 THE VALUE ZERO
IVTNUM = 12
DNBVD = 0.0D0
DNAVD = DNINT(DNBVD)
IF (DNAVD + 5.0D-10) 20120, 10120, 40120
40120 IF (DNAVD - 5.0D-10) 10120, 10120, 20120
10120 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0121
20120 IVFAIL = IVFAIL + 1
DVCORR = 0.0D0
WRITE (NUVI, 80031) IVTNUM, DNAVD, DVCORR
0121 CONTINUE
CT013* TEST 13 A VALUE IN (0,.5)
IVTNUM = 13
DNBVD = 0.25D0
DNAVD = DNINT(DNBVD)
IF (DNAVD + 5.0D-10) 20130, 10130, 40130
40130 IF (DNAVD - 5.0D-10) 10130, 10130, 20130
10130 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0131
20130 IVFAIL = IVFAIL + 1
DVCORR = 0.0D0
WRITE (NUVI, 80031) IVTNUM, DNAVD, DVCORR
0131 CONTINUE
CT014* TEST 14 THE VALUE 0.5
IVTNUM = 14
DNBVD = FLOAT(1) / FLOAT(2)
DNAVD = DNINT(DNBVD)
IF (DNAVD - 0.9999999995D0) 20140, 10140, 40140
40140 IF (DNAVD - 1.000000001D0) 10140, 10140, 20140
10140 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0141
20140 IVFAIL = IVFAIL + 1
DVCORR = 1.0D0
WRITE (NUVI, 80031) IVTNUM, DNAVD, DVCORR
0141 CONTINUE
CT015* TEST 15 A VALUE IN (.5,1)
IVTNUM = 15
DNBVD = 0.75D0
DNAVD = DNINT(DNBVD)
IF (DNAVD - 0.9999999995D0) 20150, 10150, 40150
40150 IF (DNAVD - 1.000000001D0) 10150, 10150, 20150
10150 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0151
20150 IVFAIL = IVFAIL + 1
DVCORR = 1.0D0
WRITE (NUVI, 80031) IVTNUM, DNAVD, DVCORR
0151 CONTINUE
CT016* TEST 16 AN INTEGRAL VALUE OTHER THAN 0, 1
IVTNUM = 16
DNBVD = FLOAT(5)
DNAVD = DNINT(DNBVD)
IF (DNAVD - 4.999999997D0) 20160, 10160, 40160
40160 IF (DNAVD - 5.000000003D0) 10160, 10160, 20160
10160 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0161
20160 IVFAIL = IVFAIL + 1
DVCORR = 5.0D0
WRITE (NUVI, 80031) IVTNUM, DNAVD, DVCORR
0161 CONTINUE
CT017* TEST 17 A VALUE IN (X,X+.5)
IVTNUM = 17
DNBVD = 10.46875D0
DNAVD = DNINT(DNBVD)
IF (DNAVD - 9.999999995D0) 20170, 10170, 40170
40170 IF (DNAVD - 10.00000001D0) 10170, 10170, 20170
10170 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0171
20170 IVFAIL = IVFAIL + 1
DVCORR = 10.0D0
WRITE (NUVI, 80031) IVTNUM, DNAVD, DVCORR
0171 CONTINUE
CT018* TEST 18 A VALUE WITH FRACTIONAL COMPONENT 0.5
IVTNUM = 18
DNBVD = FLOAT(15) + FLOAT(1) / FLOAT(2)
DNAVD = DNINT(DNBVD)
IF (DNAVD - 15.99999999D0) 20180, 10180, 40180
40180 IF (DNAVD - 16.00000001D0) 10180, 10180, 20180
10180 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0181
20180 IVFAIL = IVFAIL + 1
DVCORR = 16.0D0
WRITE (NUVI, 80031) IVTNUM, DNAVD, DVCORR
0181 CONTINUE
CT019* TEST 19 A VALUE IN (X+.5,X+1)
IVTNUM = 19
DNBVD = 27.96875D0
DNAVD = DNINT(DNBVD)
IF (DNAVD - 27.99999998D0) 20190, 10190, 40190
40190 IF (DNAVD - 28.00000002D0) 10190, 10190, 20190
10190 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0191
20190 IVFAIL = IVFAIL + 1
DVCORR = 28.0D0
WRITE (NUVI, 80031) IVTNUM, DNAVD, DVCORR
0191 CONTINUE
CT020* TEST 20 A NEGATIVE VALUE WITH MAGNITUDE IN (0,.5)
IVTNUM = 20
DNBVD = -0.25D0
DNAVD = DNINT(DNBVD)
IF (DNAVD + 5.0D-10) 20200, 10200, 40200
40200 IF (DNAVD - 5.0D-10) 10200, 10200, 20200
10200 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0201
20200 IVFAIL = IVFAIL + 1
DVCORR = 0.0D0
WRITE (NUVI, 80031) IVTNUM, DNAVD, DVCORR
0201 CONTINUE
CT021* TEST 21 THE VALUE -0.5
IVTNUM = 21
DNBVD = -FLOAT(1) / FLOAT(2)
DNAVD = DNINT(DNBVD)
IF (DNAVD + 1.000000001D0) 20210, 10210, 40210
40210 IF (DNAVD + 0.9999999995D0) 10210, 10210, 20210
10210 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0211
20210 IVFAIL = IVFAIL + 1
DVCORR = -1.0D0
WRITE (NUVI, 80031) IVTNUM, DNAVD, DVCORR
0211 CONTINUE
CT022* TEST 22 A NEGATIVE VALUE WITH MAGNITUDE IN (.5,1)
IVTNUM = 22
DNBVD = -0.75D0
DNAVD = DNINT(DNBVD)
IF (DNAVD + 1.000000001D0) 20220, 10220, 40220
40220 IF (DNAVD + 0.9999999995D0) 10220, 10220, 20220
10220 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0221
20220 IVFAIL = IVFAIL + 1
DVCORR = -1.0D0
WRITE (NUVI, 80031) IVTNUM, DNAVD, DVCORR
0221 CONTINUE
CT023* TEST 23 A NEGATIVE INTEGRAL VALUE
IVTNUM = 23
DNBVD = -FLOAT(5)
DNAVD = DNINT(DNBVD)
IF (DNAVD + 5.000000003D0) 20230, 10230, 40230
40230 IF (DNAVD + 4.999999997D0) 10230, 10230, 20230
10230 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0231
20230 IVFAIL = IVFAIL + 1
DVCORR = -5.0D0
WRITE (NUVI, 80031) IVTNUM, DNAVD, DVCORR
0231 CONTINUE
CT024* TEST 24 A NEGATIVE VALUE WITH MAGNITUDE IN (X,X+.5)
IVTNUM = 24
DNBVD = -10.46875D0
DNAVD = DNINT(DNBVD)
IF (DNAVD + 10.00000001D0) 20240, 10240, 40240
40240 IF (DNAVD + 9.999999995D0) 10240, 10240, 20240
10240 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0241
20240 IVFAIL = IVFAIL + 1
DVCORR = -10.0D0
WRITE (NUVI, 80031) IVTNUM, DNAVD, DVCORR
0241 CONTINUE
CT025* TEST 25 A NEGATIVE VALUE WITH FRACTIONAL COMPONENT 0.5
IVTNUM = 25
DNBVD = FLOAT(-15) - FLOAT(1) / FLOAT(2)
DNAVD = DNINT(DNBVD)
IF (DNAVD + 16.00000001D0) 20250, 10250, 40250
40250 IF (DNAVD + 15.99999999D0) 10250, 10250, 20250
10250 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0251
20250 IVFAIL = IVFAIL + 1
DVCORR = -16.0D0
WRITE (NUVI, 80031) IVTNUM, DNAVD, DVCORR
0251 CONTINUE
CT026* TEST 26 A NEGATIVE VALUE WITH MAGNITUDE IN (X+.5,X+1)
IVTNUM = 26
DNBVD = -27.96875D0
DNAVD = DNINT(DNBVD)
IF (DNAVD + 28.00000002D0) 20260, 10260, 40260
40260 IF (DNAVD + 27.99999998D0) 10260, 10260, 20260
10260 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0261
20260 IVFAIL = IVFAIL + 1
DVCORR = -28.0D0
WRITE (NUVI, 80031) IVTNUM, DNAVD, DVCORR
0261 CONTINUE
CT027* TEST 27 ZERO PREFIXED WITH A MINUS SIGN
IVTNUM = 27
DNBVD = 0.0D0
DNAVD = DNINT(-DNBVD)
IF (DNAVD + 5.0D-10) 20270, 10270, 40270
40270 IF (DNAVD - 5.0D-10) 10270, 10270, 20270
10270 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0271
20270 IVFAIL = IVFAIL + 1
DVCORR = 0.0D0
WRITE (NUVI, 80031) IVTNUM, DNAVD, DVCORR
0271 CONTINUE
CT028* TEST 28 AN ARITHMETIC EXPRESSION PRESENTED TO FUNCTION
IVTNUM = 28
DNBVD = 8.00D0
DNDVD = 7.25D0
DNAVD = DNINT(DNBVD - DNDVD)
IF (DNAVD - 0.9999999995D0) 20280, 10280, 40280
40280 IF (DNAVD - 1.000000001D0) 10280, 10280, 20280
10280 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0281
20280 IVFAIL = IVFAIL + 1
DVCORR = 1.0D0
WRITE (NUVI, 80031) IVTNUM, DNAVD, DVCORR
0281 CONTINUE
C*****
WRITE (NUVI, 90002)
WRITE (NUVI, 90013)
WRITE (NUVI, 90014)
C*****
C***** TEST OF IDNINT
C*****
C*****
WRITE(NUVI, 15506)
15506 FORMAT( // 8X, 14HTEST OF IDNINT)
CT029* TEST 29 THE VALUE ZERO
IVTNUM = 29
DNBVD = 0.0D0
INAVI = IDNINT(DNBVD)
IF (INAVI - 0) 20290, 10290, 20290
10290 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0291
20290 IVFAIL = IVFAIL + 1
IVCORR = 0
WRITE (NUVI, 80010) IVTNUM, INAVI, IVCORR
0291 CONTINUE
CT030* TEST 30 A VALUE IN (0.,5)
IVTNUM = 30
DNBVD = 0.25D0
INAVI = IDNINT(DNBVD)
IF (INAVI - 0) 20300, 10300, 20300
10300 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0301
20300 IVFAIL = IVFAIL + 1
IVCORR = 0
WRITE (NUVI, 80010) IVTNUM, INAVI, IVCORR
0301 CONTINUE
CT031* TEST 31 THE VALUE 0.5
IVTNUM = 31
DNBVD = FLOAT(1) / FLOAT(2)
INAVI = IDNINT(DNBVD)
IF (INAVI - 1) 20310, 10310, 20310
10310 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0311
20310 IVFAIL = IVFAIL + 1
IVCORR = 1
WRITE (NUVI, 80010) IVTNUM, INAVI, IVCORR
0311 CONTINUE
CT032* TEST 32 A VALUE IN (.5,1)
IVTNUM = 32
DNBVD = 0.75D0
INAVI = IDNINT(DNBVD)
IF (INAVI - 1) 20320, 10320, 20320
10320 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0321
20320 IVFAIL = IVFAIL + 1
IVCORR = 1
WRITE (NUVI, 80010) IVTNUM, INAVI, IVCORR
0321 CONTINUE
CT033* TEST 33 AN INTEGRAL VALUE OTHER THAN 0, 1
IVTNUM = 33
DNBVD = FLOAT(5)
INAVI = IDNINT(DNBVD)
IF (INAVI - 5) 20330, 10330, 20330
10330 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0331
20330 IVFAIL = IVFAIL + 1
IVCORR = 5
WRITE (NUVI, 80010) IVTNUM, INAVI, IVCORR
0331 CONTINUE
CT034* TEST 34 A VALUE IN (X,X+.5)
IVTNUM = 34
DNBVD = 10.46875D0
INAVI = IDNINT(DNBVD)
IF (INAVI - 10) 20340, 10340, 20340
10340 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0341
20340 IVFAIL = IVFAIL + 1
IVCORR = 10
WRITE (NUVI, 80010) IVTNUM, INAVI, IVCORR
0341 CONTINUE
CT035* TEST 35 A VALUE WITH FRACTIONAL COMPONENT 0.5
IVTNUM = 35
DNBVD = FLOAT(15) + FLOAT(1) / FLOAT(2)
INAVI = IDNINT(DNBVD)
IF (INAVI - 16) 20350, 10350, 20350
10350 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0351
20350 IVFAIL = IVFAIL + 1
IVCORR = 16
WRITE (NUVI, 80010) IVTNUM, INAVI, IVCORR
0351 CONTINUE
CT036* TEST 36 A VALUE IN (X+.5,X+1)
IVTNUM = 36
DNBVD = 27.96875D0
INAVI = IDNINT(DNBVD)
IF (INAVI - 28) 20360, 10360, 20360
10360 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0361
20360 IVFAIL = IVFAIL + 1
IVCORR = 28
WRITE (NUVI, 80010) IVTNUM, INAVI, IVCORR
0361 CONTINUE
CT037* TEST 37 A NEGATIVE VALUE WITH MAGNITUDE IN (0,.5)
IVTNUM = 37
DNBVD = -0.25D0
INAVI = IDNINT(DNBVD)
IF (INAVI - 0) 20370, 10370, 20370
10370 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0371
20370 IVFAIL = IVFAIL + 1
IVCORR = 0
WRITE (NUVI, 80010) IVTNUM, INAVI, IVCORR
0371 CONTINUE
CT038* TEST 38 THE VALUE -0.5
IVTNUM = 38
DNBVD = -FLOAT(1) / FLOAT(2)
INAVI = IDNINT(DNBVD)
IF (INAVI + 1) 20380, 10380, 20380
10380 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0381
20380 IVFAIL = IVFAIL + 1
IVCORR = -1
WRITE (NUVI, 80010) IVTNUM, INAVI, IVCORR
0381 CONTINUE
CT039* TEST 39 A NEGATIVE VALUE WITH MAGNITUDE IN (.5,1)
IVTNUM = 39
DNBVD = -0.75D0
INAVI = IDNINT(DNBVD)
IF (INAVI + 1) 20390, 10390, 20390
10390 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0391
20390 IVFAIL = IVFAIL + 1
IVCORR = -1
WRITE (NUVI, 80010) IVTNUM, INAVI, IVCORR
0391 CONTINUE
CT040* TEST 40 A NEGATIVE INTEGRAL VALUE
IVTNUM = 40
DNBVD = -FLOAT(5)
INAVI = IDNINT(DNBVD)
IF (INAVI + 5) 20400, 10400, 20400
10400 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0401
20400 IVFAIL = IVFAIL + 1
IVCORR = -5
WRITE (NUVI, 80010) IVTNUM, INAVI, IVCORR
0401 CONTINUE
CT041* TEST 41 A NEGATIVE VALUE WITH MAGNITUDE IN (X,X+.5)
IVTNUM = 41
DNBVD = -10.46875D0
INAVI = IDNINT(DNBVD)
IF (INAVI + 10) 20410, 10410, 20410
10410 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0411
20410 IVFAIL = IVFAIL + 1
IVCORR = -10
WRITE (NUVI, 80010) IVTNUM, INAVI, IVCORR
0411 CONTINUE
CT042* TEST 42 A NEGATIVE VALUE WITH FRACTIONAL COMPONENT 0.5
IVTNUM = 42
DNBVD = FLOAT(-15) - FLOAT(1) /FLOAT(2)
INAVI = IDNINT(DNBVD)
IF (INAVI + 16) 20420, 10420, 20420
10420 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0421
20420 IVFAIL = IVFAIL + 1
IVCORR = -16
WRITE (NUVI, 80010) IVTNUM, INAVI, IVCORR
0421 CONTINUE
CT043* TEST 43 A NEGATIVE VALUE WITH MAGNITUDE IN (X+.5,X+1)
IVTNUM = 43
DNBVD = -27.96875D0
INAVI = IDNINT(DNBVD)
IF (INAVI + 28) 20430, 10430, 20430
10430 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0431
20430 IVFAIL = IVFAIL + 1
IVCORR = -28
WRITE (NUVI, 80010) IVTNUM, INAVI, IVCORR
0431 CONTINUE
CT044* TEST 44 ZERO PREFIXED WITH A MINUS SIGN
IVTNUM = 44
DNBVD = 0.0D0
INAVI = IDNINT(-DNBVD)
IF (INAVI - 0) 20440, 10440, 20440
10440 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0441
20440 IVFAIL = IVFAIL + 1
IVCORR = 0
WRITE (NUVI, 80010) IVTNUM, INAVI, IVCORR
0441 CONTINUE
CT045* TEST 45 AN ARITHMETIC EXPRESSION PRESENTED TO FUNCTION
IVTNUM = 45
DNBVD = 8.00D0
DNDVD = 7.25D0
INAVI = IDNINT(DNBVD - DNDVD)
IF (INAVI - 1) 20450, 10450, 20450
10450 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0451
20450 IVFAIL = IVFAIL + 1
IVCORR = 1
WRITE (NUVI, 80010) IVTNUM, INAVI, IVCORR
0451 CONTINUE
C*****
CBB** ********************** BBCSUM0 **********************************
C**** WRITE OUT TEST SUMMARY
C****
IVTOTN = IVPASS + IVFAIL + IVDELE + IVINSP
WRITE (I02, 90004)
WRITE (I02, 90014)
WRITE (I02, 90004)
WRITE (I02, 90020) IVPASS
WRITE (I02, 90022) IVFAIL
WRITE (I02, 90024) IVDELE
WRITE (I02, 90026) IVINSP
WRITE (I02, 90028) IVTOTN, IVTOTL
CBE** ********************** BBCSUM0 **********************************
CBB** ********************** BBCFOOT0 **********************************
C**** WRITE OUT REPORT FOOTINGS
C****
WRITE (I02,90016) ZPROG, ZPROG
WRITE (I02,90018) ZPROJ, ZNAME, ZTAPE, ZTAPED
WRITE (I02,90019)
CBE** ********************** BBCFOOT0 **********************************
CBB** ********************** BBCFMT0A **********************************
C**** FORMATS FOR TEST DETAIL LINES
C****
80000 FORMAT (1H ,2X,I3,4X,7HDELETED,32X,A31)
80002 FORMAT (1H ,2X,I3,4X,7H PASS ,32X,A31)
80004 FORMAT (1H ,2X,I3,4X,7HINSPECT,32X,A31)
80008 FORMAT (1H ,2X,I3,4X,7H FAIL ,32X,A31)
80010 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,15X,10HCOMPUTED= ,
1I6,/,1H ,15X,10HCORRECT= ,I6)
80012 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
1E12.5,/,1H ,16X,10HCORRECT= ,E12.5)
80018 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
1A21,/,1H ,16X,10HCORRECT= ,A21)
80020 FORMAT (1H ,16X,10HCOMPUTED= ,A21,1X,A31)
80022 FORMAT (1H ,16X,10HCORRECT= ,A21,1X,A31)
80024 FORMAT (1H ,16X,10HCOMPUTED= ,I6,16X,A31)
80026 FORMAT (1H ,16X,10HCORRECT= ,I6,16X,A31)
80028 FORMAT (1H ,16X,10HCOMPUTED= ,E12.5,10X,A31)
80030 FORMAT (1H ,16X,10HCORRECT= ,E12.5,10X,A31)
80050 FORMAT (1H ,48X,A31)
CBE** ********************** BBCFMT0A **********************************
CBB** ********************** BBCFMAT1 **********************************
C**** FORMATS FOR TEST DETAIL LINES - FULL LANGUAGE
C****
80031 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
1D17.10,/,1H ,16X,10HCORRECT= ,D17.10)
80033 FORMAT (1H ,16X,10HCOMPUTED= ,D17.10,10X,A31)
80035 FORMAT (1H ,16X,10HCORRECT= ,D17.10,10X,A31)
80037 FORMAT (1H ,16X,10HCOMPUTED= ,1H(,E12.5,2H, ,E12.5,1H),6X,A31)
80039 FORMAT (1H ,16X,10HCORRECT= ,1H(,E12.5,2H, ,E12.5,1H),6X,A31)
80041 FORMAT (1H ,16X,10HCOMPUTED= ,1H(,F12.5,2H, ,F12.5,1H),6X,A31)
80043 FORMAT (1H ,16X,10HCORRECT= ,1H(,F12.5,2H, ,F12.5,1H),6X,A31)
80045 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
11H(,F12.5,2H, ,F12.5,1H)/,1H ,16X,10HCORRECT= ,
21H(,F12.5,2H, ,F12.5,1H))
CBE** ********************** BBCFMAT1 **********************************
CBB** ********************** BBCFMT0B **********************************
C**** FORMAT STATEMENTS FOR PAGE HEADERS
C****
90002 FORMAT (1H1)
90004 FORMAT (1H )
90006 FORMAT (1H ,20X,31HFEDERAL SOFTWARE TESTING CENTER)
90007 FORMAT (1H ,19X,34HFORTRAN COMPILER VALIDATION SYSTEM)
90008 FORMAT (1H ,21X,A13,A17)
90009 FORMAT (1H ,/,2H *,A5,6HBEGIN*,12X,15HTEST RESULTS - ,A5,/)
90010 FORMAT (1H ,8X,16HTEST DATE*TIME= ,A17,15H - COMPILER= ,A20)
90013 FORMAT (1H ,8H TEST ,10HPASS/FAIL ,6X,17HDISPLAYED RESULTS,
1 7X,7HREMARKS,24X)
90014 FORMAT (1H ,46H----------------------------------------------,
1 33H---------------------------------)
90015 FORMAT (1H ,48X,17HTHIS PROGRAM HAS ,I3,6H TESTS,/)
C****
C**** FORMAT STATEMENTS FOR REPORT FOOTINGS
C****
90016 FORMAT (1H ,/,2H *,A5,4HEND*,14X,14HEND OF TEST - ,A5,/)
90018 FORMAT (1H ,A13,13X,A20,7H * ,A10,1H/,
1 A13)
90019 FORMAT (1H ,26HFOR OFFICIAL USE ONLY ,35X,15HCOPYRIGHT 1982)
C****
C**** FORMAT STATEMENTS FOR RUN SUMMARY
C****
90020 FORMAT (1H ,21X,I5,13H TESTS PASSED)
90022 FORMAT (1H ,21X,I5,13H TESTS FAILED)
90024 FORMAT (1H ,21X,I5,14H TESTS DELETED)
90026 FORMAT (1H ,21X,I5,25H TESTS REQUIRE INSPECTION)
90028 FORMAT (1H ,21X,I5,4H OF ,I3,15H TESTS EXECUTED)
CBE** ********************** BBCFMT0B **********************************
C*****
C***** END OF TEST SEGMENT 155
STOP
END
*END-OF,FM801
FM802.f 481036463 170 2 100666 11385 `
*HEADER,FORTR,FM802
*FILES1,FORTR,FM802,X
C***********************************************************************
C***** FORTRAN 77
C***** FM802 YDABS - (157)
C*****
C***********************************************************************
C***** GENERAL PURPOSE ANS REF
C***** TEST INTRINSIC FUNCTION DABS (ABSOLUTE VALUE OF 15.3
C***** A DOUBLE PRECISION ARGUMENT) (TABLE 5)
CBB** ********************** BBCCOMNT **********************************
C****
C**** 1978 FORTRAN COMPILER VALIDATION SYSTEM
C**** VERSION 2.0
C****
C****
C**** SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO
C**** GENERAL SERVICES ADMINISTRATION
C**** FEDERAL SOFTWARE TESTING CENTER
C**** 5203 LEESBURG PIKE, SUITE 1100
C**** FALLS CHURCH, VA. 22041
C****
C**** (703) 756-6153
C****
CBE** ********************** BBCCOMNT **********************************
C*****
C***** S P E C I F I C A T I O N S SEGMENT 157
DOUBLE PRECISION DOAVD, DOBVD, DODVD, DOEVD, DVCORR
C*****
CBB** ********************** BBCINITA **********************************
C**** SPECIFICATION STATEMENTS
C****
CHARACTER ZVERS*13, ZVERSD*17, ZDATE*17, ZPROG*5, ZCOMPL*20,
1 ZNAME*20, ZTAPE*10, ZPROJ*13, REMRKS*31, ZTAPED*13
CBE** ********************** BBCINITA **********************************
CBB** ********************** BBCINITB **********************************
C**** INITIALIZE SECTION
DATA ZVERS, ZVERSD, ZDATE
1 /'VERSION 2.0 ', '82/08/02*18.33.46', '*NO DATE*TIME'/
DATA ZCOMPL, ZNAME, ZTAPE
1 /'*NONE SPECIFIED*', '*NO COMPANY NAME*', '*NO TAPE*'/
DATA ZPROJ, ZTAPED, ZPROG
1 /'*NO PROJECT*', '*NO TAPE DATE', 'XXXXX'/
DATA REMRKS /' '/
C**** THE FOLLOWING 9 COMMENT LINES (CZ01, CZ02, ...) CAN BE REPLACED
C**** FOR IDENTIFYING THE TEST ENVIRONMENT
C****
CZ01 ZVERS = 'VERSION OF THE COMPILER VALIDATION SYSTEM'
CZ02 ZVERSD = 'CREATION DATE/TIME OF THE COMPILER VALIDATION SYSTEM'
CZ03 ZPROG = 'PROGRAM NAME'
CZ04 ZDATE = 'DATE OF TEST'
CZ05 ZCOMPL = 'COMPILER IDENTIFICATION'
CZ06 ZPROJ = 'PROJECT NUMBER/IDENTIFICATION'
CZ07 ZNAME = 'NAME OF USER'
CZ08 ZTAPE = 'TAPE OWNER/ID'
CZ09 ZTAPED = 'DATE TAPE COPIED'
C
IVPASS = 0
IVFAIL = 0
IVDELE = 0
IVINSP = 0
IVTOTL = 0
IVTOTN = 0
ICZERO = 0
C
C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER.
I01 = 05
C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER.
I02 = 06
C
CX010 REPLACED BY FEXEC X-010 CONTROL CARD (CARD-READER UNIT NUMBER).
C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5
CX011 REPLACED BY FEXEC X-011 CONTROL CARD. CX011 IS FOR SYSTEMS
C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX010.
C
CX020 REPLACED BY FEXEC X-020 CONTROL CARD (PRINTER UNIT NUMBER).
C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02= 6
CX021 REPLACED BY FEXEC X-021 CONTROL CARD. CX021 IS FOR SYSTEMS
C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX020.
C
CBE** ********************** BBCINITB **********************************
NUVI = I02
IVTOTL = 6
ZPROG = 'FM802'
CBB** ********************** BBCHED0A **********************************
C****
C**** WRITE REPORT TITLE
C****
WRITE (I02, 90002)
WRITE (I02, 90006)
WRITE (I02, 90007)
WRITE (I02, 90008) ZVERS, ZVERSD
WRITE (I02, 90009) ZPROG, ZPROG
WRITE (I02, 90010) ZDATE, ZCOMPL
CBE** ********************** BBCHED0A **********************************
C*****
C***** HEADER FOR SEGMENT 157 WRITTEN
WRITE (NUVI,15701)
15701 FORMAT (1H //1X,34HYDABS - (157) INTRINSIC FUNCTION--//16X,
1 23HDABS (ABSOLUTE VALUE ) // 2X,
2 15HANS REF. - 15.3)
CBB** ********************** BBCHED0B **********************************
C**** WRITE DETAIL REPORT HEADERS
C****
WRITE (I02,90004)
WRITE (I02,90004)
WRITE (I02,90013)
WRITE (I02,90014)
WRITE (I02,90015) IVTOTL
CBE** ********************** BBCHED0B **********************************
C*****
CT001* TEST 1 THE VALUE ZERO
IVTNUM = 1
DOBVD = 0.0D0
DOAVD = DABS(DOBVD)
IF (DOAVD + 5.0D-10) 20010, 10010, 40010
40010 IF (DOAVD - 5.0D-10) 10010, 10010, 20010
10010 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0011
20010 IVFAIL = IVFAIL + 1
DVCORR = 0.0D0
WRITE(NUVI, 80031) IVTNUM, DOAVD, DVCORR
0011 CONTINUE
CT002* TEST 2 ZERO PREFIXED WITH A MINUS SIGN
IVTNUM = 2
DOBVD = 0.0D0
DOAVD = DABS(-DOBVD)
IF (DOAVD + 5.0D-10) 20020, 10020, 40020
40020 IF (DOAVD - 5.0D-10) 10020, 10020, 20020
10020 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0021
20020 IVFAIL = IVFAIL + 1
DVCORR = 0.0D1
WRITE(NUVI, 80031) IVTNUM, DOAVD, DVCORR
0021 CONTINUE
CT003* TEST 3 A POSITIVE NON-INTEGRAL VALUE
IVTNUM = 3
DOBVD = 0.35875D2
DOAVD = DABS(DOBVD)
IF (DOAVD - 0.3587499998D2) 20030, 10030, 40030
40030 IF (DOAVD - 0.3587500002D2) 10030, 10030, 20030
10030 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0031
20030 IVFAIL = IVFAIL + 1
DVCORR = 0.35875D2
WRITE(NUVI, 80031) IVTNUM, DOAVD, DVCORR
0031 CONTINUE
CT004* TEST 4 A NEGATIVE NON-INTEGRAL VALUE
IVTNUM = 4
DOBVD = -0.35875D2
DOAVD = DABS(DOBVD)
IF (DOAVD - 0.3587499998D2) 20040, 10040, 40040
40040 IF (DOAVD - 0.3587500002D2) 10040, 10040, 20040
10040 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0041
20040 IVFAIL = IVFAIL + 1
DVCORR = 0.35875D2
WRITE(NUVI, 80031) IVTNUM, DOAVD, DVCORR
0041 CONTINUE
CT005* TEST 5 A POSITIVE INTEGRAL VALUE
IVTNUM = 5
DOBVD = 7.0D1
DOAVD = DABS(DOBVD)
IF (DOAVD - 6.999999996D1) 20050, 10050, 40050
40050 IF (DOAVD - 7.000000004D1) 10050, 10050, 20050
10050 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0051
20050 IVFAIL = IVFAIL + 1
DVCORR = 7.0D1
WRITE(NUVI, 80031) IVTNUM, DOAVD, DVCORR
0051 CONTINUE
CT006* TEST 6 ARITHMETIC EXPRESSION PRESENTED TO FUNCTION
IVTNUM = 6
DODVD = 2.625D0
DOEVD = 3.0D0
DOAVD = DABS((-DODVD) - DOEVD ** 3)
IF (DOAVD - 29.62499998D0) 20060, 10060, 40060
40060 IF (DOAVD - 29.62500002D0) 10060, 10060, 20060
10060 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0061
20060 IVFAIL = IVFAIL + 1
DVCORR = 29.625D0
WRITE(NUVI, 80031) IVTNUM, DOAVD, DVCORR
0061 CONTINUE
C*****
CBB** ********************** BBCSUM0 **********************************
C**** WRITE OUT TEST SUMMARY
C****
IVTOTN = IVPASS + IVFAIL + IVDELE + IVINSP
WRITE (I02, 90004)
WRITE (I02, 90014)
WRITE (I02, 90004)
WRITE (I02, 90020) IVPASS
WRITE (I02, 90022) IVFAIL
WRITE (I02, 90024) IVDELE
WRITE (I02, 90026) IVINSP
WRITE (I02, 90028) IVTOTN, IVTOTL
CBE** ********************** BBCSUM0 **********************************
CBB** ********************** BBCFOOT0 **********************************
C**** WRITE OUT REPORT FOOTINGS
C****
WRITE (I02,90016) ZPROG, ZPROG
WRITE (I02,90018) ZPROJ, ZNAME, ZTAPE, ZTAPED
WRITE (I02,90019)
CBE** ********************** BBCFOOT0 **********************************
CBB** ********************** BBCFMT0A **********************************
C**** FORMATS FOR TEST DETAIL LINES
C****
80000 FORMAT (1H ,2X,I3,4X,7HDELETED,32X,A31)
80002 FORMAT (1H ,2X,I3,4X,7H PASS ,32X,A31)
80004 FORMAT (1H ,2X,I3,4X,7HINSPECT,32X,A31)
80008 FORMAT (1H ,2X,I3,4X,7H FAIL ,32X,A31)
80010 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,15X,10HCOMPUTED= ,
1I6,/,1H ,15X,10HCORRECT= ,I6)
80012 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
1E12.5,/,1H ,16X,10HCORRECT= ,E12.5)
80018 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
1A21,/,1H ,16X,10HCORRECT= ,A21)
80020 FORMAT (1H ,16X,10HCOMPUTED= ,A21,1X,A31)
80022 FORMAT (1H ,16X,10HCORRECT= ,A21,1X,A31)
80024 FORMAT (1H ,16X,10HCOMPUTED= ,I6,16X,A31)
80026 FORMAT (1H ,16X,10HCORRECT= ,I6,16X,A31)
80028 FORMAT (1H ,16X,10HCOMPUTED= ,E12.5,10X,A31)
80030 FORMAT (1H ,16X,10HCORRECT= ,E12.5,10X,A31)
80050 FORMAT (1H ,48X,A31)
CBE** ********************** BBCFMT0A **********************************
CBB** ********************** BBCFMAT1 **********************************
C**** FORMATS FOR TEST DETAIL LINES - FULL LANGUAGE
C****
80031 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
1D17.10,/,1H ,16X,10HCORRECT= ,D17.10)
80033 FORMAT (1H ,16X,10HCOMPUTED= ,D17.10,10X,A31)
80035 FORMAT (1H ,16X,10HCORRECT= ,D17.10,10X,A31)
80037 FORMAT (1H ,16X,10HCOMPUTED= ,1H(,E12.5,2H, ,E12.5,1H),6X,A31)
80039 FORMAT (1H ,16X,10HCORRECT= ,1H(,E12.5,2H, ,E12.5,1H),6X,A31)
80041 FORMAT (1H ,16X,10HCOMPUTED= ,1H(,F12.5,2H, ,F12.5,1H),6X,A31)
80043 FORMAT (1H ,16X,10HCORRECT= ,1H(,F12.5,2H, ,F12.5,1H),6X,A31)
80045 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
11H(,F12.5,2H, ,F12.5,1H)/,1H ,16X,10HCORRECT= ,
21H(,F12.5,2H, ,F12.5,1H))
CBE** ********************** BBCFMAT1 **********************************
CBB** ********************** BBCFMT0B **********************************
C**** FORMAT STATEMENTS FOR PAGE HEADERS
C****
90002 FORMAT (1H1)
90004 FORMAT (1H )
90006 FORMAT (1H ,20X,31HFEDERAL SOFTWARE TESTING CENTER)
90007 FORMAT (1H ,19X,34HFORTRAN COMPILER VALIDATION SYSTEM)
90008 FORMAT (1H ,21X,A13,A17)
90009 FORMAT (1H ,/,2H *,A5,6HBEGIN*,12X,15HTEST RESULTS - ,A5,/)
90010 FORMAT (1H ,8X,16HTEST DATE*TIME= ,A17,15H - COMPILER= ,A20)
90013 FORMAT (1H ,8H TEST ,10HPASS/FAIL ,6X,17HDISPLAYED RESULTS,
1 7X,7HREMARKS,24X)
90014 FORMAT (1H ,46H----------------------------------------------,
1 33H---------------------------------)
90015 FORMAT (1H ,48X,17HTHIS PROGRAM HAS ,I3,6H TESTS,/)
C****
C**** FORMAT STATEMENTS FOR REPORT FOOTINGS
C****
90016 FORMAT (1H ,/,2H *,A5,4HEND*,14X,14HEND OF TEST - ,A5,/)
90018 FORMAT (1H ,A13,13X,A20,7H * ,A10,1H/,
1 A13)
90019 FORMAT (1H ,26HFOR OFFICIAL USE ONLY ,35X,15HCOPYRIGHT 1982)
C****
C**** FORMAT STATEMENTS FOR RUN SUMMARY
C****
90020 FORMAT (1H ,21X,I5,13H TESTS PASSED)
90022 FORMAT (1H ,21X,I5,13H TESTS FAILED)
90024 FORMAT (1H ,21X,I5,14H TESTS DELETED)
90026 FORMAT (1H ,21X,I5,25H TESTS REQUIRE INSPECTION)
90028 FORMAT (1H ,21X,I5,4H OF ,I3,15H TESTS EXECUTED)
CBE** ********************** BBCFMT0B **********************************
C*****
C***** END OF TEST SEGMENT 157
STOP
END
*END-OF,FM802
FM803.f 481036466 170 2 100666 12505 `
*HEADER,FORTR,FM803
*FILES1,FORTR,FM803,X
C***********************************************************************
C***** FORTRAN 77
C***** FM803 YCABS - (158)
C*****
C***********************************************************************
C***** GENERAL PURPOSE ANS REF
C***** TEST INTRINSIC FUNCTION CABS (ABSOLUTE VALUE OF 15.3
C***** A COMPLEX ARGUMENT) (TABLE 5)
C*****
CBB** ********************** BBCCOMNT **********************************
C****
C**** 1978 FORTRAN COMPILER VALIDATION SYSTEM
C**** VERSION 2.0
C****
C****
C**** SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO
C**** GENERAL SERVICES ADMINISTRATION
C**** FEDERAL SOFTWARE TESTING CENTER
C**** 5203 LEESBURG PIKE, SUITE 1100
C**** FALLS CHURCH, VA. 22041
C****
C**** (703) 756-6153
C****
CBE** ********************** BBCCOMNT **********************************
C*****
C***** S P E C I F I C A T I O N S SEGMENT 158
COMPLEX CPAVC
C*****
CBB** ********************** BBCINITA **********************************
C**** SPECIFICATION STATEMENTS
C****
CHARACTER ZVERS*13, ZVERSD*17, ZDATE*17, ZPROG*5, ZCOMPL*20,
1 ZNAME*20, ZTAPE*10, ZPROJ*13, REMRKS*31, ZTAPED*13
CBE** ********************** BBCINITA **********************************
CBB** ********************** BBCINITB **********************************
C**** INITIALIZE SECTION
DATA ZVERS, ZVERSD, ZDATE
1 /'VERSION 2.0 ', '82/08/02*18.33.46', '*NO DATE*TIME'/
DATA ZCOMPL, ZNAME, ZTAPE
1 /'*NONE SPECIFIED*', '*NO COMPANY NAME*', '*NO TAPE*'/
DATA ZPROJ, ZTAPED, ZPROG
1 /'*NO PROJECT*', '*NO TAPE DATE', 'XXXXX'/
DATA REMRKS /' '/
C**** THE FOLLOWING 9 COMMENT LINES (CZ01, CZ02, ...) CAN BE REPLACED
C**** FOR IDENTIFYING THE TEST ENVIRONMENT
C****
CZ01 ZVERS = 'VERSION OF THE COMPILER VALIDATION SYSTEM'
CZ02 ZVERSD = 'CREATION DATE/TIME OF THE COMPILER VALIDATION SYSTEM'
CZ03 ZPROG = 'PROGRAM NAME'
CZ04 ZDATE = 'DATE OF TEST'
CZ05 ZCOMPL = 'COMPILER IDENTIFICATION'
CZ06 ZPROJ = 'PROJECT NUMBER/IDENTIFICATION'
CZ07 ZNAME = 'NAME OF USER'
CZ08 ZTAPE = 'TAPE OWNER/ID'
CZ09 ZTAPED = 'DATE TAPE COPIED'
C
IVPASS = 0
IVFAIL = 0
IVDELE = 0
IVINSP = 0
IVTOTL = 0
IVTOTN = 0
ICZERO = 0
C
C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER.
I01 = 05
C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER.
I02 = 06
C
CX010 REPLACED BY FEXEC X-010 CONTROL CARD (CARD-READER UNIT NUMBER).
C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5
CX011 REPLACED BY FEXEC X-011 CONTROL CARD. CX011 IS FOR SYSTEMS
C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX010.
C
CX020 REPLACED BY FEXEC X-020 CONTROL CARD (PRINTER UNIT NUMBER).
C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02= 6
CX021 REPLACED BY FEXEC X-021 CONTROL CARD. CX021 IS FOR SYSTEMS
C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX020.
C
CBE** ********************** BBCINITB **********************************
NUVI = I02
IVTOTL = 9
ZPROG = 'FM803'
CBB** ********************** BBCHED0A **********************************
C****
C**** WRITE REPORT TITLE
C****
WRITE (I02, 90002)
WRITE (I02, 90006)
WRITE (I02, 90007)
WRITE (I02, 90008) ZVERS, ZVERSD
WRITE (I02, 90009) ZPROG, ZPROG
WRITE (I02, 90010) ZDATE, ZCOMPL
CBE** ********************** BBCHED0A **********************************
C*****
C***** HEADER FOR SEGMENT 158 WRITTEN
WRITE (NUVI,15801)
15801 FORMAT (1H , //1X,34HYCABS - (158) INTRINSIC FUNCTION--//16X,
1 21HCABS (ABSOLUTE VALUE)//2X,
2 15HANS REF. - 15.3)
CBB** ********************** BBCHED0B **********************************
C**** WRITE DETAIL REPORT HEADERS
C****
WRITE (I02,90004)
WRITE (I02,90004)
WRITE (I02,90013)
WRITE (I02,90014)
WRITE (I02,90015) IVTOTL
CBE** ********************** BBCHED0B **********************************
C*****
CT001* TEST 1 COMPLEX VALUE ZERO (0,0)
IVTNUM = 1
RPAVS = CABS((0.0, 0.0))
IF (RPAVS + .00005) 20010, 10010, 40010
40010 IF (RPAVS - .00005) 10010, 10010, 20010
10010 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0011
20010 IVFAIL = IVFAIL + 1
RVCORR = 0.0
WRITE (NUVI, 80012) IVTNUM, RPAVS, RVCORR
0011 CONTINUE
CT002* TEST 2 COMPLEX VALUE HAVING ONLY REAL COMPONENT
IVTNUM = 2
RPAVS = CABS((3.0, 0.0))
IF (RPAVS - 2.9998) 20020, 10020, 40020
40020 IF (RPAVS - 3.0002) 10020, 10020, 20020
10020 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0021
20020 IVFAIL = IVFAIL + 1
RVCORR = 3.0
WRITE(NUVI, 80012) IVTNUM, RPAVS, RVCORR
0021 CONTINUE
CT003* TEST 3 COMPLEX VALUE HAVING ONLY IMAGINARY COMPONENT
IVTNUM = 3
RPAVS = CABS((0.0, 3.0))
IF (RPAVS - 2.9998) 20030, 10030, 40030
40030 IF (RPAVS - 3.0002) 10030, 10030, 20030
10030 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0031
20030 IVFAIL = IVFAIL + 1
RVCORR = 3.0
WRITE(NUVI, 80012) IVTNUM, RPAVS, RVCORR
0031 CONTINUE
CT004* TEST 4 ARBITRARY COMPLEX VALUE
IVTNUM = 4
RPAVS = CABS((3.0, 4.0))
IF (RPAVS - 4.9997) 20040, 10040, 40040
40040 IF (RPAVS - 5.0003) 10040, 10040, 20040
10040 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0041
20040 IVFAIL = IVFAIL + 1
RVCORR = 5.0
WRITE(NUVI, 80012) IVTNUM, RPAVS, RVCORR
0041 CONTINUE
CT005* TEST 5 NEGATIVE REAL COMPONENT, NO IMAGINARY COMPONENT
IVTNUM = 5
RPAVS = CABS((-3.0, 0.0))
IF (RPAVS - 2.9998) 20050, 10050, 40050
40050 IF (RPAVS - 3.0002) 10050, 10050, 20050
10050 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0051
20050 IVFAIL = IVFAIL + 1
RVCORR = 3.0
WRITE(NUVI, 80012) IVTNUM, RPAVS, RVCORR
0051 CONTINUE
CT006* TEST 6 NO REAL COMPONENT, NEGATIVE IMAGINARY COMPONENT
IVTNUM = 6
RPAVS = CABS((0.0, -3.0))
IF (RPAVS - 2.9998) 20060, 10060, 40060
40060 IF (RPAVS - 3.0002) 10060, 10060, 20060
10060 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0061
20060 IVFAIL = IVFAIL + 1
RVCORR = 3.0
WRITE(NUVI, 80012) IVTNUM, RPAVS, RVCORR
0061 CONTINUE
CT007* TEST 7 ARBITRARY COMPLEX VALUE WITH NEGATIVE COMPONENTS
IVTNUM = 7
RPAVS = CABS((-3.0, -4.0))
IF (RPAVS - 4.9997) 20070, 10070, 40070
40070 IF (RPAVS - 5.0003) 10070, 10070, 20070
10070 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0071
20070 IVFAIL = IVFAIL + 1
RVCORR = 5.0
WRITE(NUVI, 80012) IVTNUM, RPAVS, RVCORR
0071 CONTINUE
CT008* TEST 8 COMPLEX VALUE ZERO PRECEDED BY MINUS SIGN
IVTNUM = 8
CPAVC = (0.0, 0.0)
RPAVS = CABS(-CPAVC)
IF (RPAVS + 0.00005) 20080, 10080, 40080
40080 IF (RPAVS - 0.00005) 10080, 10080, 20080
10080 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0081
20080 IVFAIL = IVFAIL + 1
RVCORR = 0.0
WRITE(NUVI, 80012) IVTNUM, RPAVS, RVCORR
0081 CONTINUE
CT009* TEST 9 COMPLEX EXPRESSION PRESENTED AS ARGUMENT
IVTNUM = 9
CPAVC = (3.0, 4.0)
RPAVS = CABS(CPAVC - (3.0, 4.0))
IF (RPAVS + 0.00005) 20090, 10090, 40090
40090 IF (RPAVS - 0.00005) 10090, 10090, 20090
10090 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0091
20090 IVFAIL = IVFAIL + 1
RVCORR = 0.0
WRITE(NUVI, 80012) IVTNUM, RPAVS, RVCORR
0091 CONTINUE
C*****
CBB** ********************** BBCSUM0 **********************************
C**** WRITE OUT TEST SUMMARY
C****
IVTOTN = IVPASS + IVFAIL + IVDELE + IVINSP
WRITE (I02, 90004)
WRITE (I02, 90014)
WRITE (I02, 90004)
WRITE (I02, 90020) IVPASS
WRITE (I02, 90022) IVFAIL
WRITE (I02, 90024) IVDELE
WRITE (I02, 90026) IVINSP
WRITE (I02, 90028) IVTOTN, IVTOTL
CBE** ********************** BBCSUM0 **********************************
CBB** ********************** BBCFOOT0 **********************************
C**** WRITE OUT REPORT FOOTINGS
C****
WRITE (I02,90016) ZPROG, ZPROG
WRITE (I02,90018) ZPROJ, ZNAME, ZTAPE, ZTAPED
WRITE (I02,90019)
CBE** ********************** BBCFOOT0 **********************************
CBB** ********************** BBCFMT0A **********************************
C**** FORMATS FOR TEST DETAIL LINES
C****
80000 FORMAT (1H ,2X,I3,4X,7HDELETED,32X,A31)
80002 FORMAT (1H ,2X,I3,4X,7H PASS ,32X,A31)
80004 FORMAT (1H ,2X,I3,4X,7HINSPECT,32X,A31)
80008 FORMAT (1H ,2X,I3,4X,7H FAIL ,32X,A31)
80010 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,15X,10HCOMPUTED= ,
1I6,/,1H ,15X,10HCORRECT= ,I6)
80012 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
1E12.5,/,1H ,16X,10HCORRECT= ,E12.5)
80018 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
1A21,/,1H ,16X,10HCORRECT= ,A21)
80020 FORMAT (1H ,16X,10HCOMPUTED= ,A21,1X,A31)
80022 FORMAT (1H ,16X,10HCORRECT= ,A21,1X,A31)
80024 FORMAT (1H ,16X,10HCOMPUTED= ,I6,16X,A31)
80026 FORMAT (1H ,16X,10HCORRECT= ,I6,16X,A31)
80028 FORMAT (1H ,16X,10HCOMPUTED= ,E12.5,10X,A31)
80030 FORMAT (1H ,16X,10HCORRECT= ,E12.5,10X,A31)
80050 FORMAT (1H ,48X,A31)
CBE** ********************** BBCFMT0A **********************************
CBB** ********************** BBCFMAT1 **********************************
C**** FORMATS FOR TEST DETAIL LINES - FULL LANGUAGE
C****
80031 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
1D17.10,/,1H ,16X,10HCORRECT= ,D17.10)
80033 FORMAT (1H ,16X,10HCOMPUTED= ,D17.10,10X,A31)
80035 FORMAT (1H ,16X,10HCORRECT= ,D17.10,10X,A31)
80037 FORMAT (1H ,16X,10HCOMPUTED= ,1H(,E12.5,2H, ,E12.5,1H),6X,A31)
80039 FORMAT (1H ,16X,10HCORRECT= ,1H(,E12.5,2H, ,E12.5,1H),6X,A31)
80041 FORMAT (1H ,16X,10HCOMPUTED= ,1H(,F12.5,2H, ,F12.5,1H),6X,A31)
80043 FORMAT (1H ,16X,10HCORRECT= ,1H(,F12.5,2H, ,F12.5,1H),6X,A31)
80045 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
11H(,F12.5,2H, ,F12.5,1H)/,1H ,16X,10HCORRECT= ,
21H(,F12.5,2H, ,F12.5,1H))
CBE** ********************** BBCFMAT1 **********************************
CBB** ********************** BBCFMT0B **********************************
C**** FORMAT STATEMENTS FOR PAGE HEADERS
C****
90002 FORMAT (1H1)
90004 FORMAT (1H )
90006 FORMAT (1H ,20X,31HFEDERAL SOFTWARE TESTING CENTER)
90007 FORMAT (1H ,19X,34HFORTRAN COMPILER VALIDATION SYSTEM)
90008 FORMAT (1H ,21X,A13,A17)
90009 FORMAT (1H ,/,2H *,A5,6HBEGIN*,12X,15HTEST RESULTS - ,A5,/)
90010 FORMAT (1H ,8X,16HTEST DATE*TIME= ,A17,15H - COMPILER= ,A20)
90013 FORMAT (1H ,8H TEST ,10HPASS/FAIL ,6X,17HDISPLAYED RESULTS,
1 7X,7HREMARKS,24X)
90014 FORMAT (1H ,46H----------------------------------------------,
1 33H---------------------------------)
90015 FORMAT (1H ,48X,17HTHIS PROGRAM HAS ,I3,6H TESTS,/)
C****
C**** FORMAT STATEMENTS FOR REPORT FOOTINGS
C****
90016 FORMAT (1H ,/,2H *,A5,4HEND*,14X,14HEND OF TEST - ,A5,/)
90018 FORMAT (1H ,A13,13X,A20,7H * ,A10,1H/,
1 A13)
90019 FORMAT (1H ,26HFOR OFFICIAL USE ONLY ,35X,15HCOPYRIGHT 1982)
C****
C**** FORMAT STATEMENTS FOR RUN SUMMARY
C****
90020 FORMAT (1H ,21X,I5,13H TESTS PASSED)
90022 FORMAT (1H ,21X,I5,13H TESTS FAILED)
90024 FORMAT (1H ,21X,I5,14H TESTS DELETED)
90026 FORMAT (1H ,21X,I5,25H TESTS REQUIRE INSPECTION)
90028 FORMAT (1H ,21X,I5,4H OF ,I3,15H TESTS EXECUTED)
CBE** ********************** BBCFMT0B **********************************
C*****
C***** END OF TEST SEGMENT 158
STOP
END
*END-OF,FM803
FM804.f 481036469 170 2 100666 14080 `
*HEADER,FORTR,FM804
*FILES1,FORTR,FM804,X
C***********************************************************************
C***** FORTRAN 77
C***** FM804 YDMOD - (160)
C*****
C***********************************************************************
C***** GENERAL PURPOSE ANS REF
C***** TO TEST INTRINSIC FUNCTION - DMOD - 15.3
C***** (REMAINDERING -TYPE DOUBLE PRECISION) (TABLE 5)
CBB** ********************** BBCCOMNT **********************************
C****
C**** 1978 FORTRAN COMPILER VALIDATION SYSTEM
C**** VERSION 2.0
C****
C****
C**** SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO
C**** GENERAL SERVICES ADMINISTRATION
C**** FEDERAL SOFTWARE TESTING CENTER
C**** 5203 LEESBURG PIKE, SUITE 1100
C**** FALLS CHURCH, VA. 22041
C****
C**** (703) 756-6153
C****
CBE** ********************** BBCCOMNT **********************************
C*****
C***** S P E C I F I C A T I O N S SEGMENT 160
C*****
DOUBLE PRECISION DQAVD, DQBVD, DQDVD, DQEVD, DQFVD
C*****
CBB** ********************** BBCINITA **********************************
C**** SPECIFICATION STATEMENTS
C****
CHARACTER ZVERS*13, ZVERSD*17, ZDATE*17, ZPROG*5, ZCOMPL*20,
1 ZNAME*20, ZTAPE*10, ZPROJ*13, REMRKS*31, ZTAPED*13
CBE** ********************** BBCINITA **********************************
CBB** ********************** BBCINITB **********************************
C**** INITIALIZE SECTION
DATA ZVERS, ZVERSD, ZDATE
1 /'VERSION 2.0 ', '82/08/02*18.33.46', '*NO DATE*TIME'/
DATA ZCOMPL, ZNAME, ZTAPE
1 /'*NONE SPECIFIED*', '*NO COMPANY NAME*', '*NO TAPE*'/
DATA ZPROJ, ZTAPED, ZPROG
1 /'*NO PROJECT*', '*NO TAPE DATE', 'XXXXX'/
DATA REMRKS /' '/
C**** THE FOLLOWING 9 COMMENT LINES (CZ01, CZ02, ...) CAN BE REPLACED
C**** FOR IDENTIFYING THE TEST ENVIRONMENT
C****
CZ01 ZVERS = 'VERSION OF THE COMPILER VALIDATION SYSTEM'
CZ02 ZVERSD = 'CREATION DATE/TIME OF THE COMPILER VALIDATION SYSTEM'
CZ03 ZPROG = 'PROGRAM NAME'
CZ04 ZDATE = 'DATE OF TEST'
CZ05 ZCOMPL = 'COMPILER IDENTIFICATION'
CZ06 ZPROJ = 'PROJECT NUMBER/IDENTIFICATION'
CZ07 ZNAME = 'NAME OF USER'
CZ08 ZTAPE = 'TAPE OWNER/ID'
CZ09 ZTAPED = 'DATE TAPE COPIED'
C
IVPASS = 0
IVFAIL = 0
IVDELE = 0
IVINSP = 0
IVTOTL = 0
IVTOTN = 0
ICZERO = 0
C
C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER.
I01 = 05
C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER.
I02 = 06
C
CX010 REPLACED BY FEXEC X-010 CONTROL CARD (CARD-READER UNIT NUMBER).
C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5
CX011 REPLACED BY FEXEC X-011 CONTROL CARD. CX011 IS FOR SYSTEMS
C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX010.
C
CX020 REPLACED BY FEXEC X-020 CONTROL CARD (PRINTER UNIT NUMBER).
C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02= 6
CX021 REPLACED BY FEXEC X-021 CONTROL CARD. CX021 IS FOR SYSTEMS
C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX020.
C
CBE** ********************** BBCINITB **********************************
NUVI = I02
IVTOTL = 11
ZPROG = 'FM804'
CBB** ********************** BBCHED0A **********************************
C****
C**** WRITE REPORT TITLE
C****
WRITE (I02, 90002)
WRITE (I02, 90006)
WRITE (I02, 90007)
WRITE (I02, 90008) ZVERS, ZVERSD
WRITE (I02, 90009) ZPROG, ZPROG
WRITE (I02, 90010) ZDATE, ZCOMPL
CBE** ********************** BBCHED0A **********************************
C*****
C***** HEADER FOR SEGMENT 160
WRITE (NUVI, 16001)
16001 FORMAT( 1H , //35H YDMOD - (160) INTRINSIC FUNCTION--//
1 16X,19HDMOD (REMAINDERING) //
2 19H ANS REF. - 15.3 )
CBB** ********************** BBCHED0B **********************************
C**** WRITE DETAIL REPORT HEADERS
C****
WRITE (I02,90004)
WRITE (I02,90004)
WRITE (I02,90013)
WRITE (I02,90014)
WRITE (I02,90015) IVTOTL
CBE** ********************** BBCHED0B **********************************
C*****
CT001* TEST 1 FIRST VALUE ZERO, SECOND NON-ZERO
IVTNUM = 1
DQBVD = 0.0D0
DQDVD = 4.5D0
DQAVD = DMOD(DQBVD, DQDVD)
IF (DQAVD + 5.0D-10) 20010, 10010, 40010
40010 IF (DQAVD - 5.0D-10) 10010, 10010, 20010
10010 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0011
20010 IVFAIL = IVFAIL + 1
DVCORR = 0.0D0
WRITE (NUVI, 80031) IVTNUM, DQAVD, DVCORR
0011 CONTINUE
CT002* TEST 2 BOTH VALUES EQUAL
IVTNUM = 2
DQBVD = 0.35D1
DQDVD = 0.35D1
DQAVD = DMOD(DQBVD, DQDVD)
IF (DQAVD + 5.0D-10) 20020, 10020, 40020
40020 IF (DQAVD - 5.0D-10) 10020, 10020, 20020
10020 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0021
20020 IVFAIL = IVFAIL + 1
DVCORR = 0.0D0
WRITE (NUVI, 80031) IVTNUM, DQAVD, DVCORR
0021 CONTINUE
CT003* TEST 3 FIRST MAGNITUDE LARGER, NOT MULTIPLE OF SECOND
IVTNUM = 3
DQBVD = -0.10D2
DQDVD = -0.3D1
DQAVD = DMOD(DQBVD, DQDVD)
IF (DQAVD + 1.000000001D0) 20030, 10030, 40030
40030 IF (DQAVD + 0.9999999995D0) 10030, 10030, 20030
10030 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0031
20030 IVFAIL = IVFAIL + 1
DVCORR = -1.0D0
WRITE (NUVI, 80031) IVTNUM, DQAVD, DVCORR
0031 CONTINUE
CT004* TEST 4 FIRST MAGNITUDE LARGER, MULTIPLE OF SECOND
IVTNUM = 4
DQDVD = 1.5D0
DQBVD = 1.5D0 + DQDVD + 1.5D0
DQAVD = DMOD(DQBVD, DQDVD)
IF (DQAVD + 5.0D-10) 20040, 10040, 40040
40040 IF (DQAVD - 5.0D-10) 10040, 10040, 20040
10040 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0041
20040 IVFAIL = IVFAIL + 1
DVCORR = 0.0D0
WRITE (NUVI, 80031) IVTNUM, DQAVD, DVCORR
0041 CONTINUE
CT005* TEST 5 FIRST MAGNITUDE LARGER, NOT MULTIPLE OF SECOND
IVTNUM = 5
DQBVD = 7.625D0
DQDVD = 2.125D0
DQAVD = DMOD(DQBVD, DQDVD)
IF (DQAVD - 1.249999999D0) 20050, 10050, 40050
40050 IF (DQAVD - 1.250000001D0) 10050, 10050, 20050
10050 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0051
20050 IVFAIL = IVFAIL + 1
DVCORR = 1.25D0
WRITE (NUVI, 80031) IVTNUM, DQAVD, DVCORR
0051 CONTINUE
CT006* TEST 6 FIRST VALUE ZERO, SECOND NEGATIVE
IVTNUM = 6
DQBVD = 0.0D0
DQDVD = -0.45D1
DQAVD = DMOD(DQBVD, DQDVD)
IF (DQAVD + 5.0D-10) 20060, 10060, 40060
40060 IF (DQAVD - 5.0D-10) 10060, 10060, 20060
10060 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0061
20060 IVFAIL = IVFAIL + 1
DVCORR = 0.0D0
WRITE (NUVI, 80031) IVTNUM, DQAVD, DVCORR
0061 CONTINUE
CT007* TEST 7 BOTH VALUES EQUAL, BOTH NEGATIVE
IVTNUM = 7
DQBVD = -3.5D1
DQDVD = -3.5D1
DQAVD = DMOD(DQBVD, DQDVD)
IF (DQAVD + 5.0D-10) 20070, 10070, 40070
40070 IF (DQAVD - 5.0D-10) 10070, 10070, 20070
10070 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0071
20070 IVFAIL = IVFAIL + 1
DVCORR = 0.0D0
WRITE (NUVI, 80031) IVTNUM, DQAVD, DVCORR
0071 CONTINUE
CT008* TEST 8 FIRST MAGNITUDE LARGER, MULIPLES, BOTH NEGATIVE
IVTNUM = 8
DQDVD = 3.5D0
DQBVD = -(3.5D0 + DQDVD + 3.5D0)
DQAVD = DMOD(DQBVD, -DQDVD)
IF (DQAVD + 5.0D-10) 20080, 10080, 40080
40080 IF (DQAVD - 5.0D-10) 10080, 10080, 20080
10080 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0081
20080 IVFAIL = IVFAIL + 1
DVCORR = 0.0D0
WRITE (NUVI, 80031) IVTNUM, DQAVD, DVCORR
0081 CONTINUE
CT009* TEST 9 FIRST VALUE POSITIVE, SECOND NEGATIVE, MULTIPLE
IVTNUM = 9
DQBVD = 10.5D0
DQDVD = -3.5D0
DQAVD = DMOD(DQBVD, DQDVD)
IF (DQAVD + 5.0D-10) 20090, 10090, 40090
40090 IF (DQAVD - 5.0D-10) 10090, 10090, 20090
10090 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0091
20090 IVFAIL = IVFAIL + 1
DVCORR = 0.0D0
WRITE (NUVI, 80031) IVTNUM, DQAVD, DVCORR
0091 CONTINUE
CT010* TEST 10 FIRST VALUE ZERO PRECEDED BY MINUS SIGN
IVTNUM = 10
DQDVD = 0.0D0
DQEVD = 4.5D0
DQAVD = DMOD(-DQDVD, DQEVD)
IF (DQAVD + 5.0D-10) 20100, 10100, 40100
40100 IF (DQAVD - 5.0D-10) 10100, 10100, 20100
10100 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0101
20100 IVFAIL = IVFAIL + 1
DVCORR = 0.0D0
WRITE (NUVI, 80031) IVTNUM, DQAVD, DVCORR
0101 CONTINUE
CT011* TEST 11 PAIR OF ARITHMETIC EXPRESSIONS USED AS ARGUMENT
IVTNUM = 11
DQDVD = 0.7625D1
DQEVD = 0.2125D1
DQFVD = 0.2D1
DQAVD = DMOD(DQDVD - DQFVD, DQEVD + DQFVD)
IF (DQAVD - 0.1499999999D1) 20110, 10110, 40110
40110 IF (DQAVD - 0.1500000001D1) 10110, 10110, 20110
10110 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0111
20110 IVFAIL = IVFAIL + 1
DVCORR = 0.15D1
WRITE (NUVI, 80031) IVTNUM, DQAVD, DVCORR
0111 CONTINUE
C*****
CBB** ********************** BBCSUM0 **********************************
C**** WRITE OUT TEST SUMMARY
C****
IVTOTN = IVPASS + IVFAIL + IVDELE + IVINSP
WRITE (I02, 90004)
WRITE (I02, 90014)
WRITE (I02, 90004)
WRITE (I02, 90020) IVPASS
WRITE (I02, 90022) IVFAIL
WRITE (I02, 90024) IVDELE
WRITE (I02, 90026) IVINSP
WRITE (I02, 90028) IVTOTN, IVTOTL
CBE** ********************** BBCSUM0 **********************************
CBB** ********************** BBCFOOT0 **********************************
C**** WRITE OUT REPORT FOOTINGS
C****
WRITE (I02,90016) ZPROG, ZPROG
WRITE (I02,90018) ZPROJ, ZNAME, ZTAPE, ZTAPED
WRITE (I02,90019)
CBE** ********************** BBCFOOT0 **********************************
CBB** ********************** BBCFMT0A **********************************
C**** FORMATS FOR TEST DETAIL LINES
C****
80000 FORMAT (1H ,2X,I3,4X,7HDELETED,32X,A31)
80002 FORMAT (1H ,2X,I3,4X,7H PASS ,32X,A31)
80004 FORMAT (1H ,2X,I3,4X,7HINSPECT,32X,A31)
80008 FORMAT (1H ,2X,I3,4X,7H FAIL ,32X,A31)
80010 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,15X,10HCOMPUTED= ,
1I6,/,1H ,15X,10HCORRECT= ,I6)
80012 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
1E12.5,/,1H ,16X,10HCORRECT= ,E12.5)
80018 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
1A21,/,1H ,16X,10HCORRECT= ,A21)
80020 FORMAT (1H ,16X,10HCOMPUTED= ,A21,1X,A31)
80022 FORMAT (1H ,16X,10HCORRECT= ,A21,1X,A31)
80024 FORMAT (1H ,16X,10HCOMPUTED= ,I6,16X,A31)
80026 FORMAT (1H ,16X,10HCORRECT= ,I6,16X,A31)
80028 FORMAT (1H ,16X,10HCOMPUTED= ,E12.5,10X,A31)
80030 FORMAT (1H ,16X,10HCORRECT= ,E12.5,10X,A31)
80050 FORMAT (1H ,48X,A31)
CBE** ********************** BBCFMT0A **********************************
CBB** ********************** BBCFMAT1 **********************************
C**** FORMATS FOR TEST DETAIL LINES - FULL LANGUAGE
C****
80031 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
1D17.10,/,1H ,16X,10HCORRECT= ,D17.10)
80033 FORMAT (1H ,16X,10HCOMPUTED= ,D17.10,10X,A31)
80035 FORMAT (1H ,16X,10HCORRECT= ,D17.10,10X,A31)
80037 FORMAT (1H ,16X,10HCOMPUTED= ,1H(,E12.5,2H, ,E12.5,1H),6X,A31)
80039 FORMAT (1H ,16X,10HCORRECT= ,1H(,E12.5,2H, ,E12.5,1H),6X,A31)
80041 FORMAT (1H ,16X,10HCOMPUTED= ,1H(,F12.5,2H, ,F12.5,1H),6X,A31)
80043 FORMAT (1H ,16X,10HCORRECT= ,1H(,F12.5,2H, ,F12.5,1H),6X,A31)
80045 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
11H(,F12.5,2H, ,F12.5,1H)/,1H ,16X,10HCORRECT= ,
21H(,F12.5,2H, ,F12.5,1H))
CBE** ********************** BBCFMAT1 **********************************
CBB** ********************** BBCFMT0B **********************************
C**** FORMAT STATEMENTS FOR PAGE HEADERS
C****
90002 FORMAT (1H1)
90004 FORMAT (1H )
90006 FORMAT (1H ,20X,31HFEDERAL SOFTWARE TESTING CENTER)
90007 FORMAT (1H ,19X,34HFORTRAN COMPILER VALIDATION SYSTEM)
90008 FORMAT (1H ,21X,A13,A17)
90009 FORMAT (1H ,/,2H *,A5,6HBEGIN*,12X,15HTEST RESULTS - ,A5,/)
90010 FORMAT (1H ,8X,16HTEST DATE*TIME= ,A17,15H - COMPILER= ,A20)
90013 FORMAT (1H ,8H TEST ,10HPASS/FAIL ,6X,17HDISPLAYED RESULTS,
1 7X,7HREMARKS,24X)
90014 FORMAT (1H ,46H----------------------------------------------,
1 33H---------------------------------)
90015 FORMAT (1H ,48X,17HTHIS PROGRAM HAS ,I3,6H TESTS,/)
C****
C**** FORMAT STATEMENTS FOR REPORT FOOTINGS
C****
90016 FORMAT (1H ,/,2H *,A5,4HEND*,14X,14HEND OF TEST - ,A5,/)
90018 FORMAT (1H ,A13,13X,A20,7H * ,A10,1H/,
1 A13)
90019 FORMAT (1H ,26HFOR OFFICIAL USE ONLY ,35X,15HCOPYRIGHT 1982)
C****
C**** FORMAT STATEMENTS FOR RUN SUMMARY
C****
90020 FORMAT (1H ,21X,I5,13H TESTS PASSED)
90022 FORMAT (1H ,21X,I5,13H TESTS FAILED)
90024 FORMAT (1H ,21X,I5,14H TESTS DELETED)
90026 FORMAT (1H ,21X,I5,25H TESTS REQUIRE INSPECTION)
90028 FORMAT (1H ,21X,I5,4H OF ,I3,15H TESTS EXECUTED)
CBE** ********************** BBCFMT0B **********************************
C*****
C***** END OF TEST SEGMENT 160
STOP
END
*END-OF,FM804
FM805.f 481036474 170 2 100666 18605 `
*HEADER,FORTR,FM805
*FILES1,FORTR,FM805,X
C***********************************************************************
C***** FORTRAN 77
C***** FM805 YDDIM - (164)
C*****
C***********************************************************************
C***** GENERAL PURPOSE ANS REF
C***** TEST INTRINSIC FUNCTION DDIM AND PROD--POSITIVE 15.3
C***** DIFFERENCE AND DOUBLE PRECISION PRODUCT, RESP. (TABLE 5)
C*****
CBB** ********************** BBCCOMNT **********************************
C****
C**** 1978 FORTRAN COMPILER VALIDATION SYSTEM
C**** VERSION 2.0
C****
C****
C**** SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO
C**** GENERAL SERVICES ADMINISTRATION
C**** FEDERAL SOFTWARE TESTING CENTER
C**** 5203 LEESBURG PIKE, SUITE 1100
C**** FALLS CHURCH, VA. 22041
C****
C**** (703) 756-6153
C****
CBE** ********************** BBCCOMNT **********************************
C*****
C***** S P E C I F I C A T I O N S SEGMENT 164
DOUBLE PRECISION DSAVD, DSBVD, DSDVD, DSEVD, DVCORR
C*****
CBB** ********************** BBCINITA **********************************
C**** SPECIFICATION STATEMENTS
C****
CHARACTER ZVERS*13, ZVERSD*17, ZDATE*17, ZPROG*5, ZCOMPL*20,
1 ZNAME*20, ZTAPE*10, ZPROJ*13, REMRKS*31, ZTAPED*13
CBE** ********************** BBCINITA **********************************
CBB** ********************** BBCINITB **********************************
C**** INITIALIZE SECTION
DATA ZVERS, ZVERSD, ZDATE
1 /'VERSION 2.0 ', '82/08/02*18.33.46', '*NO DATE*TIME'/
DATA ZCOMPL, ZNAME, ZTAPE
1 /'*NONE SPECIFIED*', '*NO COMPANY NAME*', '*NO TAPE*'/
DATA ZPROJ, ZTAPED, ZPROG
1 /'*NO PROJECT*', '*NO TAPE DATE', 'XXXXX'/
DATA REMRKS /' '/
C**** THE FOLLOWING 9 COMMENT LINES (CZ01, CZ02, ...) CAN BE REPLACED
C**** FOR IDENTIFYING THE TEST ENVIRONMENT
C****
CZ01 ZVERS = 'VERSION OF THE COMPILER VALIDATION SYSTEM'
CZ02 ZVERSD = 'CREATION DATE/TIME OF THE COMPILER VALIDATION SYSTEM'
CZ03 ZPROG = 'PROGRAM NAME'
CZ04 ZDATE = 'DATE OF TEST'
CZ05 ZCOMPL = 'COMPILER IDENTIFICATION'
CZ06 ZPROJ = 'PROJECT NUMBER/IDENTIFICATION'
CZ07 ZNAME = 'NAME OF USER'
CZ08 ZTAPE = 'TAPE OWNER/ID'
CZ09 ZTAPED = 'DATE TAPE COPIED'
C
IVPASS = 0
IVFAIL = 0
IVDELE = 0
IVINSP = 0
IVTOTL = 0
IVTOTN = 0
ICZERO = 0
C
C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER.
I01 = 05
C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER.
I02 = 06
C
CX010 REPLACED BY FEXEC X-010 CONTROL CARD (CARD-READER UNIT NUMBER).
C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5
CX011 REPLACED BY FEXEC X-011 CONTROL CARD. CX011 IS FOR SYSTEMS
C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX010.
C
CX020 REPLACED BY FEXEC X-020 CONTROL CARD (PRINTER UNIT NUMBER).
C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02= 6
CX021 REPLACED BY FEXEC X-021 CONTROL CARD. CX021 IS FOR SYSTEMS
C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX020.
C
CBE** ********************** BBCINITB **********************************
NUVI = I02
IVTOTL = 18
ZPROG = 'FM805'
CBB** ********************** BBCHED0A **********************************
C****
C**** WRITE REPORT TITLE
C****
WRITE (I02, 90002)
WRITE (I02, 90006)
WRITE (I02, 90007)
WRITE (I02, 90008) ZVERS, ZVERSD
WRITE (I02, 90009) ZPROG, ZPROG
WRITE (I02, 90010) ZDATE, ZCOMPL
CBE** ********************** BBCHED0A **********************************
C*****
C***** HEADER FOR SEGMENT 164
WRITE (NUVI,16401)
16401 FORMAT (1H ,// 1X,36HYDDIM - (164) INTRINSIC FUNCTIONS-- //16X,
1 26HDDIM (POSITIVE DIFFERENCE)/,16X,
2 20HDPROD (D.P. PRODUCT)//
3 2X,15HANS REF. - 15.3)
CBB** ********************** BBCHED0B **********************************
C**** WRITE DETAIL REPORT HEADERS
C****
WRITE (I02,90004)
WRITE (I02,90004)
WRITE (I02,90013)
WRITE (I02,90014)
WRITE (I02,90015) IVTOTL
CBE** ********************** BBCHED0B **********************************
C*****
C***** TEST OF DDIM
C*****
WRITE(NUVI, 16402)
16402 FORMAT(/ 8X, 12HTEST OF DDIM)
CT001* TEST 1 BOTH VALUES EQUAL
IVTNUM = 1
DSBVD = 0.25D0
DSDVD = 0.25D0
DSAVD = DDIM(DSBVD, DSDVD)
IF (DSAVD + 5.0D-10) 20010, 10010, 40010
40010 IF (DSAVD - 5.0D-10) 10010, 10010, 20010
10010 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0011
20010 IVFAIL = IVFAIL + 1
DVCORR = 0.0D0
WRITE (NUVI, 80031) IVTNUM, DSAVD, DVCORR
0011 CONTINUE
CT002* TEST 2 BOTH VALUES EQUAL, INTEGRAL VALUES
IVTNUM = 2
DSBVD = 2.0D0
DSDVD = 2.0D0
DSAVD = DDIM(DSBVD, DSDVD)
IF (DSAVD + 5.0D-10) 20020, 10020, 40020
40020 IF (DSAVD - 5.0D-10) 10020, 10020, 20020
10020 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0021
20020 IVFAIL = IVFAIL + 1
DVCORR = 0.0D0
WRITE (NUVI, 80031) IVTNUM, DSAVD, DVCORR
0021 CONTINUE
CT003* TEST 3 FIRST VALUE LESS THAN SECOND
IVTNUM = 3
DSBVD = 0.25D1
DSDVD = 0.55D1
DSAVD = DDIM(DSBVD, DSDVD)
IF (DSAVD + 5.0D-10) 20030, 10030, 40030
40030 IF (DSAVD - 5.0D-10) 10030, 10030, 20030
10030 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0031
20030 IVFAIL = IVFAIL + 1
DVCORR = 0.0D0
WRITE (NUVI, 80031) IVTNUM, DSAVD, DVCORR
0031 CONTINUE
CT004* TEST 4 FIRST VALUE GREATER THAN SECOND
IVTNUM = 4
DSBVD = 0.55D1
DSDVD = 0.25D1
DSAVD = DDIM(DSBVD, DSDVD)
IF (DSAVD - 2.999999998D0) 20040, 10040, 40040
40040 IF (DSAVD - 3.000000002D0) 10040, 10040, 20040
10040 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0041
20040 IVFAIL = IVFAIL + 1
DVCORR = 3.0D0
WRITE (NUVI, 80031) IVTNUM, DSAVD, DVCORR
0041 CONTINUE
CT005* TEST 5 BOTH VALUES EQUAL, BOTH NEGATIVE
IVTNUM = 5
DSBVD = -0.25D1
DSDVD = -0.25D1
DSAVD = DDIM(DSBVD, DSDVD)
IF (DSAVD + 5.0D-10) 20050, 10050, 40050
40050 IF (DSAVD - 5.0D-10) 10050, 10050, 20050
10050 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0051
20050 IVFAIL = IVFAIL + 1
DVCORR = 0.0D0
WRITE (NUVI, 80031) IVTNUM, DSAVD, DVCORR
0051 CONTINUE
CT006* TEST 6 FIRST VALUE GREATER THAN SECOND, BOTH NEGATIVE
IVTNUM = 6
DSBVD = -0.25D1
DSDVD = -0.55D1
DSAVD = DDIM(DSBVD, DSDVD)
IF (DSAVD - 2.999999998D0) 20060, 10060, 40060
40060 IF (DSAVD - 3.000000002D0) 10060, 10060, 20060
10060 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0061
20060 IVFAIL = IVFAIL + 1
DVCORR = 3.0D0
WRITE (NUVI, 80031) IVTNUM, DSAVD, DVCORR
0061 CONTINUE
CT007* TEST 7 FIRST VALUE POSITIVE, SECOND NEGATIVE
IVTNUM = 7
DSBVD = 0.55D1
DSDVD = -0.25D1
DSAVD = DDIM(DSBVD, DSDVD)
IF (DSAVD - 7.999999996D0) 20070, 10070, 40070
40070 IF (DSAVD - 8.000000004D0) 10070, 10070, 20070
10070 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0071
20070 IVFAIL = IVFAIL + 1
DVCORR = 8.0D0
WRITE (NUVI, 80031) IVTNUM, DSAVD, DVCORR
0071 CONTINUE
CT008* TEST 8 ARITHMETIC EXPRESSION PRESENTED TO DDIM
IVTNUM = 8
DSDVD = 0.25D1
DSEVD = 0.125D1
DSAVD = DDIM(DSDVD / DSEVD, DSDVD * DSEVD)
IF (DSAVD + 5.0D-10) 20080, 10080, 40080
40080 IF (DSAVD - 5.0D-10) 10080, 10080, 20080
10080 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0081
20080 IVFAIL = IVFAIL + 1
DVCORR = 0.0D0
WRITE (NUVI, 80031) IVTNUM, DSAVD, DVCORR
0081 CONTINUE
C*****
C***** TEST OF DPROD
C*****
WRITE(NUVI, 16404)
REMRKS = '+ OR - 0.00005'
16404 FORMAT(// 8X, 13HTEST OF DPROD)
CT009* TEST 9 PAIR OF VALUES, ONE OF WHICH IS ZERO
IVTNUM = 9
RSAVS = 0.0
RSBVS = 2.0
DSAVD = DPROD(RSAVS, RSBVS)
IF (DSAVD + 5.0D-5) 20090, 10090, 40090
40090 IF (DSAVD - 5.0D-5) 10090, 10090, 20090
10090 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0091
20090 IVFAIL = IVFAIL + 1
DVCORR = 0.0D0
WRITE (NUVI, 80008) IVTNUM
WRITE (NUVI, 80033) DSAVD
WRITE (NUVI, 80035) DVCORR, REMRKS
0091 CONTINUE
CT010* TEST 10 PAIR OF VALUES, ONE OF WHICH IS ONE
IVTNUM = 10
RSAVS = 1.0
RSBVS = 2.0
DSAVD = DPROD(RSAVS, RSBVS)
IF (DSAVD - 1.9999D0) 20100, 10100, 40100
40100 IF (DSAVD - 2.0001D0) 10100, 10100, 20100
10100 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0101
20100 IVFAIL = IVFAIL + 1
DVCORR = 2.0D0
WRITE (NUVI, 80008) IVTNUM
WRITE (NUVI, 80033) DSAVD
WRITE (NUVI, 80035) DVCORR, REMRKS
0101 CONTINUE
CT011* TEST 11 PAIR OF NON-ZERO VALUES
IVTNUM = 11
RSAVS = 3.333333
RSBVS = 2.3948094
DSAVD = DPROD(RSAVS, RSBVS)
IF (DSAVD - 7.9823D0) 20110, 10110, 40110
40110 IF (DSAVD - 7.9831D0) 10110, 10110, 20110
10110 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0111
20110 IVFAIL = IVFAIL + 1
DVCORR = 7.982697202D0
WRITE (NUVI, 80008) IVTNUM
WRITE (NUVI, 80033) DSAVD
WRITE (NUVI, 80035) DVCORR, REMRKS
0111 CONTINUE
CT012* TEST 12 ONE POSITIVE, ONE NEGATIVE
IVTNUM = 12
RSAVS = 0.123456
RSBVS = -2.98765
DSAVD = DPROD(RSAVS, RSBVS)
IF (DSAVD + 3.6887D-1) 20120, 10120, 40120
40120 IF (DSAVD + 3.6882D-1) 10120, 10120, 20120
10120 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0121
20120 IVFAIL = IVFAIL + 1
DVCORR = -3.688433184D-1
WRITE (NUVI, 80008) IVTNUM
WRITE (NUVI, 80033) DSAVD
WRITE (NUVI, 80035) DVCORR, REMRKS
0121 CONTINUE
CT013* TEST 13 ONE VALUE ONE(1), ONE NEGATIVE
IVTNUM = 13
RSAVS = 1.0834001
RSBVS = -2.034985
DSAVD = DPROD(RSAVS, RSBVS)
IF (DSAVD + 2.2049D0) 20130, 10130, 40130
40130 IF (DSAVD + 2.2045D0) 10130, 10130, 20130
10130 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0131
20130 IVFAIL = IVFAIL + 1
DVCORR = -2.204702953D0
WRITE (NUVI, 80008) IVTNUM
WRITE (NUVI, 80033) DSAVD
WRITE (NUVI, 80035) DVCORR, REMRKS
0131 CONTINUE
CT014* TEST 14 PAIR OF NEGATIVE VALUES
IVTNUM = 14
RSAVS = -3.077734
RSBVS = -2.348343
DSAVD = DPROD(RSAVS, RSBVS)
IF (DSAVD - 7.2272D0) 20140, 10140, 40140
40140 IF (DSAVD - 7.2280D0) 10140, 10140, 20140
10140 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0141
20140 IVFAIL = IVFAIL + 1
DVCORR = 7.227575095D0
WRITE (NUVI, 80008) IVTNUM
WRITE (NUVI, 80033) DSAVD
WRITE (NUVI, 80035) DVCORR, REMRKS
0141 CONTINUE
CT015* TEST 15 ONE POSITIVE VALUE, ONE NEGATIVE VALUE
IVTNUM = 15
RSAVS = 3.3333324
RSBVS = -2.343953
DSAVD = DPROD(RSAVS, RSBVS)
IF (DSAVD + 7.8136D0) 20150, 10150, 40150
40150 IF (DSAVD + 7.8127D0) 10150, 10150, 20150
10150 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0151
20150 IVFAIL = IVFAIL + 1
DVCORR = -7.813174479D0
WRITE (NUVI, 80008) IVTNUM
WRITE (NUVI, 80033) DSAVD
WRITE (NUVI, 80035) DVCORR, REMRKS
0151 CONTINUE
CT016* TEST 16 ARITHMETIC EXPRESSION PRESENTED TO DPROD
IVTNUM = 16
RSAVS = 1.555674
RSBVS = 2.00012
DSAVD = DPROD(RSAVS - RSBVS, RSAVS + RSBVS)
IF (DSAVD + 1.5805D0) 20160, 10160, 40160
40160 IF (DSAVD + 1.5802D0) 10160, 10160, 20160
10160 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0161
20160 IVFAIL = IVFAIL + 1
DVCORR = -1.580358420D0
WRITE (NUVI, 80008) IVTNUM
WRITE (NUVI, 80033) DSAVD
WRITE (NUVI, 80035) DVCORR, REMRKS
0161 CONTINUE
CT017* TEST 17 DPROD FORMS THE ARGUMENTS TO DDIM
IVTNUM = 17
DSAVD = DDIM(DPROD(0.4, 2.0), DPROD(3.0, 0.1))
IF (DSAVD - 0.49997D0) 20170, 10170, 40170
40170 IF (DSAVD - 0.50003D0) 10170, 10170, 20170
10170 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0171
20170 IVFAIL = IVFAIL + 1
DVCORR = 0.5D0
WRITE (NUVI, 80008) IVTNUM
WRITE (NUVI, 80033) DSAVD
WRITE (NUVI, 80035) DVCORR, REMRKS
0171 CONTINUE
CT018* TEST 18 ARGUMENTS WITH HIGH AND LOW MAGNITUDES
IVTNUM = 18
RSAVS = 1.23456E-33
RSBVS = 1.23456E+34
DSAVD = DPROD(RSAVS, RSBVS)
IF (DSAVD - 1.5240D1) 20180, 10180, 40180
40180 IF (DSAVD - 1.5242D1) 10180, 10180, 20180
10180 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0181
20180 IVFAIL = IVFAIL + 1
DVCORR = 1.524138394D1
WRITE (NUVI, 80008) IVTNUM
WRITE (NUVI, 80033) DSAVD
WRITE (NUVI, 80035) DVCORR, REMRKS
0181 CONTINUE
C*****
CBB** ********************** BBCSUM0 **********************************
C**** WRITE OUT TEST SUMMARY
C****
IVTOTN = IVPASS + IVFAIL + IVDELE + IVINSP
WRITE (I02, 90004)
WRITE (I02, 90014)
WRITE (I02, 90004)
WRITE (I02, 90020) IVPASS
WRITE (I02, 90022) IVFAIL
WRITE (I02, 90024) IVDELE
WRITE (I02, 90026) IVINSP
WRITE (I02, 90028) IVTOTN, IVTOTL
CBE** ********************** BBCSUM0 **********************************
CBB** ********************** BBCFOOT0 **********************************
C**** WRITE OUT REPORT FOOTINGS
C****
WRITE (I02,90016) ZPROG, ZPROG
WRITE (I02,90018) ZPROJ, ZNAME, ZTAPE, ZTAPED
WRITE (I02,90019)
CBE** ********************** BBCFOOT0 **********************************
CBB** ********************** BBCFMT0A **********************************
C**** FORMATS FOR TEST DETAIL LINES
C****
80000 FORMAT (1H ,2X,I3,4X,7HDELETED,32X,A31)
80002 FORMAT (1H ,2X,I3,4X,7H PASS ,32X,A31)
80004 FORMAT (1H ,2X,I3,4X,7HINSPECT,32X,A31)
80008 FORMAT (1H ,2X,I3,4X,7H FAIL ,32X,A31)
80010 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,15X,10HCOMPUTED= ,
1I6,/,1H ,15X,10HCORRECT= ,I6)
80012 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
1E12.5,/,1H ,16X,10HCORRECT= ,E12.5)
80018 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
1A21,/,1H ,16X,10HCORRECT= ,A21)
80020 FORMAT (1H ,16X,10HCOMPUTED= ,A21,1X,A31)
80022 FORMAT (1H ,16X,10HCORRECT= ,A21,1X,A31)
80024 FORMAT (1H ,16X,10HCOMPUTED= ,I6,16X,A31)
80026 FORMAT (1H ,16X,10HCORRECT= ,I6,16X,A31)
80028 FORMAT (1H ,16X,10HCOMPUTED= ,E12.5,10X,A31)
80030 FORMAT (1H ,16X,10HCORRECT= ,E12.5,10X,A31)
80050 FORMAT (1H ,48X,A31)
CBE** ********************** BBCFMT0A **********************************
CBB** ********************** BBCFMAT1 **********************************
C**** FORMATS FOR TEST DETAIL LINES - FULL LANGUAGE
C****
80031 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
1D17.10,/,1H ,16X,10HCORRECT= ,D17.10)
80033 FORMAT (1H ,16X,10HCOMPUTED= ,D17.10,10X,A31)
80035 FORMAT (1H ,16X,10HCORRECT= ,D17.10,10X,A31)
80037 FORMAT (1H ,16X,10HCOMPUTED= ,1H(,E12.5,2H, ,E12.5,1H),6X,A31)
80039 FORMAT (1H ,16X,10HCORRECT= ,1H(,E12.5,2H, ,E12.5,1H),6X,A31)
80041 FORMAT (1H ,16X,10HCOMPUTED= ,1H(,F12.5,2H, ,F12.5,1H),6X,A31)
80043 FORMAT (1H ,16X,10HCORRECT= ,1H(,F12.5,2H, ,F12.5,1H),6X,A31)
80045 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
11H(,F12.5,2H, ,F12.5,1H)/,1H ,16X,10HCORRECT= ,
21H(,F12.5,2H, ,F12.5,1H))
CBE** ********************** BBCFMAT1 **********************************
CBB** ********************** BBCFMT0B **********************************
C**** FORMAT STATEMENTS FOR PAGE HEADERS
C****
90002 FORMAT (1H1)
90004 FORMAT (1H )
90006 FORMAT (1H ,20X,31HFEDERAL SOFTWARE TESTING CENTER)
90007 FORMAT (1H ,19X,34HFORTRAN COMPILER VALIDATION SYSTEM)
90008 FORMAT (1H ,21X,A13,A17)
90009 FORMAT (1H ,/,2H *,A5,6HBEGIN*,12X,15HTEST RESULTS - ,A5,/)
90010 FORMAT (1H ,8X,16HTEST DATE*TIME= ,A17,15H - COMPILER= ,A20)
90013 FORMAT (1H ,8H TEST ,10HPASS/FAIL ,6X,17HDISPLAYED RESULTS,
1 7X,7HREMARKS,24X)
90014 FORMAT (1H ,46H----------------------------------------------,
1 33H---------------------------------)
90015 FORMAT (1H ,48X,17HTHIS PROGRAM HAS ,I3,6H TESTS,/)
C****
C**** FORMAT STATEMENTS FOR REPORT FOOTINGS
C****
90016 FORMAT (1H ,/,2H *,A5,4HEND*,14X,14HEND OF TEST - ,A5,/)
90018 FORMAT (1H ,A13,13X,A20,7H * ,A10,1H/,
1 A13)
90019 FORMAT (1H ,26HFOR OFFICIAL USE ONLY ,35X,15HCOPYRIGHT 1982)
C****
C**** FORMAT STATEMENTS FOR RUN SUMMARY
C****
90020 FORMAT (1H ,21X,I5,13H TESTS PASSED)
90022 FORMAT (1H ,21X,I5,13H TESTS FAILED)
90024 FORMAT (1H ,21X,I5,14H TESTS DELETED)
90026 FORMAT (1H ,21X,I5,25H TESTS REQUIRE INSPECTION)
90028 FORMAT (1H ,21X,I5,4H OF ,I3,15H TESTS EXECUTED)
CBE** ********************** BBCFMT0B **********************************
C*****
C***** END OF TEST SEGMENT 164
STOP
END
*END-OF,FM805
FM806.f 481036477 170 2 100666 14750 `
*HEADER,FORTR,FM806
*FILES1,FORTR,FM806,X
C***********************************************************************
C***** FORTRAN 77
C***** FM806 YDMAX1 - (166)
C*****
C***********************************************************************
C***** GENERAL PURPOSE ANS REF
C***** TEST OF INTRINSIC FUNCTION -- 15.3
C***** DMAX1 -- CHOOSING LARGEST VALUE (TABLE 5)
C*****
CBB** ********************** BBCCOMNT **********************************
C****
C**** 1978 FORTRAN COMPILER VALIDATION SYSTEM
C**** VERSION 2.0
C****
C****
C**** SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO
C**** GENERAL SERVICES ADMINISTRATION
C**** FEDERAL SOFTWARE TESTING CENTER
C**** 5203 LEESBURG PIKE, SUITE 1100
C**** FALLS CHURCH, VA. 22041
C****
C**** (703) 756-6153
C****
CBE** ********************** BBCCOMNT **********************************
C***** S P E C I F I C A T I O N S SEGMENT 166
DOUBLE PRECISION DTAVD, DTBVD, DTCVD, DTDVD, DTEVD, DVCORR
C*****
CBB** ********************** BBCINITA **********************************
C**** SPECIFICATION STATEMENTS
C****
CHARACTER ZVERS*13, ZVERSD*17, ZDATE*17, ZPROG*5, ZCOMPL*20,
1 ZNAME*20, ZTAPE*10, ZPROJ*13, REMRKS*31, ZTAPED*13
CBE** ********************** BBCINITA **********************************
CBB** ********************** BBCINITB **********************************
C**** INITIALIZE SECTION
DATA ZVERS, ZVERSD, ZDATE
1 /'VERSION 2.0 ', '82/08/02*18.33.46', '*NO DATE*TIME'/
DATA ZCOMPL, ZNAME, ZTAPE
1 /'*NONE SPECIFIED*', '*NO COMPANY NAME*', '*NO TAPE*'/
DATA ZPROJ, ZTAPED, ZPROG
1 /'*NO PROJECT*', '*NO TAPE DATE', 'XXXXX'/
DATA REMRKS /' '/
C**** THE FOLLOWING 9 COMMENT LINES (CZ01, CZ02, ...) CAN BE REPLACED
C**** FOR IDENTIFYING THE TEST ENVIRONMENT
C****
CZ01 ZVERS = 'VERSION OF THE COMPILER VALIDATION SYSTEM'
CZ02 ZVERSD = 'CREATION DATE/TIME OF THE COMPILER VALIDATION SYSTEM'
CZ03 ZPROG = 'PROGRAM NAME'
CZ04 ZDATE = 'DATE OF TEST'
CZ05 ZCOMPL = 'COMPILER IDENTIFICATION'
CZ06 ZPROJ = 'PROJECT NUMBER/IDENTIFICATION'
CZ07 ZNAME = 'NAME OF USER'
CZ08 ZTAPE = 'TAPE OWNER/ID'
CZ09 ZTAPED = 'DATE TAPE COPIED'
C
IVPASS = 0
IVFAIL = 0
IVDELE = 0
IVINSP = 0
IVTOTL = 0
IVTOTN = 0
ICZERO = 0
C
C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER.
I01 = 05
C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER.
I02 = 06
C
CX010 REPLACED BY FEXEC X-010 CONTROL CARD (CARD-READER UNIT NUMBER).
C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5
CX011 REPLACED BY FEXEC X-011 CONTROL CARD. CX011 IS FOR SYSTEMS
C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX010.
C
CX020 REPLACED BY FEXEC X-020 CONTROL CARD (PRINTER UNIT NUMBER).
C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02= 6
CX021 REPLACED BY FEXEC X-021 CONTROL CARD. CX021 IS FOR SYSTEMS
C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX020.
C
CBE** ********************** BBCINITB **********************************
NUVI = I02
IVTOTL = 12
ZPROG = 'FM806'
CBB** ********************** BBCHED0A **********************************
C****
C**** WRITE REPORT TITLE
C****
WRITE (I02, 90002)
WRITE (I02, 90006)
WRITE (I02, 90007)
WRITE (I02, 90008) ZVERS, ZVERSD
WRITE (I02, 90009) ZPROG, ZPROG
WRITE (I02, 90010) ZDATE, ZCOMPL
CBE** ********************** BBCHED0A **********************************
C*****
WRITE (NUVI,16601)
16601 FORMAT (1H , // 1X,36HYDMAX1 - (166) INTRINSIC FUNCTION-- //17X,
1 31HDMAX1 (CHOOSING LARGEST VALUE)//2X,
2 15HANS REF. - 15.3)
CBB** ********************** BBCHED0B **********************************
C**** WRITE DETAIL REPORT HEADERS
C****
WRITE (I02,90004)
WRITE (I02,90004)
WRITE (I02,90013)
WRITE (I02,90014)
WRITE (I02,90015) IVTOTL
CBE** ********************** BBCHED0B **********************************
C*****
CT001* TEST 1 BOTH ZEROES
IVTNUM = 1
DTBVD = 0.0D0
DTDVD = 0.0D0
DTAVD = DMAX1(DTBVD, DTDVD)
IF (DTAVD + 5.0D-10) 20010, 10010, 40010
40010 IF (DTAVD - 5.0D-10) 10010, 10010, 20010
10010 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0011
20010 IVFAIL = IVFAIL + 1
DVCORR = 0.0D0
WRITE (NUVI, 80031) IVTNUM, DTAVD, DVCORR
0011 CONTINUE
CT002* TEST 2 ONE NON-ZERO, ONE ZERO
IVTNUM = 2
DTBVD = 5.625D0
DTDVD = 0.0D0
DTAVD = DMAX1(DTBVD, DTDVD)
IF (DTAVD - 5.624999997D0) 20020, 10020, 40020
40020 IF (DTAVD - 5.625000003D0) 10020, 10020, 20020
10020 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0021
20020 IVFAIL = IVFAIL + 1
DVCORR = 5.625D0
WRITE (NUVI, 80031) IVTNUM, DTAVD, DVCORR
0021 CONTINUE
CT003* TEST 3 BOTH VALUES EQUAL
IVTNUM = 3
DTBVD = 6.5D0
DTDVD = 6.5D0
DTAVD = DMAX1(DTBVD, DTDVD)
IF (DTAVD - 6.499999996D0) 20030, 10030, 40030
40030 IF (DTAVD - 6.500000004D0) 10030, 10030, 20030
10030 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0031
20030 IVFAIL = IVFAIL + 1
DVCORR = 6.5D0
WRITE (NUVI, 80031) IVTNUM, DTAVD, DVCORR
0031 CONTINUE
CT004* TEST 4 VALUES NOT EQUAL
IVTNUM = 4
DTBVD = 7.125D0
DTDVD = 5.125D0
DTAVD = DMAX1(DTBVD, DTDVD)
IF (DTAVD - 7.124999996D0) 20040, 10040, 40040
40040 IF (DTAVD - 7.125000004D0) 10040, 10040, 20040
10040 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0041
20040 IVFAIL = IVFAIL + 1
DVCORR = 7.125D0
WRITE (NUVI, 80031) IVTNUM, DTAVD, DVCORR
0041 CONTINUE
CT005* TEST 5 ONE VALUE ZERO, ONE NEGATIVE
IVTNUM = 5
DTBVD = -5.625D0
DTDVD = 0.0D0
DTAVD = DMAX1(DTBVD, DTDVD)
IF (DTAVD + 5.0D-10) 20050, 10050, 40050
40050 IF (DTAVD - 5.0D-10) 10050, 10050, 20050
10050 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0051
20050 IVFAIL = IVFAIL + 1
DVCORR = 0.0D0
WRITE (NUVI, 80031) IVTNUM, DTAVD, DVCORR
0051 CONTINUE
CT006* TEST 6 BOTH VALUES EQUAL, BOTH NEGATIVE
IVTNUM = 6
DTBVD = -6.5D0
DTDVD = -6.5D0
DTAVD = DMAX1(DTBVD, DTDVD)
IF (DTAVD + 6.500000004D0) 20060, 10060, 40060
40060 IF (DTAVD + 6.499999996D0) 10060, 10060, 20060
10060 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0061
20060 IVFAIL = IVFAIL + 1
DVCORR = -6.5D0
WRITE (NUVI, 80031) IVTNUM, DTAVD, DVCORR
0061 CONTINUE
CT007* TEST 7 VALUES NOT EQUAL, BOTH NEGATIVE
IVTNUM = 7
DTBVD = -7.125D0
DTDVD = -5.125D0
DTAVD = DMAX1(DTBVD, DTDVD)
IF (DTAVD + 5.125000003D0) 20070, 10070, 40070
40070 IF (DTAVD + 5.124999997D0) 10070, 10070, 20070
10070 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0071
20070 IVFAIL = IVFAIL + 1
DVCORR = -5.125D0
WRITE (NUVI, 80031) IVTNUM, DTAVD, DVCORR
0071 CONTINUE
CT008* TEST 8 1ST VALUE NON-ZERO, 2ND ZERO PRECEDED BY MINUS SIGN
IVTNUM = 8
DTDVD = 5.625D0
DTEVD = 0.0D0
DTAVD = DMAX1(DTDVD, -DTEVD)
IF (DTAVD - 5.624999997D0) 20080, 10080, 40080
40080 IF (DTAVD - 5.625000003D0) 10080, 10080, 20080
10080 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0081
20080 IVFAIL = IVFAIL + 1
DVCORR = 5.625D0
WRITE (NUVI, 80031) IVTNUM, DTAVD, DVCORR
0081 CONTINUE
CT009* TEST 9 ARITHMETIC EXPRESSIONS PRESENTED TO FUNCTION
IVTNUM = 9
DTDVD = 3.5D0
DTEVD = 4.0D0
DTAVD = DMAX1(DTDVD + DTEVD, -DTEVD - DTDVD)
IF (DTAVD - 7.499999996D0) 20090, 10090, 40090
40090 IF (DTAVD - 7.500000004D0) 10090, 10090, 20090
10090 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0091
20090 IVFAIL = IVFAIL + 1
DVCORR = 7.5D0
WRITE (NUVI, 80031) IVTNUM, DTAVD, DVCORR
0091 CONTINUE
CT010* TEST 10 3 ARGUMENTS
IVTNUM = 10
DTBVD = 0.0D0
DTCVD = -1.99D0
DTAVD = DMAX1(DTCVD, DTBVD, -DTCVD)
IF (DTAVD - 1.98999999D0) 20100, 10100, 40100
40100 IF (DTAVD - 1.99000001D0) 10100, 10100, 20100
10100 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0101
20100 IVFAIL = IVFAIL + 1
DVCORR = 1.99D0
WRITE (NUVI, 80031) IVTNUM, DTAVD, DVCORR
0101 CONTINUE
CT011* TEST 11 4 ARGUMENTS
IVTNUM = 11
C***** ARGUMENTS OF HIGH AND LOW MAGNITUDES
DTAVD = 1.0D-34
DTBVD = -1.0D-34
DTCVD = 1.0D+34
DTAVD = DMAX1(DTAVD, DTBVD, DTCVD, -DTCVD)
IF (DTAVD - 0.9999999995D34) 20110, 10110, 40110
40110 IF (DTAVD - 1.000000001D34) 10110, 10110, 20110
10110 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0111
20110 IVFAIL = IVFAIL + 1
DVCORR = 1.0D+34
WRITE (NUVI, 80031) IVTNUM, DTAVD, DVCORR
0111 CONTINUE
CT012* TEST 12 5 ARGUMENTS
IVTNUM = 12
DTDVD = 3.5D0
DTEVD = 4.5D0
DTAVD = DMAX1(DTDVD, -DTDVD, -DTEVD, +DTDVD, DTEVD)
IF (DTAVD - 4.499999997D0) 20120, 10120, 40120
40120 IF (DTAVD - 4.500000003D0) 10120, 10120, 20120
10120 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0121
20120 IVFAIL = IVFAIL + 1
DVCORR = 4.5D0
WRITE (NUVI, 80031) IVTNUM, DTAVD, DVCORR
0121 CONTINUE
C*****
CBB** ********************** BBCSUM0 **********************************
C**** WRITE OUT TEST SUMMARY
C****
IVTOTN = IVPASS + IVFAIL + IVDELE + IVINSP
WRITE (I02, 90004)
WRITE (I02, 90014)
WRITE (I02, 90004)
WRITE (I02, 90020) IVPASS
WRITE (I02, 90022) IVFAIL
WRITE (I02, 90024) IVDELE
WRITE (I02, 90026) IVINSP
WRITE (I02, 90028) IVTOTN, IVTOTL
CBE** ********************** BBCSUM0 **********************************
CBB** ********************** BBCFOOT0 **********************************
C**** WRITE OUT REPORT FOOTINGS
C****
WRITE (I02,90016) ZPROG, ZPROG
WRITE (I02,90018) ZPROJ, ZNAME, ZTAPE, ZTAPED
WRITE (I02,90019)
CBE** ********************** BBCFOOT0 **********************************
CBB** ********************** BBCFMT0A **********************************
C**** FORMATS FOR TEST DETAIL LINES
C****
80000 FORMAT (1H ,2X,I3,4X,7HDELETED,32X,A31)
80002 FORMAT (1H ,2X,I3,4X,7H PASS ,32X,A31)
80004 FORMAT (1H ,2X,I3,4X,7HINSPECT,32X,A31)
80008 FORMAT (1H ,2X,I3,4X,7H FAIL ,32X,A31)
80010 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,15X,10HCOMPUTED= ,
1I6,/,1H ,15X,10HCORRECT= ,I6)
80012 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
1E12.5,/,1H ,16X,10HCORRECT= ,E12.5)
80018 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
1A21,/,1H ,16X,10HCORRECT= ,A21)
80020 FORMAT (1H ,16X,10HCOMPUTED= ,A21,1X,A31)
80022 FORMAT (1H ,16X,10HCORRECT= ,A21,1X,A31)
80024 FORMAT (1H ,16X,10HCOMPUTED= ,I6,16X,A31)
80026 FORMAT (1H ,16X,10HCORRECT= ,I6,16X,A31)
80028 FORMAT (1H ,16X,10HCOMPUTED= ,E12.5,10X,A31)
80030 FORMAT (1H ,16X,10HCORRECT= ,E12.5,10X,A31)
80050 FORMAT (1H ,48X,A31)
CBE** ********************** BBCFMT0A **********************************
CBB** ********************** BBCFMAT1 **********************************
C**** FORMATS FOR TEST DETAIL LINES - FULL LANGUAGE
C****
80031 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
1D17.10,/,1H ,16X,10HCORRECT= ,D17.10)
80033 FORMAT (1H ,16X,10HCOMPUTED= ,D17.10,10X,A31)
80035 FORMAT (1H ,16X,10HCORRECT= ,D17.10,10X,A31)
80037 FORMAT (1H ,16X,10HCOMPUTED= ,1H(,E12.5,2H, ,E12.5,1H),6X,A31)
80039 FORMAT (1H ,16X,10HCORRECT= ,1H(,E12.5,2H, ,E12.5,1H),6X,A31)
80041 FORMAT (1H ,16X,10HCOMPUTED= ,1H(,F12.5,2H, ,F12.5,1H),6X,A31)
80043 FORMAT (1H ,16X,10HCORRECT= ,1H(,F12.5,2H, ,F12.5,1H),6X,A31)
80045 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
11H(,F12.5,2H, ,F12.5,1H)/,1H ,16X,10HCORRECT= ,
21H(,F12.5,2H, ,F12.5,1H))
CBE** ********************** BBCFMAT1 **********************************
CBB** ********************** BBCFMT0B **********************************
C**** FORMAT STATEMENTS FOR PAGE HEADERS
C****
90002 FORMAT (1H1)
90004 FORMAT (1H )
90006 FORMAT (1H ,20X,31HFEDERAL SOFTWARE TESTING CENTER)
90007 FORMAT (1H ,19X,34HFORTRAN COMPILER VALIDATION SYSTEM)
90008 FORMAT (1H ,21X,A13,A17)
90009 FORMAT (1H ,/,2H *,A5,6HBEGIN*,12X,15HTEST RESULTS - ,A5,/)
90010 FORMAT (1H ,8X,16HTEST DATE*TIME= ,A17,15H - COMPILER= ,A20)
90013 FORMAT (1H ,8H TEST ,10HPASS/FAIL ,6X,17HDISPLAYED RESULTS,
1 7X,7HREMARKS,24X)
90014 FORMAT (1H ,46H----------------------------------------------,
1 33H---------------------------------)
90015 FORMAT (1H ,48X,17HTHIS PROGRAM HAS ,I3,6H TESTS,/)
C****
C**** FORMAT STATEMENTS FOR REPORT FOOTINGS
C****
90016 FORMAT (1H ,/,2H *,A5,4HEND*,14X,14HEND OF TEST - ,A5,/)
90018 FORMAT (1H ,A13,13X,A20,7H * ,A10,1H/,
1 A13)
90019 FORMAT (1H ,26HFOR OFFICIAL USE ONLY ,35X,15HCOPYRIGHT 1982)
C****
C**** FORMAT STATEMENTS FOR RUN SUMMARY
C****
90020 FORMAT (1H ,21X,I5,13H TESTS PASSED)
90022 FORMAT (1H ,21X,I5,13H TESTS FAILED)
90024 FORMAT (1H ,21X,I5,14H TESTS DELETED)
90026 FORMAT (1H ,21X,I5,25H TESTS REQUIRE INSPECTION)
90028 FORMAT (1H ,21X,I5,4H OF ,I3,15H TESTS EXECUTED)
CBE** ********************** BBCFMT0B **********************************
C***** END OF TEST SEGMENT 166
STOP
END
*END-OF,FM806
FM807.f 481036481 170 2 100666 14749 `
*HEADER,FORTR,FM807
*FILES1,FORTR,FM807,X
C***********************************************************************
C***** FORTRAN 77
C***** FM807 YDMIN1 - (168)
C*****
C***********************************************************************
C***** GENERAL PURPOSE ANS REF
C***** TEST OF INTRINSIC FUNCTION -- 15.3
C***** DMIN1 -- CHOOSING SMALLEST VALUE (TABLE 5)
C*****
CBB** ********************** BBCCOMNT **********************************
C****
C**** 1978 FORTRAN COMPILER VALIDATION SYSTEM
C**** VERSION 2.0
C****
C****
C**** SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO
C**** GENERAL SERVICES ADMINISTRATION
C**** FEDERAL SOFTWARE TESTING CENTER
C**** 5203 LEESBURG PIKE, SUITE 1100
C**** FALLS CHURCH, VA. 22041
C****
C**** (703) 756-6153
C****
CBE** ********************** BBCCOMNT **********************************
C***** S P E C I F I C A T I O N S SEGMENT 168
DOUBLE PRECISION DUAVD, DUBVD, DUCVD, DUDVD, DUEVD, DVCORR
CBB** ********************** BBCINITA **********************************
C**** SPECIFICATION STATEMENTS
C****
CHARACTER ZVERS*13, ZVERSD*17, ZDATE*17, ZPROG*5, ZCOMPL*20,
1 ZNAME*20, ZTAPE*10, ZPROJ*13, REMRKS*31, ZTAPED*13
CBE** ********************** BBCINITA **********************************
CBB** ********************** BBCINITB **********************************
C**** INITIALIZE SECTION
DATA ZVERS, ZVERSD, ZDATE
1 /'VERSION 2.0 ', '82/08/02*18.33.46', '*NO DATE*TIME'/
DATA ZCOMPL, ZNAME, ZTAPE
1 /'*NONE SPECIFIED*', '*NO COMPANY NAME*', '*NO TAPE*'/
DATA ZPROJ, ZTAPED, ZPROG
1 /'*NO PROJECT*', '*NO TAPE DATE', 'XXXXX'/
DATA REMRKS /' '/
C**** THE FOLLOWING 9 COMMENT LINES (CZ01, CZ02, ...) CAN BE REPLACED
C**** FOR IDENTIFYING THE TEST ENVIRONMENT
C****
CZ01 ZVERS = 'VERSION OF THE COMPILER VALIDATION SYSTEM'
CZ02 ZVERSD = 'CREATION DATE/TIME OF THE COMPILER VALIDATION SYSTEM'
CZ03 ZPROG = 'PROGRAM NAME'
CZ04 ZDATE = 'DATE OF TEST'
CZ05 ZCOMPL = 'COMPILER IDENTIFICATION'
CZ06 ZPROJ = 'PROJECT NUMBER/IDENTIFICATION'
CZ07 ZNAME = 'NAME OF USER'
CZ08 ZTAPE = 'TAPE OWNER/ID'
CZ09 ZTAPED = 'DATE TAPE COPIED'
C
IVPASS = 0
IVFAIL = 0
IVDELE = 0
IVINSP = 0
IVTOTL = 0
IVTOTN = 0
ICZERO = 0
C
C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER.
I01 = 05
C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER.
I02 = 06
C
CX010 REPLACED BY FEXEC X-010 CONTROL CARD (CARD-READER UNIT NUMBER).
C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5
CX011 REPLACED BY FEXEC X-011 CONTROL CARD. CX011 IS FOR SYSTEMS
C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX010.
C
CX020 REPLACED BY FEXEC X-020 CONTROL CARD (PRINTER UNIT NUMBER).
C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02= 6
CX021 REPLACED BY FEXEC X-021 CONTROL CARD. CX021 IS FOR SYSTEMS
C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX020.
C
CBE** ********************** BBCINITB **********************************
NUVI = I02
IVTOTL = 12
ZPROG = 'FM807'
CBB** ********************** BBCHED0A **********************************
C****
C**** WRITE REPORT TITLE
C****
WRITE (I02, 90002)
WRITE (I02, 90006)
WRITE (I02, 90007)
WRITE (I02, 90008) ZVERS, ZVERSD
WRITE (I02, 90009) ZPROG, ZPROG
WRITE (I02, 90010) ZDATE, ZCOMPL
CBE** ********************** BBCHED0A **********************************
C*****
C*****
WRITE (NUVI,16801)
16801 FORMAT (1H , // 1X,36HYDMIN1 - (168) INTRINSIC FUNCTION-- //17X,
1 33HDMIN1 (CHOOSING SMALLEST VALUE) //2X,
2 15HANS REF. - 15.3)
CBB** ********************** BBCHED0B **********************************
C**** WRITE DETAIL REPORT HEADERS
C****
WRITE (I02,90004)
WRITE (I02,90004)
WRITE (I02,90013)
WRITE (I02,90014)
WRITE (I02,90015) IVTOTL
CBE** ********************** BBCHED0B **********************************
C*****
CT001* TEST 1 BOTH VALUES EQUAL
IVTNUM = 1
DUBVD = 0.0D0
DUDVD = 0.0D0
DUAVD = DMIN1(DUBVD, DUDVD)
IF (DUAVD + 5.0D-10) 20010, 10010, 40010
40010 IF (DUAVD - 5.0D-10) 10010, 10010, 20010
10010 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0011
20010 IVFAIL = IVFAIL + 1
DVCORR = 0.0D0
WRITE (NUVI, 80031) IVTNUM, DUAVD, DVCORR
0011 CONTINUE
CT002* TEST 2 FIRST VALUE NON-ZERO, SECOND ZERO
IVTNUM = 2
DUBVD = 5.625D0
DUDVD = 0.0D0
DUAVD = DMIN1(DUBVD, DUDVD)
IF (DUAVD + 5.0D-10) 20020, 10020, 40020
40020 IF (DUAVD - 5.0D-10) 10020, 10020, 20020
10020 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0021
20020 IVFAIL = IVFAIL + 1
DVCORR = 0.0D0
WRITE (NUVI, 80031) IVTNUM, DUAVD, DVCORR
0021 CONTINUE
CT003* TEST 3 BOTH VALUES EQUAL
IVTNUM = 3
DUBVD = 6.5D0
DUDVD = 6.5D0
DUAVD = DMIN1(DUBVD, DUDVD)
IF (DUAVD - 6.499999996D0) 20030, 10030, 40030
40030 IF (DUAVD - 6.500000004D0) 10030, 10030, 20030
10030 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0031
20030 IVFAIL = IVFAIL + 1
DVCORR = 6.5D0
WRITE (NUVI, 80031) IVTNUM, DUAVD, DVCORR
0031 CONTINUE
CT004* TEST 4 VALUES NOT EQUAL
IVTNUM = 4
DUBVD = 7.125D0
DUDVD = 5.125D0
DUAVD = DMIN1(DUBVD, DUDVD)
IF (DUAVD - 5.124999997D0) 20040, 10040, 40040
40040 IF (DUAVD - 5.125000003D0) 10040, 10040, 20040
10040 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0041
20040 IVFAIL = IVFAIL + 1
DVCORR = 5.125D0
WRITE (NUVI, 80031) IVTNUM, DUAVD, DVCORR
0041 CONTINUE
CT005* TEST 5 FIRST VALUE NEGATIVE, SECOND ZERO
IVTNUM = 5
DUBVD = -5.625D0
DUDVD = 0.0D0
DUAVD = DMIN1(DUBVD, DUDVD)
IF (DUAVD + 5.625000003D0) 20050, 10050, 40050
40050 IF (DUAVD + 5.624999997D0) 10050, 10050, 20050
10050 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0051
20050 IVFAIL = IVFAIL + 1
DVCORR = -5.625D0
WRITE (NUVI, 80031) IVTNUM, DUAVD, DVCORR
0051 CONTINUE
CT006* TEST 6 BOTH VALUES EQUAL, BOTH NEGATIVE
IVTNUM = 6
DUBVD = -6.5D0
DUDVD = -6.5D0
DUAVD = DMIN1(DUBVD, DUDVD)
IF (DUAVD + 6.500000004D0) 20060, 10060, 40060
40060 IF (DUAVD + 6.499999996D0) 10060, 10060, 20060
10060 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0061
20060 IVFAIL = IVFAIL + 1
DVCORR = -6.5D0
WRITE (NUVI, 80031) IVTNUM, DUAVD, DVCORR
0061 CONTINUE
CT007* TEST 7 VALUES NOT EQUAL, BOTH NEGATIVE
IVTNUM = 7
DUBVD = -7.125D0
DUDVD = -5.125D0
DUAVD = DMIN1(DUBVD, DUDVD)
IF (DUAVD + 7.125000004D0) 20070, 10070, 40070
40070 IF (DUAVD + 7.124999996D0) 10070, 10070, 20070
10070 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0071
20070 IVFAIL = IVFAIL + 1
DVCORR = -7.125D0
WRITE (NUVI, 80031) IVTNUM, DUAVD, DVCORR
0071 CONTINUE
CT008* TEST 8 1ST VALUE NON-ZERO, 2ND ZERO PRECEDED BY MINUS SIGN
IVTNUM = 8
DUDVD = 5.625D0
DUEVD = 0.0D0
DUAVD = DMIN1(DUDVD, -DUEVD)
IF (DUAVD + 5.0D-10) 20080, 10080, 40080
40080 IF (DUAVD - 5.0D-10) 10080, 10080, 20080
10080 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0081
20080 IVFAIL = IVFAIL + 1
DVCORR = 0.0D0
WRITE (NUVI, 80031) IVTNUM, DUAVD, DVCORR
0081 CONTINUE
CT009* TEST 9 ARITHMETIC EXPRESSIONS PRESENTED TO FUNCTION
IVTNUM = 9
DUDVD = 3.5D0
DUEVD = 4.0D0
DUAVD = DMIN1(DUDVD + DUEVD, -DUEVD - DUDVD)
IF (DUAVD + 7.500000004D0) 20090, 10090, 40090
40090 IF (DUAVD + 7.499999996D0) 10090, 10090, 20090
10090 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0091
20090 IVFAIL = IVFAIL + 1
DVCORR = -7.5D0
WRITE (NUVI, 80031) IVTNUM, DUAVD, DVCORR
0091 CONTINUE
CT010* TEST 10 3 ARGUMENTS
IVTNUM = 10
DUBVD = 0.0D0
DUCVD = 1.0D0
DUDVD = 2.0D0
DUAVD = DMIN1(DUBVD, DUCVD, DUDVD)
IF (DUAVD + 5.0D-10) 20100, 10100, 40100
40100 IF (DUAVD - 5.0D-10) 10100, 10100, 20100
10100 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0101
20100 IVFAIL = IVFAIL + 1
DVCORR = 0.0D0
WRITE (NUVI, 80031) IVTNUM, DUAVD, DVCORR
0101 CONTINUE
CT011* TEST 11 4 ARGUMENTS
IVTNUM = 11
C***** ARGUMENTS OF HIGH AND LOW MAGNITUDES
DUAVD = 1.0D+14
DUBVD = -1.0D+14
DUCVD = 1.0D-14
DUAVD = DMIN1(DUAVD, DUBVD, DUCVD, -DUCVD)
IF (DUAVD + 1.000000001D14) 20110, 10110, 40110
40110 IF (DUAVD + 0.9999999995D14) 10110, 10110, 20110
10110 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0111
20110 IVFAIL = IVFAIL + 1
DVCORR = -1.0D14
WRITE (NUVI, 80031) IVTNUM, DUAVD, DVCORR
0111 CONTINUE
CT012* TEST 12 5 ARGUMENTS
IVTNUM = 12
DUDVD = 3.5D0
DUEVD = 4.5D0
DUAVD = DMIN1(DUDVD, -DUDVD, -DUEVD, +DUDVD, DUEVD)
IF (DUAVD + 4.500000003D0) 20120, 10120, 40120
40120 IF (DUAVD + 4.499999997D0) 10120, 10120, 20120
10120 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0121
20120 IVFAIL = IVFAIL + 1
DVCORR = -4.5D0
WRITE (NUVI, 80031) IVTNUM, DUAVD, DVCORR
0121 CONTINUE
C*****
CBB** ********************** BBCSUM0 **********************************
C**** WRITE OUT TEST SUMMARY
C****
IVTOTN = IVPASS + IVFAIL + IVDELE + IVINSP
WRITE (I02, 90004)
WRITE (I02, 90014)
WRITE (I02, 90004)
WRITE (I02, 90020) IVPASS
WRITE (I02, 90022) IVFAIL
WRITE (I02, 90024) IVDELE
WRITE (I02, 90026) IVINSP
WRITE (I02, 90028) IVTOTN, IVTOTL
CBE** ********************** BBCSUM0 **********************************
CBB** ********************** BBCFOOT0 **********************************
C**** WRITE OUT REPORT FOOTINGS
C****
WRITE (I02,90016) ZPROG, ZPROG
WRITE (I02,90018) ZPROJ, ZNAME, ZTAPE, ZTAPED
WRITE (I02,90019)
CBE** ********************** BBCFOOT0 **********************************
CBB** ********************** BBCFMT0A **********************************
C**** FORMATS FOR TEST DETAIL LINES
C****
80000 FORMAT (1H ,2X,I3,4X,7HDELETED,32X,A31)
80002 FORMAT (1H ,2X,I3,4X,7H PASS ,32X,A31)
80004 FORMAT (1H ,2X,I3,4X,7HINSPECT,32X,A31)
80008 FORMAT (1H ,2X,I3,4X,7H FAIL ,32X,A31)
80010 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,15X,10HCOMPUTED= ,
1I6,/,1H ,15X,10HCORRECT= ,I6)
80012 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
1E12.5,/,1H ,16X,10HCORRECT= ,E12.5)
80018 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
1A21,/,1H ,16X,10HCORRECT= ,A21)
80020 FORMAT (1H ,16X,10HCOMPUTED= ,A21,1X,A31)
80022 FORMAT (1H ,16X,10HCORRECT= ,A21,1X,A31)
80024 FORMAT (1H ,16X,10HCOMPUTED= ,I6,16X,A31)
80026 FORMAT (1H ,16X,10HCORRECT= ,I6,16X,A31)
80028 FORMAT (1H ,16X,10HCOMPUTED= ,E12.5,10X,A31)
80030 FORMAT (1H ,16X,10HCORRECT= ,E12.5,10X,A31)
80050 FORMAT (1H ,48X,A31)
CBE** ********************** BBCFMT0A **********************************
CBB** ********************** BBCFMAT1 **********************************
C**** FORMATS FOR TEST DETAIL LINES - FULL LANGUAGE
C****
80031 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
1D17.10,/,1H ,16X,10HCORRECT= ,D17.10)
80033 FORMAT (1H ,16X,10HCOMPUTED= ,D17.10,10X,A31)
80035 FORMAT (1H ,16X,10HCORRECT= ,D17.10,10X,A31)
80037 FORMAT (1H ,16X,10HCOMPUTED= ,1H(,E12.5,2H, ,E12.5,1H),6X,A31)
80039 FORMAT (1H ,16X,10HCORRECT= ,1H(,E12.5,2H, ,E12.5,1H),6X,A31)
80041 FORMAT (1H ,16X,10HCOMPUTED= ,1H(,F12.5,2H, ,F12.5,1H),6X,A31)
80043 FORMAT (1H ,16X,10HCORRECT= ,1H(,F12.5,2H, ,F12.5,1H),6X,A31)
80045 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
11H(,F12.5,2H, ,F12.5,1H)/,1H ,16X,10HCORRECT= ,
21H(,F12.5,2H, ,F12.5,1H))
CBE** ********************** BBCFMAT1 **********************************
CBB** ********************** BBCFMT0B **********************************
C**** FORMAT STATEMENTS FOR PAGE HEADERS
C****
90002 FORMAT (1H1)
90004 FORMAT (1H )
90006 FORMAT (1H ,20X,31HFEDERAL SOFTWARE TESTING CENTER)
90007 FORMAT (1H ,19X,34HFORTRAN COMPILER VALIDATION SYSTEM)
90008 FORMAT (1H ,21X,A13,A17)
90009 FORMAT (1H ,/,2H *,A5,6HBEGIN*,12X,15HTEST RESULTS - ,A5,/)
90010 FORMAT (1H ,8X,16HTEST DATE*TIME= ,A17,15H - COMPILER= ,A20)
90013 FORMAT (1H ,8H TEST ,10HPASS/FAIL ,6X,17HDISPLAYED RESULTS,
1 7X,7HREMARKS,24X)
90014 FORMAT (1H ,46H----------------------------------------------,
1 33H---------------------------------)
90015 FORMAT (1H ,48X,17HTHIS PROGRAM HAS ,I3,6H TESTS,/)
C****
C**** FORMAT STATEMENTS FOR REPORT FOOTINGS
C****
90016 FORMAT (1H ,/,2H *,A5,4HEND*,14X,14HEND OF TEST - ,A5,/)
90018 FORMAT (1H ,A13,13X,A20,7H * ,A10,1H/,
1 A13)
90019 FORMAT (1H ,26HFOR OFFICIAL USE ONLY ,35X,15HCOPYRIGHT 1982)
C****
C**** FORMAT STATEMENTS FOR RUN SUMMARY
C****
90020 FORMAT (1H ,21X,I5,13H TESTS PASSED)
90022 FORMAT (1H ,21X,I5,13H TESTS FAILED)
90024 FORMAT (1H ,21X,I5,14H TESTS DELETED)
90026 FORMAT (1H ,21X,I5,25H TESTS REQUIRE INSPECTION)
90028 FORMAT (1H ,21X,I5,4H OF ,I3,15H TESTS EXECUTED)
CBE** ********************** BBCFMT0B **********************************
C***** END OF TEST SEGMENT 168
STOP
END
*END-OF,FM807
FM808.f 481036484 170 2 100666 12246 `
*HEADER,FORTR,FM808
*FILES1,FORTR,FM808,X
C***********************************************************************
C***** FORTRAN 77
C***** FM808 YDBLE - (169)
C*****
C***********************************************************************
C***** GENERAL PURPOSE ANS REF
C***** TEST INTRINSIC FUNCTION DBLE (EXPRESS S.P. ARGUMENT 15.3
C***** IN DOUBLE PRECISION FORM ) (TABLE 5)
C*****
CBB** ********************** BBCCOMNT **********************************
C****
C**** 1978 FORTRAN COMPILER VALIDATION SYSTEM
C**** VERSION 2.0
C****
C****
C**** SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO
C**** GENERAL SERVICES ADMINISTRATION
C**** FEDERAL SOFTWARE TESTING CENTER
C**** 5203 LEESBURG PIKE, SUITE 1100
C**** FALLS CHURCH, VA. 22041
C****
C**** (703) 756-6153
C****
CBE** ********************** BBCCOMNT **********************************
C*****
C***** S P E C I F I C A T I O N S SEGMENT 169
DOUBLE PRECISION DVAVD, DVBVD, DVCORR, DVAVD1
C*****
CBB** ********************** BBCINITA **********************************
C**** SPECIFICATION STATEMENTS
C****
CHARACTER ZVERS*13, ZVERSD*17, ZDATE*17, ZPROG*5, ZCOMPL*20,
1 ZNAME*20, ZTAPE*10, ZPROJ*13, REMRKS*31, ZTAPED*13
CBE** ********************** BBCINITA **********************************
CBB** ********************** BBCINITB **********************************
C**** INITIALIZE SECTION
DATA ZVERS, ZVERSD, ZDATE
1 /'VERSION 2.0 ', '82/08/02*18.33.46', '*NO DATE*TIME'/
DATA ZCOMPL, ZNAME, ZTAPE
1 /'*NONE SPECIFIED*', '*NO COMPANY NAME*', '*NO TAPE*'/
DATA ZPROJ, ZTAPED, ZPROG
1 /'*NO PROJECT*', '*NO TAPE DATE', 'XXXXX'/
DATA REMRKS /' '/
C**** THE FOLLOWING 9 COMMENT LINES (CZ01, CZ02, ...) CAN BE REPLACED
C**** FOR IDENTIFYING THE TEST ENVIRONMENT
C****
CZ01 ZVERS = 'VERSION OF THE COMPILER VALIDATION SYSTEM'
CZ02 ZVERSD = 'CREATION DATE/TIME OF THE COMPILER VALIDATION SYSTEM'
CZ03 ZPROG = 'PROGRAM NAME'
CZ04 ZDATE = 'DATE OF TEST'
CZ05 ZCOMPL = 'COMPILER IDENTIFICATION'
CZ06 ZPROJ = 'PROJECT NUMBER/IDENTIFICATION'
CZ07 ZNAME = 'NAME OF USER'
CZ08 ZTAPE = 'TAPE OWNER/ID'
CZ09 ZTAPED = 'DATE TAPE COPIED'
C
IVPASS = 0
IVFAIL = 0
IVDELE = 0
IVINSP = 0
IVTOTL = 0
IVTOTN = 0
ICZERO = 0
C
C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER.
I01 = 05
C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER.
I02 = 06
C
CX010 REPLACED BY FEXEC X-010 CONTROL CARD (CARD-READER UNIT NUMBER).
C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5
CX011 REPLACED BY FEXEC X-011 CONTROL CARD. CX011 IS FOR SYSTEMS
C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX010.
C
CX020 REPLACED BY FEXEC X-020 CONTROL CARD (PRINTER UNIT NUMBER).
C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02= 6
CX021 REPLACED BY FEXEC X-021 CONTROL CARD. CX021 IS FOR SYSTEMS
C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX020.
C
CBE** ********************** BBCINITB **********************************
NUVI = I02
IVTOTL = 8
ZPROG = 'FM808'
CBB** ********************** BBCHED0A **********************************
C****
C**** WRITE REPORT TITLE
C****
WRITE (I02, 90002)
WRITE (I02, 90006)
WRITE (I02, 90007)
WRITE (I02, 90008) ZVERS, ZVERSD
WRITE (I02, 90009) ZPROG, ZPROG
WRITE (I02, 90010) ZDATE, ZCOMPL
CBE** ********************** BBCHED0A **********************************
C*****
WRITE (NUVI,16901)
16901 FORMAT(1H ,//1X,34HYDBLE - (169) INTRINSIC FUNCTION--//
1 16X,22HDBLE (TYPE CONVERSION)// 2X,
2 15HANS REF. - 15.3)
CBB** ********************** BBCHED0B **********************************
C**** WRITE DETAIL REPORT HEADERS
C****
WRITE (I02,90004)
WRITE (I02,90004)
WRITE (I02,90013)
WRITE (I02,90014)
WRITE (I02,90015) IVTOTL
CBE** ********************** BBCHED0B **********************************
C*****
CT001* TEST 1 THE VALUE ZERO
IVTNUM = 1
RVAVS = 0.0
DVAVD = DBLE(RVAVS)
IF (DVAVD + 5.0D-5) 20010, 10010, 40010
40010 IF (DVAVD - 5.0D-5) 10010, 10010, 20010
10010 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0011
20010 IVFAIL = IVFAIL + 1
DVCORR = 0.0D0
WRITE (NUVI, 80031) IVTNUM, DVAVD, DVCORR
0011 CONTINUE
CT002* TEST 2 A D.P. CONSTANT WITH 6 SIGNIFICANT DIGITS
IVTNUM = 2
RVAVS = 0.015625
DVAVD = DBLE(RVAVS)
IF (DVAVD - 1.5624D-2) 20020, 10020, 40020
40020 IF (DVAVD - 1.5626D-2) 10020, 10020, 20020
10020 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0021
20020 IVFAIL = IVFAIL + 1
DVCORR = 1.5625D-2
WRITE (NUVI, 80031) IVTNUM, DVAVD, DVCORR
0021 CONTINUE
CT003* TEST 3 A NEGATIVE INTEGRAL VALUE
IVTNUM = 3
RVAVS = -321.0
DVAVD = DBLE(RVAVS)
IF (DVAVD + 3.2102D2) 20030, 10030, 40030
40030 IF (DVAVD + 3.2098D2) 10030, 10030, 20030
10030 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0031
20030 IVFAIL = IVFAIL + 1
DVCORR = -3.210D2
WRITE (NUVI, 80031) IVTNUM, DVAVD, DVCORR
0031 CONTINUE
CT004* TEST 4 A NEGATIVE D.P. CONSTANT WITH 6 SIGNIFICANT DIGITS
IVTNUM = 4
RVAVS = -0.015625
DVAVD = DBLE(RVAVS)
IF (DVAVD + 1.5626D-2) 20040, 10040, 40040
40040 IF (DVAVD + 1.5624D-2) 10040, 10040, 20040
10040 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0041
20040 IVFAIL = IVFAIL + 1
DVCORR = -0.015625D0
WRITE (NUVI, 80031) IVTNUM, DVAVD, DVCORR
0041 CONTINUE
CT005* TEST 5 THE VALUE ZERO PRECEDED BY A MINUS SIGN
IVTNUM = 5
RVAVS = 0.0
DVAVD = DBLE(-RVAVS)
IF (DVAVD + 5.0D-5) 20050, 10050, 40050
40050 IF (DVAVD - 5.0D-5) 10050, 10050, 20050
10050 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0051
20050 IVFAIL = IVFAIL + 1
DVCORR = -0.0D0
WRITE (NUVI, 80031) IVTNUM, DVAVD, DVCORR
0051 CONTINUE
CT006* TEST 6 A POSITIVE INTEGRAL VALUE
IVTNUM = 6
RVAVS = 321.0
DVAVD = DBLE(RVAVS)
IF (DVAVD - 3.2098D2) 20060, 10060, 40060
40060 IF (DVAVD - 3.2102D2) 10060, 10060, 20060
10060 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0061
20060 IVFAIL = IVFAIL + 1
DVCORR = 3.21D2
WRITE (NUVI, 80031) IVTNUM, DVAVD, DVCORR
0061 CONTINUE
CT007* TEST 7 AN ARITHMETIC EXPRESSION IS USED AS ARGUMENT
IVTNUM = 7
RVAVS = 6.25
RVBVS = 2.5
DVAVD = DBLE(RVBVS ** 2)
IF (DVAVD - 6.2496D0) 20070, 10070, 40070
40070 IF (DVAVD - 6.2504D0) 10070, 10070, 20070
10070 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0071
20070 IVFAIL = IVFAIL + 1
DVCORR = 6.25D0
WRITE (NUVI, 80031) IVTNUM, DVAVD, DVCORR
0071 CONTINUE
CT008* TEST 8 COMPARE AUTOMATIC TYPE CONVERSION TO EXPLICIT
IVTNUM = 8
RVBVS = 2.5
DVBVD = RVBVS ** 3
DVAVD = DBLE(RVBVS ** 3)
IF (DVAVD - 1.5624D1) 20080, 10080, 40080
40080 IF (DVAVD - 1.5626D1) 10080, 10080, 20080
10080 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0081
20080 IVFAIL = IVFAIL + 1
DVCORR = 1.5625D1
WRITE (NUVI, 80031) IVTNUM, DVAVD, DVCORR
0081 CONTINUE
CBB** ********************** BBCSUM0 **********************************
C**** WRITE OUT TEST SUMMARY
C****
IVTOTN = IVPASS + IVFAIL + IVDELE + IVINSP
WRITE (I02, 90004)
WRITE (I02, 90014)
WRITE (I02, 90004)
WRITE (I02, 90020) IVPASS
WRITE (I02, 90022) IVFAIL
WRITE (I02, 90024) IVDELE
WRITE (I02, 90026) IVINSP
WRITE (I02, 90028) IVTOTN, IVTOTL
CBE** ********************** BBCSUM0 **********************************
CBB** ********************** BBCFOOT0 **********************************
C**** WRITE OUT REPORT FOOTINGS
C****
WRITE (I02,90016) ZPROG, ZPROG
WRITE (I02,90018) ZPROJ, ZNAME, ZTAPE, ZTAPED
WRITE (I02,90019)
CBE** ********************** BBCFOOT0 **********************************
CBB** ********************** BBCFMT0A **********************************
C**** FORMATS FOR TEST DETAIL LINES
C****
80000 FORMAT (1H ,2X,I3,4X,7HDELETED,32X,A31)
80002 FORMAT (1H ,2X,I3,4X,7H PASS ,32X,A31)
80004 FORMAT (1H ,2X,I3,4X,7HINSPECT,32X,A31)
80008 FORMAT (1H ,2X,I3,4X,7H FAIL ,32X,A31)
80010 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,15X,10HCOMPUTED= ,
1I6,/,1H ,15X,10HCORRECT= ,I6)
80012 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
1E12.5,/,1H ,16X,10HCORRECT= ,E12.5)
80018 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
1A21,/,1H ,16X,10HCORRECT= ,A21)
80020 FORMAT (1H ,16X,10HCOMPUTED= ,A21,1X,A31)
80022 FORMAT (1H ,16X,10HCORRECT= ,A21,1X,A31)
80024 FORMAT (1H ,16X,10HCOMPUTED= ,I6,16X,A31)
80026 FORMAT (1H ,16X,10HCORRECT= ,I6,16X,A31)
80028 FORMAT (1H ,16X,10HCOMPUTED= ,E12.5,10X,A31)
80030 FORMAT (1H ,16X,10HCORRECT= ,E12.5,10X,A31)
80050 FORMAT (1H ,48X,A31)
CBE** ********************** BBCFMT0A **********************************
CBB** ********************** BBCFMAT1 **********************************
C**** FORMATS FOR TEST DETAIL LINES - FULL LANGUAGE
C****
80031 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
1D17.10,/,1H ,16X,10HCORRECT= ,D17.10)
80033 FORMAT (1H ,16X,10HCOMPUTED= ,D17.10,10X,A31)
80035 FORMAT (1H ,16X,10HCORRECT= ,D17.10,10X,A31)
80037 FORMAT (1H ,16X,10HCOMPUTED= ,1H(,E12.5,2H, ,E12.5,1H),6X,A31)
80039 FORMAT (1H ,16X,10HCORRECT= ,1H(,E12.5,2H, ,E12.5,1H),6X,A31)
80041 FORMAT (1H ,16X,10HCOMPUTED= ,1H(,F12.5,2H, ,F12.5,1H),6X,A31)
80043 FORMAT (1H ,16X,10HCORRECT= ,1H(,F12.5,2H, ,F12.5,1H),6X,A31)
80045 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
11H(,F12.5,2H, ,F12.5,1H)/,1H ,16X,10HCORRECT= ,
21H(,F12.5,2H, ,F12.5,1H))
CBE** ********************** BBCFMAT1 **********************************
CBB** ********************** BBCFMT0B **********************************
C**** FORMAT STATEMENTS FOR PAGE HEADERS
C****
90002 FORMAT (1H1)
90004 FORMAT (1H )
90006 FORMAT (1H ,20X,31HFEDERAL SOFTWARE TESTING CENTER)
90007 FORMAT (1H ,19X,34HFORTRAN COMPILER VALIDATION SYSTEM)
90008 FORMAT (1H ,21X,A13,A17)
90009 FORMAT (1H ,/,2H *,A5,6HBEGIN*,12X,15HTEST RESULTS - ,A5,/)
90010 FORMAT (1H ,8X,16HTEST DATE*TIME= ,A17,15H - COMPILER= ,A20)
90013 FORMAT (1H ,8H TEST ,10HPASS/FAIL ,6X,17HDISPLAYED RESULTS,
1 7X,7HREMARKS,24X)
90014 FORMAT (1H ,46H----------------------------------------------,
1 33H---------------------------------)
90015 FORMAT (1H ,48X,17HTHIS PROGRAM HAS ,I3,6H TESTS,/)
C****
C**** FORMAT STATEMENTS FOR REPORT FOOTINGS
C****
90016 FORMAT (1H ,/,2H *,A5,4HEND*,14X,14HEND OF TEST - ,A5,/)
90018 FORMAT (1H ,A13,13X,A20,7H * ,A10,1H/,
1 A13)
90019 FORMAT (1H ,26HFOR OFFICIAL USE ONLY ,35X,15HCOPYRIGHT 1982)
C****
C**** FORMAT STATEMENTS FOR RUN SUMMARY
C****
90020 FORMAT (1H ,21X,I5,13H TESTS PASSED)
90022 FORMAT (1H ,21X,I5,13H TESTS FAILED)
90024 FORMAT (1H ,21X,I5,14H TESTS DELETED)
90026 FORMAT (1H ,21X,I5,25H TESTS REQUIRE INSPECTION)
90028 FORMAT (1H ,21X,I5,4H OF ,I3,15H TESTS EXECUTED)
CBE** ********************** BBCFMT0B **********************************
C*****
C***** END OF TEST SEGMENT 169
STOP
END
*END-OF,FM808
FM809.f 481036489 170 2 100666 23021 `
*HEADER,FORTR,FM809
*FILES1,FORTR,FM809,X
C***********************************************************************
C***** FORTRAN 77
C***** FM809 YCONJG - (170)
C*****
C***********************************************************************
C***** GENERAL PURPOSE ANS REF
C***** TEST INTRINSIC FUNCTION CMPLX (CONVERT TO COMPLEX), 15.3
C***** AIMAG (IMAGINARY PART), AND CONJG (CONJUGATE) (TABLE 5)
C*****
C***** S P E C I F I C A T I O N S SEGMENT 170
CBB** ********************** BBCCOMNT **********************************
C****
C**** 1978 FORTRAN COMPILER VALIDATION SYSTEM
C**** VERSION 2.0
C****
C****
C**** SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO
C**** GENERAL SERVICES ADMINISTRATION
C**** FEDERAL SOFTWARE TESTING CENTER
C**** 5203 LEESBURG PIKE, SUITE 1100
C**** FALLS CHURCH, VA. 22041
C****
C**** (703) 756-6153
C****
CBE** ********************** BBCCOMNT **********************************
C*****
COMPLEX CWAVC, CWBVC, CWDVC, CWEVC, ZVCORR
REAL R2E(2)
EQUIVALENCE (CWAVC,R2E)
C*****
CBB** ********************** BBCINITA **********************************
C**** SPECIFICATION STATEMENTS
C****
CHARACTER ZVERS*13, ZVERSD*17, ZDATE*17, ZPROG*5, ZCOMPL*20,
1 ZNAME*20, ZTAPE*10, ZPROJ*13, REMRKS*31, ZTAPED*13
CBE** ********************** BBCINITA **********************************
CBB** ********************** BBCINITB **********************************
C**** INITIALIZE SECTION
DATA ZVERS, ZVERSD, ZDATE
1 /'VERSION 2.0 ', '82/08/02*18.33.46', '*NO DATE*TIME'/
DATA ZCOMPL, ZNAME, ZTAPE
1 /'*NONE SPECIFIED*', '*NO COMPANY NAME*', '*NO TAPE*'/
DATA ZPROJ, ZTAPED, ZPROG
1 /'*NO PROJECT*', '*NO TAPE DATE', 'XXXXX'/
DATA REMRKS /' '/
C**** THE FOLLOWING 9 COMMENT LINES (CZ01, CZ02, ...) CAN BE REPLACED
C**** FOR IDENTIFYING THE TEST ENVIRONMENT
C****
CZ01 ZVERS = 'VERSION OF THE COMPILER VALIDATION SYSTEM'
CZ02 ZVERSD = 'CREATION DATE/TIME OF THE COMPILER VALIDATION SYSTEM'
CZ03 ZPROG = 'PROGRAM NAME'
CZ04 ZDATE = 'DATE OF TEST'
CZ05 ZCOMPL = 'COMPILER IDENTIFICATION'
CZ06 ZPROJ = 'PROJECT NUMBER/IDENTIFICATION'
CZ07 ZNAME = 'NAME OF USER'
CZ08 ZTAPE = 'TAPE OWNER/ID'
CZ09 ZTAPED = 'DATE TAPE COPIED'
C
IVPASS = 0
IVFAIL = 0
IVDELE = 0
IVINSP = 0
IVTOTL = 0
IVTOTN = 0
ICZERO = 0
C
C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER.
I01 = 05
C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER.
I02 = 06
C
CX010 REPLACED BY FEXEC X-010 CONTROL CARD (CARD-READER UNIT NUMBER).
C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5
CX011 REPLACED BY FEXEC X-011 CONTROL CARD. CX011 IS FOR SYSTEMS
C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX010.
C
CX020 REPLACED BY FEXEC X-020 CONTROL CARD (PRINTER UNIT NUMBER).
C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02= 6
CX021 REPLACED BY FEXEC X-021 CONTROL CARD. CX021 IS FOR SYSTEMS
C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX020.
C
CBE** ********************** BBCINITB **********************************
NUVI = I02
IVTOTL = 25
ZPROG = 'FM809'
CBB** ********************** BBCHED0A **********************************
C****
C**** WRITE REPORT TITLE
C****
WRITE (I02, 90002)
WRITE (I02, 90006)
WRITE (I02, 90007)
WRITE (I02, 90008) ZVERS, ZVERSD
WRITE (I02, 90009) ZPROG, ZPROG
WRITE (I02, 90010) ZDATE, ZCOMPL
CBE** ********************** BBCHED0A **********************************
C*****
C***** HEADER FOR SEGMENT 170 WRITTEN
WRITE (NUVI,17001)
17001 FORMAT(1H , //1X,35HYCONJG - (170) INTRINSIC FUNCTION--//17X,
1 27HCMPLX (CONVERT TO COMPLEX),/17X,
2 19HAIMAG (IMAG. PART),/17X,
3 17HCONJG (CONJUGATE)//,2X,
4 15HANS REF. - 15.3)
CBB** ********************** BBCHED0B **********************************
C**** WRITE DETAIL REPORT HEADERS
C****
WRITE (I02,90004)
WRITE (I02,90004)
WRITE (I02,90013)
WRITE (I02,90014)
WRITE (I02,90015) IVTOTL
CBE** ********************** BBCHED0B **********************************
C*****
C***** TEST OF CMPLX
C*****
WRITE(NUVI, 17002)
17002 FORMAT(/ 8X, 13HTEST OF CMPLX)
CT001* TEST 1 PAIR OF ZEROES
IVTNUM = 1
RWBVS = 0.0
RWDVS = 0.0
CWAVC = CMPLX(RWBVS, RWDVS)
IF (R2E(1) + 0.00005) 20010, 40012, 40011
40011 IF (R2E(1) - 0.00005) 40012, 40012, 20010
40012 IF (R2E(2) + 0.00005) 20010, 10010, 40010
40010 IF (R2E(2) - 0.00005) 10010, 10010, 20010
10010 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0011
20010 IVFAIL = IVFAIL + 1
ZVCORR = (0.0 , 0.0)
WRITE (NUVI, 80045) IVTNUM, CWAVC, ZVCORR
0011 CONTINUE
CT002* TEST 2 FIRST VALUE NON-ZERO, SECOND ZERO
IVTNUM = 2
RWBVS = 3.0
RWDVS = 0.0
CWAVC = CMPLX(RWBVS, RWDVS)
IF (R2E(1) - 2.9998) 20020, 40022, 40021
40021 IF (R2E(1) - 3.0002) 40022, 40022, 20020
40022 IF (R2E(2) + 0.00005) 20020, 10020, 40020
40020 IF (R2E(2) - 0.00005) 10020, 10020, 20020
10020 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0021
20020 IVFAIL = IVFAIL + 1
ZVCORR = (3.0 , 0.0)
WRITE (NUVI, 80045) IVTNUM, CWAVC, ZVCORR
0021 CONTINUE
CT003* TEST 3 FIRST VALUE ZERO, SECOND NON-ZERO
IVTNUM = 3
RWBVS = 0.0
RWDVS = 4.0
CWAVC = CMPLX(RWBVS, RWDVS)
IF (R2E(1) + 0.00005) 20030, 40032, 40031
40031 IF (R2E(1) - 0.00005) 40032, 40032, 20030
40032 IF (R2E(2) - 3.9998) 20030, 10030, 40030
40030 IF (R2E(2) - 4.0002) 10030, 10030, 20030
10030 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0031
20030 IVFAIL = IVFAIL + 1
ZVCORR = (0.0 , 4.0)
WRITE (NUVI, 80045) IVTNUM, CWAVC, ZVCORR
0031 CONTINUE
CT004* TEST 4 PAIR OF NON-ZERO VALUES
IVTNUM = 4
RWBVS = 3.0
RWDVS = 4.0
CWAVC = CMPLX(RWBVS, RWDVS)
IF (R2E(1) - 2.9998) 20040, 40042, 40041
40041 IF (R2E(1) - 3.0002) 40042, 40042, 20040
40042 IF (R2E(2) - 3.9998) 20040, 10040, 40040
40040 IF (R2E(2) - 4.0002) 10040, 10040, 20040
10040 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0041
20040 IVFAIL = IVFAIL + 1
ZVCORR = (3.0 , 4.0)
WRITE (NUVI, 80045) IVTNUM, CWAVC, ZVCORR
0041 CONTINUE
CT005* TEST 5 FIRST VALUE NEGATIVE, SECOND ZERO
IVTNUM = 5
RWBVS = -3.0
RWDVS = 0.0
CWAVC = CMPLX(RWBVS, RWDVS)
IF (R2E(1) + 3.0002) 20050, 40052, 40051
40051 IF (R2E(1) + 2.9998) 40052, 40052, 20050
40052 IF (R2E(2) + 0.00005) 20050, 10050, 40050
40050 IF (R2E(2) - 0.00005) 10050, 10050, 20050
10050 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0051
20050 IVFAIL = IVFAIL + 1
ZVCORR = (-3.0, 0.0)
WRITE (NUVI, 80045) IVTNUM, CWAVC, ZVCORR
0051 CONTINUE
CT006* TEST 6 FIRST VALUE ZERO, SECOND NEGATIVE
IVTNUM = 6
RWBVS = 0.0
RWDVS = -4.0
CWAVC = CMPLX(RWBVS, RWDVS)
IF (R2E(1) + 0.00005) 20060, 40062, 40061
40061 IF (R2E(1) - 0.00005) 40062, 40062, 20060
40062 IF (R2E(2) + 4.0002) 20060, 10060, 40060
40060 IF (R2E(2) + 3.9998) 10060, 10060, 20060
10060 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0061
20060 IVFAIL = IVFAIL + 1
ZVCORR = (0.0, -4.0)
WRITE (NUVI, 80045) IVTNUM, CWAVC, ZVCORR
0061 CONTINUE
CT007* TEST 7 PAIR OF NEGATIVE VALUES
IVTNUM = 7
RWBVS = -3.0
RWDVS = -4.0
CWAVC = CMPLX(RWBVS, RWDVS)
IF (R2E(1) + 3.0002) 20070, 40072, 40071
40071 IF (R2E(1) + 2.9998) 40072, 40072, 20070
40072 IF (R2E(2) + 4.0002) 20070, 10070, 40070
40070 IF (R2E(2) + 3.9998) 10070, 10070, 20070
10070 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0071
20070 IVFAIL = IVFAIL + 1
ZVCORR = (-3.0, -4.0)
WRITE (NUVI, 80045) IVTNUM, CWAVC, ZVCORR
0071 CONTINUE
CT008* TEST 8 FIRST VALUE PRECEDED BY A MINUS SIGN
IVTNUM = 8
RWAVS = 3.0
RWBVS = 0.0
CWAVC = CMPLX(-RWAVS, RWBVS)
IF (R2E(1) + 3.0002) 20080, 40082, 40081
40081 IF (R2E(1) + 2.9998) 40082, 40082, 20080
40082 IF (R2E(2) + 0.00005) 20080, 10080, 40080
40080 IF (R2E(2) - 0.00005) 10080, 10080, 20080
10080 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0081
20080 IVFAIL = IVFAIL + 1
ZVCORR = (-3.0, 0.0)
WRITE (NUVI, 80045) IVTNUM, CWAVC, ZVCORR
0081 CONTINUE
CT009* TEST 9 ONE ARGUMENT A CONSTANT, OTHER A VARIABLE
IVTNUM = 9
RWAVS = 4.0
CWAVC = CMPLX(0.0, RWAVS)
IF (R2E(1) + 0.00005) 20090, 40092, 40091
40091 IF (R2E(1) - 0.00005) 40092, 40092, 20090
40092 IF (R2E(2) - 3.9998) 20090, 10090, 40090
40090 IF (R2E(2) - 4.0002) 10090, 10090, 20090
10090 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0091
20090 IVFAIL = IVFAIL + 1
ZVCORR = (0.0, 4.0)
WRITE (NUVI, 80045) IVTNUM, CWAVC, ZVCORR
0091 CONTINUE
CT010* TEST 10 PAIR OF ARITHMETIC EXPRESSIONS USED AS ARGUMENT
IVTNUM = 10
RWAVS = 1.5
RWBVS = 2.0
RWCVS = 3.5
CWAVC = CMPLX((RWCVS + RWAVS)/ RWBVS, (RWCVS - RWAVS) / RWBVS)
IF (R2E(1) - 2.4998) 20100, 40102, 40101
40101 IF (R2E(1) - 2.5002) 40102, 40102, 20100
40102 IF (R2E(2) - 0.99995) 20100, 10100, 40100
40100 IF (R2E(2) - 1.0001) 10100, 10100, 20100
10100 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0101
20100 IVFAIL = IVFAIL + 1
ZVCORR = (2.5, 1.0)
WRITE (NUVI, 80045) IVTNUM, CWAVC, ZVCORR
0101 CONTINUE
C*****
WRITE(NUVI, 90002)
WRITE(NUVI, 90013)
WRITE(NUVI, 90014)
C*****
C***** TEST OF AIMAG
C*****
WRITE(NUVI, 17004)
17004 FORMAT(/ 8X, 13HTEST OF AIMAG)
CT011* TEST 11 THE COMPLEX VALUE ZERO (0,0)
IVTNUM = 11
RWAVS = AIMAG((0.0, 0.0))
IF (RWAVS + 0.00005) 20110, 10110, 40110
40110 IF (RWAVS - 0.00005) 10110, 10110, 20110
10110 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0111
20110 IVFAIL = IVFAIL + 1
RVCORR = 0.0
WRITE (NUVI, 80012) IVTNUM, RWAVS, RVCORR
0111 CONTINUE
CT012* TEST 12 COMPLEX VALUE HAVING ONLY A REAL COMPONENT
IVTNUM = 12
RWAVS = AIMAG((3.0, 0.0))
IF (RWAVS + 0.00005) 20120, 10120, 40120
40120 IF (RWAVS - 0.00005) 10120, 10120, 20120
10120 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0121
20120 IVFAIL = IVFAIL + 1
RVCORR = 0.0
WRITE (NUVI, 80012) IVTNUM, RWAVS, RVCORR
0121 CONTINUE
CT013* TEST 13 ARBITRARY COMPLEX VALUE
IVTNUM = 13
RWAVS = AIMAG((3.0, 4.0))
IF (RWAVS - 3.9998) 20130, 10130, 40130
40130 IF (RWAVS - 4.0002) 10130, 10130, 20130
10130 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0131
20130 IVFAIL = IVFAIL + 1
RVCORR = 4.0
WRITE (NUVI, 80012) IVTNUM, RWAVS, RVCORR
0131 CONTINUE
CT014* TEST 14 IMAGINARY COMPONENT A ZERO PRECEDED BY MINUS SIGN
IVTNUM = 14
RWAVS = AIMAG((-3.0, -0.0))
IF (RWAVS + 0.00005) 20140, 10140, 40140
40140 IF (RWAVS - 0.00005) 10140, 10140, 20140
10140 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0141
20140 IVFAIL = IVFAIL + 1
RVCORR = 0.0
WRITE (NUVI, 80012) IVTNUM, RWAVS, RVCORR
0141 CONTINUE
CT015* TEST 15 ARBITRARY COMPLEX VALUE WITH NEGATIVE COMPONENTS
IVTNUM = 15
RWAVS = AIMAG((-3.0, -4.0))
IF (RWAVS + 4.0002) 20150, 10150, 40150
40150 IF (RWAVS + 3.9998) 10150, 10150, 20150
10150 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0151
20150 IVFAIL = IVFAIL + 1
RVCORR = -4.0
WRITE (NUVI, 80012) IVTNUM, RWAVS, RVCORR
0151 CONTINUE
CT016* TEST 16 COMPLEX VALUE ZERO (0,0) PRECEDED BY MINUS SIGN
IVTNUM = 16
CWDVC = (0.0, 0.0)
RWAVS = AIMAG(-CWDVC)
IF (RWAVS + 0.00005) 20160, 10160, 40160
40160 IF (RWAVS - 0.00005) 10160, 10160, 20160
10160 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0161
20160 IVFAIL = IVFAIL + 1
RVCORR = 0.0
WRITE (NUVI, 80012) IVTNUM, RWAVS, RVCORR
0161 CONTINUE
CT017* TEST 17 ARGUMENT IS A COMPLEX EXPRESSION
IVTNUM = 17
CWDVC = (3.5, 4.5)
CWEVC = (4.0, 5.0)
RWAVS = AIMAG(CWDVC - CWEVC)
IF (RWAVS + 0.50003) 20170, 10170, 40170
40170 IF (RWAVS + 0.49997) 10170, 10170, 20170
10170 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0171
20170 IVFAIL = IVFAIL + 1
RVCORR = -0.5
WRITE (NUVI, 80012) IVTNUM, RWAVS, RVCORR
0171 CONTINUE
CT018* TEST 18 CONJG FORMS ARGUMENT TO AIMAG
IVTNUM = 18
CWDVC = (3.0, 4.0)
RWAVS = AIMAG(CONJG(CWDVC))
IF (RWAVS + 4.0002) 20180, 10180, 40180
40180 IF (RWAVS + 3.9998) 10180, 10180, 20180
10180 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0181
20180 IVFAIL = IVFAIL + 1
RVCORR = -4.0
WRITE (NUVI, 80012) IVTNUM, RWAVS, RVCORR
0181 CONTINUE
C*****
WRITE(NUVI, 90002)
WRITE(NUVI, 90013)
WRITE(NUVI, 90014)
C*****
C***** TEST OF CONJG
C*****
WRITE (NUVI,17006)
17006 FORMAT (/ 8X, 13HTEST OF CONJG)
CT019* TEST 19 COMPLEX VALUE ZERO (0,0)
IVTNUM = 19
CWAVC = CONJG((0.0, 0.0))
IF (R2E(1) + 0.00005) 20190, 40192, 40191
40191 IF (R2E(1) - 0.00005) 40192, 40192, 20190
40192 IF (R2E(2) + 0.00005) 20190, 10190, 40190
40190 IF (R2E(2) - 0.00005) 10190, 10190, 20190
10190 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0191
20190 IVFAIL = IVFAIL + 1
ZVCORR = (0.0, 0.0)
WRITE (NUVI, 80045) IVTNUM, CWAVC, ZVCORR
0191 CONTINUE
CT020* TEST 20 COMPLEX VALUE HAVING ONLY REAL COMPONENT
IVTNUM = 20
CWAVC = CONJG((3.0, 0.0))
IF (R2E(1) - 2.9998) 20200, 40202, 40201
40201 IF (R2E(1) - 3.0002) 40202, 40202, 20200
40202 IF (R2E(2) + 0.00005) 20200, 10200, 40200
40200 IF (R2E(2) - 0.00005) 10200, 10200, 20200
10200 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0201
20200 IVFAIL = IVFAIL + 1
ZVCORR = (3.0, 0.0)
WRITE (NUVI, 80045) IVTNUM, CWAVC, ZVCORR
0201 CONTINUE
CT021* TEST 21 ARBITRARY COMPLEX VALUE
IVTNUM = 21
CWAVC = CONJG((3.0, 4.0))
IF (R2E(1) - 2.9998) 20210, 40212, 40211
40211 IF (R2E(1) - 3.0002) 40212, 40212, 20210
40212 IF (R2E(2) + 4.0002) 20210, 10210, 40210
40210 IF (R2E(2) + 3.9998) 10210, 10210, 20210
10210 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0211
20210 IVFAIL = IVFAIL + 1
ZVCORR = (3.0, -4.0)
WRITE (NUVI, 80045) IVTNUM, CWAVC, ZVCORR
0211 CONTINUE
CWBVC = (3.0, -4.0)
CT022* TEST 22 SECOND ARGUMENT IS A ZERO PRECEDED BY MINUS SIGN
IVTNUM = 22
CWAVC = CONJG((-3.0, -0.0))
IF (R2E(1) + 3.0002) 20220, 40222, 40221
40221 IF (R2E(1) + 2.9998) 40222, 40222, 20220
40222 IF (R2E(2) + 0.00005) 20220, 10220, 40220
40220 IF (R2E(2) - 0.00005) 10220, 10220, 20220
10220 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0221
20220 IVFAIL = IVFAIL + 1
ZVCORR = (-3.0, 0.0)
WRITE (NUVI, 80045) IVTNUM, CWAVC, ZVCORR
0221 CONTINUE
CT023* TEST 23 ABITRARY COMPLEX VALUE WITH NEGATIVE COMPONENTS
IVTNUM = 23
CWAVC = CONJG((-3.0, -4.0))
IF (R2E(1) + 3.0002) 20230, 40232, 40231
40231 IF (R2E(1) + 2.9998) 40232, 40232, 20230
40232 IF (R2E(2) - 3.9998) 20230, 10230, 40230
40230 IF (R2E(2) - 4.0002) 10230, 10230, 20230
10230 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0231
20230 IVFAIL = IVFAIL + 1
ZVCORR = (-3.0, 4.0)
WRITE (NUVI, 80045) IVTNUM, CWAVC, ZVCORR
0231 CONTINUE
CWBVC = (-3.0, 4.0)
CT024* TEST 24 COMPLEX ZERO PRECEDED BY A MINUS SIGN
IVTNUM = 24
CWDVC = (0.0, 0.0)
CWAVC = CONJG(-CWDVC)
IF (R2E(1) + 0.00005) 20240, 40242, 40241
40241 IF (R2E(1) - 0.00005) 40242, 40242, 20240
40242 IF (R2E(2) + 0.00005) 20240, 10240, 40240
40240 IF (R2E(2) - 0.00005) 10240, 10240, 20240
10240 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0241
20240 IVFAIL = IVFAIL + 1
ZVCORR = (0.0, 0.0)
WRITE (NUVI, 80045) IVTNUM, CWAVC, ZVCORR
0241 CONTINUE
CT025* TEST 25 COMPLEX EXPRESSION PRESENTED AS ARGUMENT
IVTNUM = 25
CWDVC = (3.5, 4.5)
CWEVC = (4.0, 5.0)
CWAVC = CONJG(CWDVC - CWEVC)
IF (R2E(1) + 0.50003) 20250, 40252, 40251
40251 IF (R2E(1) + 0.49997) 40252, 40252, 20250
40252 IF (R2E(2) - 0.49997) 20250, 10250, 40250
40250 IF (R2E(2) - 0.50003) 10250, 10250, 20250
10250 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0251
20250 IVFAIL = IVFAIL + 1
ZVCORR = (-0.5, 0.5)
WRITE (NUVI, 80045) IVTNUM, CWAVC, ZVCORR
0251 CONTINUE
C*****
CBB** ********************** BBCSUM0 **********************************
C**** WRITE OUT TEST SUMMARY
C****
IVTOTN = IVPASS + IVFAIL + IVDELE + IVINSP
WRITE (I02, 90004)
WRITE (I02, 90014)
WRITE (I02, 90004)
WRITE (I02, 90020) IVPASS
WRITE (I02, 90022) IVFAIL
WRITE (I02, 90024) IVDELE
WRITE (I02, 90026) IVINSP
WRITE (I02, 90028) IVTOTN, IVTOTL
CBE** ********************** BBCSUM0 **********************************
CBB** ********************** BBCFOOT0 **********************************
C**** WRITE OUT REPORT FOOTINGS
C****
WRITE (I02,90016) ZPROG, ZPROG
WRITE (I02,90018) ZPROJ, ZNAME, ZTAPE, ZTAPED
WRITE (I02,90019)
CBE** ********************** BBCFOOT0 **********************************
CBB** ********************** BBCFMT0A **********************************
C**** FORMATS FOR TEST DETAIL LINES
C****
80000 FORMAT (1H ,2X,I3,4X,7HDELETED,32X,A31)
80002 FORMAT (1H ,2X,I3,4X,7H PASS ,32X,A31)
80004 FORMAT (1H ,2X,I3,4X,7HINSPECT,32X,A31)
80008 FORMAT (1H ,2X,I3,4X,7H FAIL ,32X,A31)
80010 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,15X,10HCOMPUTED= ,
1I6,/,1H ,15X,10HCORRECT= ,I6)
80012 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
1E12.5,/,1H ,16X,10HCORRECT= ,E12.5)
80018 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
1A21,/,1H ,16X,10HCORRECT= ,A21)
80020 FORMAT (1H ,16X,10HCOMPUTED= ,A21,1X,A31)
80022 FORMAT (1H ,16X,10HCORRECT= ,A21,1X,A31)
80024 FORMAT (1H ,16X,10HCOMPUTED= ,I6,16X,A31)
80026 FORMAT (1H ,16X,10HCORRECT= ,I6,16X,A31)
80028 FORMAT (1H ,16X,10HCOMPUTED= ,E12.5,10X,A31)
80030 FORMAT (1H ,16X,10HCORRECT= ,E12.5,10X,A31)
80050 FORMAT (1H ,48X,A31)
CBE** ********************** BBCFMT0A **********************************
CBB** ********************** BBCFMAT1 **********************************
C**** FORMATS FOR TEST DETAIL LINES - FULL LANGUAGE
C****
80031 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
1D17.10,/,1H ,16X,10HCORRECT= ,D17.10)
80033 FORMAT (1H ,16X,10HCOMPUTED= ,D17.10,10X,A31)
80035 FORMAT (1H ,16X,10HCORRECT= ,D17.10,10X,A31)
80037 FORMAT (1H ,16X,10HCOMPUTED= ,1H(,E12.5,2H, ,E12.5,1H),6X,A31)
80039 FORMAT (1H ,16X,10HCORRECT= ,1H(,E12.5,2H, ,E12.5,1H),6X,A31)
80041 FORMAT (1H ,16X,10HCOMPUTED= ,1H(,F12.5,2H, ,F12.5,1H),6X,A31)
80043 FORMAT (1H ,16X,10HCORRECT= ,1H(,F12.5,2H, ,F12.5,1H),6X,A31)
80045 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
11H(,F12.5,2H, ,F12.5,1H)/,1H ,16X,10HCORRECT= ,
21H(,F12.5,2H, ,F12.5,1H))
CBE** ********************** BBCFMAT1 **********************************
CBB** ********************** BBCFMT0B **********************************
C**** FORMAT STATEMENTS FOR PAGE HEADERS
C****
90002 FORMAT (1H1)
90004 FORMAT (1H )
90006 FORMAT (1H ,20X,31HFEDERAL SOFTWARE TESTING CENTER)
90007 FORMAT (1H ,19X,34HFORTRAN COMPILER VALIDATION SYSTEM)
90008 FORMAT (1H ,21X,A13,A17)
90009 FORMAT (1H ,/,2H *,A5,6HBEGIN*,12X,15HTEST RESULTS - ,A5,/)
90010 FORMAT (1H ,8X,16HTEST DATE*TIME= ,A17,15H - COMPILER= ,A20)
90013 FORMAT (1H ,8H TEST ,10HPASS/FAIL ,6X,17HDISPLAYED RESULTS,
1 7X,7HREMARKS,24X)
90014 FORMAT (1H ,46H----------------------------------------------,
1 33H---------------------------------)
90015 FORMAT (1H ,48X,17HTHIS PROGRAM HAS ,I3,6H TESTS,/)
C****
C**** FORMAT STATEMENTS FOR REPORT FOOTINGS
C****
90016 FORMAT (1H ,/,2H *,A5,4HEND*,14X,14HEND OF TEST - ,A5,/)
90018 FORMAT (1H ,A13,13X,A20,7H * ,A10,1H/,
1 A13)
90019 FORMAT (1H ,26HFOR OFFICIAL USE ONLY ,35X,15HCOPYRIGHT 1982)
C****
C**** FORMAT STATEMENTS FOR RUN SUMMARY
C****
90020 FORMAT (1H ,21X,I5,13H TESTS PASSED)
90022 FORMAT (1H ,21X,I5,13H TESTS FAILED)
90024 FORMAT (1H ,21X,I5,14H TESTS DELETED)
90026 FORMAT (1H ,21X,I5,25H TESTS REQUIRE INSPECTION)
90028 FORMAT (1H ,21X,I5,4H OF ,I3,15H TESTS EXECUTED)
CBE** ********************** BBCFMT0B **********************************
C*****
C***** END OF TEST SEGMENT 170
STOP
END
*END-OF,FM809
FM810.f 481036504 170 2 100666 13579 `
*HEADER,FORTR,FM810
*FILES1,FORTR,FM810,X
C***********************************************************************
C***** FORTRAN 77
C***** FM810 YDMMX - (173)
C*****
C***********************************************************************
C***** GENERAL PURPOSE ANS REF
C***** TESTS THE USE OF INTEGER, REAL, DOUBLE PRECISION, 15.3
C***** AND MIXED MODE EXPRESSIONS CONTAINING REFERENCES TO 15.10
C***** THE INTRINSIC FUNCTIONS OF THE FULL LANGUAGE 6.1.4
C*****
C***** GENERAL COMMENTS
C***** SEGMENTS TESTING XINT, XREAL, XAINT, XABS, XAMOD,
C***** XSIGN, XDIM, XMAX, XMIN, YIDINT, YSNGL
C***** YDINT, YDABS, YCABS, YDMOD, YDSIGN,
C***** YDMAX1, YDMIN1, YDBLE, YCONJG ASSUMED WORKING
CBB** ********************** BBCCOMNT **********************************
C****
C**** 1978 FORTRAN COMPILER VALIDATION SYSTEM
C**** VERSION 2.0
C****
C****
C**** SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO
C**** GENERAL SERVICES ADMINISTRATION
C**** FEDERAL SOFTWARE TESTING CENTER
C**** 5203 LEESBURG PIKE, SUITE 1100
C**** FALLS CHURCH, VA. 22041
C****
C**** (703) 756-6153
C****
CBE** ********************** BBCCOMNT **********************************
C*****
C***** S P E C I F I C A T I O N S SEGMENT 173
DOUBLE PRECISION DXAVD,DXBVD,DXDVD,DXEVD,DXFVD,DXGVD,DVCORR
CBB** ********************** BBCINITA **********************************
C**** SPECIFICATION STATEMENTS
C****
CHARACTER ZVERS*13, ZVERSD*17, ZDATE*17, ZPROG*5, ZCOMPL*20,
1 ZNAME*20, ZTAPE*10, ZPROJ*13, REMRKS*31, ZTAPED*13
CBE** ********************** BBCINITA **********************************
CBB** ********************** BBCINITB **********************************
C**** INITIALIZE SECTION
DATA ZVERS, ZVERSD, ZDATE
1 /'VERSION 2.0 ', '82/08/02*18.33.46', '*NO DATE*TIME'/
DATA ZCOMPL, ZNAME, ZTAPE
1 /'*NONE SPECIFIED*', '*NO COMPANY NAME*', '*NO TAPE*'/
DATA ZPROJ, ZTAPED, ZPROG
1 /'*NO PROJECT*', '*NO TAPE DATE', 'XXXXX'/
DATA REMRKS /' '/
C**** THE FOLLOWING 9 COMMENT LINES (CZ01, CZ02, ...) CAN BE REPLACED
C**** FOR IDENTIFYING THE TEST ENVIRONMENT
C****
CZ01 ZVERS = 'VERSION OF THE COMPILER VALIDATION SYSTEM'
CZ02 ZVERSD = 'CREATION DATE/TIME OF THE COMPILER VALIDATION SYSTEM'
CZ03 ZPROG = 'PROGRAM NAME'
CZ04 ZDATE = 'DATE OF TEST'
CZ05 ZCOMPL = 'COMPILER IDENTIFICATION'
CZ06 ZPROJ = 'PROJECT NUMBER/IDENTIFICATION'
CZ07 ZNAME = 'NAME OF USER'
CZ08 ZTAPE = 'TAPE OWNER/ID'
CZ09 ZTAPED = 'DATE TAPE COPIED'
C
IVPASS = 0
IVFAIL = 0
IVDELE = 0
IVINSP = 0
IVTOTL = 0
IVTOTN = 0
ICZERO = 0
C
C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER.
I01 = 05
C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER.
I02 = 06
C
CX010 REPLACED BY FEXEC X-010 CONTROL CARD (CARD-READER UNIT NUMBER).
C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5
CX011 REPLACED BY FEXEC X-011 CONTROL CARD. CX011 IS FOR SYSTEMS
C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX010.
C
CX020 REPLACED BY FEXEC X-020 CONTROL CARD (PRINTER UNIT NUMBER).
C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02= 6
CX021 REPLACED BY FEXEC X-021 CONTROL CARD. CX021 IS FOR SYSTEMS
C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX020.
C
CBE** ********************** BBCINITB **********************************
NUVI = I02
IVTOTL = 10
ZPROG = 'FM810'
CBB** ********************** BBCHED0A **********************************
C****
C**** WRITE REPORT TITLE
C****
WRITE (I02, 90002)
WRITE (I02, 90006)
WRITE (I02, 90007)
WRITE (I02, 90008) ZVERS, ZVERSD
WRITE (I02, 90009) ZPROG, ZPROG
WRITE (I02, 90010) ZDATE, ZCOMPL
CBE** ********************** BBCHED0A **********************************
C*****
C*****
C***** HEADER FOR SEGMENT 173 WRITTEN
WRITE (NUVI,17301)
17301 FORMAT(1H , //1X, 35HYDMMX - (173) INTRINSIC FUNCTIONS--//
1 16X, 22HINTEGER, REAL AND D.P./,
2 16X, 26HAND MIXED MODE EXPRESSIONS//
3 2X, 29HANS REF. - 15.3, 15.10, 6.1.4)
CBB** ********************** BBCHED0B **********************************
C**** WRITE DETAIL REPORT HEADERS
C****
WRITE (I02,90004)
WRITE (I02,90004)
WRITE (I02,90013)
WRITE (I02,90014)
WRITE (I02,90015) IVTOTL
CBE** ********************** BBCHED0B **********************************
C*****
CT001* TEST 1
IVTNUM = 1
DXBVD = 3.5D0
IXAVI = IDINT(DXBVD) + 2
IF (IXAVI - 5) 20010, 10010, 20010
10010 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0011
20010 IVFAIL = IVFAIL + 1
IVCORR = 5
WRITE (NUVI, 80010) IVTNUM, IXAVI, IVCORR
0011 CONTINUE
CT002* TEST 2
IVTNUM = 2
DXBVD = 5.25D0
RXAVS = SNGL(DXBVD) * 3.0
IF (RXAVS - 15.749) 20020, 10020, 40020
40020 IF (RXAVS - 15.751) 10020, 10020, 20020
10020 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0021
20020 IVFAIL = IVFAIL + 1
RVCORR = 15.75
WRITE (NUVI, 80012) IVTNUM, RXAVS, RVCORR
0021 CONTINUE
CT003* TEST 3
IVTNUM = 3
DXBVD = 3.2D0
DXAVD = DINT(DXBVD) ** 2.0
IF (DXAVD - 8.999999995D0) 20030, 10030, 40030
40030 IF (DXAVD - 9.000000005D0) 10030, 10030, 20030
10030 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0031
20030 IVFAIL = IVFAIL + 1
DVCORR = 9.0D0
WRITE (NUVI, 80031) IVTNUM, DXAVD, DVCORR
0031 CONTINUE
CT004* TEST 4
IVTNUM = 4
DXBVD = 3.2D0
DXAVD = DNINT(DXBVD) + 2.5
IF (DXAVD - 5.499999997D0) 20040, 10040, 40040
40040 IF (DXAVD - 5.500000003D0) 10040, 10040, 20040
10040 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0041
20040 IVFAIL = IVFAIL + 1
DVCORR = 5.5D0
WRITE (NUVI, 80031) IVTNUM, DXAVD, DVCORR
0041 CONTINUE
CT005* TEST 5
IVTNUM = 5
DXBVD = 3.5D0
RXAVS = IDINT(DXBVD) * 2.5
IF (RXAVS - 7.4996) 20050, 10050, 40050
40050 IF (RXAVS - 7.5004) 10050, 10050, 20050
10050 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0051
20050 IVFAIL = IVFAIL + 1
RVCORR = 7.5
WRITE (NUVI, 80012) IVTNUM, RXAVS, RVCORR
0051 CONTINUE
CT006* TEST 6
IVTNUM = 6
DXBVD = -2.5D0
DXAVD = DABS(DXBVD) * 2
IF (DXAVD - 4.999999997D0) 20060, 10060, 40060
40060 IF (DXAVD - 5.000000003D0) 10060, 10060, 20060
10060 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0061
20060 IVFAIL = IVFAIL + 1
DVCORR = 5.0D0
WRITE (NUVI, 80031) IVTNUM, DXAVD, DVCORR
0061 CONTINUE
CT007* TEST 7
IVTNUM = 7
DXBVD = 5.0D0
DXDVD = 2.0D0
DXEVD = 3.0D0
DXFVD = -1.0D0
DXAVD = DMOD(DXBVD, DXDVD) * 3 + DSIGN(DXEVD, DXFVD)
IF (DXAVD + 5.0D-10) 20070, 10070, 40070
40070 IF (DXAVD - 5.0D-10) 10070, 10070, 20070
10070 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0071
20070 IVFAIL = IVFAIL + 1
DVCORR = 0.0D0
WRITE (NUVI, 80031) IVTNUM, DXAVD, DVCORR
0071 CONTINUE
CT008* TEST 8
IVTNUM = 8
DXBVD = 1.5D1
DXDVD = 0.5D1
RXBVS = 5.0
RXDVS = 2.0
DXAVD = DDIM(DXBVD, DXDVD) / DPROD(RXBVS, RXDVS)
IF (DXAVD - 0.9999999995D0) 20080, 10080, 40080
40080 IF (DXAVD - 1.000000001D0) 10080, 10080, 20080
10080 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0081
20080 IVFAIL = IVFAIL + 1
DVCORR = 1.0D0
WRITE (NUVI, 80031) IVTNUM, DXAVD, DVCORR
0081 CONTINUE
CT009* TEST 9
IVTNUM = 9
DXBVD = 5.5D0
DXDVD = 2.5D0
DXEVD = 1.0D0
RXBVS = 1.0
DXAVD = (10 - DMAX1(DXBVD, DXDVD)) * (DMIN1(DXEVD, DXDVD)
1 + DBLE(RXBVS))
IF (DXAVD - 8.999999995D0) 20090, 10090, 40090
40090 IF (DXAVD - 9.000000005D0) 10090, 10090, 20090
10090 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0091
20090 IVFAIL = IVFAIL + 1
DVCORR = 9.0D0
WRITE (NUVI, 80031) IVTNUM, DXAVD, DVCORR
0091 CONTINUE
CT010* TEST 10
IVTNUM = 10
DXBVD = 0.635D2
RXBVS = 5.0
DXDVD = 5.7D0
DXEVD = -6.0D0
DXFVD = 1.0D0
DXGVD = 3.0D0
DXAVD = (IDINT(DXBVD) + 1.0) / (7 - DBLE(RXBVS)) -
1 (DINT(DXDVD) + 5 + 5.5) * (DSIGN(DXEVD, DXFVD) /
2 SNGL(DXGVD))
IF (DXAVD - 0.9999999995D0) 20100, 10100, 40100
40100 IF (DXAVD - 1.000000001D0) 10100, 10100, 20100
10100 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0101
20100 IVFAIL = IVFAIL + 1
DVCORR = 1.0D0
WRITE (NUVI, 80031) IVTNUM, DXAVD, DVCORR
0101 CONTINUE
C*****
CBB** ********************** BBCSUM0 **********************************
C**** WRITE OUT TEST SUMMARY
C****
IVTOTN = IVPASS + IVFAIL + IVDELE + IVINSP
WRITE (I02, 90004)
WRITE (I02, 90014)
WRITE (I02, 90004)
WRITE (I02, 90020) IVPASS
WRITE (I02, 90022) IVFAIL
WRITE (I02, 90024) IVDELE
WRITE (I02, 90026) IVINSP
WRITE (I02, 90028) IVTOTN, IVTOTL
CBE** ********************** BBCSUM0 **********************************
CBB** ********************** BBCFOOT0 **********************************
C**** WRITE OUT REPORT FOOTINGS
C****
WRITE (I02,90016) ZPROG, ZPROG
WRITE (I02,90018) ZPROJ, ZNAME, ZTAPE, ZTAPED
WRITE (I02,90019)
CBE** ********************** BBCFOOT0 **********************************
CBB** ********************** BBCFMT0A **********************************
C**** FORMATS FOR TEST DETAIL LINES
C****
80000 FORMAT (1H ,2X,I3,4X,7HDELETED,32X,A31)
80002 FORMAT (1H ,2X,I3,4X,7H PASS ,32X,A31)
80004 FORMAT (1H ,2X,I3,4X,7HINSPECT,32X,A31)
80008 FORMAT (1H ,2X,I3,4X,7H FAIL ,32X,A31)
80010 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,15X,10HCOMPUTED= ,
1I6,/,1H ,15X,10HCORRECT= ,I6)
80012 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
1E12.5,/,1H ,16X,10HCORRECT= ,E12.5)
80018 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
1A21,/,1H ,16X,10HCORRECT= ,A21)
80020 FORMAT (1H ,16X,10HCOMPUTED= ,A21,1X,A31)
80022 FORMAT (1H ,16X,10HCORRECT= ,A21,1X,A31)
80024 FORMAT (1H ,16X,10HCOMPUTED= ,I6,16X,A31)
80026 FORMAT (1H ,16X,10HCORRECT= ,I6,16X,A31)
80028 FORMAT (1H ,16X,10HCOMPUTED= ,E12.5,10X,A31)
80030 FORMAT (1H ,16X,10HCORRECT= ,E12.5,10X,A31)
80050 FORMAT (1H ,48X,A31)
CBE** ********************** BBCFMT0A **********************************
CBB** ********************** BBCFMAT1 **********************************
C**** FORMATS FOR TEST DETAIL LINES - FULL LANGUAGE
C****
80031 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
1D17.10,/,1H ,16X,10HCORRECT= ,D17.10)
80033 FORMAT (1H ,16X,10HCOMPUTED= ,D17.10,10X,A31)
80035 FORMAT (1H ,16X,10HCORRECT= ,D17.10,10X,A31)
80037 FORMAT (1H ,16X,10HCOMPUTED= ,1H(,E12.5,2H, ,E12.5,1H),6X,A31)
80039 FORMAT (1H ,16X,10HCORRECT= ,1H(,E12.5,2H, ,E12.5,1H),6X,A31)
80041 FORMAT (1H ,16X,10HCOMPUTED= ,1H(,F12.5,2H, ,F12.5,1H),6X,A31)
80043 FORMAT (1H ,16X,10HCORRECT= ,1H(,F12.5,2H, ,F12.5,1H),6X,A31)
80045 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
11H(,F12.5,2H, ,F12.5,1H)/,1H ,16X,10HCORRECT= ,
21H(,F12.5,2H, ,F12.5,1H))
CBE** ********************** BBCFMAT1 **********************************
CBB** ********************** BBCFMT0B **********************************
C**** FORMAT STATEMENTS FOR PAGE HEADERS
C****
90002 FORMAT (1H1)
90004 FORMAT (1H )
90006 FORMAT (1H ,20X,31HFEDERAL SOFTWARE TESTING CENTER)
90007 FORMAT (1H ,19X,34HFORTRAN COMPILER VALIDATION SYSTEM)
90008 FORMAT (1H ,21X,A13,A17)
90009 FORMAT (1H ,/,2H *,A5,6HBEGIN*,12X,15HTEST RESULTS - ,A5,/)
90010 FORMAT (1H ,8X,16HTEST DATE*TIME= ,A17,15H - COMPILER= ,A20)
90013 FORMAT (1H ,8H TEST ,10HPASS/FAIL ,6X,17HDISPLAYED RESULTS,
1 7X,7HREMARKS,24X)
90014 FORMAT (1H ,46H----------------------------------------------,
1 33H---------------------------------)
90015 FORMAT (1H ,48X,17HTHIS PROGRAM HAS ,I3,6H TESTS,/)
C****
C**** FORMAT STATEMENTS FOR REPORT FOOTINGS
C****
90016 FORMAT (1H ,/,2H *,A5,4HEND*,14X,14HEND OF TEST - ,A5,/)
90018 FORMAT (1H ,A13,13X,A20,7H * ,A10,1H/,
1 A13)
90019 FORMAT (1H ,26HFOR OFFICIAL USE ONLY ,35X,15HCOPYRIGHT 1982)
C****
C**** FORMAT STATEMENTS FOR RUN SUMMARY
C****
90020 FORMAT (1H ,21X,I5,13H TESTS PASSED)
90022 FORMAT (1H ,21X,I5,13H TESTS FAILED)
90024 FORMAT (1H ,21X,I5,14H TESTS DELETED)
90026 FORMAT (1H ,21X,I5,25H TESTS REQUIRE INSPECTION)
90028 FORMAT (1H ,21X,I5,4H OF ,I3,15H TESTS EXECUTED)
CBE** ********************** BBCFMT0B **********************************
C***** END OF TEST SEGMENT 173
STOP
END
*END-OF,FM810
FM811.f 481036513 170 2 100666 14773 `
*HEADER,FORTR,FM811
*FILES1,FORTR,FM811,X
C***********************************************************************
C***** FORTRAN 77
C***** FM811 YCMMX - (174)
C*****
C***********************************************************************
C***** GENERAL PURPOSE ANS REF
C***** TESTS THE USE OF INTEGER, REAL, DOUBLE PRECISION, 15.10
C***** AND COMPLEX EXPRESSIONS CONTAINING REFERENCE (TABLE 5)
C***** TO THE INTRINSIC FUNCTIONS OF THE FULL LANGUAGE 6.1.4
C*****
C***** GENERAL COMMENTS
C***** SEGMENTS TESTING XINT, XREAL, XAINT, XABS, XAMOD,
C***** XSIGN, XDIM, XMAX, XMIN, YIDINT, YSNGL
C***** YDINT, YDABS, YCABS, YDMOD, YDSIGN,
C***** YDMAX1, YDMIN1, YDBLE, YCONJG ASSUMED WORKING
C*****
CBB** ********************** BBCCOMNT **********************************
C****
C**** 1978 FORTRAN COMPILER VALIDATION SYSTEM
C**** VERSION 2.0
C****
C****
C**** SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO
C**** GENERAL SERVICES ADMINISTRATION
C**** FEDERAL SOFTWARE TESTING CENTER
C**** 5203 LEESBURG PIKE, SUITE 1100
C**** FALLS CHURCH, VA. 22041
C****
C**** (703) 756-6153
C****
CBE** ********************** BBCCOMNT **********************************
C*****
C***** S P E C I F I C A T I O N S SEGMENT 174
DOUBLE PRECISION DYAVD, DYBVD, DYDVD, DVCORR
COMPLEX CYAVC, CYDVC, ZVCORR
REAL R2E(2)
EQUIVALENCE (CYAVC,R2E)
C*****
CBB** ********************** BBCINITA **********************************
C**** SPECIFICATION STATEMENTS
C****
CHARACTER ZVERS*13, ZVERSD*17, ZDATE*17, ZPROG*5, ZCOMPL*20,
1 ZNAME*20, ZTAPE*10, ZPROJ*13, REMRKS*31, ZTAPED*13
CBE** ********************** BBCINITA **********************************
CBB** ********************** BBCINITB **********************************
C**** INITIALIZE SECTION
DATA ZVERS, ZVERSD, ZDATE
1 /'VERSION 2.0 ', '82/08/02*18.33.46', '*NO DATE*TIME'/
DATA ZCOMPL, ZNAME, ZTAPE
1 /'*NONE SPECIFIED*', '*NO COMPANY NAME*', '*NO TAPE*'/
DATA ZPROJ, ZTAPED, ZPROG
1 /'*NO PROJECT*', '*NO TAPE DATE', 'XXXXX'/
DATA REMRKS /' '/
C**** THE FOLLOWING 9 COMMENT LINES (CZ01, CZ02, ...) CAN BE REPLACED
C**** FOR IDENTIFYING THE TEST ENVIRONMENT
C****
CZ01 ZVERS = 'VERSION OF THE COMPILER VALIDATION SYSTEM'
CZ02 ZVERSD = 'CREATION DATE/TIME OF THE COMPILER VALIDATION SYSTEM'
CZ03 ZPROG = 'PROGRAM NAME'
CZ04 ZDATE = 'DATE OF TEST'
CZ05 ZCOMPL = 'COMPILER IDENTIFICATION'
CZ06 ZPROJ = 'PROJECT NUMBER/IDENTIFICATION'
CZ07 ZNAME = 'NAME OF USER'
CZ08 ZTAPE = 'TAPE OWNER/ID'
CZ09 ZTAPED = 'DATE TAPE COPIED'
C
IVPASS = 0
IVFAIL = 0
IVDELE = 0
IVINSP = 0
IVTOTL = 0
IVTOTN = 0
ICZERO = 0
C
C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER.
I01 = 05
C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER.
I02 = 06
C
CX010 REPLACED BY FEXEC X-010 CONTROL CARD (CARD-READER UNIT NUMBER).
C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5
CX011 REPLACED BY FEXEC X-011 CONTROL CARD. CX011 IS FOR SYSTEMS
C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX010.
C
CX020 REPLACED BY FEXEC X-020 CONTROL CARD (PRINTER UNIT NUMBER).
C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02= 6
CX021 REPLACED BY FEXEC X-021 CONTROL CARD. CX021 IS FOR SYSTEMS
C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX020.
C
CBE** ********************** BBCINITB **********************************
NUVI = I02
IVTOTL = 10
ZPROG = 'FM811'
CBB** ********************** BBCHED0A **********************************
C****
C**** WRITE REPORT TITLE
C****
WRITE (I02, 90002)
WRITE (I02, 90006)
WRITE (I02, 90007)
WRITE (I02, 90008) ZVERS, ZVERSD
WRITE (I02, 90009) ZPROG, ZPROG
WRITE (I02, 90010) ZDATE, ZCOMPL
CBE** ********************** BBCHED0A **********************************
C*****
C***** HEADER FOR SEGMENT 174 WRITTEN
WRITE (NUVI,17401)
17401 FORMAT( 1H , //1X, 35HYCMMX - (174) INTRINSIC FUNCTIONS--//
1 16X, 19HINTEGER, REAL, D.P./
2 16X, 37HAND COMPLEX IN MIXED MODE EXPRESSIONS//
3 2X, 16HANS REF. - 15.10)
CBB** ********************** BBCHED0B **********************************
C**** WRITE DETAIL REPORT HEADERS
C****
WRITE (I02,90004)
WRITE (I02,90004)
WRITE (I02,90013)
WRITE (I02,90014)
WRITE (I02,90015) IVTOTL
CBE** ********************** BBCHED0B **********************************
C*****
CT001* TEST 1 IDINT
IVTNUM = 1
DYBVD = 5.2D0
CYAVC = IDINT(DYBVD) + (1.0, 2.0)
IF (R2E(1) - 5.9997) 20010, 40012, 40011
40011 IF (R2E(1) - 6.0003) 40012, 40012, 20010
40012 IF (R2E(2) - 1.9999) 20010, 10010, 40010
40010 IF (R2E(2) - 2.0001) 10010, 10010, 20010
10010 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0011
20010 IVFAIL = IVFAIL + 1
ZVCORR = (6.0, 2.0)
WRITE (NUVI, 80045) IVTNUM, CYAVC, ZVCORR
0011 CONTINUE
CT002* TEST 2 SNGL
IVTNUM = 2
DYAVD = 5.5D0
CYAVC = SNGL(DYAVD) - (3.0, 4.0)
IF (R2E(1) - 2.4998) 20020, 40022, 40021
40021 IF (R2E(1) - 2.5002) 40022, 40022, 20020
40022 IF (R2E(2) + 4.0002) 20020, 10020, 40020
40020 IF (R2E(2) + 3.9998) 10020, 10020, 20020
10020 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0021
20020 IVFAIL = IVFAIL + 1
ZVCORR = (2.5, -4.0)
WRITE (NUVI, 80045) IVTNUM, CYAVC, ZVCORR
0021 CONTINUE
CT003* TEST 3 SNGL, DINT, DNINT, CABS
IVTNUM = 3
DYBVD = 5.8D0
RYAVS = SNGL(DINT(DYBVD) + DNINT(DYBVD)) * CABS((3.0, 4.0))
IF (RYAVS - 54.997) 20030, 10030, 40030
40030 IF (RYAVS - 55.003) 10030, 10030, 20030
10030 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0031
20030 IVFAIL = IVFAIL + 1
RVCORR = 55.0
WRITE (NUVI, 80012) IVTNUM, RYAVS, RVCORR
0031 CONTINUE
CT004* TEST 4 IDNINT, AIMAG
IVTNUM = 4
CYDVC = (3.0, 4.0)
DYBVD = 5.8D0
CYAVC = ((IDNINT(DYBVD) - CYDVC)) * AIMAG((4.0, 3.0))
IF (R2E(1) - 8.9995) 20040, 40042, 40041
40041 IF (R2E(1) - 9.0005) 40042, 40042, 20040
40042 IF (R2E(2) + 12.001) 20040, 10040, 40040
40040 IF (R2E(2) + 11.999) 10040, 10040, 20040
10040 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0041
20040 IVFAIL = IVFAIL + 1
ZVCORR = (9.0, -12.0)
WRITE (NUVI, 80045) IVTNUM, CYAVC, ZVCORR
0041 CONTINUE
CT005* TEST 5 CABS, CMPLX
IVTNUM = 5
IYAVI = 5
RYAVS = CABS(CMPLX(3.0, 4.0)) / IYAVI
IF (RYAVS - 0.99995) 20050, 10050, 40050
40050 IF (RYAVS - 1.0001) 10050, 10050, 20050
10050 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0051
20050 IVFAIL = IVFAIL + 1
RVCORR = 1.0
WRITE (NUVI, 80012) IVTNUM, RYAVS, RVCORR
0051 CONTINUE
CT006* TEST 6 CONJG, SNGL, DMOD
IVTNUM = 6
DYBVD = 5.0D0
DYDVD = 3.0D0
CYAVC = CONJG((3.0, 4.0)) * SNGL(DMOD(DYBVD, DYDVD))
IF (R2E(1) - 5.9997) 20060, 40062, 40061
40061 IF (R2E(1) - 6.0003) 40062, 40062, 20060
40062 IF (R2E(2) + 8.0004) 20060, 10060, 40060
40060 IF (R2E(2) + 7.9996) 10060, 10060, 20060
10060 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0061
20060 IVFAIL = IVFAIL + 1
ZVCORR = (6.0, -8.0)
WRITE (NUVI, 80045) IVTNUM, CYAVC, ZVCORR
0061 CONTINUE
CT007* TEST 7 DSIGN, AIMAG, CONJG
IVTNUM = 7
CYDVC = (-3.0, -4.0)
DYBVD = 4.0D0
DYDVD = 1.0D0
DYAVD = DSIGN(DYBVD, DYDVD) / AIMAG(CONJG(CYDVC))
IF (DYAVD - 0.9999999995D0) 20070, 10070, 40070
40070 IF (DYAVD - 1.000000001D0) 10070, 10070, 20070
10070 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0071
20070 IVFAIL = IVFAIL + 1
DVCORR = 1.0D0
WRITE (NUVI, 80031) IVTNUM, DYAVD, DVCORR
0071 CONTINUE
CT008* TEST 8 DPROD, CABS, AIMAG, SNGL, DDIM
IVTNUM = 8
CYDVC = (3.0, 4.0)
DYBVD = -7.0D0
DYDVD = 3.0D0
DYAVD = DPROD(CABS(CYDVC + (-3.0, 3.0)),
1 AIMAG(CYDVC) + (SNGL(DDIM(DYBVD, DYDVD))))
IF (DYAVD - 27.99999998D0) 20080, 10080, 40080
40080 IF (DYAVD - 28.00000002D0) 10080, 10080, 20080
10080 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0081
20080 IVFAIL = IVFAIL + 1
DVCORR = 28.0D0
WRITE (NUVI, 80031) IVTNUM, DYAVD, DVCORR
0081 CONTINUE
CT009* TEST 9 AMAX1, CABS, AIMAG
IVTNUM = 9
CYDVC = (3.0, 4.0)
DYAVD = AMAX1(CABS(CYDVC), AIMAG(CYDVC * CYDVC))
IF (DYAVD - 23.99999998D0) 20090, 10090, 40090
40090 IF (DYAVD - 24.00000002D0) 10090, 10090, 20090
10090 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0091
20090 IVFAIL = IVFAIL + 1
DVCORR = 24.0D0
WRITE (NUVI, 80031) IVTNUM, DYAVD, DVCORR
0091 CONTINUE
CT010* TEST 10 AIMAG, ABS, AMIN0
IVTNUM = 10
CYDVC = (3.0, -3.)
IYBVI = 4
IYDVI = -3
CYAVC = ((3.0, 4.0) + AIMAG((3.0, 4.0))) *
1 (ABS(AMIN0(IYBVI, IYDVI)) - CYDVC)
IF (R2E(1) + 12.001) 20100, 40102, 40101
40101 IF (R2E(1) + 11.999) 40102, 40102, 20100
40102 IF (R2E(2) - 20.999) 20100, 10100, 40100
40100 IF (R2E(2) - 21.001) 10100, 10100, 20100
10100 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0101
20100 IVFAIL = IVFAIL + 1
ZVCORR = (-12.0, 21.0)
WRITE (NUVI, 80045) IVTNUM, CYAVC, ZVCORR
0101 CONTINUE
C*****
CBB** ********************** BBCSUM0 **********************************
C**** WRITE OUT TEST SUMMARY
C****
IVTOTN = IVPASS + IVFAIL + IVDELE + IVINSP
WRITE (I02, 90004)
WRITE (I02, 90014)
WRITE (I02, 90004)
WRITE (I02, 90020) IVPASS
WRITE (I02, 90022) IVFAIL
WRITE (I02, 90024) IVDELE
WRITE (I02, 90026) IVINSP
WRITE (I02, 90028) IVTOTN, IVTOTL
CBE** ********************** BBCSUM0 **********************************
CBB** ********************** BBCFOOT0 **********************************
C**** WRITE OUT REPORT FOOTINGS
C****
WRITE (I02,90016) ZPROG, ZPROG
WRITE (I02,90018) ZPROJ, ZNAME, ZTAPE, ZTAPED
WRITE (I02,90019)
CBE** ********************** BBCFOOT0 **********************************
CBB** ********************** BBCFMT0A **********************************
C**** FORMATS FOR TEST DETAIL LINES
C****
80000 FORMAT (1H ,2X,I3,4X,7HDELETED,32X,A31)
80002 FORMAT (1H ,2X,I3,4X,7H PASS ,32X,A31)
80004 FORMAT (1H ,2X,I3,4X,7HINSPECT,32X,A31)
80008 FORMAT (1H ,2X,I3,4X,7H FAIL ,32X,A31)
80010 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,15X,10HCOMPUTED= ,
1I6,/,1H ,15X,10HCORRECT= ,I6)
80012 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
1E12.5,/,1H ,16X,10HCORRECT= ,E12.5)
80018 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
1A21,/,1H ,16X,10HCORRECT= ,A21)
80020 FORMAT (1H ,16X,10HCOMPUTED= ,A21,1X,A31)
80022 FORMAT (1H ,16X,10HCORRECT= ,A21,1X,A31)
80024 FORMAT (1H ,16X,10HCOMPUTED= ,I6,16X,A31)
80026 FORMAT (1H ,16X,10HCORRECT= ,I6,16X,A31)
80028 FORMAT (1H ,16X,10HCOMPUTED= ,E12.5,10X,A31)
80030 FORMAT (1H ,16X,10HCORRECT= ,E12.5,10X,A31)
80050 FORMAT (1H ,48X,A31)
CBE** ********************** BBCFMT0A **********************************
CBB** ********************** BBCFMAT1 **********************************
C**** FORMATS FOR TEST DETAIL LINES - FULL LANGUAGE
C****
80031 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
1D17.10,/,1H ,16X,10HCORRECT= ,D17.10)
80033 FORMAT (1H ,16X,10HCOMPUTED= ,D17.10,10X,A31)
80035 FORMAT (1H ,16X,10HCORRECT= ,D17.10,10X,A31)
80037 FORMAT (1H ,16X,10HCOMPUTED= ,1H(,E12.5,2H, ,E12.5,1H),6X,A31)
80039 FORMAT (1H ,16X,10HCORRECT= ,1H(,E12.5,2H, ,E12.5,1H),6X,A31)
80041 FORMAT (1H ,16X,10HCOMPUTED= ,1H(,F12.5,2H, ,F12.5,1H),6X,A31)
80043 FORMAT (1H ,16X,10HCORRECT= ,1H(,F12.5,2H, ,F12.5,1H),6X,A31)
80045 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
11H(,F12.5,2H, ,F12.5,1H)/,1H ,16X,10HCORRECT= ,
21H(,F12.5,2H, ,F12.5,1H))
CBE** ********************** BBCFMAT1 **********************************
CBB** ********************** BBCFMT0B **********************************
C**** FORMAT STATEMENTS FOR PAGE HEADERS
C****
90002 FORMAT (1H1)
90004 FORMAT (1H )
90006 FORMAT (1H ,20X,31HFEDERAL SOFTWARE TESTING CENTER)
90007 FORMAT (1H ,19X,34HFORTRAN COMPILER VALIDATION SYSTEM)
90008 FORMAT (1H ,21X,A13,A17)
90009 FORMAT (1H ,/,2H *,A5,6HBEGIN*,12X,15HTEST RESULTS - ,A5,/)
90010 FORMAT (1H ,8X,16HTEST DATE*TIME= ,A17,15H - COMPILER= ,A20)
90013 FORMAT (1H ,8H TEST ,10HPASS/FAIL ,6X,17HDISPLAYED RESULTS,
1 7X,7HREMARKS,24X)
90014 FORMAT (1H ,46H----------------------------------------------,
1 33H---------------------------------)
90015 FORMAT (1H ,48X,17HTHIS PROGRAM HAS ,I3,6H TESTS,/)
C****
C**** FORMAT STATEMENTS FOR REPORT FOOTINGS
C****
90016 FORMAT (1H ,/,2H *,A5,4HEND*,14X,14HEND OF TEST - ,A5,/)
90018 FORMAT (1H ,A13,13X,A20,7H * ,A10,1H/,
1 A13)
90019 FORMAT (1H ,26HFOR OFFICIAL USE ONLY ,35X,15HCOPYRIGHT 1982)
C****
C**** FORMAT STATEMENTS FOR RUN SUMMARY
C****
90020 FORMAT (1H ,21X,I5,13H TESTS PASSED)
90022 FORMAT (1H ,21X,I5,13H TESTS FAILED)
90024 FORMAT (1H ,21X,I5,14H TESTS DELETED)
90026 FORMAT (1H ,21X,I5,25H TESTS REQUIRE INSPECTION)
90028 FORMAT (1H ,21X,I5,4H OF ,I3,15H TESTS EXECUTED)
CBE** ********************** BBCFMT0B **********************************
C*****
C***** END OF TEST SEGMENT 174
STOP
END
*END-OF,FM811
FM812.f 481036517 170 2 100666 14803 `
*HEADER,FORTR,FM812
*FILES1,FORTR,FM812,X
C***********************************************************************
C***** FORTRAN 77
C***** FM812
C***** YDSQRT - (176)
C*****
C***********************************************************************
C***** GENERAL PURPOSE ANS REF
C***** TEST INTRINSIC FUNCTION DSQRT 15.3
C***** TABLE 5
C*****
CBB** ********************** BBCCOMNT **********************************
C****
C**** 1978 FORTRAN COMPILER VALIDATION SYSTEM
C**** VERSION 2.0
C****
C****
C**** SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO
C**** GENERAL SERVICES ADMINISTRATION
C**** FEDERAL SOFTWARE TESTING CENTER
C**** 5203 LEESBURG PIKE, SUITE 1100
C**** FALLS CHURCH, VA. 22041
C****
C**** (703) 756-6153
C****
CBE** ********************** BBCCOMNT **********************************
C***** S P E C I F I C A T I O N S SEGMENT 176
DOUBLE PRECISION AVD, BVD, DVCORR
C*****
CBB** ********************** BBCINITA **********************************
C**** SPECIFICATION STATEMENTS
C****
CHARACTER ZVERS*13, ZVERSD*17, ZDATE*17, ZPROG*5, ZCOMPL*20,
1 ZNAME*20, ZTAPE*10, ZPROJ*13, REMRKS*31, ZTAPED*13
CBE** ********************** BBCINITA **********************************
CBB** ********************** BBCINITB **********************************
C**** INITIALIZE SECTION
DATA ZVERS, ZVERSD, ZDATE
1 /'VERSION 2.0 ', '82/08/02*18.33.46', '*NO DATE*TIME'/
DATA ZCOMPL, ZNAME, ZTAPE
1 /'*NONE SPECIFIED*', '*NO COMPANY NAME*', '*NO TAPE*'/
DATA ZPROJ, ZTAPED, ZPROG
1 /'*NO PROJECT*', '*NO TAPE DATE', 'XXXXX'/
DATA REMRKS /' '/
C**** THE FOLLOWING 9 COMMENT LINES (CZ01, CZ02, ...) CAN BE REPLACED
C**** FOR IDENTIFYING THE TEST ENVIRONMENT
C****
CZ01 ZVERS = 'VERSION OF THE COMPILER VALIDATION SYSTEM'
CZ02 ZVERSD = 'CREATION DATE/TIME OF THE COMPILER VALIDATION SYSTEM'
CZ03 ZPROG = 'PROGRAM NAME'
CZ04 ZDATE = 'DATE OF TEST'
CZ05 ZCOMPL = 'COMPILER IDENTIFICATION'
CZ06 ZPROJ = 'PROJECT NUMBER/IDENTIFICATION'
CZ07 ZNAME = 'NAME OF USER'
CZ08 ZTAPE = 'TAPE OWNER/ID'
CZ09 ZTAPED = 'DATE TAPE COPIED'
C
IVPASS = 0
IVFAIL = 0
IVDELE = 0
IVINSP = 0
IVTOTL = 0
IVTOTN = 0
ICZERO = 0
C
C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER.
I01 = 05
C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER.
I02 = 06
C
CX010 REPLACED BY FEXEC X-010 CONTROL CARD (CARD-READER UNIT NUMBER).
C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5
CX011 REPLACED BY FEXEC X-011 CONTROL CARD. CX011 IS FOR SYSTEMS
C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX010.
C
CX020 REPLACED BY FEXEC X-020 CONTROL CARD (PRINTER UNIT NUMBER).
C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02= 6
CX021 REPLACED BY FEXEC X-021 CONTROL CARD. CX021 IS FOR SYSTEMS
C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX020.
C
CBE** ********************** BBCINITB **********************************
NUVI = I02
IVTOTL = 13
ZPROG = 'FM812'
CBB** ********************** BBCHED0A **********************************
C****
C**** WRITE REPORT TITLE
C****
WRITE (I02, 90002)
WRITE (I02, 90006)
WRITE (I02, 90007)
WRITE (I02, 90008) ZVERS, ZVERSD
WRITE (I02, 90009) ZPROG, ZPROG
WRITE (I02, 90010) ZDATE, ZCOMPL
CBE** ********************** BBCHED0A **********************************
C*****
C***** HEADER FOR SEGMENT 176
WRITE(NUVI,17600)
17600 FORMAT(1H , / 36H YDSQRT - (176) INTRINSIC FUNCTIONS//
1 38H DSQRT (DOUBLE PRECISION SQUARE ROOT)//
2 17H ANS REF. - 15.3)
CBB** ********************** BBCHED0B **********************************
C**** WRITE DETAIL REPORT HEADERS
C****
WRITE (I02,90004)
WRITE (I02,90004)
WRITE (I02,90013)
WRITE (I02,90014)
WRITE (I02,90015) IVTOTL
CBE** ********************** BBCHED0B **********************************
C*****
CT001* TEST 1 FIXED POINT OF FUNCTION
IVTNUM = 1
BVD = 0.0D0
AVD = DSQRT(BVD)
IF (AVD + 0.5000000000D-09) 20010, 10010, 40010
40010 IF (AVD - 0.5000000000D-09) 10010, 10010, 20010
10010 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0011
20010 IVFAIL = IVFAIL + 1
DVCORR = 0.00000000000000000000D0
WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR
0011 CONTINUE
CT002* TEST 2 FIXED POINT OF FUNCTION
IVTNUM = 2
AVD = DSQRT(1.0D0)
IF (AVD - 0.9999999995D+00) 20020, 10020, 40020
40020 IF (AVD - 0.1000000001D+01) 10020, 10020, 20020
10020 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0021
20020 IVFAIL = IVFAIL + 1
DVCORR = 1.0000000000000000000D0
WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR
0021 CONTINUE
CT003* TEST 3 CONSTANT OF VALUE 2.0D0
IVTNUM = 3
AVD = DSQRT(2.0D0)
IF (AVD - 0.1414213561D+01) 20030, 10030, 40030
40030 IF (AVD - 0.1414213563D+01) 10030, 10030, 20030
10030 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0031
20030 IVFAIL = IVFAIL + 1
DVCORR = 1.4142135623730950488D0
WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR
0031 CONTINUE
CT004* TEST 4 CONSTANT OF VALUE 4.0D0
IVTNUM = 4
AVD = DSQRT(4.0D0)
IF (AVD - 0.1999999999D+01) 20040, 10040, 40040
40040 IF (AVD - 0.2000000001D+01) 10040, 10040, 20040
10040 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0041
20040 IVFAIL = IVFAIL + 1
DVCORR = 2.0000000000000000000D0
WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR
0041 CONTINUE
CT005* TEST 5 CONSTANT OF VALUE 15.0D0
IVTNUM = 5
AVD = DSQRT(15.0D0)
IF (AVD - 0.3872983344D+01) 20050, 10050, 40050
40050 IF (AVD - 0.3872983348D+01) 10050, 10050, 20050
10050 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0051
20050 IVFAIL = IVFAIL + 1
DVCORR = 3.8729833462074168852D0
WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR
0051 CONTINUE
CT006* TEST 6 CONSTANT OF VALUE 31.0D0
IVTNUM = 6
AVD = DSQRT(31.0D0)
IF (AVD - 0.5567764360D+01) 20060, 10060, 40060
40060 IF (AVD - 0.5567764366D+01) 10060, 10060, 20060
10060 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0061
20060 IVFAIL = IVFAIL + 1
DVCORR = 5.5677643628300219221D0
WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR
0061 CONTINUE
CT007* TEST 7 VARIABLE PRESENTED TO DSQRT
IVTNUM = 7
BVD = 2.0D0 / 4.0D0
AVD = DSQRT(BVD)
IF (AVD - 0.7071067808D+00) 20070, 10070, 40070
40070 IF (AVD - 0.7071067816D+00) 10070, 10070, 20070
10070 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0071
20070 IVFAIL = IVFAIL + 1
DVCORR = 0.70710678118654752440D0
WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR
0071 CONTINUE
CT008* TEST 8 EXPRESSION PRESENTED TO DSQRT
IVTNUM = 8
BVD = 25.0D0
AVD = DSQRT(BVD / 100.0D0)
IF (AVD - 0.4999999997D+00) 20080, 10080, 40080
40080 IF (AVD - 0.5000000003D+00) 10080, 10080, 20080
10080 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0081
20080 IVFAIL = IVFAIL + 1
DVCORR = 0.50000000000000000000D0
WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR
0081 CONTINUE
CT009* TEST 9 EXPRESSION PRESENTED TO DSQRT
IVTNUM = 9
BVD = 0.0875D0
AVD = DSQRT(BVD * 10.0D0)
IF (AVD - 0.9354143462D+00) 20090, 10090, 40090
40090 IF (AVD - 0.9354143472D+00) 10090, 10090, 20090
10090 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0091
20090 IVFAIL = IVFAIL + 1
DVCORR = 0.93541434669348534640D0
WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR
0091 CONTINUE
CT010* TEST 10 AN EXPRESSION WITH VALUE CLOSE TO ONE
IVTNUM = 10
AVD = DSQRT(31.0D0 / 32.0D0)
IF (AVD - 0.9842509837D+00) 20100, 10100, 40100
40100 IF (AVD - 0.9842509848D+00) 10100, 10100, 20100
10100 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0101
20100 IVFAIL = IVFAIL + 1
DVCORR = 0.98425098425147637746D0
WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR
0101 CONTINUE
CT011* TEST 11 AN ARGUMENT OF LOW MAGNITUDE
IVTNUM = 11
AVD = DSQRT(1.6D-35)
IF (AVD - 0.3999999998D-17) 20110, 10110, 40110
40110 IF (AVD - 0.4000000002D-17) 10110, 10110, 20110
10110 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0111
20110 IVFAIL = IVFAIL + 1
DVCORR = 0.40000000000000000000D-17
WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR
0111 CONTINUE
CT012* TEST 12 AN ARGUMENT OF HIGH MAGNITUDE
IVTNUM = 12
AVD = DSQRT(1.0D+35)
IF (AVD - 0.3162277658D+18) 20120, 10120, 40120
40120 IF (AVD - 0.3162277662D+18) 10120, 10120, 20120
10120 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0121
20120 IVFAIL = IVFAIL + 1
DVCORR = 0.31622776601683793320D+18
WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR
0121 CONTINUE
CT013* TEST 13 THE FUNCTION APPLIED TWICE
IVTNUM = 13
BVD = DSQRT(1.6D0)
AVD = DSQRT(0.625D0) * BVD
IF (AVD - 0.9999999995D+00) 20130, 10130, 40130
40130 IF (AVD - 0.1000000001D+01) 10130, 10130, 20130
10130 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0131
20130 IVFAIL = IVFAIL + 1
DVCORR = 1.00000000000000D0
WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR
0131 CONTINUE
C*****
CBB** ********************** BBCSUM0 **********************************
C**** WRITE OUT TEST SUMMARY
C****
IVTOTN = IVPASS + IVFAIL + IVDELE + IVINSP
WRITE (I02, 90004)
WRITE (I02, 90014)
WRITE (I02, 90004)
WRITE (I02, 90020) IVPASS
WRITE (I02, 90022) IVFAIL
WRITE (I02, 90024) IVDELE
WRITE (I02, 90026) IVINSP
WRITE (I02, 90028) IVTOTN, IVTOTL
CBE** ********************** BBCSUM0 **********************************
CBB** ********************** BBCFOOT0 **********************************
C**** WRITE OUT REPORT FOOTINGS
C****
WRITE (I02,90016) ZPROG, ZPROG
WRITE (I02,90018) ZPROJ, ZNAME, ZTAPE, ZTAPED
WRITE (I02,90019)
CBE** ********************** BBCFOOT0 **********************************
CBB** ********************** BBCFMT0A **********************************
C**** FORMATS FOR TEST DETAIL LINES
C****
80000 FORMAT (1H ,2X,I3,4X,7HDELETED,32X,A31)
80002 FORMAT (1H ,2X,I3,4X,7H PASS ,32X,A31)
80004 FORMAT (1H ,2X,I3,4X,7HINSPECT,32X,A31)
80008 FORMAT (1H ,2X,I3,4X,7H FAIL ,32X,A31)
80010 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,15X,10HCOMPUTED= ,
1I6,/,1H ,15X,10HCORRECT= ,I6)
80012 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
1E12.5,/,1H ,16X,10HCORRECT= ,E12.5)
80018 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
1A21,/,1H ,16X,10HCORRECT= ,A21)
80020 FORMAT (1H ,16X,10HCOMPUTED= ,A21,1X,A31)
80022 FORMAT (1H ,16X,10HCORRECT= ,A21,1X,A31)
80024 FORMAT (1H ,16X,10HCOMPUTED= ,I6,16X,A31)
80026 FORMAT (1H ,16X,10HCORRECT= ,I6,16X,A31)
80028 FORMAT (1H ,16X,10HCOMPUTED= ,E12.5,10X,A31)
80030 FORMAT (1H ,16X,10HCORRECT= ,E12.5,10X,A31)
80050 FORMAT (1H ,48X,A31)
CBE** ********************** BBCFMT0A **********************************
CBB** ********************** BBCFMAT1 **********************************
C**** FORMATS FOR TEST DETAIL LINES - FULL LANGUAGE
C****
80031 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
1D17.10,/,1H ,16X,10HCORRECT= ,D17.10)
80033 FORMAT (1H ,16X,10HCOMPUTED= ,D17.10,10X,A31)
80035 FORMAT (1H ,16X,10HCORRECT= ,D17.10,10X,A31)
80037 FORMAT (1H ,16X,10HCOMPUTED= ,1H(,E12.5,2H, ,E12.5,1H),6X,A31)
80039 FORMAT (1H ,16X,10HCORRECT= ,1H(,E12.5,2H, ,E12.5,1H),6X,A31)
80041 FORMAT (1H ,16X,10HCOMPUTED= ,1H(,F12.5,2H, ,F12.5,1H),6X,A31)
80043 FORMAT (1H ,16X,10HCORRECT= ,1H(,F12.5,2H, ,F12.5,1H),6X,A31)
80045 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
11H(,F12.5,2H, ,F12.5,1H)/,1H ,16X,10HCORRECT= ,
21H(,F12.5,2H, ,F12.5,1H))
CBE** ********************** BBCFMAT1 **********************************
CBB** ********************** BBCFMT0B **********************************
C**** FORMAT STATEMENTS FOR PAGE HEADERS
C****
90002 FORMAT (1H1)
90004 FORMAT (1H )
90006 FORMAT (1H ,20X,31HFEDERAL SOFTWARE TESTING CENTER)
90007 FORMAT (1H ,19X,34HFORTRAN COMPILER VALIDATION SYSTEM)
90008 FORMAT (1H ,21X,A13,A17)
90009 FORMAT (1H ,/,2H *,A5,6HBEGIN*,12X,15HTEST RESULTS - ,A5,/)
90010 FORMAT (1H ,8X,16HTEST DATE*TIME= ,A17,15H - COMPILER= ,A20)
90013 FORMAT (1H ,8H TEST ,10HPASS/FAIL ,6X,17HDISPLAYED RESULTS,
1 7X,7HREMARKS,24X)
90014 FORMAT (1H ,46H----------------------------------------------,
1 33H---------------------------------)
90015 FORMAT (1H ,48X,17HTHIS PROGRAM HAS ,I3,6H TESTS,/)
C****
C**** FORMAT STATEMENTS FOR REPORT FOOTINGS
C****
90016 FORMAT (1H ,/,2H *,A5,4HEND*,14X,14HEND OF TEST - ,A5,/)
90018 FORMAT (1H ,A13,13X,A20,7H * ,A10,1H/,
1 A13)
90019 FORMAT (1H ,26HFOR OFFICIAL USE ONLY ,35X,15HCOPYRIGHT 1982)
C****
C**** FORMAT STATEMENTS FOR RUN SUMMARY
C****
90020 FORMAT (1H ,21X,I5,13H TESTS PASSED)
90022 FORMAT (1H ,21X,I5,13H TESTS FAILED)
90024 FORMAT (1H ,21X,I5,14H TESTS DELETED)
90026 FORMAT (1H ,21X,I5,25H TESTS REQUIRE INSPECTION)
90028 FORMAT (1H ,21X,I5,4H OF ,I3,15H TESTS EXECUTED)
CBE** ********************** BBCFMT0B **********************************
C***** END OF TEST SEGMENT 176
STOP
END
*END-OF,FM812
FM813.f 481036520 170 2 100666 16728 `
*HEADER,FORTR,FM813
*FILES1,FORTR,FM813,X
C***********************************************************************
C***** FORTRAN 77
C***** FM813
C***** YCSQRT - (177)
C*****
C***********************************************************************
C***** GENERAL PURPOSE ANS REF
C***** TEST INTRINSIC FUNCTION CSQRT 15.3
C***** TABLE 5
C*****
CBB** ********************** BBCCOMNT **********************************
C****
C**** 1978 FORTRAN COMPILER VALIDATION SYSTEM
C**** VERSION 2.0
C****
C****
C**** SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO
C**** GENERAL SERVICES ADMINISTRATION
C**** FEDERAL SOFTWARE TESTING CENTER
C**** 5203 LEESBURG PIKE, SUITE 1100
C**** FALLS CHURCH, VA. 22041
C****
C**** (703) 756-6153
C****
CBE** ********************** BBCCOMNT **********************************
C*****
C***** S P E C F I C A T I O N S SEGMENT 177
COMPLEX AVC, BVC, CVC, ZVCORR
REAL R2E(2)
EQUIVALENCE (AVC, R2E)
C*****
CBB** ********************** BBCINITA **********************************
C**** SPECIFICATION STATEMENTS
C****
CHARACTER ZVERS*13, ZVERSD*17, ZDATE*17, ZPROG*5, ZCOMPL*20,
1 ZNAME*20, ZTAPE*10, ZPROJ*13, REMRKS*31, ZTAPED*13
CBE** ********************** BBCINITA **********************************
CBB** ********************** BBCINITB **********************************
C**** INITIALIZE SECTION
DATA ZVERS, ZVERSD, ZDATE
1 /'VERSION 2.0 ', '82/08/02*18.33.46', '*NO DATE*TIME'/
DATA ZCOMPL, ZNAME, ZTAPE
1 /'*NONE SPECIFIED*', '*NO COMPANY NAME*', '*NO TAPE*'/
DATA ZPROJ, ZTAPED, ZPROG
1 /'*NO PROJECT*', '*NO TAPE DATE', 'XXXXX'/
DATA REMRKS /' '/
C**** THE FOLLOWING 9 COMMENT LINES (CZ01, CZ02, ...) CAN BE REPLACED
C**** FOR IDENTIFYING THE TEST ENVIRONMENT
C****
CZ01 ZVERS = 'VERSION OF THE COMPILER VALIDATION SYSTEM'
CZ02 ZVERSD = 'CREATION DATE/TIME OF THE COMPILER VALIDATION SYSTEM'
CZ03 ZPROG = 'PROGRAM NAME'
CZ04 ZDATE = 'DATE OF TEST'
CZ05 ZCOMPL = 'COMPILER IDENTIFICATION'
CZ06 ZPROJ = 'PROJECT NUMBER/IDENTIFICATION'
CZ07 ZNAME = 'NAME OF USER'
CZ08 ZTAPE = 'TAPE OWNER/ID'
CZ09 ZTAPED = 'DATE TAPE COPIED'
C
IVPASS = 0
IVFAIL = 0
IVDELE = 0
IVINSP = 0
IVTOTL = 0
IVTOTN = 0
ICZERO = 0
C
C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER.
I01 = 05
C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER.
I02 = 06
C
CX010 REPLACED BY FEXEC X-010 CONTROL CARD (CARD-READER UNIT NUMBER).
C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5
CX011 REPLACED BY FEXEC X-011 CONTROL CARD. CX011 IS FOR SYSTEMS
C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX010.
C
CX020 REPLACED BY FEXEC X-020 CONTROL CARD (PRINTER UNIT NUMBER).
C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02= 6
CX021 REPLACED BY FEXEC X-021 CONTROL CARD. CX021 IS FOR SYSTEMS
C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX020.
C
CBE** ********************** BBCINITB **********************************
NUVI = I02
IVTOTL = 13
ZPROG = 'FM813'
CBB** ********************** BBCHED0A **********************************
C****
C**** WRITE REPORT TITLE
C****
WRITE (I02, 90002)
WRITE (I02, 90006)
WRITE (I02, 90007)
WRITE (I02, 90008) ZVERS, ZVERSD
WRITE (I02, 90009) ZPROG, ZPROG
WRITE (I02, 90010) ZDATE, ZCOMPL
CBE** ********************** BBCHED0A **********************************
C*****
C***** HEADER FOR SEGMENT 177
WRITE(NUVI,17700)
17700 FORMAT(1H , / 36H YCSQRT - (177) INTRINSIC FUNCTIONS//
1 29H CSQRT (COMPLEX SQUARE ROOT)//
2 17H ANS REF. - 15.3)
CBB** ********************** BBCHED0B **********************************
C**** WRITE DETAIL REPORT HEADERS
C****
WRITE (I02,90004)
WRITE (I02,90004)
WRITE (I02,90013)
WRITE (I02,90014)
WRITE (I02,90015) IVTOTL
CBE** ********************** BBCHED0B **********************************
C*****
CT001* TEST 1 ZERO
IVTNUM = 1
BVC = (0.0, 0.0)
AVC = CSQRT(BVC)
IF (R2E(1) + 0.50000E-04) 20010, 40012, 40011
40011 IF (R2E(1) - 0.50000E-04) 40012, 40012, 20010
40012 IF (R2E(2) + 0.50000E-04) 20010, 10010, 40010
40010 IF (R2E(2) - 0.50000E-04) 10010, 10010, 20010
10010 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0011
20010 IVFAIL = IVFAIL + 1
ZVCORR = (0.00000000000000, 0.00000000000000)
WRITE (NUVI, 80045) IVTNUM, AVC, ZVCORR
0011 CONTINUE
CT002* TEST 2 POSITIVE REAL NUMBERS
IVTNUM = 2
BVC = (4.0, 4.0)
AVC = CSQRT(BVC - (0.0, 4.0))
IF (R2E(1) - 0.19999E+01) 20020, 40022, 40021
40021 IF (R2E(1) - 0.20001E+01) 40022, 40022, 20020
40022 IF (R2E(2) + 0.50000E-04) 20020, 10020, 40020
40020 IF (R2E(2) - 0.50000E-04) 10020, 10020, 20020
10020 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0021
20020 IVFAIL = IVFAIL + 1
ZVCORR = (2.00000000000000, 0.00000000000000)
WRITE (NUVI, 80045) IVTNUM, AVC, ZVCORR
0021 CONTINUE
CT003* TEST 3 POSITIVE REAL NUMBERS
IVTNUM = 3
BVC = (4.0, 4.0)
CVC = (4.0, -4.0)
AVC = CSQRT(BVC + CVC)
IF (R2E(1) - 0.28282E+01) 20030, 40032, 40031
40031 IF (R2E(1) - 0.28286E+01) 40032, 40032, 20030
40032 IF (R2E(2) + 0.50000E-04) 20030, 10030, 40030
40030 IF (R2E(2) - 0.50000E-04) 10030, 10030, 20030
10030 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0031
20030 IVFAIL = IVFAIL + 1
ZVCORR = (2.8284271247462, 0.00000000000000)
WRITE (NUVI, 80045) IVTNUM, AVC, ZVCORR
0031 CONTINUE
CT004* TEST 4 POSITIVE REAL NUMBERS
IVTNUM = 4
BVC = (4.0, 0.0)
CVC = BVC + (5.0, 0.0)
AVC = CSQRT(CVC)
IF (R2E(1) - 0.29998E+01) 20040, 40042, 40041
40041 IF (R2E(1) - 0.30002E+01) 40042, 40042, 20040
40042 IF (R2E(2) + 0.50000E-04) 20040, 10040, 40040
40040 IF (R2E(2) - 0.50000E-04) 10040, 10040, 20040
10040 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0041
20040 IVFAIL = IVFAIL + 1
ZVCORR = (3.00000000000000, 0.00000000000000)
WRITE (NUVI, 80045) IVTNUM, AVC, ZVCORR
0041 CONTINUE
CT005* TEST 5 NEGATIVE REAL NUMBERS
IVTNUM = 5
BVC = (-1.0, 0.0)
AVC = CSQRT(BVC)
IF (R2E(1) + 0.50000E-04) 20050, 40052, 40051
40051 IF (R2E(1) - 0.50000E-04) 40052, 40052, 20050
40052 IF (R2E(2) - 0.99995E+00) 20050, 10050, 40050
40050 IF (R2E(2) - 0.10001E+01) 10050, 10050, 20050
10050 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0051
20050 IVFAIL = IVFAIL + 1
ZVCORR = (0.00000000000000, 1.0000000000000)
WRITE (NUVI, 80045) IVTNUM, AVC, ZVCORR
0051 CONTINUE
CT006* TEST 6 NEGATIVE REAL NUMBERS
IVTNUM = 6
AVC = CSQRT((-5.0, 0.0))
IF (R2E(1) + 0.50000E-04) 20060, 40062, 40061
40061 IF (R2E(1) - 0.50000E-04) 40062, 40062, 20060
40062 IF (R2E(2) - 0.22359E+01) 20060, 10060, 40060
40060 IF (R2E(2) - 0.22362E+01) 10060, 10060, 20060
10060 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0061
20060 IVFAIL = IVFAIL + 1
ZVCORR = (0.00000000000000, 2.2360679774998)
WRITE (NUVI, 80045) IVTNUM, AVC, ZVCORR
0061 CONTINUE
CT007* TEST 7 NEGATIVE REAL NUMBERS
IVTNUM = 7
BVC = (-25.0, 0.0)
AVC = CSQRT(BVC)
IF (R2E(1) + 0.50000E-04) 20070, 40072, 40071
40071 IF (R2E(1) - 0.50000E-04) 40072, 40072, 20070
40072 IF (R2E(2) - 0.49997E+01) 20070, 10070, 40070
40070 IF (R2E(2) - 0.50003E+01) 10070, 10070, 20070
10070 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0071
20070 IVFAIL = IVFAIL + 1
ZVCORR = (0.00000000000000, 5.0000000000000)
WRITE (NUVI, 80045) IVTNUM, AVC, ZVCORR
0071 CONTINUE
CT008* TEST 8 VARIABLES SUPPLIED WITHIN AN EXPRESSION
IVTNUM = 8
BVC = (0.203125,0.0)
CVC = (0.0, 1.3125)
AVC = CSQRT(BVC + CVC)
IF (R2E(1) - 0.87495E+00) 20080, 40082, 40081
40081 IF (R2E(1) - 0.87505E+00) 40082, 40082, 20080
40082 IF (R2E(2) - 0.74996E+00) 20080, 10080, 40080
40080 IF (R2E(2) - 0.75004E+00) 10080, 10080, 20080
10080 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0081
20080 IVFAIL = IVFAIL + 1
ZVCORR = (0.87500000000000, 0.75000000000000)
WRITE (NUVI, 80045) IVTNUM, AVC, ZVCORR
0081 CONTINUE
CT009* TEST 9 VARIABLES SUPPLIED WITHIN AN EXPRESSION
IVTNUM = 9
BVC = (1.0,0.0)
AVC = CSQRT(BVC - (0.38671875, 0.515625))
IF (R2E(1) - 0.84094E+00) 20090, 40092, 40091
40091 IF (R2E(1) - 0.84103E+00) 40092, 40092, 20090
40092 IF (R2E(2) + 0.30658E+00) 20090, 10090, 40090
40090 IF (R2E(2) + 0.30654E+00) 10090, 10090, 20090
10090 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0091
20090 IVFAIL = IVFAIL + 1
ZVCORR = (0.84098742159541, -0.30655928183909)
WRITE (NUVI, 80045) IVTNUM, AVC, ZVCORR
0091 CONTINUE
CT010* TEST 10 VARIABLES SUPPLIED WITHIN AN EXPRESSION
IVTNUM = 10
BVC = (-0.375, 0.5)
AVC = CSQRT(BVC + BVC)
IF (R2E(1) - 0.49997E+00) 20100, 40102, 40101
40101 IF (R2E(1) - 0.50003E+00) 40102, 40102, 20100
40102 IF (R2E(2) - 0.99995E+00) 20100, 10100, 40100
40100 IF (R2E(2) - 0.10001E+01) 10100, 10100, 20100
10100 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0101
20100 IVFAIL = IVFAIL + 1
ZVCORR = (0.50000000000000, 1.0000000000000)
WRITE (NUVI, 80045) IVTNUM, AVC, ZVCORR
0101 CONTINUE
CT011* TEST 11 PURELY IMAGINARY NUMBERS
IVTNUM = 11
AVC = CSQRT((0.0, 2.0))
IF (R2E(1) - 0.99995E+00) 20110, 40112, 40111
40111 IF (R2E(1) - 0.10001E+01) 40112, 40112, 20110
40112 IF (R2E(2) - 0.99995E+00) 20110, 10110, 40110
40110 IF (R2E(2) - 0.10001E+01) 10110, 10110, 20110
10110 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0111
20110 IVFAIL = IVFAIL + 1
ZVCORR = (1.00000000000000, 1.0000000000000)
WRITE (NUVI, 80045) IVTNUM, AVC, ZVCORR
0111 CONTINUE
CT012* TEST 12 PURELY IMAGINARY NUMBERS
IVTNUM = 12
AVC = CSQRT((0.0, -8.0))
IF (R2E(1) - 0.19999E+01) 20120, 40122, 40121
40121 IF (R2E(1) - 0.20001E+01) 40122, 40122, 20120
40122 IF (R2E(2) + 0.20001E+01) 20120, 10120, 40120
40120 IF (R2E(2) + 0.19999E+01) 10120, 10120, 20120
10120 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0121
20120 IVFAIL = IVFAIL + 1
ZVCORR = (2.00000000000000, -2.0000000000000)
WRITE (NUVI, 80045) IVTNUM, AVC, ZVCORR
0121 CONTINUE
CT013* TEST 13 (-0.5,SQRT(3)/2)
IVTNUM = 13
BVC = (-0.5, -0.8660254038)
CVC = CSQRT(CSQRT(BVC))
AVC = CVC - BVC * (0.0, 1.0)
IF (R2E(1) + 0.50000E-04) 20130, 40132, 40131
40131 IF (R2E(1) - 0.50000E-04) 40132, 40132, 20130
40132 IF (R2E(2) + 0.50000E-04) 20130, 10130, 40130
40130 IF (R2E(2) - 0.50000E-04) 10130, 10130, 20130
10130 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0131
20130 IVFAIL = IVFAIL + 1
ZVCORR = (0.00000000000000, 0.00000000000000)
WRITE (NUVI, 80045) IVTNUM, AVC, ZVCORR
0131 CONTINUE
C*****
CBB** ********************** BBCSUM0 **********************************
C**** WRITE OUT TEST SUMMARY
C****
IVTOTN = IVPASS + IVFAIL + IVDELE + IVINSP
WRITE (I02, 90004)
WRITE (I02, 90014)
WRITE (I02, 90004)
WRITE (I02, 90020) IVPASS
WRITE (I02, 90022) IVFAIL
WRITE (I02, 90024) IVDELE
WRITE (I02, 90026) IVINSP
WRITE (I02, 90028) IVTOTN, IVTOTL
CBE** ********************** BBCSUM0 **********************************
CBB** ********************** BBCFOOT0 **********************************
C**** WRITE OUT REPORT FOOTINGS
C****
WRITE (I02,90016) ZPROG, ZPROG
WRITE (I02,90018) ZPROJ, ZNAME, ZTAPE, ZTAPED
WRITE (I02,90019)
CBE** ********************** BBCFOOT0 **********************************
CBB** ********************** BBCFMT0A **********************************
C**** FORMATS FOR TEST DETAIL LINES
C****
80000 FORMAT (1H ,2X,I3,4X,7HDELETED,32X,A31)
80002 FORMAT (1H ,2X,I3,4X,7H PASS ,32X,A31)
80004 FORMAT (1H ,2X,I3,4X,7HINSPECT,32X,A31)
80008 FORMAT (1H ,2X,I3,4X,7H FAIL ,32X,A31)
80010 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,15X,10HCOMPUTED= ,
1I6,/,1H ,15X,10HCORRECT= ,I6)
80012 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
1E12.5,/,1H ,16X,10HCORRECT= ,E12.5)
80018 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
1A21,/,1H ,16X,10HCORRECT= ,A21)
80020 FORMAT (1H ,16X,10HCOMPUTED= ,A21,1X,A31)
80022 FORMAT (1H ,16X,10HCORRECT= ,A21,1X,A31)
80024 FORMAT (1H ,16X,10HCOMPUTED= ,I6,16X,A31)
80026 FORMAT (1H ,16X,10HCORRECT= ,I6,16X,A31)
80028 FORMAT (1H ,16X,10HCOMPUTED= ,E12.5,10X,A31)
80030 FORMAT (1H ,16X,10HCORRECT= ,E12.5,10X,A31)
80050 FORMAT (1H ,48X,A31)
CBE** ********************** BBCFMT0A **********************************
CBB** ********************** BBCFMAT1 **********************************
C**** FORMATS FOR TEST DETAIL LINES - FULL LANGUAGE
C****
80031 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
1D17.10,/,1H ,16X,10HCORRECT= ,D17.10)
80033 FORMAT (1H ,16X,10HCOMPUTED= ,D17.10,10X,A31)
80035 FORMAT (1H ,16X,10HCORRECT= ,D17.10,10X,A31)
80037 FORMAT (1H ,16X,10HCOMPUTED= ,1H(,E12.5,2H, ,E12.5,1H),6X,A31)
80039 FORMAT (1H ,16X,10HCORRECT= ,1H(,E12.5,2H, ,E12.5,1H),6X,A31)
80041 FORMAT (1H ,16X,10HCOMPUTED= ,1H(,F12.5,2H, ,F12.5,1H),6X,A31)
80043 FORMAT (1H ,16X,10HCORRECT= ,1H(,F12.5,2H, ,F12.5,1H),6X,A31)
80045 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
11H(,F12.5,2H, ,F12.5,1H)/,1H ,16X,10HCORRECT= ,
21H(,F12.5,2H, ,F12.5,1H))
CBE** ********************** BBCFMAT1 **********************************
CBB** ********************** BBCFMT0B **********************************
C**** FORMAT STATEMENTS FOR PAGE HEADERS
C****
90002 FORMAT (1H1)
90004 FORMAT (1H )
90006 FORMAT (1H ,20X,31HFEDERAL SOFTWARE TESTING CENTER)
90007 FORMAT (1H ,19X,34HFORTRAN COMPILER VALIDATION SYSTEM)
90008 FORMAT (1H ,21X,A13,A17)
90009 FORMAT (1H ,/,2H *,A5,6HBEGIN*,12X,15HTEST RESULTS - ,A5,/)
90010 FORMAT (1H ,8X,16HTEST DATE*TIME= ,A17,15H - COMPILER= ,A20)
90013 FORMAT (1H ,8H TEST ,10HPASS/FAIL ,6X,17HDISPLAYED RESULTS,
1 7X,7HREMARKS,24X)
90014 FORMAT (1H ,46H----------------------------------------------,
1 33H---------------------------------)
90015 FORMAT (1H ,48X,17HTHIS PROGRAM HAS ,I3,6H TESTS,/)
C****
C**** FORMAT STATEMENTS FOR REPORT FOOTINGS
C****
90016 FORMAT (1H ,/,2H *,A5,4HEND*,14X,14HEND OF TEST - ,A5,/)
90018 FORMAT (1H ,A13,13X,A20,7H * ,A10,1H/,
1 A13)
90019 FORMAT (1H ,26HFOR OFFICIAL USE ONLY ,35X,15HCOPYRIGHT 1982)
C****
C**** FORMAT STATEMENTS FOR RUN SUMMARY
C****
90020 FORMAT (1H ,21X,I5,13H TESTS PASSED)
90022 FORMAT (1H ,21X,I5,13H TESTS FAILED)
90024 FORMAT (1H ,21X,I5,14H TESTS DELETED)
90026 FORMAT (1H ,21X,I5,25H TESTS REQUIRE INSPECTION)
90028 FORMAT (1H ,21X,I5,4H OF ,I3,15H TESTS EXECUTED)
CBE** ********************** BBCFMT0B **********************************
C*****
C***** END OF TEST SEGMENT 177
STOP
END
*END-OF,FM813
FM814.f 481036524 170 2 100666 17044 `
*HEADER,FORTR,FM814
*FILES1,FORTR,FM814,X
C***********************************************************************
C***** FORTRAN 77
C***** FM814
C***** YDEXP - (179)
C*****
C***********************************************************************
C***** GENERAL PURPOSE ANS REF
C***** TEST INTRINSIC FUNCTION DEXP 15.3
C***** TABLE 5
C*****
CBB** ********************** BBCCOMNT **********************************
C****
C**** 1978 FORTRAN COMPILER VALIDATION SYSTEM
C**** VERSION 2.0
C****
C****
C**** SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO
C**** GENERAL SERVICES ADMINISTRATION
C**** FEDERAL SOFTWARE TESTING CENTER
C**** 5203 LEESBURG PIKE, SUITE 1100
C**** FALLS CHURCH, VA. 22041
C****
C**** (703) 756-6153
C****
CBE** ********************** BBCCOMNT **********************************
C*****
C***** S P E C I F I C A T I O N S SEGMENT 179
DOUBLE PRECISION AVD, BVD, DVCORR
C*****
CBB** ********************** BBCINITA **********************************
C**** SPECIFICATION STATEMENTS
C****
CHARACTER ZVERS*13, ZVERSD*17, ZDATE*17, ZPROG*5, ZCOMPL*20,
1 ZNAME*20, ZTAPE*10, ZPROJ*13, REMRKS*31, ZTAPED*13
CBE** ********************** BBCINITA **********************************
CBB** ********************** BBCINITB **********************************
C**** INITIALIZE SECTION
DATA ZVERS, ZVERSD, ZDATE
1 /'VERSION 2.0 ', '82/08/02*18.33.46', '*NO DATE*TIME'/
DATA ZCOMPL, ZNAME, ZTAPE
1 /'*NONE SPECIFIED*', '*NO COMPANY NAME*', '*NO TAPE*'/
DATA ZPROJ, ZTAPED, ZPROG
1 /'*NO PROJECT*', '*NO TAPE DATE', 'XXXXX'/
DATA REMRKS /' '/
C**** THE FOLLOWING 9 COMMENT LINES (CZ01, CZ02, ...) CAN BE REPLACED
C**** FOR IDENTIFYING THE TEST ENVIRONMENT
C****
CZ01 ZVERS = 'VERSION OF THE COMPILER VALIDATION SYSTEM'
CZ02 ZVERSD = 'CREATION DATE/TIME OF THE COMPILER VALIDATION SYSTEM'
CZ03 ZPROG = 'PROGRAM NAME'
CZ04 ZDATE = 'DATE OF TEST'
CZ05 ZCOMPL = 'COMPILER IDENTIFICATION'
CZ06 ZPROJ = 'PROJECT NUMBER/IDENTIFICATION'
CZ07 ZNAME = 'NAME OF USER'
CZ08 ZTAPE = 'TAPE OWNER/ID'
CZ09 ZTAPED = 'DATE TAPE COPIED'
C
IVPASS = 0
IVFAIL = 0
IVDELE = 0
IVINSP = 0
IVTOTL = 0
IVTOTN = 0
ICZERO = 0
C
C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER.
I01 = 05
C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER.
I02 = 06
C
CX010 REPLACED BY FEXEC X-010 CONTROL CARD (CARD-READER UNIT NUMBER).
C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5
CX011 REPLACED BY FEXEC X-011 CONTROL CARD. CX011 IS FOR SYSTEMS
C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX010.
C
CX020 REPLACED BY FEXEC X-020 CONTROL CARD (PRINTER UNIT NUMBER).
C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02= 6
CX021 REPLACED BY FEXEC X-021 CONTROL CARD. CX021 IS FOR SYSTEMS
C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX020.
C
CBE** ********************** BBCINITB **********************************
NUVI = I02
IVTOTL = 19
ZPROG = 'FM814'
CBB** ********************** BBCHED0A **********************************
C****
C**** WRITE REPORT TITLE
C****
WRITE (I02, 90002)
WRITE (I02, 90006)
WRITE (I02, 90007)
WRITE (I02, 90008) ZVERS, ZVERSD
WRITE (I02, 90009) ZPROG, ZPROG
WRITE (I02, 90010) ZDATE, ZCOMPL
CBE** ********************** BBCHED0A **********************************
C*****
C***** HEADER FOR SEGMENT 179
WRITE(NUVI,17900)
17900 FORMAT(1H , / 35H YDEXP - (179) INTRINSIC FUNCTIONS//
1 37H DEXP (DOUBLE PRECISION EXPONENTIAL)//
2 17H ANS REF. - 15.3)
CBB** ********************** BBCHED0B **********************************
C**** WRITE DETAIL REPORT HEADERS
C****
WRITE (I02,90004)
WRITE (I02,90004)
WRITE (I02,90013)
WRITE (I02,90014)
WRITE (I02,90015) IVTOTL
CBE** ********************** BBCHED0B **********************************
C*****
CT001* TEST 1 ZERO, SINCE EXP(0) = 1
IVTNUM = 1
BVD = 0.0D0
AVD = DEXP(BVD)
IF (AVD - 0.9999999995D+00) 20010, 10010, 40010
40010 IF (AVD - 0.1000000001D+01) 10010, 10010, 20010
10010 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0011
20010 IVFAIL = IVFAIL + 1
DVCORR = 0.10000000000000000000D+01
WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR
0011 CONTINUE
CT002* TEST 2 ONE, SINCE EXP(1) = E
IVTNUM = 2
AVD = DEXP(1.0D0)
IF (AVD - 0.2718281827D+01) 20020, 10020, 40020
40020 IF (AVD - 0.2718281830D+01) 10020, 10020, 20020
10020 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0021
20020 IVFAIL = IVFAIL + 1
DVCORR = 0.27182818284590452354D+01
WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR
0021 CONTINUE
CT003* TEST 3
IVTNUM = 3
AVD = DEXP(2.0D0)
IF (AVD - 0.7389056095D+01) 20030, 10030, 40030
40030 IF (AVD - 0.7389056103D+01) 10030, 10030, 20030
10030 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0031
20030 IVFAIL = IVFAIL + 1
DVCORR = 0.73890560989306502272D+01
WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR
0031 CONTINUE
CT004* TEST 4
IVTNUM = 4
AVD = DEXP(5.125D0)
IF (AVD - 0.1681741415D+03) 20040, 10040, 40040
40040 IF (AVD - 0.1681741418D+03) 10040, 10040, 20040
10040 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0041
20040 IVFAIL = IVFAIL + 1
DVCORR = 0.16817414165184545127D+03
WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR
0041 CONTINUE
CT005* TEST 5
IVTNUM = 5
AVD = DEXP(15.0D0)
IF (AVD - 0.3269017370D+07) 20050, 10050, 40050
40050 IF (AVD - 0.3269017374D+07) 10050, 10050, 20050
10050 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0051
20050 IVFAIL = IVFAIL + 1
DVCORR = 0.32690173724721106393D+07
WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR
0051 CONTINUE
CT006* TEST 6
IVTNUM = 6
BVD = 20.5D0
AVD = DEXP(BVD)
IF (AVD - 0.7999021770D+09) 20060, 10060, 40060
40060 IF (AVD - 0.7999021779D+09) 10060, 10060, 20060
10060 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0061
20060 IVFAIL = IVFAIL + 1
DVCORR = 0.79990217747550540670D+09
WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR
0061 CONTINUE
CT007* TEST 7
IVTNUM = 7
BVD = 4.5D0
AVD = DEXP(BVD - 7.5D0)
IF (AVD - 0.4978706834D-01) 20070, 10070, 40070
40070 IF (AVD - 0.4978706840D-01) 10070, 10070, 20070
10070 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0071
20070 IVFAIL = IVFAIL + 1
DVCORR = 0.49787068367863942979D-01
WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR
0071 CONTINUE
CT008* TEST 8
IVTNUM = 8
BVD = 0.25D0
AVD = DEXP(BVD - 5.0D0)
IF (AVD - 0.8651695198D-02) 20080, 10080, 40080
40080 IF (AVD - 0.8651695208D-02) 10080, 10080, 20080
10080 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0081
20080 IVFAIL = IVFAIL + 1
DVCORR = 0.86516952031206341771D-02
WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR
0081 CONTINUE
CT009* TEST 9
IVTNUM = 9
AVD = DEXP(0.5D0 * (-20.0D0))
IF (AVD - 0.4539992974D-04) 20090, 10090, 40090
40090 IF (AVD - 0.4539992979D-04) 10090, 10090, 20090
10090 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0091
20090 IVFAIL = IVFAIL + 1
DVCORR = 0.45399929762484851536D-04
WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR
0091 CONTINUE
CT010* TEST 10
IVTNUM = 10
BVD = 30.5D0
AVD = DEXP(BVD / (-2.0D0))
IF (AVD - 0.2382369666D-06) 20100, 10100, 40100
40100 IF (AVD - 0.2382369669D-06) 10100, 10100, 20100
10100 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0101
20100 IVFAIL = IVFAIL + 1
DVCORR = 0.23823696675018179180D-06
WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR
0101 CONTINUE
CT011* TEST 11 VALUES CLOSE TO 1.0
IVTNUM = 11
AVD = DEXP(0.9921875D0)
IF (AVD - 0.2697127990D+01) 20110, 10110, 40110
40110 IF (AVD - 0.2697127993D+01) 10110, 10110, 20110
10110 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0111
20110 IVFAIL = IVFAIL + 1
DVCORR = 0.26971279914439187908D+01
WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR
0111 CONTINUE
CT012* TEST 12
IVTNUM = 12
BVD = 0.9990234375D0
AVD = DEXP(BVD)
IF (AVD - 0.2715628550D+01) 20120, 10120, 40120
40120 IF (AVD - 0.2715628554D+01) 10120, 10120, 20120
10120 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0121
20120 IVFAIL = IVFAIL + 1
DVCORR = 0.27156285521168930956D+01
WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR
0121 CONTINUE
CT013* TEST 13
IVTNUM = 13
AVD = DEXP(1.00390625D0)
IF (AVD - 0.2728920881D+01) 20130, 10130, 40130
40130 IF (AVD - 0.2728920884D+01) 10130, 10130, 20130
10130 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0131
20130 IVFAIL = IVFAIL + 1
DVCORR = 0.27289208827260750401D+01
WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR
0131 CONTINUE
CT014* TEST 14
IVTNUM = 14
BVD = 1.001953125D0
AVD = DEXP(BVD)
IF (AVD - 0.2723596159D+01) 20140, 10140, 40140
40140 IF (AVD - 0.2723596162D+01) 10140, 10140, 20140
10140 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0141
20140 IVFAIL = IVFAIL + 1
DVCORR = 0.27235961607434952125D+01
WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR
0141 CONTINUE
CT015* TEST 15 VALUES CLOSE TO 1/E
IVTNUM = 15
BVD = 128.0D0
AVD = DEXP(44.0D0 / BVD)
IF (AVD - 0.1410226034D+01) 20150, 10150, 40150
40150 IF (AVD - 0.1410226036D+01) 10150, 10150, 20150
10150 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0151
20150 IVFAIL = IVFAIL + 1
DVCORR = 0.14102260349257107057D+01
WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR
0151 CONTINUE
CT016* TEST 16
IVTNUM = 16
BVD = 128.0D0
AVD = DEXP(45.0D0 / BVD)
IF (AVD - 0.1421286574D+01) 20160, 10160, 40160
40160 IF (AVD - 0.1421286576D+01) 10160, 10160, 20160
10160 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0161
20160 IVFAIL = IVFAIL + 1
DVCORR = 0.14212865748006967556D+01
WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR
0161 CONTINUE
CT017* TEST 17
IVTNUM = 17
BVD = 128.0D0
AVD = DEXP(46.0D0 / BVD)
IF (AVD - 0.1432433862D+01) 20170, 10170, 40170
40170 IF (AVD - 0.1432433865D+01) 10170, 10170, 20170
10170 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0171
20170 IVFAIL = IVFAIL + 1
DVCORR = 0.14324338635650781150D+01
WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR
0171 CONTINUE
CT018* TEST 18
IVTNUM = 18
BVD = 128.0D0
AVD = DEXP(47.0D0 / BVD)
IF (AVD - 0.1443668580D+01) 20180, 10180, 40180
40180 IF (AVD - 0.1443668583D+01) 10180, 10180, 20180
10180 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0181
20180 IVFAIL = IVFAIL + 1
DVCORR = 0.14436685815988268628D+01
WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR
0181 CONTINUE
CT019* TEST 19
IVTNUM = 19
BVD = 128.0D0
AVD = DEXP(48.0D0 / BVD)
IF (AVD - 0.1454991413D+01) 20190, 10190, 40190
40190 IF (AVD - 0.1454991416D+01) 10190, 10190, 20190
10190 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0191
20190 IVFAIL = IVFAIL + 1
DVCORR = 0.14549914146182013361D+01
WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR
0191 CONTINUE
C*****
CBB** ********************** BBCSUM0 **********************************
C**** WRITE OUT TEST SUMMARY
C****
IVTOTN = IVPASS + IVFAIL + IVDELE + IVINSP
WRITE (I02, 90004)
WRITE (I02, 90014)
WRITE (I02, 90004)
WRITE (I02, 90020) IVPASS
WRITE (I02, 90022) IVFAIL
WRITE (I02, 90024) IVDELE
WRITE (I02, 90026) IVINSP
WRITE (I02, 90028) IVTOTN, IVTOTL
CBE** ********************** BBCSUM0 **********************************
CBB** ********************** BBCFOOT0 **********************************
C**** WRITE OUT REPORT FOOTINGS
C****
WRITE (I02,90016) ZPROG, ZPROG
WRITE (I02,90018) ZPROJ, ZNAME, ZTAPE, ZTAPED
WRITE (I02,90019)
CBE** ********************** BBCFOOT0 **********************************
CBB** ********************** BBCFMT0A **********************************
C**** FORMATS FOR TEST DETAIL LINES
C****
80000 FORMAT (1H ,2X,I3,4X,7HDELETED,32X,A31)
80002 FORMAT (1H ,2X,I3,4X,7H PASS ,32X,A31)
80004 FORMAT (1H ,2X,I3,4X,7HINSPECT,32X,A31)
80008 FORMAT (1H ,2X,I3,4X,7H FAIL ,32X,A31)
80010 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,15X,10HCOMPUTED= ,
1I6,/,1H ,15X,10HCORRECT= ,I6)
80012 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
1E12.5,/,1H ,16X,10HCORRECT= ,E12.5)
80018 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
1A21,/,1H ,16X,10HCORRECT= ,A21)
80020 FORMAT (1H ,16X,10HCOMPUTED= ,A21,1X,A31)
80022 FORMAT (1H ,16X,10HCORRECT= ,A21,1X,A31)
80024 FORMAT (1H ,16X,10HCOMPUTED= ,I6,16X,A31)
80026 FORMAT (1H ,16X,10HCORRECT= ,I6,16X,A31)
80028 FORMAT (1H ,16X,10HCOMPUTED= ,E12.5,10X,A31)
80030 FORMAT (1H ,16X,10HCORRECT= ,E12.5,10X,A31)
80050 FORMAT (1H ,48X,A31)
CBE** ********************** BBCFMT0A **********************************
CBB** ********************** BBCFMAT1 **********************************
C**** FORMATS FOR TEST DETAIL LINES - FULL LANGUAGE
C****
80031 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
1D17.10,/,1H ,16X,10HCORRECT= ,D17.10)
80033 FORMAT (1H ,16X,10HCOMPUTED= ,D17.10,10X,A31)
80035 FORMAT (1H ,16X,10HCORRECT= ,D17.10,10X,A31)
80037 FORMAT (1H ,16X,10HCOMPUTED= ,1H(,E12.5,2H, ,E12.5,1H),6X,A31)
80039 FORMAT (1H ,16X,10HCORRECT= ,1H(,E12.5,2H, ,E12.5,1H),6X,A31)
80041 FORMAT (1H ,16X,10HCOMPUTED= ,1H(,F12.5,2H, ,F12.5,1H),6X,A31)
80043 FORMAT (1H ,16X,10HCORRECT= ,1H(,F12.5,2H, ,F12.5,1H),6X,A31)
80045 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
11H(,F12.5,2H, ,F12.5,1H)/,1H ,16X,10HCORRECT= ,
21H(,F12.5,2H, ,F12.5,1H))
CBE** ********************** BBCFMAT1 **********************************
CBB** ********************** BBCFMT0B **********************************
C**** FORMAT STATEMENTS FOR PAGE HEADERS
C****
90002 FORMAT (1H1)
90004 FORMAT (1H )
90006 FORMAT (1H ,20X,31HFEDERAL SOFTWARE TESTING CENTER)
90007 FORMAT (1H ,19X,34HFORTRAN COMPILER VALIDATION SYSTEM)
90008 FORMAT (1H ,21X,A13,A17)
90009 FORMAT (1H ,/,2H *,A5,6HBEGIN*,12X,15HTEST RESULTS - ,A5,/)
90010 FORMAT (1H ,8X,16HTEST DATE*TIME= ,A17,15H - COMPILER= ,A20)
90013 FORMAT (1H ,8H TEST ,10HPASS/FAIL ,6X,17HDISPLAYED RESULTS,
1 7X,7HREMARKS,24X)
90014 FORMAT (1H ,46H----------------------------------------------,
1 33H---------------------------------)
90015 FORMAT (1H ,48X,17HTHIS PROGRAM HAS ,I3,6H TESTS,/)
C****
C**** FORMAT STATEMENTS FOR REPORT FOOTINGS
C****
90016 FORMAT (1H ,/,2H *,A5,4HEND*,14X,14HEND OF TEST - ,A5,/)
90018 FORMAT (1H ,A13,13X,A20,7H * ,A10,1H/,
1 A13)
90019 FORMAT (1H ,26HFOR OFFICIAL USE ONLY ,35X,15HCOPYRIGHT 1982)
C****
C**** FORMAT STATEMENTS FOR RUN SUMMARY
C****
90020 FORMAT (1H ,21X,I5,13H TESTS PASSED)
90022 FORMAT (1H ,21X,I5,13H TESTS FAILED)
90024 FORMAT (1H ,21X,I5,14H TESTS DELETED)
90026 FORMAT (1H ,21X,I5,25H TESTS REQUIRE INSPECTION)
90028 FORMAT (1H ,21X,I5,4H OF ,I3,15H TESTS EXECUTED)
CBE** ********************** BBCFMT0B **********************************
C*****
C***** END OF TEST SEGMENT 179
STOP
END
*END-OF,FM814
FM815.f 481036528 170 2 100666 14100 `
*HEADER,FORTR,FM815
*FILES1,FORTR,FM815,X
C***********************************************************************
C***** FORTRAN 77
C***** FM815
C***** YCEXP - (180)
C*****
C***********************************************************************
C***** GENERAL PURPOSE ANS REF
C***** TEST INTRINSIC FUNCTION CEXP 15.3
C***** INTRINSIC FUNCTIONS AIMAG AND CABS ASSUMED WORKING TABLE 5
C*****
CBB** ********************** BBCCOMNT **********************************
C****
C**** 1978 FORTRAN COMPILER VALIDATION SYSTEM
C**** VERSION 2.0
C****
C****
C**** SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO
C**** GENERAL SERVICES ADMINISTRATION
C**** FEDERAL SOFTWARE TESTING CENTER
C**** 5203 LEESBURG PIKE, SUITE 1100
C**** FALLS CHURCH, VA. 22041
C****
C**** (703) 756-6153
C****
CBE** ********************** BBCCOMNT **********************************
C*****
C***** S P E C I F I C A T I O N S SEGMENT 180
COMPLEX AVC, BVC, CVC, ZVCORR
REAL R2E(2)
EQUIVALENCE (AVC, R2E)
C*****
CBB** ********************** BBCINITA **********************************
C**** SPECIFICATION STATEMENTS
C****
CHARACTER ZVERS*13, ZVERSD*17, ZDATE*17, ZPROG*5, ZCOMPL*20,
1 ZNAME*20, ZTAPE*10, ZPROJ*13, REMRKS*31, ZTAPED*13
CBE** ********************** BBCINITA **********************************
CBB** ********************** BBCINITB **********************************
C**** INITIALIZE SECTION
DATA ZVERS, ZVERSD, ZDATE
1 /'VERSION 2.0 ', '82/08/02*18.33.46', '*NO DATE*TIME'/
DATA ZCOMPL, ZNAME, ZTAPE
1 /'*NONE SPECIFIED*', '*NO COMPANY NAME*', '*NO TAPE*'/
DATA ZPROJ, ZTAPED, ZPROG
1 /'*NO PROJECT*', '*NO TAPE DATE', 'XXXXX'/
DATA REMRKS /' '/
C**** THE FOLLOWING 9 COMMENT LINES (CZ01, CZ02, ...) CAN BE REPLACED
C**** FOR IDENTIFYING THE TEST ENVIRONMENT
C****
CZ01 ZVERS = 'VERSION OF THE COMPILER VALIDATION SYSTEM'
CZ02 ZVERSD = 'CREATION DATE/TIME OF THE COMPILER VALIDATION SYSTEM'
CZ03 ZPROG = 'PROGRAM NAME'
CZ04 ZDATE = 'DATE OF TEST'
CZ05 ZCOMPL = 'COMPILER IDENTIFICATION'
CZ06 ZPROJ = 'PROJECT NUMBER/IDENTIFICATION'
CZ07 ZNAME = 'NAME OF USER'
CZ08 ZTAPE = 'TAPE OWNER/ID'
CZ09 ZTAPED = 'DATE TAPE COPIED'
C
IVPASS = 0
IVFAIL = 0
IVDELE = 0
IVINSP = 0
IVTOTL = 0
IVTOTN = 0
ICZERO = 0
C
C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER.
I01 = 05
C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER.
I02 = 06
C
CX010 REPLACED BY FEXEC X-010 CONTROL CARD (CARD-READER UNIT NUMBER).
C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5
CX011 REPLACED BY FEXEC X-011 CONTROL CARD. CX011 IS FOR SYSTEMS
C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX010.
C
CX020 REPLACED BY FEXEC X-020 CONTROL CARD (PRINTER UNIT NUMBER).
C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02= 6
CX021 REPLACED BY FEXEC X-021 CONTROL CARD. CX021 IS FOR SYSTEMS
C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX020.
C
CBE** ********************** BBCINITB **********************************
NUVI = I02
IVTOTL = 9
ZPROG = 'FM815'
CBB** ********************** BBCHED0A **********************************
C****
C**** WRITE REPORT TITLE
C****
WRITE (I02, 90002)
WRITE (I02, 90006)
WRITE (I02, 90007)
WRITE (I02, 90008) ZVERS, ZVERSD
WRITE (I02, 90009) ZPROG, ZPROG
WRITE (I02, 90010) ZDATE, ZCOMPL
CBE** ********************** BBCHED0A **********************************
C*****
C***** HEADER FOR SEGMENT 180
WRITE(NUVI,18000)
18000 FORMAT(1H , / 35H YCEXP - (180) INTRINSIC FUNCTIONS//
1 28H CEXP (COMPLEX EXPONENTIAL)//
2 17H ANS REF. - 15.3)
CBB** ********************** BBCHED0B **********************************
C**** WRITE DETAIL REPORT HEADERS
C****
WRITE (I02,90004)
WRITE (I02,90004)
WRITE (I02,90013)
WRITE (I02,90014)
WRITE (I02,90015) IVTOTL
CBE** ********************** BBCHED0B **********************************
C*****
CT001* TEST 1 ZERO
IVTNUM = 1
BVC = (0.0, 0.0)
AVC = CEXP(BVC)
IF (R2E(1) - 0.99995E+00) 20010, 40012, 40011
40011 IF (R2E(1) - 0.10001E+01) 40012, 40012, 20010
40012 IF (R2E(2) + 0.50000E-04) 20010, 10010, 40010
40010 IF (R2E(2) - 0.50000E-04) 10010, 10010, 20010
10010 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0011
20010 IVFAIL = IVFAIL + 1
ZVCORR = (1.0000000000000, 0.00000000000000)
WRITE (NUVI, 80045) IVTNUM, AVC, ZVCORR
0011 CONTINUE
CT002* TEST 2 PURELY REAL NUMBERS -- RESULT AGREES WITH EXP
IVTNUM = 2
AVC = CEXP((1.0, 0.0))
IF (R2E(1) - 0.27181E+01) 20020, 40022, 40021
40021 IF (R2E(1) - 0.27185E+01) 40022, 40022, 20020
40022 IF (R2E(2) + 0.50000E-04) 20020, 10020, 40020
40020 IF (R2E(2) - 0.50000E-04) 10020, 10020, 20020
10020 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0021
20020 IVFAIL = IVFAIL + 1
ZVCORR = (2.7182818284590, 0.00000000000000)
WRITE (NUVI, 80045) IVTNUM, AVC, ZVCORR
0021 CONTINUE
CT003* TEST 3 PURELY REAL NUMBERS -- RESULT AGREES WITH EXP
IVTNUM = 3
BVC = (-3.0, 0.0)
AVC = CEXP(BVC)
IF (R2E(1) - 0.49784E-01) 20030, 40032, 40031
40031 IF (R2E(1) - 0.49790E-01) 40032, 40032, 20030
40032 IF (R2E(2) + 0.50000E-04) 20030, 10030, 40030
40030 IF (R2E(2) - 0.50000E-04) 10030, 10030, 20030
10030 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0031
20030 IVFAIL = IVFAIL + 1
ZVCORR = (0.04978706836785, 0.00000000000000)
WRITE (NUVI, 80045) IVTNUM, AVC, ZVCORR
0031 CONTINUE
C***** TESTS 4 AND 5 - PURELY IMAGINARY NUMBERS--RESULT LIES
C***** ON UNIT CIRCLE
CT004* TEST 4 (0,PI)
IVTNUM = 4
BVC = (0.0, 3.1415926536)
AVC = CEXP(BVC * (1.0, 0.0))
IF (R2E(1) + 0.10001E+01) 20040, 40042, 40041
40041 IF (R2E(1) + 0.99995E+00) 40042, 40042, 20040
40042 IF (R2E(2) + 0.50000E-04) 20040, 10040, 40040
40040 IF (R2E(2) - 0.50000E-04) 10040, 10040, 20040
10040 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0041
20040 IVFAIL = IVFAIL + 1
ZVCORR = (-1.0000000000000, 0.00000000000000)
WRITE (NUVI, 80045) IVTNUM, AVC, ZVCORR
0041 CONTINUE
CT005* TEST 5 (0,-PI/2)
IVTNUM = 5
BVC = (0.0, -3.1415926536)
AVC = CEXP(BVC / (2.0, 0.0))
IF (R2E(1) + 0.50000E-04) 20050, 40052, 40051
40051 IF (R2E(1) - 0.50000E-04) 40052, 40052, 20050
40052 IF (R2E(2) + 0.10001E+01) 20050, 10050, 40050
40050 IF (R2E(2) + 0.99995E+00) 10050, 10050, 20050
10050 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0051
20050 IVFAIL = IVFAIL + 1
ZVCORR = (0.00000000000000, -1.0000000000000)
WRITE (NUVI, 80045) IVTNUM, AVC, ZVCORR
0051 CONTINUE
CT006* TEST 6 (2.5,PI/4)
IVTNUM = 6
AVC = CEXP((1.0, 2.0))
IF (R2E(1) + 0.11313E+01) 20060, 40062, 40061
40061 IF (R2E(1) + 0.11311E+01) 40062, 40062, 20060
40062 IF (R2E(2) - 0.24716E+01) 20060, 10060, 40060
40060 IF (R2E(2) - 0.24719E+01) 10060, 10060, 20060
10060 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0061
20060 IVFAIL = IVFAIL + 1
ZVCORR = (-1.1312043837568, 2.4717266720048)
WRITE (NUVI, 80045) IVTNUM, AVC, ZVCORR
0061 CONTINUE
CT007* TEST 7 A VARIABLE SUPPLIED TO CEXP
IVTNUM = 7
BVC = (-1.75, 4.625)
AVC = CEXP(BVC)
IF (R2E(1) + 0.15168E-01) 20070, 40072, 40071
40071 IF (R2E(1) + 0.15165E-01) 40072, 40072, 20070
40072 IF (R2E(2) + 0.17312E+00) 20070, 10070, 40070
40070 IF (R2E(2) + 0.17310E+00) 10070, 10070, 20070
10070 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0071
20070 IVFAIL = IVFAIL + 1
ZVCORR = (-0.01516660638013, -0.17311082425206)
WRITE (NUVI, 80045) IVTNUM, AVC, ZVCORR
0071 CONTINUE
CT008* TEST 8 POSITIVE REAL, NEGATIVE IMAGINARY ARGUMENT
IVTNUM = 8
AVC = CEXP((5.5, -1.015625))
IF (R2E(1) - 0.12896E+03) 20080, 40082, 40081
40081 IF (R2E(1) - 0.12898E+03) 40082, 40082, 20080
40082 IF (R2E(2) + 0.20796E+03) 20080, 10080, 40080
40080 IF (R2E(2) + 0.20793E+03) 10080, 10080, 20080
10080 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0081
20080 IVFAIL = IVFAIL + 1
ZVCORR = (128.97440219594, -207.94168724284)
WRITE (NUVI, 80045) IVTNUM, AVC, ZVCORR
0081 CONTINUE
CT009* TEST 9 THE FUNCTION TOGETHER WITH AIMAG AND CABS
IVTNUM = 9
BVC = (10.0, 3.1415926536)
CVC = CEXP(BVC / (4.0, 0.0))
AVS = (AIMAG(CVC) / CABS(CVC)) ** 2
IF (AVS - 0.49997E+00) 20090, 10090, 40090
40090 IF (AVS - 0.50003E+00) 10090, 10090, 20090
10090 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0091
20090 IVFAIL = IVFAIL + 1
RVCORR = 0.5000000
WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR
0091 CONTINUE
C*****
CBB** ********************** BBCSUM0 **********************************
C**** WRITE OUT TEST SUMMARY
C****
IVTOTN = IVPASS + IVFAIL + IVDELE + IVINSP
WRITE (I02, 90004)
WRITE (I02, 90014)
WRITE (I02, 90004)
WRITE (I02, 90020) IVPASS
WRITE (I02, 90022) IVFAIL
WRITE (I02, 90024) IVDELE
WRITE (I02, 90026) IVINSP
WRITE (I02, 90028) IVTOTN, IVTOTL
CBE** ********************** BBCSUM0 **********************************
CBB** ********************** BBCFOOT0 **********************************
C**** WRITE OUT REPORT FOOTINGS
C****
WRITE (I02,90016) ZPROG, ZPROG
WRITE (I02,90018) ZPROJ, ZNAME, ZTAPE, ZTAPED
WRITE (I02,90019)
CBE** ********************** BBCFOOT0 **********************************
CBB** ********************** BBCFMT0A **********************************
C**** FORMATS FOR TEST DETAIL LINES
C****
80000 FORMAT (1H ,2X,I3,4X,7HDELETED,32X,A31)
80002 FORMAT (1H ,2X,I3,4X,7H PASS ,32X,A31)
80004 FORMAT (1H ,2X,I3,4X,7HINSPECT,32X,A31)
80008 FORMAT (1H ,2X,I3,4X,7H FAIL ,32X,A31)
80010 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,15X,10HCOMPUTED= ,
1I6,/,1H ,15X,10HCORRECT= ,I6)
80012 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
1E12.5,/,1H ,16X,10HCORRECT= ,E12.5)
80018 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
1A21,/,1H ,16X,10HCORRECT= ,A21)
80020 FORMAT (1H ,16X,10HCOMPUTED= ,A21,1X,A31)
80022 FORMAT (1H ,16X,10HCORRECT= ,A21,1X,A31)
80024 FORMAT (1H ,16X,10HCOMPUTED= ,I6,16X,A31)
80026 FORMAT (1H ,16X,10HCORRECT= ,I6,16X,A31)
80028 FORMAT (1H ,16X,10HCOMPUTED= ,E12.5,10X,A31)
80030 FORMAT (1H ,16X,10HCORRECT= ,E12.5,10X,A31)
80050 FORMAT (1H ,48X,A31)
CBE** ********************** BBCFMT0A **********************************
CBB** ********************** BBCFMAT1 **********************************
C**** FORMATS FOR TEST DETAIL LINES - FULL LANGUAGE
C****
80031 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
1D17.10,/,1H ,16X,10HCORRECT= ,D17.10)
80033 FORMAT (1H ,16X,10HCOMPUTED= ,D17.10,10X,A31)
80035 FORMAT (1H ,16X,10HCORRECT= ,D17.10,10X,A31)
80037 FORMAT (1H ,16X,10HCOMPUTED= ,1H(,E12.5,2H, ,E12.5,1H),6X,A31)
80039 FORMAT (1H ,16X,10HCORRECT= ,1H(,E12.5,2H, ,E12.5,1H),6X,A31)
80041 FORMAT (1H ,16X,10HCOMPUTED= ,1H(,F12.5,2H, ,F12.5,1H),6X,A31)
80043 FORMAT (1H ,16X,10HCORRECT= ,1H(,F12.5,2H, ,F12.5,1H),6X,A31)
80045 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
11H(,F12.5,2H, ,F12.5,1H)/,1H ,16X,10HCORRECT= ,
21H(,F12.5,2H, ,F12.5,1H))
CBE** ********************** BBCFMAT1 **********************************
CBB** ********************** BBCFMT0B **********************************
C**** FORMAT STATEMENTS FOR PAGE HEADERS
C****
90002 FORMAT (1H1)
90004 FORMAT (1H )
90006 FORMAT (1H ,20X,31HFEDERAL SOFTWARE TESTING CENTER)
90007 FORMAT (1H ,19X,34HFORTRAN COMPILER VALIDATION SYSTEM)
90008 FORMAT (1H ,21X,A13,A17)
90009 FORMAT (1H ,/,2H *,A5,6HBEGIN*,12X,15HTEST RESULTS - ,A5,/)
90010 FORMAT (1H ,8X,16HTEST DATE*TIME= ,A17,15H - COMPILER= ,A20)
90013 FORMAT (1H ,8H TEST ,10HPASS/FAIL ,6X,17HDISPLAYED RESULTS,
1 7X,7HREMARKS,24X)
90014 FORMAT (1H ,46H----------------------------------------------,
1 33H---------------------------------)
90015 FORMAT (1H ,48X,17HTHIS PROGRAM HAS ,I3,6H TESTS,/)
C****
C**** FORMAT STATEMENTS FOR REPORT FOOTINGS
C****
90016 FORMAT (1H ,/,2H *,A5,4HEND*,14X,14HEND OF TEST - ,A5,/)
90018 FORMAT (1H ,A13,13X,A20,7H * ,A10,1H/,
1 A13)
90019 FORMAT (1H ,26HFOR OFFICIAL USE ONLY ,35X,15HCOPYRIGHT 1982)
C****
C**** FORMAT STATEMENTS FOR RUN SUMMARY
C****
90020 FORMAT (1H ,21X,I5,13H TESTS PASSED)
90022 FORMAT (1H ,21X,I5,13H TESTS FAILED)
90024 FORMAT (1H ,21X,I5,14H TESTS DELETED)
90026 FORMAT (1H ,21X,I5,25H TESTS REQUIRE INSPECTION)
90028 FORMAT (1H ,21X,I5,4H OF ,I3,15H TESTS EXECUTED)
CBE** ********************** BBCFMT0B **********************************
C*****
C***** END OF TEST SEGMENT 180
STOP
END
*END-OF,FM815
FM816.f 481036532 170 2 100666 15829 `
*HEADER,FORTR,FM816
*FILES1,FORTR,FM816,X
C***********************************************************************
C***** FORTRAN 77
C***** FM816
C***** YDLOG - (182)
C*****
C***********************************************************************
C***** GENERAL PURPOSE ANS REF
C***** TEST INTRINSIC FUNCTION DLOG 15.3
C***** TABLE 5
CBB** ********************** BBCCOMNT **********************************
C****
C**** 1978 FORTRAN COMPILER VALIDATION SYSTEM
C**** VERSION 2.0
C****
C****
C**** SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO
C**** GENERAL SERVICES ADMINISTRATION
C**** FEDERAL SOFTWARE TESTING CENTER
C**** 5203 LEESBURG PIKE, SUITE 1100
C**** FALLS CHURCH, VA. 22041
C****
C**** (703) 756-6153
C****
CBE** ********************** BBCCOMNT **********************************
C*****
C***** S P E C I F I C A T I O N S SEGMENT 182
DOUBLE PRECISION AVD, BVD, CVD, DVCORR
C*****
CBB** ********************** BBCINITA **********************************
C**** SPECIFICATION STATEMENTS
C****
CHARACTER ZVERS*13, ZVERSD*17, ZDATE*17, ZPROG*5, ZCOMPL*20,
1 ZNAME*20, ZTAPE*10, ZPROJ*13, REMRKS*31, ZTAPED*13
CBE** ********************** BBCINITA **********************************
CBB** ********************** BBCINITB **********************************
C**** INITIALIZE SECTION
DATA ZVERS, ZVERSD, ZDATE
1 /'VERSION 2.0 ', '82/08/02*18.33.46', '*NO DATE*TIME'/
DATA ZCOMPL, ZNAME, ZTAPE
1 /'*NONE SPECIFIED*', '*NO COMPANY NAME*', '*NO TAPE*'/
DATA ZPROJ, ZTAPED, ZPROG
1 /'*NO PROJECT*', '*NO TAPE DATE', 'XXXXX'/
DATA REMRKS /' '/
C**** THE FOLLOWING 9 COMMENT LINES (CZ01, CZ02, ...) CAN BE REPLACED
C**** FOR IDENTIFYING THE TEST ENVIRONMENT
C****
CZ01 ZVERS = 'VERSION OF THE COMPILER VALIDATION SYSTEM'
CZ02 ZVERSD = 'CREATION DATE/TIME OF THE COMPILER VALIDATION SYSTEM'
CZ03 ZPROG = 'PROGRAM NAME'
CZ04 ZDATE = 'DATE OF TEST'
CZ05 ZCOMPL = 'COMPILER IDENTIFICATION'
CZ06 ZPROJ = 'PROJECT NUMBER/IDENTIFICATION'
CZ07 ZNAME = 'NAME OF USER'
CZ08 ZTAPE = 'TAPE OWNER/ID'
CZ09 ZTAPED = 'DATE TAPE COPIED'
C
IVPASS = 0
IVFAIL = 0
IVDELE = 0
IVINSP = 0
IVTOTL = 0
IVTOTN = 0
ICZERO = 0
C
C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER.
I01 = 05
C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER.
I02 = 06
C
CX010 REPLACED BY FEXEC X-010 CONTROL CARD (CARD-READER UNIT NUMBER).
C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5
CX011 REPLACED BY FEXEC X-011 CONTROL CARD. CX011 IS FOR SYSTEMS
C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX010.
C
CX020 REPLACED BY FEXEC X-020 CONTROL CARD (PRINTER UNIT NUMBER).
C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02= 6
CX021 REPLACED BY FEXEC X-021 CONTROL CARD. CX021 IS FOR SYSTEMS
C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX020.
C
CBE** ********************** BBCINITB **********************************
NUVI = I02
IVTOTL = 16
ZPROG = 'FM816'
CBB** ********************** BBCHED0A **********************************
C****
C**** WRITE REPORT TITLE
C****
WRITE (I02, 90002)
WRITE (I02, 90006)
WRITE (I02, 90007)
WRITE (I02, 90008) ZVERS, ZVERSD
WRITE (I02, 90009) ZPROG, ZPROG
WRITE (I02, 90010) ZDATE, ZCOMPL
CBE** ********************** BBCHED0A **********************************
C*****
C***** HEADER FOR SEGMENT 182
WRITE(NUVI,18200)
18200 FORMAT(1H , / 35H YDLOG - (182) INTRINSIC FUNCTIONS//
1 43H DLOG (DOUBLE PRECISION NATURAL LOGARITHM)//
2 17H ANS REF. - 15.3)
CBB** ********************** BBCHED0B **********************************
C**** WRITE DETAIL REPORT HEADERS
C****
WRITE (I02,90004)
WRITE (I02,90004)
WRITE (I02,90013)
WRITE (I02,90014)
WRITE (I02,90015) IVTOTL
CBE** ********************** BBCHED0B **********************************
C*****
CT001* TEST 1 ONE, SINCE LN(1.0) = 0.0
IVTNUM = 1
BVD = 1.0D0
AVD = DLOG(BVD)
IF (AVD + 0.5000000000D-09) 20010, 10010, 40010
40010 IF (AVD - 0.5000000000D-09) 10010, 10010, 20010
10010 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0011
20010 IVFAIL = IVFAIL + 1
DVCORR = 0.00000000000000000000D+00
WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR
0011 CONTINUE
CT002* TEST 2 VALUE CLOSE TO E
IVTNUM = 2
AVD = DLOG(2.6875D0)
IF (AVD - 0.9886113929D+00) 20020, 10020, 40020
40020 IF (AVD - 0.9886113940D+00) 10020, 10020, 20020
10020 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0021
20020 IVFAIL = IVFAIL + 1
DVCORR = 0.98861139345378118580D+00
WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR
0021 CONTINUE
CT003* TEST 3
IVTNUM = 3
AVD = DLOG(5.125D0)
IF (AVD - 0.1634130524D+01) 20030, 10030, 40030
40030 IF (AVD - 0.1634130526D+01) 10030, 10030, 20030
10030 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0031
20030 IVFAIL = IVFAIL + 1
DVCORR = 1.6341305250244718756D+00
WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR
0031 CONTINUE
CT004* TEST 4
IVTNUM = 4
AVD = DLOG(10.0D0)
IF (AVD - 0.2302585091D+01) 20040, 10040, 40040
40040 IF (AVD - 0.2302585095D+01) 10040, 10040, 20040
10040 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0041
20040 IVFAIL = IVFAIL + 1
DVCORR = 2.3025850929940456840D+00
WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR
0041 CONTINUE
CT005* TEST 5
IVTNUM = 5
AVD = DLOG(100.0D0)
IF (AVD - 0.4605170183D+01) 20050, 10050, 40050
40050 IF (AVD - 0.4605170189D+01) 10050, 10050, 20050
10050 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0051
20050 IVFAIL = IVFAIL + 1
DVCORR = 4.6051701859880913680D+00
WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR
0051 CONTINUE
CT006* TEST 6
IVTNUM = 6
BVD = 1.0D0
AVD = DLOG(BVD / 4.D0)
IF (AVD + 0.1386294362D+01) 20060, 10060, 40060
40060 IF (AVD + 0.1386294360D+01) 10060, 10060, 20060
10060 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0061
20060 IVFAIL = IVFAIL + 1
DVCORR = -1.3862943611198906188D+00
WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR
0061 CONTINUE
CT007* TEST 7
IVTNUM = 7
BVD = 1.0D0
CVD = 8.0D0
AVD = DLOG(3.0D0 * BVD / CVD)
IF (AVD + 0.9808292535D+00) 20070, 10070, 40070
40070 IF (AVD + 0.9808292525D+00) 10070, 10070, 20070
10070 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0071
20070 IVFAIL = IVFAIL + 1
DVCORR = -0.98082925301172623686D+00
WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR
0071 CONTINUE
CT008* TEST 8
IVTNUM = 8
AVD = DLOG(50.0D0 / 100.0D0)
IF (AVD + 0.6931471809D+00) 20080, 10080, 40080
40080 IF (AVD + 0.6931471802D+00) 10080, 10080, 20080
10080 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0081
20080 IVFAIL = IVFAIL + 1
DVCORR = -0.69314718055994530942D+00
WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR
0081 CONTINUE
CT009* TEST 9
IVTNUM = 9
BVD = 68.75D0
AVD = DLOG(BVD * 0.01D0)
IF (AVD + 0.3746934497D+00) 20090, 10090, 40090
40090 IF (AVD + 0.3746934492D+00) 10090, 10090, 20090
10090 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0091
20090 IVFAIL = IVFAIL + 1
DVCORR = -0.37469344944141069361D+00
WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR
0091 CONTINUE
CT010* TEST 10 VALUES CLOSE TO ONE
IVTNUM = 10
AVD = DLOG(0.96875D0)
IF (AVD + 0.3174869833D-01) 20100, 10100, 40100
40100 IF (AVD + 0.3174869829D-01) 10100, 10100, 20100
10100 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0101
20100 IVFAIL = IVFAIL + 1
DVCORR = -0.031748698314580301157D+00
WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR
0101 CONTINUE
CT011* TEST 11
IVTNUM = 11
BVD = 1.015625D0
AVD = DLOG(BVD)
IF (AVD - 0.1550418652D-01) 20110, 10110, 40110
40110 IF (AVD - 0.1550418655D-01) 10110, 10110, 20110
10110 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0111
20110 IVFAIL = IVFAIL + 1
DVCORR = 0.015504186535965254150D+00
WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR
0111 CONTINUE
CT012* TEST 12 VALUES CLOSE TO ZERO
IVTNUM = 12
BVD = 128.0D0
AVD = DLOG(1.0D0 / BVD)
IF (AVD + 0.4852030267D+01) 20120, 10120, 40120
40120 IF (AVD + 0.4852030261D+01) 10120, 10120, 20120
10120 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0121
20120 IVFAIL = IVFAIL + 1
DVCORR = -4.8520302639196171659D+00
WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR
0121 CONTINUE
CT013* TEST 13
IVTNUM = 13
BVD = 128.0D0
AVD = DLOG(1.0D0 / (BVD * 4.0D0))
IF (AVD + 0.6238324629D+01) 20130, 10130, 40130
40130 IF (AVD + 0.6238324622D+01) 10130, 10130, 20130
10130 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0131
20130 IVFAIL = IVFAIL + 1
DVCORR = -6.2383246250395077848D+00
WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR
0131 CONTINUE
CT014* TEST 14 AN ARGUMENT OF HIGH MAGNITUDE
IVTNUM = 14
BVD = 1.0D+37
AVD = DLOG(BVD)
IF (AVD - 0.8519564839D+02) 20140, 10140, 40140
40140 IF (AVD - 0.8519564849D+02) 10140, 10140, 20140
10140 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0141
20140 IVFAIL = IVFAIL + 1
DVCORR = 85.195648440779690309D+00
WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR
0141 CONTINUE
CT015* TEST 15 AN ARGUMENT OF LOW MAGNITUDE
IVTNUM = 15
BVD = 1.0D-37
AVD = DLOG(BVD)
IF (AVD + 0.8519564849D+02) 20150, 10150, 40150
40150 IF (AVD + 0.8519564840D+02) 10150, 10150, 20150
10150 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0151
20150 IVFAIL = IVFAIL + 1
DVCORR = -85.195648440779690309D+00
WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR
0151 CONTINUE
CT016* TEST 16
IVTNUM = 16
AVD = DLOG(8.0D0) + DLOG(0.125D0)
IF (AVD + 0.5000000000D-09) 20160, 10160, 40160
40160 IF (AVD - 0.5000000000D-09) 10160, 10160, 20160
10160 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0161
20160 IVFAIL = IVFAIL + 1
DVCORR = 0.00000000000000D+00
WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR
0161 CONTINUE
C*****
CBB** ********************** BBCSUM0 **********************************
C**** WRITE OUT TEST SUMMARY
C****
IVTOTN = IVPASS + IVFAIL + IVDELE + IVINSP
WRITE (I02, 90004)
WRITE (I02, 90014)
WRITE (I02, 90004)
WRITE (I02, 90020) IVPASS
WRITE (I02, 90022) IVFAIL
WRITE (I02, 90024) IVDELE
WRITE (I02, 90026) IVINSP
WRITE (I02, 90028) IVTOTN, IVTOTL
CBE** ********************** BBCSUM0 **********************************
CBB** ********************** BBCFOOT0 **********************************
C**** WRITE OUT REPORT FOOTINGS
C****
WRITE (I02,90016) ZPROG, ZPROG
WRITE (I02,90018) ZPROJ, ZNAME, ZTAPE, ZTAPED
WRITE (I02,90019)
CBE** ********************** BBCFOOT0 **********************************
CBB** ********************** BBCFMT0A **********************************
C**** FORMATS FOR TEST DETAIL LINES
C****
80000 FORMAT (1H ,2X,I3,4X,7HDELETED,32X,A31)
80002 FORMAT (1H ,2X,I3,4X,7H PASS ,32X,A31)
80004 FORMAT (1H ,2X,I3,4X,7HINSPECT,32X,A31)
80008 FORMAT (1H ,2X,I3,4X,7H FAIL ,32X,A31)
80010 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,15X,10HCOMPUTED= ,
1I6,/,1H ,15X,10HCORRECT= ,I6)
80012 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
1E12.5,/,1H ,16X,10HCORRECT= ,E12.5)
80018 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
1A21,/,1H ,16X,10HCORRECT= ,A21)
80020 FORMAT (1H ,16X,10HCOMPUTED= ,A21,1X,A31)
80022 FORMAT (1H ,16X,10HCORRECT= ,A21,1X,A31)
80024 FORMAT (1H ,16X,10HCOMPUTED= ,I6,16X,A31)
80026 FORMAT (1H ,16X,10HCORRECT= ,I6,16X,A31)
80028 FORMAT (1H ,16X,10HCOMPUTED= ,E12.5,10X,A31)
80030 FORMAT (1H ,16X,10HCORRECT= ,E12.5,10X,A31)
80050 FORMAT (1H ,48X,A31)
CBE** ********************** BBCFMT0A **********************************
CBB** ********************** BBCFMAT1 **********************************
C**** FORMATS FOR TEST DETAIL LINES - FULL LANGUAGE
C****
80031 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
1D17.10,/,1H ,16X,10HCORRECT= ,D17.10)
80033 FORMAT (1H ,16X,10HCOMPUTED= ,D17.10,10X,A31)
80035 FORMAT (1H ,16X,10HCORRECT= ,D17.10,10X,A31)
80037 FORMAT (1H ,16X,10HCOMPUTED= ,1H(,E12.5,2H, ,E12.5,1H),6X,A31)
80039 FORMAT (1H ,16X,10HCORRECT= ,1H(,E12.5,2H, ,E12.5,1H),6X,A31)
80041 FORMAT (1H ,16X,10HCOMPUTED= ,1H(,F12.5,2H, ,F12.5,1H),6X,A31)
80043 FORMAT (1H ,16X,10HCORRECT= ,1H(,F12.5,2H, ,F12.5,1H),6X,A31)
80045 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
11H(,F12.5,2H, ,F12.5,1H)/,1H ,16X,10HCORRECT= ,
21H(,F12.5,2H, ,F12.5,1H))
CBE** ********************** BBCFMAT1 **********************************
CBB** ********************** BBCFMT0B **********************************
C**** FORMAT STATEMENTS FOR PAGE HEADERS
C****
90002 FORMAT (1H1)
90004 FORMAT (1H )
90006 FORMAT (1H ,20X,31HFEDERAL SOFTWARE TESTING CENTER)
90007 FORMAT (1H ,19X,34HFORTRAN COMPILER VALIDATION SYSTEM)
90008 FORMAT (1H ,21X,A13,A17)
90009 FORMAT (1H ,/,2H *,A5,6HBEGIN*,12X,15HTEST RESULTS - ,A5,/)
90010 FORMAT (1H ,8X,16HTEST DATE*TIME= ,A17,15H - COMPILER= ,A20)
90013 FORMAT (1H ,8H TEST ,10HPASS/FAIL ,6X,17HDISPLAYED RESULTS,
1 7X,7HREMARKS,24X)
90014 FORMAT (1H ,46H----------------------------------------------,
1 33H---------------------------------)
90015 FORMAT (1H ,48X,17HTHIS PROGRAM HAS ,I3,6H TESTS,/)
C****
C**** FORMAT STATEMENTS FOR REPORT FOOTINGS
C****
90016 FORMAT (1H ,/,2H *,A5,4HEND*,14X,14HEND OF TEST - ,A5,/)
90018 FORMAT (1H ,A13,13X,A20,7H * ,A10,1H/,
1 A13)
90019 FORMAT (1H ,26HFOR OFFICIAL USE ONLY ,35X,15HCOPYRIGHT 1982)
C****
C**** FORMAT STATEMENTS FOR RUN SUMMARY
C****
90020 FORMAT (1H ,21X,I5,13H TESTS PASSED)
90022 FORMAT (1H ,21X,I5,13H TESTS FAILED)
90024 FORMAT (1H ,21X,I5,14H TESTS DELETED)
90026 FORMAT (1H ,21X,I5,25H TESTS REQUIRE INSPECTION)
90028 FORMAT (1H ,21X,I5,4H OF ,I3,15H TESTS EXECUTED)
CBE** ********************** BBCFMT0B **********************************
C*****
C***** END OF TEST SEGMENT 182
STOP
END
*END-OF,FM816
FM817.f 481036536 170 2 100666 15293 `
*HEADER,FORTR,FM817
*FILES1,FORTR,FM817,X
C***********************************************************************
C***** FORTRAN 77
C***** FM817
C***** YCLOG - (183)
C*****
C***********************************************************************
C***** GENERAL PURPOSE ANS REF
C***** TEST INTRINSIC FUNCTION CLOG 15.3
C***** INTRINSIC FUNCTIONS AIMAG AND CMPLX ASSUMED WORKING TABLE 5
C*****
CBB** ********************** BBCCOMNT **********************************
C****
C**** 1978 FORTRAN COMPILER VALIDATION SYSTEM
C**** VERSION 2.0
C****
C****
C**** SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO
C**** GENERAL SERVICES ADMINISTRATION
C**** FEDERAL SOFTWARE TESTING CENTER
C**** 5203 LEESBURG PIKE, SUITE 1100
C**** FALLS CHURCH, VA. 22041
C****
C**** (703) 756-6153
C****
CBE** ********************** BBCCOMNT **********************************
C*****
C***** S P E C I F I C A T I O N S SEGMENT 183
COMPLEX AVC, BVC, CVC, ZVCORR
REAL R2E(2)
EQUIVALENCE (AVC, R2E)
C*****
CBB** ********************** BBCINITA **********************************
C**** SPECIFICATION STATEMENTS
C****
CHARACTER ZVERS*13, ZVERSD*17, ZDATE*17, ZPROG*5, ZCOMPL*20,
1 ZNAME*20, ZTAPE*10, ZPROJ*13, REMRKS*31, ZTAPED*13
CBE** ********************** BBCINITA **********************************
CBB** ********************** BBCINITB **********************************
C**** INITIALIZE SECTION
DATA ZVERS, ZVERSD, ZDATE
1 /'VERSION 2.0 ', '82/08/02*18.33.46', '*NO DATE*TIME'/
DATA ZCOMPL, ZNAME, ZTAPE
1 /'*NONE SPECIFIED*', '*NO COMPANY NAME*', '*NO TAPE*'/
DATA ZPROJ, ZTAPED, ZPROG
1 /'*NO PROJECT*', '*NO TAPE DATE', 'XXXXX'/
DATA REMRKS /' '/
C**** THE FOLLOWING 9 COMMENT LINES (CZ01, CZ02, ...) CAN BE REPLACED
C**** FOR IDENTIFYING THE TEST ENVIRONMENT
C****
CZ01 ZVERS = 'VERSION OF THE COMPILER VALIDATION SYSTEM'
CZ02 ZVERSD = 'CREATION DATE/TIME OF THE COMPILER VALIDATION SYSTEM'
CZ03 ZPROG = 'PROGRAM NAME'
CZ04 ZDATE = 'DATE OF TEST'
CZ05 ZCOMPL = 'COMPILER IDENTIFICATION'
CZ06 ZPROJ = 'PROJECT NUMBER/IDENTIFICATION'
CZ07 ZNAME = 'NAME OF USER'
CZ08 ZTAPE = 'TAPE OWNER/ID'
CZ09 ZTAPED = 'DATE TAPE COPIED'
C
IVPASS = 0
IVFAIL = 0
IVDELE = 0
IVINSP = 0
IVTOTL = 0
IVTOTN = 0
ICZERO = 0
C
C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER.
I01 = 05
C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER.
I02 = 06
C
CX010 REPLACED BY FEXEC X-010 CONTROL CARD (CARD-READER UNIT NUMBER).
C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5
CX011 REPLACED BY FEXEC X-011 CONTROL CARD. CX011 IS FOR SYSTEMS
C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX010.
C
CX020 REPLACED BY FEXEC X-020 CONTROL CARD (PRINTER UNIT NUMBER).
C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02= 6
CX021 REPLACED BY FEXEC X-021 CONTROL CARD. CX021 IS FOR SYSTEMS
C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX020.
C
CBE** ********************** BBCINITB **********************************
NUVI = I02
IVTOTL = 11
ZPROG = 'FM817'
CBB** ********************** BBCHED0A **********************************
C****
C**** WRITE REPORT TITLE
C****
WRITE (I02, 90002)
WRITE (I02, 90006)
WRITE (I02, 90007)
WRITE (I02, 90008) ZVERS, ZVERSD
WRITE (I02, 90009) ZPROG, ZPROG
WRITE (I02, 90010) ZDATE, ZCOMPL
CBE** ********************** BBCHED0A **********************************
C*****
C***** HEADER FOR SEGMENT 183
WRITE(NUVI,18300)
18300 FORMAT(1H , / 35H YCLOG - (183) INTRINSIC FUNCTIONS//
1 34H CLOG (COMPLEX NATURAL LOGARITHM)//
2 17H ANS REF. - 15.3)
CBB** ********************** BBCHED0B **********************************
C**** WRITE DETAIL REPORT HEADERS
C****
WRITE (I02,90004)
WRITE (I02,90004)
WRITE (I02,90013)
WRITE (I02,90014)
WRITE (I02,90015) IVTOTL
CBE** ********************** BBCHED0B **********************************
C*****
PIVS = 3.1415926535897932384626434
C***** TESTS 1 THRU 3 - POSITIVE REAL NUMBERS--CLOG, ALOG AGREE ON
C***** REAL LINE
CT001* TEST 1
IVTNUM = 1
AVC = CLOG((1.0, 0.0))
IF (R2E(1) + 0.50000E-04) 20010, 40012, 40011
40011 IF (R2E(1) - 0.50000E-04) 40012, 40012, 20010
40012 IF (R2E(2) + 0.50000E-04) 20010, 10010, 40010
40010 IF (R2E(2) - 0.50000E-04) 10010, 10010, 20010
10010 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0011
20010 IVFAIL = IVFAIL + 1
ZVCORR = (0.00000000000000, 0.00000000000000)
WRITE (NUVI, 80045) IVTNUM, AVC, ZVCORR
0011 CONTINUE
CT002* TEST 2
IVTNUM = 2
AVC = CLOG((5.125, 0.0))
IF (R2E(1) - 0.16340E+01) 20020, 40022, 40021
40021 IF (R2E(1) - 0.16343E+01) 40022, 40022, 20020
40022 IF (R2E(2) + 0.50000E-04) 20020, 10020, 40020
40020 IF (R2E(2) - 0.50000E-04) 10020, 10020, 20020
10020 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0021
20020 IVFAIL = IVFAIL + 1
ZVCORR = (1.6341305250245, 0.00000000000000)
WRITE (NUVI, 80045) IVTNUM, AVC, ZVCORR
0021 CONTINUE
CT003* TEST 3
IVTNUM = 3
AVC = CLOG((100.0, 0.0))
IF (R2E(1) - 0.46049E+01) 20030, 40032, 40031
40031 IF (R2E(1) - 0.46054E+01) 40032, 40032, 20030
40032 IF (R2E(2) + 0.50000E-04) 20030, 10030, 40030
40030 IF (R2E(2) - 0.50000E-04) 10030, 10030, 20030
10030 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0031
20030 IVFAIL = IVFAIL + 1
ZVCORR = (4.6051701859881, 0.00000000000000)
WRITE (NUVI, 80045) IVTNUM, AVC, ZVCORR
0031 CONTINUE
CT004* TEST 4 AN EXPRESSION PRESENTED TO CLOG
IVTNUM = 4
AVC = CLOG((2.6875, 0.0) * (-1.0, 0.0))
IF (R2E(1) - 0.98856E+00) 20040, 40042, 40041
40041 IF (R2E(1) - 0.98866E+00) 40042, 40042, 20040
40042 IF (R2E(2) - 0.31414E+01) 20040, 10040, 40040
40040 IF (R2E(2) - 0.31418E+01) 10040, 10040, 20040
10040 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0041
20040 IVFAIL = IVFAIL + 1
ZVCORR = (0.98861139345378, 3.1415926535898)
WRITE (NUVI, 80045) IVTNUM, AVC, ZVCORR
0041 CONTINUE
C***** TESTS 5 AND 6 - NEGATIVE REAL NUMBERS--CHECK RIGHT BRANCH AT
C***** ENDPOINTS
CT005* TEST 5
IVTNUM = 5
BVC = (-2.5, 0.0)
AVC = CLOG(BVC + BVC)
IF (R2E(1) - 0.16093E+01) 20050, 40052, 40051
40051 IF (R2E(1) - 0.16096E+01) 40052, 40052, 20050
40052 IF (R2E(2) - 0.31414E+01) 20050, 10050, 40050
40050 IF (R2E(2) - 0.31418E+01) 10050, 10050, 20050
10050 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0051
20050 IVFAIL = IVFAIL + 1
ZVCORR = (1.6094379124341, 3.1415926535898)
WRITE (NUVI, 80045) IVTNUM, AVC, ZVCORR
0051 CONTINUE
CT006* TEST 6
IVTNUM = 6
BVC = (-10.0, 0.0) + (-10.25, 0.0)
AVC = CLOG(BVC)
IF (R2E(1) - 0.30080E+01) 20060, 40062, 40061
40061 IF (R2E(1) - 0.30083E+01) 40062, 40062, 20060
40062 IF (R2E(2) - 0.31414E+01) 20060, 10060, 40060
40060 IF (R2E(2) - 0.31418E+01) 10060, 10060, 20060
10060 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0061
20060 IVFAIL = IVFAIL + 1
ZVCORR = (3.0081547935525, 3.1415926535898)
WRITE (NUVI, 80045) IVTNUM, AVC, ZVCORR
0061 CONTINUE
CT007* TEST 7 POSITIVE REAL, POSITIVE IMAGINARY ARGUMENTS
IVTNUM = 7
BVC = (2.0, 1.5)
AVC = CLOG(BVC)
IF (R2E(1) - 0.91624E+00) 20070, 40072, 40071
40071 IF (R2E(1) - 0.91634E+00) 40072, 40072, 20070
40072 IF (R2E(2) - 0.64346E+00) 20070, 10070, 40070
40070 IF (R2E(2) - 0.64354E+00) 10070, 10070, 20070
10070 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0071
20070 IVFAIL = IVFAIL + 1
ZVCORR = (0.91629073187416, 0.64350110879328)
WRITE (NUVI, 80045) IVTNUM, AVC, ZVCORR
0071 CONTINUE
CT008* TEST 8 NEGATIVE REAL, POSITIVE IMAGINARY ARGUMENTS
IVTNUM = 8
BVC = (-2.75, 1.375)
AVC = CLOG(BVC)
IF (R2E(1) - 0.11231E+01) 20080, 40082, 40081
40081 IF (R2E(1) - 0.11233E+01) 40082, 40082, 20080
40082 IF (R2E(2) - 0.26778E+01) 20080, 10080, 40080
40080 IF (R2E(2) - 0.26781E+01) 10080, 10080, 20080
10080 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0081
20080 IVFAIL = IVFAIL + 1
ZVCORR = (1.1231726873356, 2.6779450445890)
WRITE (NUVI, 80045) IVTNUM, AVC, ZVCORR
0081 CONTINUE
CT009* TEST 9 NEGATIVE REAL, NEGATIVE IMAGINARY ARGUMENTS
IVTNUM = 9
BVC = (-10.0, -10.0)
AVC = CLOG(BVC)
IF (R2E(1) - 0.26490E+01) 20090, 40092, 40091
40091 IF (R2E(1) - 0.26493E+01) 40092, 40092, 20090
40092 IF (R2E(2) + 0.23564E+01) 20090, 10090, 40090
40090 IF (R2E(2) + 0.23560E+01) 10090, 10090, 20090
10090 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0091
20090 IVFAIL = IVFAIL + 1
ZVCORR = (2.6491586832740, -2.3561944901923)
WRITE (NUVI, 80045) IVTNUM, AVC, ZVCORR
0091 CONTINUE
CT010* TEST 10 CLOG USED TOGETHER WITH AIMAG
IVTNUM = 10
AVS = (AIMAG(CLOG((3.0, 1.75))) + AIMAG(CLOG((-3.0, 1.75))))
1 - PIVS
IF (AVS + 0.50000E-04) 20100, 10100, 40100
40100 IF (AVS - 0.50000E-04) 10100, 10100, 20100
10100 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0101
20100 IVFAIL = IVFAIL + 1
RVCORR = 0.00000000000000
WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR
0101 CONTINUE
CT011* TEST 11 CLOG USED TOGETHER WITH CMPLX AND AIMAG
IVTNUM = 11
BVC = CLOG((4.5, -3.75))
CVC = CLOG((-4.5, -3.75))
AVC = (BVC - CMPLX(0.0, AIMAG(BVC))) -
1 (CVC - CMPLX(0.0, AIMAG(CVC)))
IF (R2E(1) + 0.50000E-04) 20110, 40112, 40111
40111 IF (R2E(1) - 0.50000E-04) 40112, 40112, 20110
40112 IF (R2E(2) + 0.50000E-04) 20110, 10110, 40110
40110 IF (R2E(2) - 0.50000E-04) 10110, 10110, 20110
10110 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0111
20110 IVFAIL = IVFAIL + 1
ZVCORR = (0.00000000000000, 0.00000000000000)
WRITE (NUVI, 80045) IVTNUM, AVC, ZVCORR
0111 CONTINUE
C*****
CBB** ********************** BBCSUM0 **********************************
C**** WRITE OUT TEST SUMMARY
C****
IVTOTN = IVPASS + IVFAIL + IVDELE + IVINSP
WRITE (I02, 90004)
WRITE (I02, 90014)
WRITE (I02, 90004)
WRITE (I02, 90020) IVPASS
WRITE (I02, 90022) IVFAIL
WRITE (I02, 90024) IVDELE
WRITE (I02, 90026) IVINSP
WRITE (I02, 90028) IVTOTN, IVTOTL
CBE** ********************** BBCSUM0 **********************************
CBB** ********************** BBCFOOT0 **********************************
C**** WRITE OUT REPORT FOOTINGS
C****
WRITE (I02,90016) ZPROG, ZPROG
WRITE (I02,90018) ZPROJ, ZNAME, ZTAPE, ZTAPED
WRITE (I02,90019)
CBE** ********************** BBCFOOT0 **********************************
CBB** ********************** BBCFMT0A **********************************
C**** FORMATS FOR TEST DETAIL LINES
C****
80000 FORMAT (1H ,2X,I3,4X,7HDELETED,32X,A31)
80002 FORMAT (1H ,2X,I3,4X,7H PASS ,32X,A31)
80004 FORMAT (1H ,2X,I3,4X,7HINSPECT,32X,A31)
80008 FORMAT (1H ,2X,I3,4X,7H FAIL ,32X,A31)
80010 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,15X,10HCOMPUTED= ,
1I6,/,1H ,15X,10HCORRECT= ,I6)
80012 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
1E12.5,/,1H ,16X,10HCORRECT= ,E12.5)
80018 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
1A21,/,1H ,16X,10HCORRECT= ,A21)
80020 FORMAT (1H ,16X,10HCOMPUTED= ,A21,1X,A31)
80022 FORMAT (1H ,16X,10HCORRECT= ,A21,1X,A31)
80024 FORMAT (1H ,16X,10HCOMPUTED= ,I6,16X,A31)
80026 FORMAT (1H ,16X,10HCORRECT= ,I6,16X,A31)
80028 FORMAT (1H ,16X,10HCOMPUTED= ,E12.5,10X,A31)
80030 FORMAT (1H ,16X,10HCORRECT= ,E12.5,10X,A31)
80050 FORMAT (1H ,48X,A31)
CBE** ********************** BBCFMT0A **********************************
CBB** ********************** BBCFMAT1 **********************************
C**** FORMATS FOR TEST DETAIL LINES - FULL LANGUAGE
C****
80031 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
1D17.10,/,1H ,16X,10HCORRECT= ,D17.10)
80033 FORMAT (1H ,16X,10HCOMPUTED= ,D17.10,10X,A31)
80035 FORMAT (1H ,16X,10HCORRECT= ,D17.10,10X,A31)
80037 FORMAT (1H ,16X,10HCOMPUTED= ,1H(,E12.5,2H, ,E12.5,1H),6X,A31)
80039 FORMAT (1H ,16X,10HCORRECT= ,1H(,E12.5,2H, ,E12.5,1H),6X,A31)
80041 FORMAT (1H ,16X,10HCOMPUTED= ,1H(,F12.5,2H, ,F12.5,1H),6X,A31)
80043 FORMAT (1H ,16X,10HCORRECT= ,1H(,F12.5,2H, ,F12.5,1H),6X,A31)
80045 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
11H(,F12.5,2H, ,F12.5,1H)/,1H ,16X,10HCORRECT= ,
21H(,F12.5,2H, ,F12.5,1H))
CBE** ********************** BBCFMAT1 **********************************
CBB** ********************** BBCFMT0B **********************************
C**** FORMAT STATEMENTS FOR PAGE HEADERS
C****
90002 FORMAT (1H1)
90004 FORMAT (1H )
90006 FORMAT (1H ,20X,31HFEDERAL SOFTWARE TESTING CENTER)
90007 FORMAT (1H ,19X,34HFORTRAN COMPILER VALIDATION SYSTEM)
90008 FORMAT (1H ,21X,A13,A17)
90009 FORMAT (1H ,/,2H *,A5,6HBEGIN*,12X,15HTEST RESULTS - ,A5,/)
90010 FORMAT (1H ,8X,16HTEST DATE*TIME= ,A17,15H - COMPILER= ,A20)
90013 FORMAT (1H ,8H TEST ,10HPASS/FAIL ,6X,17HDISPLAYED RESULTS,
1 7X,7HREMARKS,24X)
90014 FORMAT (1H ,46H----------------------------------------------,
1 33H---------------------------------)
90015 FORMAT (1H ,48X,17HTHIS PROGRAM HAS ,I3,6H TESTS,/)
C****
C**** FORMAT STATEMENTS FOR REPORT FOOTINGS
C****
90016 FORMAT (1H ,/,2H *,A5,4HEND*,14X,14HEND OF TEST - ,A5,/)
90018 FORMAT (1H ,A13,13X,A20,7H * ,A10,1H/,
1 A13)
90019 FORMAT (1H ,26HFOR OFFICIAL USE ONLY ,35X,15HCOPYRIGHT 1982)
C****
C**** FORMAT STATEMENTS FOR RUN SUMMARY
C****
90020 FORMAT (1H ,21X,I5,13H TESTS PASSED)
90022 FORMAT (1H ,21X,I5,13H TESTS FAILED)
90024 FORMAT (1H ,21X,I5,14H TESTS DELETED)
90026 FORMAT (1H ,21X,I5,25H TESTS REQUIRE INSPECTION)
90028 FORMAT (1H ,21X,I5,4H OF ,I3,15H TESTS EXECUTED)
CBE** ********************** BBCFMT0B **********************************
C*****
C***** END OF TEST SEGMENT 183
STOP
END
*END-OF,FM817
FM818.f 481036541 170 2 100666 16489 `
*HEADER,FORTR,FM818
*FILES1,FORTR,FM818,X
C***********************************************************************
C***** FORTRAN 77
C***** FM818
C***** YDLG10 - (185)
C*****
C***********************************************************************
C***** GENERAL PURPOSE ANS REF
C***** TEST INTRINSIC FUNCTION DLOG10 15.3
C***** TABLE 5
C*****
CBB** ********************** BBCCOMNT **********************************
C****
C**** 1978 FORTRAN COMPILER VALIDATION SYSTEM
C**** VERSION 2.0
C****
C****
C**** SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO
C**** GENERAL SERVICES ADMINISTRATION
C**** FEDERAL SOFTWARE TESTING CENTER
C**** 5203 LEESBURG PIKE, SUITE 1100
C**** FALLS CHURCH, VA. 22041
C****
C**** (703) 756-6153
C****
CBE** ********************** BBCCOMNT **********************************
C***** S P E C I F I C A T I O N S SEGMENT 185
DOUBLE PRECISION AVD, BVD, CVD, DVCORR
C*****
CBB** ********************** BBCINITA **********************************
C**** SPECIFICATION STATEMENTS
C****
CHARACTER ZVERS*13, ZVERSD*17, ZDATE*17, ZPROG*5, ZCOMPL*20,
1 ZNAME*20, ZTAPE*10, ZPROJ*13, REMRKS*31, ZTAPED*13
CBE** ********************** BBCINITA **********************************
CBB** ********************** BBCINITB **********************************
C**** INITIALIZE SECTION
DATA ZVERS, ZVERSD, ZDATE
1 /'VERSION 2.0 ', '82/08/02*18.33.46', '*NO DATE*TIME'/
DATA ZCOMPL, ZNAME, ZTAPE
1 /'*NONE SPECIFIED*', '*NO COMPANY NAME*', '*NO TAPE*'/
DATA ZPROJ, ZTAPED, ZPROG
1 /'*NO PROJECT*', '*NO TAPE DATE', 'XXXXX'/
DATA REMRKS /' '/
C**** THE FOLLOWING 9 COMMENT LINES (CZ01, CZ02, ...) CAN BE REPLACED
C**** FOR IDENTIFYING THE TEST ENVIRONMENT
C****
CZ01 ZVERS = 'VERSION OF THE COMPILER VALIDATION SYSTEM'
CZ02 ZVERSD = 'CREATION DATE/TIME OF THE COMPILER VALIDATION SYSTEM'
CZ03 ZPROG = 'PROGRAM NAME'
CZ04 ZDATE = 'DATE OF TEST'
CZ05 ZCOMPL = 'COMPILER IDENTIFICATION'
CZ06 ZPROJ = 'PROJECT NUMBER/IDENTIFICATION'
CZ07 ZNAME = 'NAME OF USER'
CZ08 ZTAPE = 'TAPE OWNER/ID'
CZ09 ZTAPED = 'DATE TAPE COPIED'
C
IVPASS = 0
IVFAIL = 0
IVDELE = 0
IVINSP = 0
IVTOTL = 0
IVTOTN = 0
ICZERO = 0
C
C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER.
I01 = 05
C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER.
I02 = 06
C
CX010 REPLACED BY FEXEC X-010 CONTROL CARD (CARD-READER UNIT NUMBER).
C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5
CX011 REPLACED BY FEXEC X-011 CONTROL CARD. CX011 IS FOR SYSTEMS
C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX010.
C
CX020 REPLACED BY FEXEC X-020 CONTROL CARD (PRINTER UNIT NUMBER).
C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02= 6
CX021 REPLACED BY FEXEC X-021 CONTROL CARD. CX021 IS FOR SYSTEMS
C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX020.
C
CBE** ********************** BBCINITB **********************************
NUVI = I02
IVTOTL = 16
ZPROG = 'FM818'
CBB** ********************** BBCHED0A **********************************
C****
C**** WRITE REPORT TITLE
C****
WRITE (I02, 90002)
WRITE (I02, 90006)
WRITE (I02, 90007)
WRITE (I02, 90008) ZVERS, ZVERSD
WRITE (I02, 90009) ZPROG, ZPROG
WRITE (I02, 90010) ZDATE, ZCOMPL
CBE** ********************** BBCHED0A **********************************
C*****
C***** HEADER FOR SEGMENT 185
WRITE(NUVI,18500)
18500 FORMAT(1H , / 36H YDLG10 - (185) INTRINSIC FUNCTIONS//
1 44H DLOG10 (DOUBLE PRECISION COMMON LOGARITHM)//
2 17H ANS REF. - 15.3)
CBB** ********************** BBCHED0B **********************************
C**** WRITE DETAIL REPORT HEADERS
C****
WRITE (I02,90004)
WRITE (I02,90004)
WRITE (I02,90013)
WRITE (I02,90014)
WRITE (I02,90015) IVTOTL
CBE** ********************** BBCHED0B **********************************
C*****
CT001* TEST 1 ONE, SINCE LN(1.0) = 0.0
IVTNUM = 1
BVD = 1.0D0
AVD = DLOG10(BVD)
IF (AVD + 0.5000000000D-09) 20010, 10010, 40010
40010 IF (AVD - 0.5000000000D-09) 10010, 10010, 20010
10010 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0011
20010 IVFAIL = IVFAIL + 1
DVCORR = 0.00000000000000000000D+00
WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR
0011 CONTINUE
CT002* TEST 2 A VALUE CLOSE TO 10
IVTNUM = 2
AVD = DLOG10(9.875D0)
IF (AVD - 0.9945371038D+00) 20020, 10020, 40020
40020 IF (AVD - 0.9945371048D+00) 10020, 10020, 20020
10020 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0021
20020 IVFAIL = IVFAIL + 1
DVCORR = 0.99453710429849784235D+00
WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR
0021 CONTINUE
CT003* TEST 3 THE VALUE 10.D0
IVTNUM = 3
AVD = DLOG10(10.0D0)
IF (AVD - 0.9999999995D+00) 20030, 10030, 40030
40030 IF (AVD - 0.1000000001D+01) 10030, 10030, 20030
10030 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0031
20030 IVFAIL = IVFAIL + 1
DVCORR = 1.0000000000000000000D+00
WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR
0031 CONTINUE
CT004* TEST 4 THE VALUE 20.5D0
IVTNUM = 4
AVD = DLOG10(20.5D0)
IF (AVD - 0.1311753860D+01) 20040, 10040, 40040
40040 IF (AVD - 0.1311753862D+01) 10040, 10040, 20040
10040 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0041
20040 IVFAIL = IVFAIL + 1
DVCORR = 1.3117538610557542993D+00
WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR
0041 CONTINUE
CT005* TEST 5 THE VALUE 99.0D0
IVTNUM = 5
AVD = DLOG10(99.0D0)
IF (AVD - 0.1995635193D+01) 20050, 10050, 40050
40050 IF (AVD - 0.1995635196D+01) 10050, 10050, 20050
10050 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0051
20050 IVFAIL = IVFAIL + 1
DVCORR = 1.9956351945975499153D+00
WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR
0051 CONTINUE
CT006* TEST 6 VARIABLE WITHIN AN EXPRESSION
IVTNUM = 6
BVD = 1.0D0
CVD = 8.0D0
AVD = DLOG10(3.0D0 * BVD / CVD)
IF (AVD + 0.4259687325D+00) 20060, 10060, 40060
40060 IF (AVD + 0.4259687320D+00) 10060, 10060, 20060
10060 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0061
20060 IVFAIL = IVFAIL + 1
DVCORR = -0.42596873227228114835D+00
WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR
0061 CONTINUE
CT007* TEST 7 VARIABLE WITHIN AN EXPRESSION
IVTNUM = 7
BVD = 1.0D0
CVD = 8.0D0
AVD = DLOG10(5.0D0 * BVD / CVD)
IF (AVD + 0.2041199828D+00) 20070, 10070, 40070
40070 IF (AVD + 0.2041199825D+00) 10070, 10070, 20070
10070 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0071
20070 IVFAIL = IVFAIL + 1
DVCORR = -0.20411998265592478085D+00
WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR
0071 CONTINUE
CT008* TEST 8 AN EXPRESSION SUPPLIED TO DLOG10
IVTNUM = 8
AVD = DLOG10(75.D0 / 100.0D0)
IF (AVD + 0.1249387367D+00) 20080, 10080, 40080
40080 IF (AVD + 0.1249387365D+00) 10080, 10080, 20080
10080 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0081
20080 IVFAIL = IVFAIL + 1
DVCORR = -0.12493873660829995313D+00
WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR
0081 CONTINUE
CT009* TEST 9 VARIABLE WITHIN AN EXPRESSION
IVTNUM = 9
BVD = 1.0D0
CVD = 8.0D0
AVD = DLOG10(7.0D0 * BVD / CVD)
IF (AVD + 0.5799194701D-01) 20090, 10090, 40090
40090 IF (AVD + 0.5799194694D-01) 10090, 10090, 20090
10090 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0091
20090 IVFAIL = IVFAIL + 1
DVCORR = -0.057991946977686754929D+00
WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR
0091 CONTINUE
CT010* TEST 10 A VALUE CLOSE TO ONE
IVTNUM = 10
AVD = DLOG10(0.9921875D0)
IF (AVD + 0.3406248694D-02) 20100, 10100, 40100
40100 IF (AVD + 0.3406248690D-02) 10100, 10100, 20100
10100 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0101
20100 IVFAIL = IVFAIL + 1
DVCORR = -0.0034062486919115022492D+00
WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR
0101 CONTINUE
CT011* TEST 11 A VALUE CLOSE TO ONE
IVTNUM = 11
BVD = 1.0009765625
AVD = DLOG10(BVD)
IF (AVD - 0.4239087517D-03) 20110, 10110, 40110
40110 IF (AVD - 0.4239087522D-03) 10110, 10110, 20110
10110 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0111
20110 IVFAIL = IVFAIL + 1
DVCORR = 0.00042390875196115194455D+00
WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR
0111 CONTINUE
CT012* TEST 12 A VALUE CLOSE TO ZERO
IVTNUM = 12
BVD = 256.0D0
AVD = DLOG10(1.0D0 / BVD)
IF (AVD + 0.2408239967D+01) 20120, 10120, 40120
40120 IF (AVD + 0.2408239964D+01) 10120, 10120, 20120
10120 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0121
20120 IVFAIL = IVFAIL + 1
DVCORR = -2.4082399653118495617D+00
WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR
0121 CONTINUE
CT013* TEST 13 A VALUE CLOSE TO ZERO
IVTNUM = 13
BVD = 128.0D0
AVD = DLOG10(1.0D0 / (BVD * 8D0))
IF (AVD + 0.3010299959D+01) 20130, 10130, 40130
40130 IF (AVD + 0.3010299955D+01) 10130, 10130, 20130
10130 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0131
20130 IVFAIL = IVFAIL + 1
DVCORR = -3.0102999566398119521D+00
WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR
0131 CONTINUE
CT014* TEST 14 AN ARGUMENT OF HIGH MAGNITUDE
IVTNUM = 14
BVD = 2.0D+35
AVD = DLOG10(BVD)
IF (AVD - 0.3530102997D+01) 20140, 10140, 40140
40140 IF (AVD - 0.3530103002D+02) 10140, 10140, 20140
10140 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0141
20140 IVFAIL = IVFAIL + 1
DVCORR = 35.301029995663981195D+00
WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR
0141 CONTINUE
CT015* TEST 15 AN ARGUMENT OF LOW MAGNITUDE
IVTNUM = 15
BVD = 2.0D-35
AVD = DLOG10(BVD)
IF (AVD + 0.3469897003D+02) 20150, 10150, 40150
40150 IF (AVD + 0.3469896998D+02) 10150, 10150, 20150
10150 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0151
20150 IVFAIL = IVFAIL + 1
DVCORR = -34.698970004336018805D+00
WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR
0151 CONTINUE
CT016* TEST 16 THE FUNCTION APPIED TWICE
IVTNUM = 16
AVD = DLOG10(20.0D0) - DLOG10(2.0D0)
IF (AVD - 0.9999999995D+00) 20160, 10160, 40160
40160 IF (AVD - 0.1000000001D+01) 10160, 10160, 20160
10160 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0161
20160 IVFAIL = IVFAIL + 1
DVCORR = 1.00000000000000D+00
WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR
0161 CONTINUE
C*****
CBB** ********************** BBCSUM0 **********************************
C**** WRITE OUT TEST SUMMARY
C****
IVTOTN = IVPASS + IVFAIL + IVDELE + IVINSP
WRITE (I02, 90004)
WRITE (I02, 90014)
WRITE (I02, 90004)
WRITE (I02, 90020) IVPASS
WRITE (I02, 90022) IVFAIL
WRITE (I02, 90024) IVDELE
WRITE (I02, 90026) IVINSP
WRITE (I02, 90028) IVTOTN, IVTOTL
CBE** ********************** BBCSUM0 **********************************
CBB** ********************** BBCFOOT0 **********************************
C**** WRITE OUT REPORT FOOTINGS
C****
WRITE (I02,90016) ZPROG, ZPROG
WRITE (I02,90018) ZPROJ, ZNAME, ZTAPE, ZTAPED
WRITE (I02,90019)
CBE** ********************** BBCFOOT0 **********************************
CBB** ********************** BBCFMT0A **********************************
C**** FORMATS FOR TEST DETAIL LINES
C****
80000 FORMAT (1H ,2X,I3,4X,7HDELETED,32X,A31)
80002 FORMAT (1H ,2X,I3,4X,7H PASS ,32X,A31)
80004 FORMAT (1H ,2X,I3,4X,7HINSPECT,32X,A31)
80008 FORMAT (1H ,2X,I3,4X,7H FAIL ,32X,A31)
80010 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,15X,10HCOMPUTED= ,
1I6,/,1H ,15X,10HCORRECT= ,I6)
80012 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
1E12.5,/,1H ,16X,10HCORRECT= ,E12.5)
80018 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
1A21,/,1H ,16X,10HCORRECT= ,A21)
80020 FORMAT (1H ,16X,10HCOMPUTED= ,A21,1X,A31)
80022 FORMAT (1H ,16X,10HCORRECT= ,A21,1X,A31)
80024 FORMAT (1H ,16X,10HCOMPUTED= ,I6,16X,A31)
80026 FORMAT (1H ,16X,10HCORRECT= ,I6,16X,A31)
80028 FORMAT (1H ,16X,10HCOMPUTED= ,E12.5,10X,A31)
80030 FORMAT (1H ,16X,10HCORRECT= ,E12.5,10X,A31)
80050 FORMAT (1H ,48X,A31)
CBE** ********************** BBCFMT0A **********************************
CBB** ********************** BBCFMAT1 **********************************
C**** FORMATS FOR TEST DETAIL LINES - FULL LANGUAGE
C****
80031 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
1D17.10,/,1H ,16X,10HCORRECT= ,D17.10)
80033 FORMAT (1H ,16X,10HCOMPUTED= ,D17.10,10X,A31)
80035 FORMAT (1H ,16X,10HCORRECT= ,D17.10,10X,A31)
80037 FORMAT (1H ,16X,10HCOMPUTED= ,1H(,E12.5,2H, ,E12.5,1H),6X,A31)
80039 FORMAT (1H ,16X,10HCORRECT= ,1H(,E12.5,2H, ,E12.5,1H),6X,A31)
80041 FORMAT (1H ,16X,10HCOMPUTED= ,1H(,F12.5,2H, ,F12.5,1H),6X,A31)
80043 FORMAT (1H ,16X,10HCORRECT= ,1H(,F12.5,2H, ,F12.5,1H),6X,A31)
80045 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
11H(,F12.5,2H, ,F12.5,1H)/,1H ,16X,10HCORRECT= ,
21H(,F12.5,2H, ,F12.5,1H))
CBE** ********************** BBCFMAT1 **********************************
CBB** ********************** BBCFMT0B **********************************
C**** FORMAT STATEMENTS FOR PAGE HEADERS
C****
90002 FORMAT (1H1)
90004 FORMAT (1H )
90006 FORMAT (1H ,20X,31HFEDERAL SOFTWARE TESTING CENTER)
90007 FORMAT (1H ,19X,34HFORTRAN COMPILER VALIDATION SYSTEM)
90008 FORMAT (1H ,21X,A13,A17)
90009 FORMAT (1H ,/,2H *,A5,6HBEGIN*,12X,15HTEST RESULTS - ,A5,/)
90010 FORMAT (1H ,8X,16HTEST DATE*TIME= ,A17,15H - COMPILER= ,A20)
90013 FORMAT (1H ,8H TEST ,10HPASS/FAIL ,6X,17HDISPLAYED RESULTS,
1 7X,7HREMARKS,24X)
90014 FORMAT (1H ,46H----------------------------------------------,
1 33H---------------------------------)
90015 FORMAT (1H ,48X,17HTHIS PROGRAM HAS ,I3,6H TESTS,/)
C****
C**** FORMAT STATEMENTS FOR REPORT FOOTINGS
C****
90016 FORMAT (1H ,/,2H *,A5,4HEND*,14X,14HEND OF TEST - ,A5,/)
90018 FORMAT (1H ,A13,13X,A20,7H * ,A10,1H/,
1 A13)
90019 FORMAT (1H ,26HFOR OFFICIAL USE ONLY ,35X,15HCOPYRIGHT 1982)
C****
C**** FORMAT STATEMENTS FOR RUN SUMMARY
C****
90020 FORMAT (1H ,21X,I5,13H TESTS PASSED)
90022 FORMAT (1H ,21X,I5,13H TESTS FAILED)
90024 FORMAT (1H ,21X,I5,14H TESTS DELETED)
90026 FORMAT (1H ,21X,I5,25H TESTS REQUIRE INSPECTION)
90028 FORMAT (1H ,21X,I5,4H OF ,I3,15H TESTS EXECUTED)
CBE** ********************** BBCFMT0B **********************************
C***** END OF TEST SEGMENT 185
STOP
END
*END-OF,FM818
FM819.f 481036546 170 2 100666 18140 `
*HEADER,FORTR,FM819
*FILES1,FORTR,FM819,X
C***********************************************************************
C***** FORTRAN 77
C***** FM819
C***** YDSIN - (187)
C*****
C***********************************************************************
C***** GENERAL PURPOSE ANS REF
C***** TEST INTRINSIC FUNCTION DSIN 15.3
C***** TABLE 5
C*****
CBB** ********************** BBCCOMNT **********************************
C****
C**** 1978 FORTRAN COMPILER VALIDATION SYSTEM
C**** VERSION 2.0
C****
C****
C**** SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO
C**** GENERAL SERVICES ADMINISTRATION
C**** FEDERAL SOFTWARE TESTING CENTER
C**** 5203 LEESBURG PIKE, SUITE 1100
C**** FALLS CHURCH, VA. 22041
C****
C**** (703) 756-6153
C****
CBE** ********************** BBCCOMNT **********************************
C***** S P E C I F I C A T I O N S SEGMENT 187
DOUBLE PRECISION AVD, BVD, PIVD, DVCORR
C*****
CBB** ********************** BBCINITA **********************************
C**** SPECIFICATION STATEMENTS
C****
CHARACTER ZVERS*13, ZVERSD*17, ZDATE*17, ZPROG*5, ZCOMPL*20,
1 ZNAME*20, ZTAPE*10, ZPROJ*13, REMRKS*31, ZTAPED*13
CBE** ********************** BBCINITA **********************************
CBB** ********************** BBCINITB **********************************
C**** INITIALIZE SECTION
DATA ZVERS, ZVERSD, ZDATE
1 /'VERSION 2.0 ', '82/08/02*18.33.46', '*NO DATE*TIME'/
DATA ZCOMPL, ZNAME, ZTAPE
1 /'*NONE SPECIFIED*', '*NO COMPANY NAME*', '*NO TAPE*'/
DATA ZPROJ, ZTAPED, ZPROG
1 /'*NO PROJECT*', '*NO TAPE DATE', 'XXXXX'/
DATA REMRKS /' '/
C**** THE FOLLOWING 9 COMMENT LINES (CZ01, CZ02, ...) CAN BE REPLACED
C**** FOR IDENTIFYING THE TEST ENVIRONMENT
C****
CZ01 ZVERS = 'VERSION OF THE COMPILER VALIDATION SYSTEM'
CZ02 ZVERSD = 'CREATION DATE/TIME OF THE COMPILER VALIDATION SYSTEM'
CZ03 ZPROG = 'PROGRAM NAME'
CZ04 ZDATE = 'DATE OF TEST'
CZ05 ZCOMPL = 'COMPILER IDENTIFICATION'
CZ06 ZPROJ = 'PROJECT NUMBER/IDENTIFICATION'
CZ07 ZNAME = 'NAME OF USER'
CZ08 ZTAPE = 'TAPE OWNER/ID'
CZ09 ZTAPED = 'DATE TAPE COPIED'
C
IVPASS = 0
IVFAIL = 0
IVDELE = 0
IVINSP = 0
IVTOTL = 0
IVTOTN = 0
ICZERO = 0
C
C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER.
I01 = 05
C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER.
I02 = 06
C
CX010 REPLACED BY FEXEC X-010 CONTROL CARD (CARD-READER UNIT NUMBER).
C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5
CX011 REPLACED BY FEXEC X-011 CONTROL CARD. CX011 IS FOR SYSTEMS
C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX010.
C
CX020 REPLACED BY FEXEC X-020 CONTROL CARD (PRINTER UNIT NUMBER).
C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02= 6
CX021 REPLACED BY FEXEC X-021 CONTROL CARD. CX021 IS FOR SYSTEMS
C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX020.
C
CBE** ********************** BBCINITB **********************************
NUVI = I02
IVTOTL = 19
ZPROG = 'FM819'
CBB** ********************** BBCHED0A **********************************
C****
C**** WRITE REPORT TITLE
C****
WRITE (I02, 90002)
WRITE (I02, 90006)
WRITE (I02, 90007)
WRITE (I02, 90008) ZVERS, ZVERSD
WRITE (I02, 90009) ZPROG, ZPROG
WRITE (I02, 90010) ZDATE, ZCOMPL
CBE** ********************** BBCHED0A **********************************
C*****
C***** HEADER FOR SEGMENT 187
WRITE(NUVI,18700)
18700 FORMAT(1H /34H YDSIN - (187) INTRINSIC FUNCTIONS//
1 32H DSIN - (DOUBLE PRECISION SINE)//
2 17H ANS REF. - 15.3)
CBB** ********************** BBCHED0B **********************************
C**** WRITE DETAIL REPORT HEADERS
C****
WRITE (I02,90004)
WRITE (I02,90004)
WRITE (I02,90013)
WRITE (I02,90014)
WRITE (I02,90015) IVTOTL
CBE** ********************** BBCHED0B **********************************
C*****
PIVD = 3.1415926535897932384626434D0
C*****
CT001* TEST 1 ZERO (0.0) SINCE SIN(0)=0
IVTNUM = 1
BVD = 0.0D0
AVD = DSIN(BVD)
IF (AVD + 0.5000000000D-09) 20010, 10010, 40010
40010 IF (AVD - 0.5000000000D-09) 10010, 10010, 20010
10010 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0011
20010 IVFAIL = IVFAIL + 1
DVCORR = 0.00000000000000000000D+00
WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR
0011 CONTINUE
CT002* TEST 2 PI
IVTNUM = 2
AVD = DSIN(PIVD)
IF (AVD + 0.5000000000D-09) 20020, 10020, 40020
40020 IF (AVD - 0.5000000000D-09) 10020, 10020, 20020
10020 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0021
20020 IVFAIL = IVFAIL + 1
DVCORR = 0.00000000000000000000D+00
WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR
0021 CONTINUE
CT003* TEST 3 PI - 1/8
IVTNUM = 3
BVD = 3.01659265358979323846D0
AVD = DSIN(BVD)
IF (AVD - 0.1246747333D+00) 20030, 10030, 40030
40030 IF (AVD - 0.1246747335D+00) 10030, 10030, 20030
10030 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0031
20030 IVFAIL = IVFAIL + 1
DVCORR = 0.12467473338522768996D+00
WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR
0031 CONTINUE
CT004* TEST 4 PI - 1/16
IVTNUM = 4
AVD = DSIN(3.204092653589793238D0)
IF (AVD + 0.6245931788D-01) 20040, 10040, 40040
40040 IF (AVD + 0.6245931781D-01) 10040, 10040, 20040
10040 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0041
20040 IVFAIL = IVFAIL + 1
DVCORR = -0.062459317842380198585D+00
WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR
0041 CONTINUE
CT005* TEST 5 2*PI
IVTNUM = 5
BVD = PIVD * 2.0D0
AVD = DSIN(BVD)
IF (AVD + 0.5000000000D-09) 20050, 10050, 40050
40050 IF (AVD - 0.5000000000D-09) 10050, 10050, 20050
10050 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0051
20050 IVFAIL = IVFAIL + 1
DVCORR = 0.00000000000000000000D+00
WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR
0051 CONTINUE
CT006* TEST 6 2*PI - 1/128
IVTNUM = 6
BVD = (2.0D0 * PIVD) - 1.0D0 / 128.0D0
AVD = DSIN(BVD)
IF (AVD + 0.7812420532D-02) 20060, 10060, 40060
40060 IF (AVD + 0.7812420523D-02) 10060, 10060, 20060
10060 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0061
20060 IVFAIL = IVFAIL + 1
DVCORR = -0.0078124205273828310472D+00
WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR
0061 CONTINUE
CT007* TEST 7 2*PI - 1/256
IVTNUM = 7
BVD = (2.0D0 * PIVD) + 1.0D0 / 256.0D0
AVD = DSIN(BVD)
IF (AVD - 0.3906240064D-02) 20070, 10070, 40070
40070 IF (AVD - 0.3906240068D-02) 10070, 10070, 20070
10070 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0071
20070 IVFAIL = IVFAIL + 1
DVCORR = 0.0039062400659001165547D+00
WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR
0071 CONTINUE
CT008* TEST 8 AN EXPRESSION SUPPLIED TO DSIN
IVTNUM = 8
BVD = 2000.0D0
AVD = DSIN(BVD / 10.0D2)
IF (AVD - 0.9092974263D+00) 20080, 10080, 40080
40080 IF (AVD - 0.9092974273D+00) 10080, 10080, 20080
10080 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0081
20080 IVFAIL = IVFAIL + 1
DVCORR = 0.90929742682568169540D+00
WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR
0081 CONTINUE
CT009* TEST 9 THE VALUE -2.0D0
IVTNUM = 9
BVD = -2.0D0
AVD = DSIN(BVD)
IF (AVD + 0.9092974273D+00) 20090, 10090, 40090
40090 IF (AVD + 0.9092974263D+00) 10090, 10090, 20090
10090 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0091
20090 IVFAIL = IVFAIL + 1
DVCORR = -0.90929742682568169540D+00
WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR
0091 CONTINUE
CT010* TEST 10 A LARGE VALUE TO TEST ARGUMENT REDUCTION
IVTNUM = 10
AVD = DSIN(100.0D0)
IF (AVD + 0.5063656414D+00) 20100, 10100, 40100
40100 IF (AVD + 0.5063656408D+00) 10100, 10100, 20100
10100 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0101
20100 IVFAIL = IVFAIL + 1
DVCORR = -0.50636564110975879366D+00
WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR
0101 CONTINUE
CT011* TEST 11 A VERY LARGE VALUE
IVTNUM = 11
AVD = DSIN(-1000.0D0)
IF (AVD + 0.8268795410D+00) 20110, 10110, 40110
40110 IF (AVD + 0.8268795401D+00) 10110, 10110, 20110
10110 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0111
20110 IVFAIL = IVFAIL + 1
DVCORR = -0.82687954053200256026D+00
WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR
0111 CONTINUE
CT012* TEST 12 PI/2
IVTNUM = 12
AVD = DSIN(1.57079632679489661923D0)
IF (AVD - 0.9999999995D+00) 20120, 10120, 40120
40120 IF (AVD - 0.1000000001D+01) 10120, 10120, 20120
10120 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0121
20120 IVFAIL = IVFAIL + 1
DVCORR = 1.0000000000000000000D+00
WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR
0121 CONTINUE
CT013* TEST 13 (PI / 2) - 1/32
IVTNUM = 13
BVD = 1.53954632679489661923D0
AVD = DSIN(BVD)
IF (AVD - 0.9995117579D+00) 20130, 10130, 40130
40130 IF (AVD - 0.9995117590D+00) 10130, 10130, 20130
10130 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0131
20130 IVFAIL = IVFAIL + 1
DVCORR = 0.99951175848513636924D+00
WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR
0131 CONTINUE
CT014* TEST 14 (PI / 2) + 1/64
IVTNUM = 14
BVD = 1.58642132679489661923D0
AVD = DSIN(BVD)
IF (AVD - 0.9998779316D+00) 20140, 10140, 40140
40140 IF (AVD - 0.9998779327D+00) 10140, 10140, 20140
10140 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0141
20140 IVFAIL = IVFAIL + 1
DVCORR = 0.99987793217100665474D+00
WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR
0141 CONTINUE
CT015* TEST 15 3*PI/2
IVTNUM = 15
BVD = 3.0D0 * PIVD / 2.0D0
AVD = DSIN(BVD)
IF (AVD + 0.1000000001D+01) 20150, 10150, 40150
40150 IF (AVD + 0.9999999995D+00) 10150, 10150, 20150
10150 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0151
20150 IVFAIL = IVFAIL + 1
DVCORR = -1.000000000000000000D+00
WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR
0151 CONTINUE
CT016* TEST 16 3*PI/2 - 1/16
IVTNUM = 16
BVD = (3.0D0 * PIVD / 2.0D0) - 1.0D0 / 16.0D0
AVD = DSIN(BVD)
IF (AVD + 0.9980475112D+00) 20160, 10160, 40160
40160 IF (AVD + 0.9980475102D+00) 10160, 10160, 20160
10160 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0161
20160 IVFAIL = IVFAIL + 1
DVCORR = -0.99804751070009914963D+00
WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR
0161 CONTINUE
CT017* TEST 17 3*PI - 1/512
IVTNUM = 17
BVD = (3.0D0 * PIVD / 2.0D0) + 1.0D0 / 512.0D0
AVD = DSIN(BVD)
IF (AVD + 0.9999980932D+00) 20170, 10170, 40170
40170 IF (AVD + 0.9999980921D+00) 10170, 10170, 20170
10170 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0171
20170 IVFAIL = IVFAIL + 1
DVCORR = -0.99999809265197351722D+00
WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR
0171 CONTINUE
CT018* TEST 18 ARGUMENT OF LOW MAGNITUDE
IVTNUM = 18
BVD = PIVD * 1.0D-17
AVD = DSIN(BVD)
IF (AVD - 0.3141592652D-16) 20180, 10180, 40180
40180 IF (AVD - 0.3141592655D-16) 10180, 10180, 20180
10180 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0181
20180 IVFAIL = IVFAIL + 1
DVCORR = 3.1415926535897932385D-17
WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR
0181 CONTINUE
CT019* TEST 19 THE FUNCTION APPLIED TWICE
IVTNUM = 19
AVD = DSIN(PIVD / 4.0D0) * DSIN(3.0D0 * PIVD / 4.0D0)
IF (AVD - 0.4999999997D+00) 20190, 10190, 40190
40190 IF (AVD - 0.5000000003D+00) 10190, 10190, 20190
10190 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0191
20190 IVFAIL = IVFAIL + 1
DVCORR = 0.50000000000000000000D+00
WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR
0191 CONTINUE
C*****
CBB** ********************** BBCSUM0 **********************************
C**** WRITE OUT TEST SUMMARY
C****
IVTOTN = IVPASS + IVFAIL + IVDELE + IVINSP
WRITE (I02, 90004)
WRITE (I02, 90014)
WRITE (I02, 90004)
WRITE (I02, 90020) IVPASS
WRITE (I02, 90022) IVFAIL
WRITE (I02, 90024) IVDELE
WRITE (I02, 90026) IVINSP
WRITE (I02, 90028) IVTOTN, IVTOTL
CBE** ********************** BBCSUM0 **********************************
CBB** ********************** BBCFOOT0 **********************************
C**** WRITE OUT REPORT FOOTINGS
C****
WRITE (I02,90016) ZPROG, ZPROG
WRITE (I02,90018) ZPROJ, ZNAME, ZTAPE, ZTAPED
WRITE (I02,90019)
CBE** ********************** BBCFOOT0 **********************************
CBB** ********************** BBCFMT0A **********************************
C**** FORMATS FOR TEST DETAIL LINES
C****
80000 FORMAT (1H ,2X,I3,4X,7HDELETED,32X,A31)
80002 FORMAT (1H ,2X,I3,4X,7H PASS ,32X,A31)
80004 FORMAT (1H ,2X,I3,4X,7HINSPECT,32X,A31)
80008 FORMAT (1H ,2X,I3,4X,7H FAIL ,32X,A31)
80010 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,15X,10HCOMPUTED= ,
1I6,/,1H ,15X,10HCORRECT= ,I6)
80012 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
1E12.5,/,1H ,16X,10HCORRECT= ,E12.5)
80018 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
1A21,/,1H ,16X,10HCORRECT= ,A21)
80020 FORMAT (1H ,16X,10HCOMPUTED= ,A21,1X,A31)
80022 FORMAT (1H ,16X,10HCORRECT= ,A21,1X,A31)
80024 FORMAT (1H ,16X,10HCOMPUTED= ,I6,16X,A31)
80026 FORMAT (1H ,16X,10HCORRECT= ,I6,16X,A31)
80028 FORMAT (1H ,16X,10HCOMPUTED= ,E12.5,10X,A31)
80030 FORMAT (1H ,16X,10HCORRECT= ,E12.5,10X,A31)
80050 FORMAT (1H ,48X,A31)
CBE** ********************** BBCFMT0A **********************************
CBB** ********************** BBCFMAT1 **********************************
C**** FORMATS FOR TEST DETAIL LINES - FULL LANGUAGE
C****
80031 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
1D17.10,/,1H ,16X,10HCORRECT= ,D17.10)
80033 FORMAT (1H ,16X,10HCOMPUTED= ,D17.10,10X,A31)
80035 FORMAT (1H ,16X,10HCORRECT= ,D17.10,10X,A31)
80037 FORMAT (1H ,16X,10HCOMPUTED= ,1H(,E12.5,2H, ,E12.5,1H),6X,A31)
80039 FORMAT (1H ,16X,10HCORRECT= ,1H(,E12.5,2H, ,E12.5,1H),6X,A31)
80041 FORMAT (1H ,16X,10HCOMPUTED= ,1H(,F12.5,2H, ,F12.5,1H),6X,A31)
80043 FORMAT (1H ,16X,10HCORRECT= ,1H(,F12.5,2H, ,F12.5,1H),6X,A31)
80045 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
11H(,F12.5,2H, ,F12.5,1H)/,1H ,16X,10HCORRECT= ,
21H(,F12.5,2H, ,F12.5,1H))
CBE** ********************** BBCFMAT1 **********************************
CBB** ********************** BBCFMT0B **********************************
C**** FORMAT STATEMENTS FOR PAGE HEADERS
C****
90002 FORMAT (1H1)
90004 FORMAT (1H )
90006 FORMAT (1H ,20X,31HFEDERAL SOFTWARE TESTING CENTER)
90007 FORMAT (1H ,19X,34HFORTRAN COMPILER VALIDATION SYSTEM)
90008 FORMAT (1H ,21X,A13,A17)
90009 FORMAT (1H ,/,2H *,A5,6HBEGIN*,12X,15HTEST RESULTS - ,A5,/)
90010 FORMAT (1H ,8X,16HTEST DATE*TIME= ,A17,15H - COMPILER= ,A20)
90013 FORMAT (1H ,8H TEST ,10HPASS/FAIL ,6X,17HDISPLAYED RESULTS,
1 7X,7HREMARKS,24X)
90014 FORMAT (1H ,46H----------------------------------------------,
1 33H---------------------------------)
90015 FORMAT (1H ,48X,17HTHIS PROGRAM HAS ,I3,6H TESTS,/)
C****
C**** FORMAT STATEMENTS FOR REPORT FOOTINGS
C****
90016 FORMAT (1H ,/,2H *,A5,4HEND*,14X,14HEND OF TEST - ,A5,/)
90018 FORMAT (1H ,A13,13X,A20,7H * ,A10,1H/,
1 A13)
90019 FORMAT (1H ,26HFOR OFFICIAL USE ONLY ,35X,15HCOPYRIGHT 1982)
C****
C**** FORMAT STATEMENTS FOR RUN SUMMARY
C****
90020 FORMAT (1H ,21X,I5,13H TESTS PASSED)
90022 FORMAT (1H ,21X,I5,13H TESTS FAILED)
90024 FORMAT (1H ,21X,I5,14H TESTS DELETED)
90026 FORMAT (1H ,21X,I5,25H TESTS REQUIRE INSPECTION)
90028 FORMAT (1H ,21X,I5,4H OF ,I3,15H TESTS EXECUTED)
CBE** ********************** BBCFMT0B **********************************
C*****
C***** END OF TEST SEGMENT 187
STOP
END
*END-OF,FM819
FM820.f 481036551 170 2 100666 20550 `
*HEADER,FORTR,FM820
*FILES1,FORTR,FM820,X
C***********************************************************************
C***** FORTRAN 77
C***** FM820
C***** YCSIN - (188)
C*****
C***********************************************************************
C***** GENERAL PURPOSE ANS REF
C***** TEST INTRINSIC FUNCTION CSIN 15.3
C***** INTRINSIC FUNCTION CABS ASSUMED WORKING TABLE 5
C*****
CBB** ********************** BBCCOMNT **********************************
C****
C**** 1978 FORTRAN COMPILER VALIDATION SYSTEM
C**** VERSION 2.0
C****
C****
C**** SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO
C**** GENERAL SERVICES ADMINISTRATION
C**** FEDERAL SOFTWARE TESTING CENTER
C**** 5203 LEESBURG PIKE, SUITE 1100
C**** FALLS CHURCH, VA. 22041
C****
C**** (703) 756-6153
C****
CBE** ********************** BBCCOMNT **********************************
C*****
C***** S P E C I F I C A T I O N S SEGMENT 188
COMPLEX AVC, BVC, ZVCORR
REAL R2E(2)
EQUIVALENCE (AVC, R2E)
C*****
CBB** ********************** BBCINITA **********************************
C**** SPECIFICATION STATEMENTS
C****
CHARACTER ZVERS*13, ZVERSD*17, ZDATE*17, ZPROG*5, ZCOMPL*20,
1 ZNAME*20, ZTAPE*10, ZPROJ*13, REMRKS*31, ZTAPED*13
CBE** ********************** BBCINITA **********************************
CBB** ********************** BBCINITB **********************************
C**** INITIALIZE SECTION
DATA ZVERS, ZVERSD, ZDATE
1 /'VERSION 2.0 ', '82/08/02*18.33.46', '*NO DATE*TIME'/
DATA ZCOMPL, ZNAME, ZTAPE
1 /'*NONE SPECIFIED*', '*NO COMPANY NAME*', '*NO TAPE*'/
DATA ZPROJ, ZTAPED, ZPROG
1 /'*NO PROJECT*', '*NO TAPE DATE', 'XXXXX'/
DATA REMRKS /' '/
C**** THE FOLLOWING 9 COMMENT LINES (CZ01, CZ02, ...) CAN BE REPLACED
C**** FOR IDENTIFYING THE TEST ENVIRONMENT
C****
CZ01 ZVERS = 'VERSION OF THE COMPILER VALIDATION SYSTEM'
CZ02 ZVERSD = 'CREATION DATE/TIME OF THE COMPILER VALIDATION SYSTEM'
CZ03 ZPROG = 'PROGRAM NAME'
CZ04 ZDATE = 'DATE OF TEST'
CZ05 ZCOMPL = 'COMPILER IDENTIFICATION'
CZ06 ZPROJ = 'PROJECT NUMBER/IDENTIFICATION'
CZ07 ZNAME = 'NAME OF USER'
CZ08 ZTAPE = 'TAPE OWNER/ID'
CZ09 ZTAPED = 'DATE TAPE COPIED'
C
IVPASS = 0
IVFAIL = 0
IVDELE = 0
IVINSP = 0
IVTOTL = 0
IVTOTN = 0
ICZERO = 0
C
C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER.
I01 = 05
C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER.
I02 = 06
C
CX010 REPLACED BY FEXEC X-010 CONTROL CARD (CARD-READER UNIT NUMBER).
C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5
CX011 REPLACED BY FEXEC X-011 CONTROL CARD. CX011 IS FOR SYSTEMS
C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX010.
C
CX020 REPLACED BY FEXEC X-020 CONTROL CARD (PRINTER UNIT NUMBER).
C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02= 6
CX021 REPLACED BY FEXEC X-021 CONTROL CARD. CX021 IS FOR SYSTEMS
C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX020.
C
CBE** ********************** BBCINITB **********************************
NUVI = I02
IVTOTL = 19
ZPROG = 'FM820'
CBB** ********************** BBCHED0A **********************************
C****
C**** WRITE REPORT TITLE
C****
WRITE (I02, 90002)
WRITE (I02, 90006)
WRITE (I02, 90007)
WRITE (I02, 90008) ZVERS, ZVERSD
WRITE (I02, 90009) ZPROG, ZPROG
WRITE (I02, 90010) ZDATE, ZCOMPL
CBE** ********************** BBCHED0A **********************************
C*****
C***** HEADER FOR SEGMENT 188
WRITE(NUVI,18800)
18800 FORMAT(1H /35H YCSIN - (188) INTRINSIC FUNCTIONS//
1 36H CSIN, CCOS (COMPLEX SINE, COSINE)//
2 17H ANS REF. - 15.3)
CBB** ********************** BBCHED0B **********************************
C**** WRITE DETAIL REPORT HEADERS
C****
WRITE (I02,90004)
WRITE (I02,90004)
WRITE (I02,90013)
WRITE (I02,90014)
WRITE (I02,90015) IVTOTL
CBE** ********************** BBCHED0B **********************************
C*****
WRITE(NUVI, 18801)
18801 FORMAT(/ 8X, 12HTEST OF CSIN)
C*****
CT001* TEST 1 TEST AT ZERO (0.0, 0.0)
IVTNUM = 1
AVC = CSIN(( 0.0, 0.0))
IF (R2E(1) + 0.50000E-04) 20010, 40012, 40011
40011 IF (R2E(1) - 0.50000E-04) 40012, 40012, 20010
40012 IF (R2E(2) + 0.50000E-04) 20010, 10010, 40010
40010 IF (R2E(2) - 0.50000E-04) 10010, 10010, 20010
10010 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0011
20010 IVFAIL = IVFAIL + 1
ZVCORR = (0.00000000000000, 0.00000000000000)
WRITE (NUVI, 80045) IVTNUM, AVC, ZVCORR
0011 CONTINUE
CT002* TEST 2 TEST SIN ON THE REAL LINE, CSIN SAME AS SIN
IVTNUM = 2
AVC = CSIN(( 2.0, 0.0))
IF (R2E(1) - 0.90925E+00) 20020, 40022, 40021
40021 IF (R2E(1) - 0.90935E+00) 40022, 40022, 20020
40022 IF (R2E(2) + 0.50000E-04) 20020, 10020, 40020
40020 IF (R2E(2) - 0.50000E-04) 10020, 10020, 20020
10020 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0021
20020 IVFAIL = IVFAIL + 1
ZVCORR = (0.90929742682568, 0.00000000000000)
WRITE (NUVI, 80045) IVTNUM, AVC, ZVCORR
0021 CONTINUE
CT003* TEST 3 TEST SIN ON THE REAL LINE, CSIN SAME AS SIN
IVTNUM = 3
AVC = CSIN(( -1000.0, 0.0))
IF (R2E(1) + 0.82692E+00) 20030, 40032, 40031
40031 IF (R2E(1) + 0.82683E+00) 40032, 40032, 20030
40032 IF (R2E(2) + 0.50000E-04) 20030, 10030, 40030
40030 IF (R2E(2) - 0.50000E-04) 10030, 10030, 20030
10030 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0031
20030 IVFAIL = IVFAIL + 1
ZVCORR = (-0.82687954053200, 0.00000000000000)
WRITE (NUVI, 80045) IVTNUM, AVC, ZVCORR
0031 CONTINUE
CT004* TEST 4 EXPRESSION PRESENTED TO CSIN
IVTNUM = 4
AVC = CSIN(( 150.0, 350.0) / (100.0, 0.0))
IF (R2E(1) - 0.16530E+02) 20040, 40042, 40041
40041 IF (R2E(1) - 0.16533E+02) 40042, 40042, 20040
40042 IF (R2E(2) - 0.11701E+01) 20040, 10040, 40040
40040 IF (R2E(2) - 0.11703E+01) 10040, 10040, 20040
10040 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0041
20040 IVFAIL = IVFAIL + 1
ZVCORR = (16.531309523248, 1.1701791625591)
WRITE (NUVI, 80045) IVTNUM, AVC, ZVCORR
0041 CONTINUE
CT005* TEST 5 VARIABLE PRESENTED TO CSIN
IVTNUM = 5
BVC = ( 4.75, 2.50) - (9.50, 1.25)
AVC = CSIN(BVC)
IF (R2E(1) - 0.18870E+01) 20050, 40052, 40051
40051 IF (R2E(1) - 0.18872E+01) 40052, 40052, 20050
40052 IF (R2E(2) - 0.60232E-01) 20050, 10050, 40050
40050 IF (R2E(2) - 0.60239E-01) 10050, 10050, 20050
10050 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0051
20050 IVFAIL = IVFAIL + 1
ZVCORR = (1.8870883629759, 0.060235606171638)
WRITE (NUVI, 80045) IVTNUM, AVC, ZVCORR
0051 CONTINUE
CT006* TEST 6 VARIABLE PRESENTED TO CSIN
IVTNUM = 6
BVC = ( 0.125, 2.0) * (10.0, 0.0)
AVC = CSIN(BVC)
IF (R2E(1) - 0.23019E+09) 20060, 40062, 40061
40061 IF (R2E(1) - 0.23022E+09) 40062, 40062, 20060
40062 IF (R2E(2) - 0.76487E+08) 20060, 10060, 40060
40060 IF (R2E(2) - 0.76496E+08) 10060, 10060, 20060
10060 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0061
20060 IVFAIL = IVFAIL + 1
ZVCORR = (230207154.14527, 76491717.784289)
WRITE (NUVI, 80145) IVTNUM, AVC, ZVCORR
80145 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED: ,
1 1H(,E12.5,2H, ,E12.5,1H)/,1H ,16X,10HCORRECT: ,
2 1H(,E12.5,2H, ,E12.5,1H))
0061 CONTINUE
CT007* TEST 7 TEST WHERE REAL IS ZERO
IVTNUM = 7
BVC = ( 0.0, 1.0)
AVC = CSIN(BVC)
IF (R2E(1) + 0.50000E-04) 20070, 40072, 40071
40071 IF (R2E(1) - 0.50000E-04) 40072, 40072, 20070
40072 IF (R2E(2) - 0.11751E+01) 20070, 10070, 40070
40070 IF (R2E(2) - 0.11753E+01) 10070, 10070, 20070
10070 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0071
20070 IVFAIL = IVFAIL + 1
ZVCORR = (0.00000000000000, 1.1752011936438)
WRITE (NUVI, 80045) IVTNUM, AVC, ZVCORR
0071 CONTINUE
CT008* TEST 8 TEST WHERE REAL IS ZERO
IVTNUM = 8
BVC = ( 0.0, -4.75)
AVC = CSIN(BVC)
IF (R2E(1) + 0.50000E-04) 20080, 40082, 40081
40081 IF (R2E(1) - 0.50000E-04) 40082, 40082, 20080
40082 IF (R2E(2) + 0.57791E+02) 20080, 10080, 40080
40080 IF (R2E(2) + 0.57785E+02) 10080, 10080, 20080
10080 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0081
20080 IVFAIL = IVFAIL + 1
ZVCORR = (0.00000000000000, -57.787816415992)
WRITE (NUVI, 80045) IVTNUM, AVC, ZVCORR
0081 CONTINUE
CT009* TEST 9 TEST WHERE REAL IS ZERO
IVTNUM = 9
AVC = CSIN(( 0.0, -10.0))
IF (R2E(1) + 0.50000E-04) 20090, 40092, 40091
40091 IF (R2E(1) - 0.50000E-04) 40092, 40092, 20090
40092 IF (R2E(2) + 0.11014E+05) 20090, 10090, 40090
40090 IF (R2E(2) + 0.11012E+05) 10090, 10090, 20090
10090 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0091
20090 IVFAIL = IVFAIL + 1
ZVCORR = (0.00000000000000, -11013.232874703)
WRITE (NUVI, 80045) IVTNUM, AVC, ZVCORR
0091 CONTINUE
C*****
WRITE (NUVI, 90002)
WRITE (NUVI, 90013)
WRITE (NUVI, 90014)
C*****
WRITE(NUVI, 18811)
18811 FORMAT(/ 08X, 12HTEST OF CCOS)
CT010* TEST 10 TEST FOR ZERO (0.0, 0.0)
IVTNUM = 10
AVC = CCOS(( 0.0, 0.0))
IF (R2E(1) - 0.99995E+00) 20100, 40102, 40101
40101 IF (R2E(1) - 0.10001E+01) 40102, 40102, 20100
40102 IF (R2E(2) + 0.50000E-04) 20100, 10100, 40100
40100 IF (R2E(2) - 0.50000E-04) 10100, 10100, 20100
10100 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0101
20100 IVFAIL = IVFAIL + 1
ZVCORR = (1.00000000000000, 0.00000000000000)
WRITE (NUVI, 80045) IVTNUM, AVC, ZVCORR
0101 CONTINUE
CT011* TEST 11 TEST WITH ZERO IMAGINARY, CCOS = COS
IVTNUM = 11
AVC = CCOS((3.5, 1.0) - (0.0, 1.0))
IF (R2E(1) + 0.93651E+00) 20110, 40112, 40111
40111 IF (R2E(1) + 0.93641E+00) 40112, 40112, 20110
40112 IF (R2E(2) + 0.50000E-04) 20110, 10110, 40110
40110 IF (R2E(2) - 0.50000E-04) 10110, 10110, 20110
10110 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0111
20110 IVFAIL = IVFAIL + 1
ZVCORR = (-0.93645668729080, 0.00000000000000)
WRITE (NUVI, 80045) IVTNUM, AVC, ZVCORR
0111 CONTINUE
CT012* TEST 12 EXPRESSION PRESENTED TO CCOS
IVTNUM = 12
AVC = CCOS(( 3.1416, 0.0) * (-10000.0, 0.0))
IF (R2E(1) - 0.99725E+00) 20120, 40122, 40121
40121 IF (R2E(1) - 0.99736E+00) 40122, 40122, 20120
40122 IF (R2E(2) + 0.50000E-04) 20120, 10120, 40120
40120 IF (R2E(2) - 0.50000E-04) 10120, 10120, 20120
10120 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0121
20120 IVFAIL = IVFAIL + 1
ZVCORR = (0.99730272627420, 0.00000000000000)
WRITE (NUVI, 80045) IVTNUM, AVC, ZVCORR
0121 CONTINUE
CT013* TEST 13 EXPRESSION PRESENTED TO CCOS
IVTNUM = 13
AVC = CCOS(( 3.5, 5.5) - (2.0, 2.0))
IF (R2E(1) - 0.11722E+01) 20130, 40132, 40131
40131 IF (R2E(1) - 0.11724E+01) 40132, 40132, 20130
40132 IF (R2E(2) + 0.16502E+02) 20130, 10130, 40130
40130 IF (R2E(2) + 0.16500E+02) 10130, 10130, 20130
10130 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0131
20130 IVFAIL = IVFAIL + 1
ZVCORR = (1.1723152409601, -16.501187784675)
WRITE (NUVI, 80045) IVTNUM, AVC, ZVCORR
0131 CONTINUE
CT014* TEST 14 VARIABLE WITHIN AN EXPRESSION
IVTNUM = 14
BVC = ( 4.75, 1.25)
AVC = CCOS(BVC - (9.50, 0.0))
IF (R2E(1) - 0.71005E-01) 20140, 40142, 40141
40141 IF (R2E(1) - 0.71013E-01) 40142, 40142, 20140
40142 IF (R2E(2) + 0.16009E+01) 20140, 10140, 40140
40140 IF (R2E(2) + 0.16007E+01) 10140, 10140, 20140
10140 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0141
20140 IVFAIL = IVFAIL + 1
ZVCORR = (0.071008803346314, -1.6007861854666)
WRITE (NUVI, 80045) IVTNUM, AVC, ZVCORR
0141 CONTINUE
CT015* TEST 15 VARIABLE WITHIN AN EXPRESSION
IVTNUM = 15
BVC = ( 1.00, 10.0)
AVC = CCOS(BVC + ( 0.25, 10.0))
IF (R2E(1) - 0.76487E+08) 20150, 40152, 40151
40151 IF (R2E(1) - 0.76496E+08) 40152, 40152, 20150
40152 IF (R2E(2) + 0.23022E+09) 20150, 10150, 40150
40150 IF (R2E(2) + 0.23019E+09) 10150, 10150, 20150
10150 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0151
20150 IVFAIL = IVFAIL + 1
ZVCORR = (76491717.784289, -230207154.14527)
WRITE (NUVI, 80145) IVTNUM, AVC, ZVCORR
0151 CONTINUE
CT016* TEST 16 TEST WITH ZERO REAL PART
IVTNUM = 16
BVC = ( 0.0, 1.0)
AVC = CCOS(BVC)
IF (R2E(1) - 0.15430E+01) 20160, 40162, 40161
40161 IF (R2E(1) - 0.15432E+01) 40162, 40162, 20160
40162 IF (R2E(2) + 0.50000E-04) 20160, 10160, 40160
40160 IF (R2E(2) - 0.50000E-04) 10160, 10160, 20160
10160 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0161
20160 IVFAIL = IVFAIL + 1
ZVCORR = (1.5430806348152, 0.00000000000000)
WRITE (NUVI, 80045) IVTNUM, AVC, ZVCORR
0161 CONTINUE
CT017* TEST 17 TEST WITH ZERO REAL PART
IVTNUM = 17
BVC = ( 0.0, -4.75)
AVC = CCOS(BVC)
IF (R2E(1) - 0.57793E+02) 20170, 40172, 40171
40171 IF (R2E(1) - 0.57800E+02) 40172, 40172, 20170
40172 IF (R2E(2) + 0.50000E-04) 20170, 10170, 40170
40170 IF (R2E(2) - 0.50000E-04) 10170, 10170, 20170
10170 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0171
20170 IVFAIL = IVFAIL + 1
ZVCORR = (57.796468111195, 0.00000000000000)
WRITE (NUVI, 80045) IVTNUM, AVC, ZVCORR
0171 CONTINUE
CT018* TEST 18 TEST WITH ZERO REAL PART
IVTNUM = 18
AVC = CCOS(( 0.0, -10.0))
IF (R2E(1) - 0.11012E+05) 20180, 40182, 40181
40181 IF (R2E(1) - 0.11014E+05) 40182, 40182, 20180
40182 IF (R2E(2) + 0.50000E-04) 20180, 10180, 40180
40180 IF (R2E(2) - 0.50000E-04) 10180, 10180, 20180
10180 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0181
20180 IVFAIL = IVFAIL + 1
ZVCORR = (11013.232920103, 0.00000000000000)
WRITE (NUVI, 80045) IVTNUM, AVC, ZVCORR
0181 CONTINUE
CT019* TEST 19 THE FUNCTION TOGETHER WITH CSIN AND CABS
IVTNUM = 19
DVS = (CABS(CCOS((-2.25, 0.0))) ** 2) +
1 (CABS(CSIN((-2.25, 0.0))) ** 2)
IF (DVS - 0.99995E+00) 20190, 10190, 40190
40190 IF (DVS - 0.10001E+01) 10190, 10190, 20190
10190 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0191
20190 IVFAIL = IVFAIL + 1
RVCORR = 1.00000000000000
WRITE (NUVI, 80012) IVTNUM, DVS, RVCORR
0191 CONTINUE
C*****
CBB** ********************** BBCSUM0 **********************************
C**** WRITE OUT TEST SUMMARY
C****
IVTOTN = IVPASS + IVFAIL + IVDELE + IVINSP
WRITE (I02, 90004)
WRITE (I02, 90014)
WRITE (I02, 90004)
WRITE (I02, 90020) IVPASS
WRITE (I02, 90022) IVFAIL
WRITE (I02, 90024) IVDELE
WRITE (I02, 90026) IVINSP
WRITE (I02, 90028) IVTOTN, IVTOTL
CBE** ********************** BBCSUM0 **********************************
CBB** ********************** BBCFOOT0 **********************************
C**** WRITE OUT REPORT FOOTINGS
C****
WRITE (I02,90016) ZPROG, ZPROG
WRITE (I02,90018) ZPROJ, ZNAME, ZTAPE, ZTAPED
WRITE (I02,90019)
CBE** ********************** BBCFOOT0 **********************************
CBB** ********************** BBCFMT0A **********************************
C**** FORMATS FOR TEST DETAIL LINES
C****
80000 FORMAT (1H ,2X,I3,4X,7HDELETED,32X,A31)
80002 FORMAT (1H ,2X,I3,4X,7H PASS ,32X,A31)
80004 FORMAT (1H ,2X,I3,4X,7HINSPECT,32X,A31)
80008 FORMAT (1H ,2X,I3,4X,7H FAIL ,32X,A31)
80010 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,15X,10HCOMPUTED= ,
1I6,/,1H ,15X,10HCORRECT= ,I6)
80012 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
1E12.5,/,1H ,16X,10HCORRECT= ,E12.5)
80018 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
1A21,/,1H ,16X,10HCORRECT= ,A21)
80020 FORMAT (1H ,16X,10HCOMPUTED= ,A21,1X,A31)
80022 FORMAT (1H ,16X,10HCORRECT= ,A21,1X,A31)
80024 FORMAT (1H ,16X,10HCOMPUTED= ,I6,16X,A31)
80026 FORMAT (1H ,16X,10HCORRECT= ,I6,16X,A31)
80028 FORMAT (1H ,16X,10HCOMPUTED= ,E12.5,10X,A31)
80030 FORMAT (1H ,16X,10HCORRECT= ,E12.5,10X,A31)
80050 FORMAT (1H ,48X,A31)
CBE** ********************** BBCFMT0A **********************************
CBB** ********************** BBCFMAT1 **********************************
C**** FORMATS FOR TEST DETAIL LINES - FULL LANGUAGE
C****
80031 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
1D17.10,/,1H ,16X,10HCORRECT= ,D17.10)
80033 FORMAT (1H ,16X,10HCOMPUTED= ,D17.10,10X,A31)
80035 FORMAT (1H ,16X,10HCORRECT= ,D17.10,10X,A31)
80037 FORMAT (1H ,16X,10HCOMPUTED= ,1H(,E12.5,2H, ,E12.5,1H),6X,A31)
80039 FORMAT (1H ,16X,10HCORRECT= ,1H(,E12.5,2H, ,E12.5,1H),6X,A31)
80041 FORMAT (1H ,16X,10HCOMPUTED= ,1H(,F12.5,2H, ,F12.5,1H),6X,A31)
80043 FORMAT (1H ,16X,10HCORRECT= ,1H(,F12.5,2H, ,F12.5,1H),6X,A31)
80045 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
11H(,F12.5,2H, ,F12.5,1H)/,1H ,16X,10HCORRECT= ,
21H(,F12.5,2H, ,F12.5,1H))
CBE** ********************** BBCFMAT1 **********************************
CBB** ********************** BBCFMT0B **********************************
C**** FORMAT STATEMENTS FOR PAGE HEADERS
C****
90002 FORMAT (1H1)
90004 FORMAT (1H )
90006 FORMAT (1H ,20X,31HFEDERAL SOFTWARE TESTING CENTER)
90007 FORMAT (1H ,19X,34HFORTRAN COMPILER VALIDATION SYSTEM)
90008 FORMAT (1H ,21X,A13,A17)
90009 FORMAT (1H ,/,2H *,A5,6HBEGIN*,12X,15HTEST RESULTS - ,A5,/)
90010 FORMAT (1H ,8X,16HTEST DATE*TIME= ,A17,15H - COMPILER= ,A20)
90013 FORMAT (1H ,8H TEST ,10HPASS/FAIL ,6X,17HDISPLAYED RESULTS,
1 7X,7HREMARKS,24X)
90014 FORMAT (1H ,46H----------------------------------------------,
1 33H---------------------------------)
90015 FORMAT (1H ,48X,17HTHIS PROGRAM HAS ,I3,6H TESTS,/)
C****
C**** FORMAT STATEMENTS FOR REPORT FOOTINGS
C****
90016 FORMAT (1H ,/,2H *,A5,4HEND*,14X,14HEND OF TEST - ,A5,/)
90018 FORMAT (1H ,A13,13X,A20,7H * ,A10,1H/,
1 A13)
90019 FORMAT (1H ,26HFOR OFFICIAL USE ONLY ,35X,15HCOPYRIGHT 1982)
C****
C**** FORMAT STATEMENTS FOR RUN SUMMARY
C****
90020 FORMAT (1H ,21X,I5,13H TESTS PASSED)
90022 FORMAT (1H ,21X,I5,13H TESTS FAILED)
90024 FORMAT (1H ,21X,I5,14H TESTS DELETED)
90026 FORMAT (1H ,21X,I5,25H TESTS REQUIRE INSPECTION)
90028 FORMAT (1H ,21X,I5,4H OF ,I3,15H TESTS EXECUTED)
CBE** ********************** BBCFMT0B **********************************
C*****
C***** END OF TEST SEGMENT 188
STOP
END
*END-OF,FM820
FM821.f 481036556 170 2 100666 18143 `
*HEADER,FORTR,FM821
*FILES1,FORTR,FM821,X
C***********************************************************************
C***** FORTRAN 77
C***** FM821
C***** YDCOS - (190)
C*****
C***********************************************************************
C***** GENERAL PURPOSE ANS REF
C***** TEST INTRINSIC FUNCTION DCOS 15.3
C***** TABLE 5
C*****
CBB** ********************** BBCCOMNT **********************************
C****
C**** 1978 FORTRAN COMPILER VALIDATION SYSTEM
C**** VERSION 2.0
C****
C****
C**** SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO
C**** GENERAL SERVICES ADMINISTRATION
C**** FEDERAL SOFTWARE TESTING CENTER
C**** 5203 LEESBURG PIKE, SUITE 1100
C**** FALLS CHURCH, VA. 22041
C****
C**** (703) 756-6153
C****
CBE** ********************** BBCCOMNT **********************************
C*****
C***** S P E C I F I C A T I O N S SEGMENT 190
DOUBLE PRECISION AVD, BVD, PIVD, DVCORR
C*****
CBB** ********************** BBCINITA **********************************
C**** SPECIFICATION STATEMENTS
C****
CHARACTER ZVERS*13, ZVERSD*17, ZDATE*17, ZPROG*5, ZCOMPL*20,
1 ZNAME*20, ZTAPE*10, ZPROJ*13, REMRKS*31, ZTAPED*13
CBE** ********************** BBCINITA **********************************
CBB** ********************** BBCINITB **********************************
C**** INITIALIZE SECTION
DATA ZVERS, ZVERSD, ZDATE
1 /'VERSION 2.0 ', '82/08/02*18.33.46', '*NO DATE*TIME'/
DATA ZCOMPL, ZNAME, ZTAPE
1 /'*NONE SPECIFIED*', '*NO COMPANY NAME*', '*NO TAPE*'/
DATA ZPROJ, ZTAPED, ZPROG
1 /'*NO PROJECT*', '*NO TAPE DATE', 'XXXXX'/
DATA REMRKS /' '/
C**** THE FOLLOWING 9 COMMENT LINES (CZ01, CZ02, ...) CAN BE REPLACED
C**** FOR IDENTIFYING THE TEST ENVIRONMENT
C****
CZ01 ZVERS = 'VERSION OF THE COMPILER VALIDATION SYSTEM'
CZ02 ZVERSD = 'CREATION DATE/TIME OF THE COMPILER VALIDATION SYSTEM'
CZ03 ZPROG = 'PROGRAM NAME'
CZ04 ZDATE = 'DATE OF TEST'
CZ05 ZCOMPL = 'COMPILER IDENTIFICATION'
CZ06 ZPROJ = 'PROJECT NUMBER/IDENTIFICATION'
CZ07 ZNAME = 'NAME OF USER'
CZ08 ZTAPE = 'TAPE OWNER/ID'
CZ09 ZTAPED = 'DATE TAPE COPIED'
C
IVPASS = 0
IVFAIL = 0
IVDELE = 0
IVINSP = 0
IVTOTL = 0
IVTOTN = 0
ICZERO = 0
C
C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER.
I01 = 05
C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER.
I02 = 06
C
CX010 REPLACED BY FEXEC X-010 CONTROL CARD (CARD-READER UNIT NUMBER).
C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5
CX011 REPLACED BY FEXEC X-011 CONTROL CARD. CX011 IS FOR SYSTEMS
C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX010.
C
CX020 REPLACED BY FEXEC X-020 CONTROL CARD (PRINTER UNIT NUMBER).
C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02= 6
CX021 REPLACED BY FEXEC X-021 CONTROL CARD. CX021 IS FOR SYSTEMS
C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX020.
C
CBE** ********************** BBCINITB **********************************
NUVI = I02
IVTOTL = 19
ZPROG = 'FM821'
CBB** ********************** BBCHED0A **********************************
C****
C**** WRITE REPORT TITLE
C****
WRITE (I02, 90002)
WRITE (I02, 90006)
WRITE (I02, 90007)
WRITE (I02, 90008) ZVERS, ZVERSD
WRITE (I02, 90009) ZPROG, ZPROG
WRITE (I02, 90010) ZDATE, ZCOMPL
CBE** ********************** BBCHED0A **********************************
C*****
C***** HEADER FOR SEGMENT 190
WRITE(NUVI,19000)
19000 FORMAT(1H /34H YDCOS - (190) INTRINSIC FUNCTIONS//
1 32H DCOS (DOUBLE PRECISION COSINE)//
2 17H ANS REF. - 15.3)
CBB** ********************** BBCHED0B **********************************
C**** WRITE DETAIL REPORT HEADERS
C****
WRITE (I02,90004)
WRITE (I02,90004)
WRITE (I02,90013)
WRITE (I02,90014)
WRITE (I02,90015) IVTOTL
CBE** ********************** BBCHED0B **********************************
C*****
PIVD = 3.1415926535897932384626434D0
C*****
CT001* TEST 1 ZERO (0.0), SINCE COS(0)=1
IVTNUM = 1
BVD = 0.0D0
AVD = DCOS(BVD)
IF (AVD - 0.9999999995D+00) 20010, 10010, 40010
40010 IF (AVD - 0.1000000001D+01) 10010, 10010, 20010
10010 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0011
20010 IVFAIL = IVFAIL + 1
DVCORR = 1.00000000000000000000D+00
WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR
0011 CONTINUE
CT002* TEST 2 VALUES NEAR PI
IVTNUM = 2
AVD = DCOS(PIVD)
IF (AVD + 0.1000000001D+01) 20020, 10020, 40020
40020 IF (AVD + 0.9999999995D+00) 10020, 10020, 20020
10020 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0021
20020 IVFAIL = IVFAIL + 1
DVCORR = -1.00000000000000000000D+00
WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR
0021 CONTINUE
CT003* TEST 3 PI - 1/16
IVTNUM = 3
BVD = 3.07909265358979323846D0
AVD = DCOS(BVD)
IF (AVD + 0.9980475112D+00) 20030, 10030, 40030
40030 IF (AVD + 0.9980475102D+00) 10030, 10030, 20030
10030 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0031
20030 IVFAIL = IVFAIL + 1
DVCORR = -0.99804751070009914963D+00
WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR
0031 CONTINUE
CT004* TEST 4 PI + 1/32
IVTNUM = 4
AVD = DCOS(3.17284265358979323846D0)
IF (AVD + 0.9995117590D+00) 20040, 10040, 40040
40040 IF (AVD + 0.9995117580D+00) 10040, 10040, 20040
10040 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0041
20040 IVFAIL = IVFAIL + 1
DVCORR = -0.99951175848513636924D+00
WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR
0041 CONTINUE
CT005* TEST 5 VALUES NEAR 2*PI
IVTNUM = 5
BVD = PIVD * 2.0D0
AVD = DCOS(BVD)
IF (AVD - 0.9999999995D+00) 20050, 10050, 40050
40050 IF (AVD - 0.1000000001D+01) 10050, 10050, 20050
10050 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0051
20050 IVFAIL = IVFAIL + 1
DVCORR = 1.00000000000000000000D+00
WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR
0051 CONTINUE
CT006* TEST 6 VALUES NEAR 2*PI
IVTNUM = 6
BVD = (2.0D0 * PIVD) - 1.0D0 / 64.0D0
AVD = DCOS(BVD)
IF (AVD - 0.9998779316D+00) 20060, 10060, 40060
40060 IF (AVD - 0.9998779327D+00) 10060, 10060, 20060
10060 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0061
20060 IVFAIL = IVFAIL + 1
DVCORR = 0.99987793217100665474D+00
WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR
0061 CONTINUE
CT007* TEST 7 VALUES NEAR 2*PI
IVTNUM = 7
BVD = (2.0D0 * PIVD) + 1.0D0 / 128.0D0
AVD = DCOS(BVD)
IF (AVD - 0.9999694820D+00) 20070, 10070, 40070
40070 IF (AVD - 0.9999694831D+00) 10070, 10070, 20070
10070 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0071
20070 IVFAIL = IVFAIL + 1
DVCORR = 0.99996948257709511331D+00
WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR
0071 CONTINUE
CT008* TEST 8 AN EXPRESSION PRESENTED TO DCOS
IVTNUM = 8
BVD = 350.0D1
AVD = DCOS(BVD / 100.0D1)
IF (AVD + 0.9364566878D+00) 20080, 10080, 40080
40080 IF (AVD + 0.9364566868D+00) 10080, 10080, 20080
10080 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0081
20080 IVFAIL = IVFAIL + 1
DVCORR = -0.93645668729079633770D+00
WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR
0081 CONTINUE
CT009* TEST 9 A NEGATIVE ARGUMENT
IVTNUM = 9
BVD = -1.5D0
AVD = DCOS(BVD)
IF (AVD - 0.7073720163D-01) 20090, 10090, 40090
40090 IF (AVD - 0.7073720171D-01) 10090, 10090, 20090
10090 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0091
20090 IVFAIL = IVFAIL + 1
DVCORR = 0.070737201667702910088D+00
WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR
0091 CONTINUE
CT010* TEST 10 LARGE VALUES TO CHECK ARGUMENT REDUCTION
IVTNUM = 10
AVD = DCOS(200.0D0)
IF (AVD - 0.4871876747D+00) 20100, 10100, 40100
40100 IF (AVD - 0.4871876753D+00) 10100, 10100, 20100
10100 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0101
20100 IVFAIL = IVFAIL + 1
DVCORR = 0.48718767500700591035D+00
WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR
0101 CONTINUE
CT011* TEST 11 LARGE VALUES TO CHECK ARGUMENT REDUCTION
IVTNUM = 11
AVD = DCOS(-31416.0D0)
IF (AVD - 0.9973027257D+00) 20110, 10110, 40110
40110 IF (AVD - 0.9973027268D+00) 10110, 10110, 20110
10110 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0111
20110 IVFAIL = IVFAIL + 1
DVCORR = 0.99730272627420107808D+00
WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR
0111 CONTINUE
CT012* TEST 12 VALUES NEAR PI/2
IVTNUM = 12
AVD = DCOS(1.57079632679489661923D0)
IF (AVD + 0.5000000000D-09) 20120, 10120, 40120
40120 IF (AVD - 0.5000000000D-09) 10120, 10120, 20120
10120 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0121
20120 IVFAIL = IVFAIL + 1
DVCORR = 0.00000000000000000000D+00
WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR
0121 CONTINUE
CT013* TEST 13 (PI / 2) - 1/32
IVTNUM = 13
BVD = (1.53954632679489661923D0)
AVD = DCOS(BVD)
IF (AVD - 0.3124491397D-01) 20130, 10130, 40130
40130 IF (AVD - 0.3124491400D-01) 10130, 10130, 20130
10130 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0131
20130 IVFAIL = IVFAIL + 1
DVCORR = 0.031244913985326078739D+00
WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR
0131 CONTINUE
CT014* TEST 14 (PI / 2) + 1/16
IVTNUM = 14
AVD = DCOS(1.63329632679489661923D0)
IF (AVD + 0.6245931788D-01) 20140, 10140, 40140
40140 IF (AVD + 0.6245931781D-01) 10140, 10140, 20140
10140 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0141
20140 IVFAIL = IVFAIL + 1
DVCORR = -0.062459317842380198585D+00
WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR
0141 CONTINUE
CT015* TEST 15 VALUES NEAR 3*PI/2
IVTNUM = 15
BVD = 3.0D0 * PIVD / 2.0D0
AVD = DCOS(BVD)
IF (AVD + 0.5000000000D-09) 20150, 10150, 40150
40150 IF (AVD - 0.5000000000D-09) 10150, 10150, 20150
10150 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0151
20150 IVFAIL = IVFAIL + 1
DVCORR = 0.00000000000000000000D+00
WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR
0151 CONTINUE
CT016* TEST 16 VALUES NEAR 3*PI/2
IVTNUM = 16
BVD = (3.0D0 * PIVD / 2.0D0) + 1.0D0 / 16.0D0
AVD = DCOS(BVD)
IF (AVD - 0.6245931781D-01) 20160, 10160, 40160
40160 IF (AVD - 0.6245931788D-01) 10160, 10160, 20160
10160 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0161
20160 IVFAIL = IVFAIL + 1
DVCORR = 0.062459317842380198585D+00
WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR
0161 CONTINUE
CT017* TEST 17 VALUES NEAR 3*PI/2
IVTNUM = 17
BVD = (3.0D0 * PIVD / 2.0D0) - 1.0D0 / 512.0D0
AVD = DCOS(BVD)
IF (AVD + 0.1953123760D-02) 20170, 10170, 40170
40170 IF (AVD + 0.1953123757D-02) 10170, 10170, 20170
10170 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0171
20170 IVFAIL = IVFAIL + 1
DVCORR = -0.0019531237582368040269D+00
WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR
0171 CONTINUE
CT018* TEST 18 ARGUMENT OF LOW MAGNITUDE
IVTNUM = 18
BVD = -3.1415926535898D-35
AVD = DCOS(BVD)
IF (AVD - 0.9999999995D+00) 20180, 10180, 40180
40180 IF (AVD - 0.1000000001D+01) 10180, 10180, 20180
10180 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0181
20180 IVFAIL = IVFAIL + 1
DVCORR = 1.00000000000000000000D+00
WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR
0181 CONTINUE
CT019* TEST 19 THE FUNCTION APPLIED TWICE
IVTNUM = 19
AVD = DCOS(PIVD / 4.0D0) * DCOS(3.0D0 * PIVD / 4.0D0)
IF (AVD + 0.5000000003D+00) 20190, 10190, 40190
40190 IF (AVD + 0.4999999997D+00) 10190, 10190, 20190
10190 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0191
20190 IVFAIL = IVFAIL + 1
DVCORR = -0.5000000000000000000000D+00
WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR
0191 CONTINUE
C*****
CBB** ********************** BBCSUM0 **********************************
C**** WRITE OUT TEST SUMMARY
C****
IVTOTN = IVPASS + IVFAIL + IVDELE + IVINSP
WRITE (I02, 90004)
WRITE (I02, 90014)
WRITE (I02, 90004)
WRITE (I02, 90020) IVPASS
WRITE (I02, 90022) IVFAIL
WRITE (I02, 90024) IVDELE
WRITE (I02, 90026) IVINSP
WRITE (I02, 90028) IVTOTN, IVTOTL
CBE** ********************** BBCSUM0 **********************************
CBB** ********************** BBCFOOT0 **********************************
C**** WRITE OUT REPORT FOOTINGS
C****
WRITE (I02,90016) ZPROG, ZPROG
WRITE (I02,90018) ZPROJ, ZNAME, ZTAPE, ZTAPED
WRITE (I02,90019)
CBE** ********************** BBCFOOT0 **********************************
CBB** ********************** BBCFMT0A **********************************
C**** FORMATS FOR TEST DETAIL LINES
C****
80000 FORMAT (1H ,2X,I3,4X,7HDELETED,32X,A31)
80002 FORMAT (1H ,2X,I3,4X,7H PASS ,32X,A31)
80004 FORMAT (1H ,2X,I3,4X,7HINSPECT,32X,A31)
80008 FORMAT (1H ,2X,I3,4X,7H FAIL ,32X,A31)
80010 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,15X,10HCOMPUTED= ,
1I6,/,1H ,15X,10HCORRECT= ,I6)
80012 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
1E12.5,/,1H ,16X,10HCORRECT= ,E12.5)
80018 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
1A21,/,1H ,16X,10HCORRECT= ,A21)
80020 FORMAT (1H ,16X,10HCOMPUTED= ,A21,1X,A31)
80022 FORMAT (1H ,16X,10HCORRECT= ,A21,1X,A31)
80024 FORMAT (1H ,16X,10HCOMPUTED= ,I6,16X,A31)
80026 FORMAT (1H ,16X,10HCORRECT= ,I6,16X,A31)
80028 FORMAT (1H ,16X,10HCOMPUTED= ,E12.5,10X,A31)
80030 FORMAT (1H ,16X,10HCORRECT= ,E12.5,10X,A31)
80050 FORMAT (1H ,48X,A31)
CBE** ********************** BBCFMT0A **********************************
CBB** ********************** BBCFMAT1 **********************************
C**** FORMATS FOR TEST DETAIL LINES - FULL LANGUAGE
C****
80031 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
1D17.10,/,1H ,16X,10HCORRECT= ,D17.10)
80033 FORMAT (1H ,16X,10HCOMPUTED= ,D17.10,10X,A31)
80035 FORMAT (1H ,16X,10HCORRECT= ,D17.10,10X,A31)
80037 FORMAT (1H ,16X,10HCOMPUTED= ,1H(,E12.5,2H, ,E12.5,1H),6X,A31)
80039 FORMAT (1H ,16X,10HCORRECT= ,1H(,E12.5,2H, ,E12.5,1H),6X,A31)
80041 FORMAT (1H ,16X,10HCOMPUTED= ,1H(,F12.5,2H, ,F12.5,1H),6X,A31)
80043 FORMAT (1H ,16X,10HCORRECT= ,1H(,F12.5,2H, ,F12.5,1H),6X,A31)
80045 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
11H(,F12.5,2H, ,F12.5,1H)/,1H ,16X,10HCORRECT= ,
21H(,F12.5,2H, ,F12.5,1H))
CBE** ********************** BBCFMAT1 **********************************
CBB** ********************** BBCFMT0B **********************************
C**** FORMAT STATEMENTS FOR PAGE HEADERS
C****
90002 FORMAT (1H1)
90004 FORMAT (1H )
90006 FORMAT (1H ,20X,31HFEDERAL SOFTWARE TESTING CENTER)
90007 FORMAT (1H ,19X,34HFORTRAN COMPILER VALIDATION SYSTEM)
90008 FORMAT (1H ,21X,A13,A17)
90009 FORMAT (1H ,/,2H *,A5,6HBEGIN*,12X,15HTEST RESULTS - ,A5,/)
90010 FORMAT (1H ,8X,16HTEST DATE*TIME= ,A17,15H - COMPILER= ,A20)
90013 FORMAT (1H ,8H TEST ,10HPASS/FAIL ,6X,17HDISPLAYED RESULTS,
1 7X,7HREMARKS,24X)
90014 FORMAT (1H ,46H----------------------------------------------,
1 33H---------------------------------)
90015 FORMAT (1H ,48X,17HTHIS PROGRAM HAS ,I3,6H TESTS,/)
C****
C**** FORMAT STATEMENTS FOR REPORT FOOTINGS
C****
90016 FORMAT (1H ,/,2H *,A5,4HEND*,14X,14HEND OF TEST - ,A5,/)
90018 FORMAT (1H ,A13,13X,A20,7H * ,A10,1H/,
1 A13)
90019 FORMAT (1H ,26HFOR OFFICIAL USE ONLY ,35X,15HCOPYRIGHT 1982)
C****
C**** FORMAT STATEMENTS FOR RUN SUMMARY
C****
90020 FORMAT (1H ,21X,I5,13H TESTS PASSED)
90022 FORMAT (1H ,21X,I5,13H TESTS FAILED)
90024 FORMAT (1H ,21X,I5,14H TESTS DELETED)
90026 FORMAT (1H ,21X,I5,25H TESTS REQUIRE INSPECTION)
90028 FORMAT (1H ,21X,I5,4H OF ,I3,15H TESTS EXECUTED)
CBE** ********************** BBCFMT0B **********************************
C*****
C***** END OF TEST SEGMENT 190
STOP
END
*END-OF,FM821
FM822.f 481036560 170 2 100666 15678 `
*HEADER,FORTR,FM822
*FILES1,FORTR,FM822,X
C***********************************************************************
C***** FORTRAN 77
C***** FM822
C***** YDTAN - (192)
C*****
C***********************************************************************
C***** GENERAL PURPOSE ANS REF
C***** TEST INTRINSIC FUNCTION DTAN 15.3
C***** TABLE 5
C*****
CBB** ********************** BBCCOMNT **********************************
C****
C**** 1978 FORTRAN COMPILER VALIDATION SYSTEM
C**** VERSION 2.0
C****
C****
C**** SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO
C**** GENERAL SERVICES ADMINISTRATION
C**** FEDERAL SOFTWARE TESTING CENTER
C**** 5203 LEESBURG PIKE, SUITE 1100
C**** FALLS CHURCH, VA. 22041
C****
C**** (703) 756-6153
C****
CBE** ********************** BBCCOMNT **********************************
C*****
C***** S P E C I F I C A T I O N S SEGMENT 192
DOUBLE PRECISION AVD, BVD, PIVD, DVCORR
C*****
CBB** ********************** BBCINITA **********************************
C**** SPECIFICATION STATEMENTS
C****
CHARACTER ZVERS*13, ZVERSD*17, ZDATE*17, ZPROG*5, ZCOMPL*20,
1 ZNAME*20, ZTAPE*10, ZPROJ*13, REMRKS*31, ZTAPED*13
CBE** ********************** BBCINITA **********************************
CBB** ********************** BBCINITB **********************************
C**** INITIALIZE SECTION
DATA ZVERS, ZVERSD, ZDATE
1 /'VERSION 2.0 ', '82/08/02*18.33.46', '*NO DATE*TIME'/
DATA ZCOMPL, ZNAME, ZTAPE
1 /'*NONE SPECIFIED*', '*NO COMPANY NAME*', '*NO TAPE*'/
DATA ZPROJ, ZTAPED, ZPROG
1 /'*NO PROJECT*', '*NO TAPE DATE', 'XXXXX'/
DATA REMRKS /' '/
C**** THE FOLLOWING 9 COMMENT LINES (CZ01, CZ02, ...) CAN BE REPLACED
C**** FOR IDENTIFYING THE TEST ENVIRONMENT
C****
CZ01 ZVERS = 'VERSION OF THE COMPILER VALIDATION SYSTEM'
CZ02 ZVERSD = 'CREATION DATE/TIME OF THE COMPILER VALIDATION SYSTEM'
CZ03 ZPROG = 'PROGRAM NAME'
CZ04 ZDATE = 'DATE OF TEST'
CZ05 ZCOMPL = 'COMPILER IDENTIFICATION'
CZ06 ZPROJ = 'PROJECT NUMBER/IDENTIFICATION'
CZ07 ZNAME = 'NAME OF USER'
CZ08 ZTAPE = 'TAPE OWNER/ID'
CZ09 ZTAPED = 'DATE TAPE COPIED'
C
IVPASS = 0
IVFAIL = 0
IVDELE = 0
IVINSP = 0
IVTOTL = 0
IVTOTN = 0
ICZERO = 0
C
C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER.
I01 = 05
C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER.
I02 = 06
C
CX010 REPLACED BY FEXEC X-010 CONTROL CARD (CARD-READER UNIT NUMBER).
C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5
CX011 REPLACED BY FEXEC X-011 CONTROL CARD. CX011 IS FOR SYSTEMS
C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX010.
C
CX020 REPLACED BY FEXEC X-020 CONTROL CARD (PRINTER UNIT NUMBER).
C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02= 6
CX021 REPLACED BY FEXEC X-021 CONTROL CARD. CX021 IS FOR SYSTEMS
C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX020.
C
CBE** ********************** BBCINITB **********************************
NUVI = I02
IVTOTL = 14
ZPROG = 'FM822'
CBB** ********************** BBCHED0A **********************************
C****
C**** WRITE REPORT TITLE
C****
WRITE (I02, 90002)
WRITE (I02, 90006)
WRITE (I02, 90007)
WRITE (I02, 90008) ZVERS, ZVERSD
WRITE (I02, 90009) ZPROG, ZPROG
WRITE (I02, 90010) ZDATE, ZCOMPL
CBE** ********************** BBCHED0A **********************************
C*****
C***** HEADER FOR SEGMENT 192
WRITE(NUVI,19200)
19200 FORMAT(1H , / 35H YDTAN - (192) INTRINSIC FUNCTIONS//
1 34H DTAN (DOUBLE PRECISION TANGENT)//
2 17H ANS REF. - 15.3)
CBB** ********************** BBCHED0B **********************************
C**** WRITE DETAIL REPORT HEADERS
C****
WRITE (I02,90004)
WRITE (I02,90004)
WRITE (I02,90013)
WRITE (I02,90014)
WRITE (I02,90015) IVTOTL
CBE** ********************** BBCHED0B **********************************
C*****
PIVD = 3.1415926535897932384626434D0
C*****
CT001* TEST 1 ZERO (0.0), SINCE TAN(0) = 0.
IVTNUM = 1
BVD = 0.0D0
AVD = DTAN(BVD)
IF (AVD + 0.5000000000D-09) 20010, 10010, 40010
40010 IF (AVD - 0.5000000000D-09) 10010, 10010, 20010
10010 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0011
20010 IVFAIL = IVFAIL + 1
DVCORR = 0.00000000000000000000D+00
WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR
0011 CONTINUE
CT002* TEST 2 2*PI
IVTNUM = 2
BVD = 6.28318530717958647692D0
AVD = DTAN(BVD)
IF (AVD + 0.5000000000D-09) 20020, 10020, 40020
40020 IF (AVD - 0.5000000000D-09) 10020, 10020, 20020
10020 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0021
20020 IVFAIL = IVFAIL + 1
DVCORR = 0.00000000000000000000D+00
WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR
0021 CONTINUE
CT003* TEST 3 3*PI
IVTNUM = 3
BVD = 9.42477796076937971538D0
AVD = DTAN(BVD)
IF (AVD + 0.5000000000D-09) 20030, 10030, 40030
40030 IF (AVD - 0.5000000000D-09) 10030, 10030, 20030
10030 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0031
20030 IVFAIL = IVFAIL + 1
DVCORR = 0.00000000000000000000D+00
WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR
0031 CONTINUE
CT004* TEST 4 PI/4
IVTNUM = 4
AVD = DTAN(PIVD / 4.0D0)
IF (AVD - 0.9999999995D+00) 20040, 10040, 40040
40040 IF (AVD - 0.1000000001D+01) 10040, 10040, 20040
10040 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0041
20040 IVFAIL = IVFAIL + 1
DVCORR = 1.00000000000000000000D+00
WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR
0041 CONTINUE
CT005* TEST 5 5*PI/4
IVTNUM = 5
BVD = 5.0D0 * PIVD / 4.0D0
AVD = DTAN(BVD)
IF (AVD - 0.9999999995D+00) 20050, 10050, 40050
40050 IF (AVD - 0.1000000001D+01) 10050, 10050, 20050
10050 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0051
20050 IVFAIL = IVFAIL + 1
DVCORR = 1.00000000000000000000D+00
WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR
0051 CONTINUE
CT006* TEST 6 A NEGATIVE VALUE
IVTNUM = 6
BVD = -2.0D0 / 1.0D0
AVD = DTAN(BVD)
IF (AVD - 0.2185039862D+01) 20060, 10060, 40060
40060 IF (AVD - 0.2185039865D+01) 10060, 10060, 20060
10060 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0061
20060 IVFAIL = IVFAIL + 1
DVCORR = 2.1850398632615189916D+00
WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR
0061 CONTINUE
CT007* TEST 7 A POSITIVE VALUE
IVTNUM = 7
BVD = 350.0D0 / 100.0D0
AVD = DTAN(BVD)
IF (AVD - 0.3745856399D+00) 20070, 10070, 40070
40070 IF (AVD - 0.3745856404D+00) 10070, 10070, 20070
10070 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0071
20070 IVFAIL = IVFAIL + 1
DVCORR = 0.37458564015859466633D+00
WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR
0071 CONTINUE
CT008* TEST 8 (PI / 2) - 1/8
IVTNUM = 8
BVD = 1.44579632679489661923D0
AVD = DTAN(BVD)
IF (AVD - 0.7958289861D+01) 20080, 10080, 40080
40080 IF (AVD - 0.7958289870D+01) 10080, 10080, 20080
10080 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0081
20080 IVFAIL = IVFAIL + 1
DVCORR = 7.9582898658670111779D+00
WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR
0081 CONTINUE
CT009* TEST 9 (PI / 2) + 1/256
IVTNUM = 9
BVD = 1.57470257679489661923D0
AVD = DTAN(BVD)
IF (AVD + 0.2559986981D+03) 20090, 10090, 40090
40090 IF (AVD + 0.2559986977D+03) 10090, 10090, 20090
10090 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0091
20090 IVFAIL = IVFAIL + 1
DVCORR = -255.99869791534211708D+00
WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR
0091 CONTINUE
CT010* TEST 10 3*PI/2 - 1/1024
IVTNUM = 10
AVD = DTAN((3.0D0 * PIVD / 2.0D0) - 1.0D0 / 1024.0D0)
IF (AVD - 0.1023999674D+04) 20100, 10100, 40100
40100 IF (AVD - 0.1023999675D+04) 10100, 10100, 20100
10100 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0101
20100 IVFAIL = IVFAIL + 1
DVCORR = 1023.9996744791459706D+00
WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR
0101 CONTINUE
CT011* TEST 11 3*PI + 1/64
IVTNUM = 11
BVD = (3.0D0 * PIVD / 2.0D0) + 1.0D0 / 64.0D0
AVD = DTAN(BVD)
IF (AVD + 0.6399479162D+02) 20110, 10110, 40110
40110 IF (AVD + 0.6399479155D+02) 10110, 10110, 20110
10110 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0111
20110 IVFAIL = IVFAIL + 1
DVCORR = -63.994791581893645218D+00
WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR
0111 CONTINUE
CT012* TEST 12 LARGE VALUE TO TEST ARGUMENT REDUCTION
IVTNUM = 12
AVD = DTAN(2000.0D0)
IF (AVD + 0.2530998330D+01) 20120, 10120, 40120
40120 IF (AVD + 0.2530998326D+01) 10120, 10120, 20120
10120 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0121
20120 IVFAIL = IVFAIL + 1
DVCORR = -2.5309983280933409104D+00
WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR
0121 CONTINUE
CT013* TEST 13 ARGUMENT OF LOW MAGNITUDE
IVTNUM = 13
BVD = PIVD * 1.0D-15
AVD = DTAN(BVD)
IF (AVD - 0.3141592652D-14) 20130, 10130, 40130
40130 IF (AVD - 0.3141592655D-14) 10130, 10130, 20130
10130 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0131
20130 IVFAIL = IVFAIL + 1
DVCORR = 3.1415926535897932385D-15
WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR
0131 CONTINUE
CT014* TEST 14 THE FUNCTION APPLIED TWICE
IVTNUM = 14
AVD = DTAN(PIVD / 6.0D0) * DTAN(PIVD / 6.0D0)
IF (AVD - 0.3333333331D+00) 20140, 10140, 40140
40140 IF (AVD - 0.3333333335D+00) 10140, 10140, 20140
10140 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0141
20140 IVFAIL = IVFAIL + 1
DVCORR = 0.33333333333333333333D+00
WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR
0141 CONTINUE
C*****
CBB** ********************** BBCSUM0 **********************************
C**** WRITE OUT TEST SUMMARY
C****
IVTOTN = IVPASS + IVFAIL + IVDELE + IVINSP
WRITE (I02, 90004)
WRITE (I02, 90014)
WRITE (I02, 90004)
WRITE (I02, 90020) IVPASS
WRITE (I02, 90022) IVFAIL
WRITE (I02, 90024) IVDELE
WRITE (I02, 90026) IVINSP
WRITE (I02, 90028) IVTOTN, IVTOTL
CBE** ********************** BBCSUM0 **********************************
CBB** ********************** BBCFOOT0 **********************************
C**** WRITE OUT REPORT FOOTINGS
C****
WRITE (I02,90016) ZPROG, ZPROG
WRITE (I02,90018) ZPROJ, ZNAME, ZTAPE, ZTAPED
WRITE (I02,90019)
CBE** ********************** BBCFOOT0 **********************************
CBB** ********************** BBCFMT0A **********************************
C**** FORMATS FOR TEST DETAIL LINES
C****
80000 FORMAT (1H ,2X,I3,4X,7HDELETED,32X,A31)
80002 FORMAT (1H ,2X,I3,4X,7H PASS ,32X,A31)
80004 FORMAT (1H ,2X,I3,4X,7HINSPECT,32X,A31)
80008 FORMAT (1H ,2X,I3,4X,7H FAIL ,32X,A31)
80010 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,15X,10HCOMPUTED= ,
1I6,/,1H ,15X,10HCORRECT= ,I6)
80012 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
1E12.5,/,1H ,16X,10HCORRECT= ,E12.5)
80018 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
1A21,/,1H ,16X,10HCORRECT= ,A21)
80020 FORMAT (1H ,16X,10HCOMPUTED= ,A21,1X,A31)
80022 FORMAT (1H ,16X,10HCORRECT= ,A21,1X,A31)
80024 FORMAT (1H ,16X,10HCOMPUTED= ,I6,16X,A31)
80026 FORMAT (1H ,16X,10HCORRECT= ,I6,16X,A31)
80028 FORMAT (1H ,16X,10HCOMPUTED= ,E12.5,10X,A31)
80030 FORMAT (1H ,16X,10HCORRECT= ,E12.5,10X,A31)
80050 FORMAT (1H ,48X,A31)
CBE** ********************** BBCFMT0A **********************************
CBB** ********************** BBCFMAT1 **********************************
C**** FORMATS FOR TEST DETAIL LINES - FULL LANGUAGE
C****
80031 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
1D17.10,/,1H ,16X,10HCORRECT= ,D17.10)
80033 FORMAT (1H ,16X,10HCOMPUTED= ,D17.10,10X,A31)
80035 FORMAT (1H ,16X,10HCORRECT= ,D17.10,10X,A31)
80037 FORMAT (1H ,16X,10HCOMPUTED= ,1H(,E12.5,2H, ,E12.5,1H),6X,A31)
80039 FORMAT (1H ,16X,10HCORRECT= ,1H(,E12.5,2H, ,E12.5,1H),6X,A31)
80041 FORMAT (1H ,16X,10HCOMPUTED= ,1H(,F12.5,2H, ,F12.5,1H),6X,A31)
80043 FORMAT (1H ,16X,10HCORRECT= ,1H(,F12.5,2H, ,F12.5,1H),6X,A31)
80045 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
11H(,F12.5,2H, ,F12.5,1H)/,1H ,16X,10HCORRECT= ,
21H(,F12.5,2H, ,F12.5,1H))
CBE** ********************** BBCFMAT1 **********************************
CBB** ********************** BBCFMT0B **********************************
C**** FORMAT STATEMENTS FOR PAGE HEADERS
C****
90002 FORMAT (1H1)
90004 FORMAT (1H )
90006 FORMAT (1H ,20X,31HFEDERAL SOFTWARE TESTING CENTER)
90007 FORMAT (1H ,19X,34HFORTRAN COMPILER VALIDATION SYSTEM)
90008 FORMAT (1H ,21X,A13,A17)
90009 FORMAT (1H ,/,2H *,A5,6HBEGIN*,12X,15HTEST RESULTS - ,A5,/)
90010 FORMAT (1H ,8X,16HTEST DATE*TIME= ,A17,15H - COMPILER= ,A20)
90013 FORMAT (1H ,8H TEST ,10HPASS/FAIL ,6X,17HDISPLAYED RESULTS,
1 7X,7HREMARKS,24X)
90014 FORMAT (1H ,46H----------------------------------------------,
1 33H---------------------------------)
90015 FORMAT (1H ,48X,17HTHIS PROGRAM HAS ,I3,6H TESTS,/)
C****
C**** FORMAT STATEMENTS FOR REPORT FOOTINGS
C****
90016 FORMAT (1H ,/,2H *,A5,4HEND*,14X,14HEND OF TEST - ,A5,/)
90018 FORMAT (1H ,A13,13X,A20,7H * ,A10,1H/,
1 A13)
90019 FORMAT (1H ,26HFOR OFFICIAL USE ONLY ,35X,15HCOPYRIGHT 1982)
C****
C**** FORMAT STATEMENTS FOR RUN SUMMARY
C****
90020 FORMAT (1H ,21X,I5,13H TESTS PASSED)
90022 FORMAT (1H ,21X,I5,13H TESTS FAILED)
90024 FORMAT (1H ,21X,I5,14H TESTS DELETED)
90026 FORMAT (1H ,21X,I5,25H TESTS REQUIRE INSPECTION)
90028 FORMAT (1H ,21X,I5,4H OF ,I3,15H TESTS EXECUTED)
CBE** ********************** BBCFMT0B **********************************
C*****
C***** END OF TEST SEGMENT 192
STOP
END
*END-OF,FM822
FM823.f 481036563 170 2 100666 14666 `
*HEADER,FORTR,FM823
*FILES1,FORTR,FM823,X
C***********************************************************************
C***** FORTRAN 77
C***** FM823
C***** YDASIN - (194)
C*****
C***********************************************************************
C***** GENERAL PURPOSE ANS REF
C***** TEST INTRINSIC FUNCTION DASIN, DACOS 15.3
C***** TABLE 5
C*****
CBB** ********************** BBCCOMNT **********************************
C****
C**** 1978 FORTRAN COMPILER VALIDATION SYSTEM
C**** VERSION 2.0
C****
C****
C**** SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO
C**** GENERAL SERVICES ADMINISTRATION
C**** FEDERAL SOFTWARE TESTING CENTER
C**** 5203 LEESBURG PIKE, SUITE 1100
C**** FALLS CHURCH, VA. 22041
C****
C**** (703) 756-6153
C****
CBE** ********************** BBCCOMNT **********************************
C*****
C***** S P E C I F I C A T I O N S SEGMENT 194
DOUBLE PRECISION AVD, BVD, CVD, DVCORR
C*****
CBB** ********************** BBCINITA **********************************
C**** SPECIFICATION STATEMENTS
C****
CHARACTER ZVERS*13, ZVERSD*17, ZDATE*17, ZPROG*5, ZCOMPL*20,
1 ZNAME*20, ZTAPE*10, ZPROJ*13, REMRKS*31, ZTAPED*13
CBE** ********************** BBCINITA **********************************
CBB** ********************** BBCINITB **********************************
C**** INITIALIZE SECTION
DATA ZVERS, ZVERSD, ZDATE
1 /'VERSION 2.0 ', '82/08/02*18.33.46', '*NO DATE*TIME'/
DATA ZCOMPL, ZNAME, ZTAPE
1 /'*NONE SPECIFIED*', '*NO COMPANY NAME*', '*NO TAPE*'/
DATA ZPROJ, ZTAPED, ZPROG
1 /'*NO PROJECT*', '*NO TAPE DATE', 'XXXXX'/
DATA REMRKS /' '/
C**** THE FOLLOWING 9 COMMENT LINES (CZ01, CZ02, ...) CAN BE REPLACED
C**** FOR IDENTIFYING THE TEST ENVIRONMENT
C****
CZ01 ZVERS = 'VERSION OF THE COMPILER VALIDATION SYSTEM'
CZ02 ZVERSD = 'CREATION DATE/TIME OF THE COMPILER VALIDATION SYSTEM'
CZ03 ZPROG = 'PROGRAM NAME'
CZ04 ZDATE = 'DATE OF TEST'
CZ05 ZCOMPL = 'COMPILER IDENTIFICATION'
CZ06 ZPROJ = 'PROJECT NUMBER/IDENTIFICATION'
CZ07 ZNAME = 'NAME OF USER'
CZ08 ZTAPE = 'TAPE OWNER/ID'
CZ09 ZTAPED = 'DATE TAPE COPIED'
C
IVPASS = 0
IVFAIL = 0
IVDELE = 0
IVINSP = 0
IVTOTL = 0
IVTOTN = 0
ICZERO = 0
C
C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER.
I01 = 05
C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER.
I02 = 06
C
CX010 REPLACED BY FEXEC X-010 CONTROL CARD (CARD-READER UNIT NUMBER).
C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5
CX011 REPLACED BY FEXEC X-011 CONTROL CARD. CX011 IS FOR SYSTEMS
C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX010.
C
CX020 REPLACED BY FEXEC X-020 CONTROL CARD (PRINTER UNIT NUMBER).
C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02= 6
CX021 REPLACED BY FEXEC X-021 CONTROL CARD. CX021 IS FOR SYSTEMS
C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX020.
C
CBE** ********************** BBCINITB **********************************
NUVI = I02
IVTOTL = 12
ZPROG = 'FM823'
CBB** ********************** BBCHED0A **********************************
C****
C**** WRITE REPORT TITLE
C****
WRITE (I02, 90002)
WRITE (I02, 90006)
WRITE (I02, 90007)
WRITE (I02, 90008) ZVERS, ZVERSD
WRITE (I02, 90009) ZPROG, ZPROG
WRITE (I02, 90010) ZDATE, ZCOMPL
CBE** ********************** BBCHED0A **********************************
C*****
C***** HEADER FOR SEGMENT 194
WRITE(NUVI,19400)
19400 FORMAT(1H , / 36H YDASIN - (194) INTRINSIC FUNCTIONS//
1 52H DASIN, DACOS (DOUBLE PRECISION ARCSINE, ARCCOSINE)//
2 17H ANS REF. - 15.3)
CBB** ********************** BBCHED0B **********************************
C**** WRITE DETAIL REPORT HEADERS
C****
WRITE (I02,90004)
WRITE (I02,90004)
WRITE (I02,90013)
WRITE (I02,90014)
WRITE (I02,90015) IVTOTL
CBE** ********************** BBCHED0B **********************************
C*****
WRITE(NUVI,19401)
19401 FORMAT(1H0,8X,13HTEST OF DASIN)
C*****
CT001* TEST 1 -1.0D0 FOR PRINCIPAL VALUE AT ENDPOINTS
IVTNUM = 1
BVD = -1.0D0
AVD = DASIN(BVD)
IF (AVD + 0.1570796328D+01) 20010, 10010, 40010
40010 IF (AVD + 0.1570796326D+01) 10010, 10010, 20010
10010 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0011
20010 IVFAIL = IVFAIL + 1
DVCORR = -1.5707963267948966192D+00
WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR
0011 CONTINUE
CT002* TEST 2 +1.0D0 FOR PRINCIPAL VALUE AT ENDPOINTS
IVTNUM = 2
AVD = DASIN(1.0D0)
IF (AVD - 0.1570796326D+01) 20020, 10020, 40020
40020 IF (AVD - 0.1570796328D+01) 10020, 10020, 20020
10020 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0021
20020 IVFAIL = IVFAIL + 1
DVCORR = 1.5707963267948966192D+00
WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR
0021 CONTINUE
CT003* TEST 3 THE VALUE -DSQRT(0.5D0)
IVTNUM = 3
BVD = -(DSQRT(2.0D0) / 2.0D0)
AVD = DASIN(BVD)
IF (AVD + 0.7853981638D+00) 20030, 10030, 40030
40030 IF (AVD + 0.7853981630D+00) 10030, 10030, 20030
10030 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0031
20030 IVFAIL = IVFAIL + 1
DVCORR = -0.78539816339744830962D+00
WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR
0031 CONTINUE
CT004* TEST 4 THE VALUE 0.5D0
IVTNUM = 4
AVD = DASIN(1.0D0 / 2.0D0)
IF (AVD - 0.5235987753D+00) 20040, 10040, 40040
40040 IF (AVD - 0.5235987759D+00) 10040, 10040, 20040
10040 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0041
20040 IVFAIL = IVFAIL + 1
DVCORR = 0.52359877559829887308D+00
WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR
0041 CONTINUE
CT005* TEST 5 AN ARGUMENT OF LOW MAGNITUDE
IVTNUM = 5
AVD = DASIN(-1.0D-13)
IF (AVD + 0.1000000001D-12) 20050, 10050, 40050
40050 IF (AVD + 0.9999999995D-13) 10050, 10050, 20050
10050 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0051
20050 IVFAIL = IVFAIL + 1
DVCORR = -1.0000000000000000000D-13
WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR
0051 CONTINUE
C*****
WRITE(NUVI,19407)
19407 FORMAT(1H0,8X,13HTEST OF DACOS)
C*****
CT006* TEST 6 -1.0D0 FOR PRINCIPAL VALUE AT ENDPOINTS
IVTNUM = 6
BVD = -1.0D0
AVD = DACOS(BVD)
IF (AVD - 0.3141592652D+01) 20060, 10060, 40060
40060 IF (AVD - 0.3141592655D+01) 10060, 10060, 20060
10060 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0061
20060 IVFAIL = IVFAIL + 1
DVCORR = 3.1415926535897932384D+00
WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR
0061 CONTINUE
CT007* TEST 7 +1.0D0 TO TEST PRINCIPAL VALUE AT ENDPOINTS
IVTNUM = 7
AVD = DACOS(1.0D0)
IF (AVD + 0.5000000000D-09) 20070, 10070, 40070
40070 IF (AVD - 0.5000000000D-09) 10070, 10070, 20070
10070 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0071
20070 IVFAIL = IVFAIL + 1
DVCORR = 0.00000000000000000000D+00
WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR
0071 CONTINUE
CT008* TEST 8 THE VALUE -DSQRT(0.5D0)
IVTNUM = 8
BVD = -(DSQRT(2.0D0) / 2.0D0)
AVD = DACOS(BVD)
IF (AVD - 0.2356194489D+01) 20080, 10080, 40080
40080 IF (AVD - 0.2356194492D+01) 10080, 10080, 20080
10080 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0081
20080 IVFAIL = IVFAIL + 1
DVCORR = 2.3561944901923449288D+00
WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR
0081 CONTINUE
CT009* TEST 9 THE VALUE 0.5D0
IVTNUM = 9
AVD = DACOS(1.0D0 / 2.0D0)
IF (AVD - 0.1047197550D+01) 20090, 10090, 40090
40090 IF (AVD - 0.1047197552D+01) 10090, 10090, 20090
10090 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0091
20090 IVFAIL = IVFAIL + 1
DVCORR = 1.0471975511965977461D+00
WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR
0091 CONTINUE
CT010* TEST 10 AN ARGUMENT OF LOW MAGNITUDE
IVTNUM = 10
AVD = DACOS(-1.0D-33)
IF (AVD - 0.1570796326D+01) 20100, 10100, 40100
40100 IF (AVD - 0.1570796328D+01) 10100, 10100, 20100
10100 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0101
20100 IVFAIL = IVFAIL + 1
DVCORR = 1.5707963267948966192D+00
WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR
0101 CONTINUE
CT011* TEST 11 COMPARISON OF DASIN AND DACOS FOR RIGHT RELATIONSHIP
IVTNUM = 11
BVD = DASIN(DSQRT(3.0D0) / 3.0D0)
CVD = DACOS(DSQRT(3.0D0) / 3.0D0)
AVD = (BVD + CVD) * 2.0D0
IF (AVD - 0.3141592652D+01) 20110, 10110, 40110
40110 IF (AVD - 0.3141592655D+01) 10110, 10110, 20110
10110 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0111
20110 IVFAIL = IVFAIL + 1
DVCORR = 3.1415926535897932384D+00
WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR
0111 CONTINUE
CT012* TEST 12 COMPARISON OF DASIN AND DACOS TO TEST RELATIONSHIP
IVTNUM = 12
AVD = (DASIN(+0.25D0) + DACOS(+0.25D0)) * 2.0D0
IF (AVD - 0.3141592652D+01) 20120, 10120, 40120
40120 IF (AVD - 0.3141592655D+01) 10120, 10120, 20120
10120 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0121
20120 IVFAIL = IVFAIL + 1
DVCORR = 3.1415926535897932384D+00
WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR
0121 CONTINUE
C*****
CBB** ********************** BBCSUM0 **********************************
C**** WRITE OUT TEST SUMMARY
C****
IVTOTN = IVPASS + IVFAIL + IVDELE + IVINSP
WRITE (I02, 90004)
WRITE (I02, 90014)
WRITE (I02, 90004)
WRITE (I02, 90020) IVPASS
WRITE (I02, 90022) IVFAIL
WRITE (I02, 90024) IVDELE
WRITE (I02, 90026) IVINSP
WRITE (I02, 90028) IVTOTN, IVTOTL
CBE** ********************** BBCSUM0 **********************************
CBB** ********************** BBCFOOT0 **********************************
C**** WRITE OUT REPORT FOOTINGS
C****
WRITE (I02,90016) ZPROG, ZPROG
WRITE (I02,90018) ZPROJ, ZNAME, ZTAPE, ZTAPED
WRITE (I02,90019)
CBE** ********************** BBCFOOT0 **********************************
CBB** ********************** BBCFMT0A **********************************
C**** FORMATS FOR TEST DETAIL LINES
C****
80000 FORMAT (1H ,2X,I3,4X,7HDELETED,32X,A31)
80002 FORMAT (1H ,2X,I3,4X,7H PASS ,32X,A31)
80004 FORMAT (1H ,2X,I3,4X,7HINSPECT,32X,A31)
80008 FORMAT (1H ,2X,I3,4X,7H FAIL ,32X,A31)
80010 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,15X,10HCOMPUTED= ,
1I6,/,1H ,15X,10HCORRECT= ,I6)
80012 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
1E12.5,/,1H ,16X,10HCORRECT= ,E12.5)
80018 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
1A21,/,1H ,16X,10HCORRECT= ,A21)
80020 FORMAT (1H ,16X,10HCOMPUTED= ,A21,1X,A31)
80022 FORMAT (1H ,16X,10HCORRECT= ,A21,1X,A31)
80024 FORMAT (1H ,16X,10HCOMPUTED= ,I6,16X,A31)
80026 FORMAT (1H ,16X,10HCORRECT= ,I6,16X,A31)
80028 FORMAT (1H ,16X,10HCOMPUTED= ,E12.5,10X,A31)
80030 FORMAT (1H ,16X,10HCORRECT= ,E12.5,10X,A31)
80050 FORMAT (1H ,48X,A31)
CBE** ********************** BBCFMT0A **********************************
CBB** ********************** BBCFMAT1 **********************************
C**** FORMATS FOR TEST DETAIL LINES - FULL LANGUAGE
C****
80031 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
1D17.10,/,1H ,16X,10HCORRECT= ,D17.10)
80033 FORMAT (1H ,16X,10HCOMPUTED= ,D17.10,10X,A31)
80035 FORMAT (1H ,16X,10HCORRECT= ,D17.10,10X,A31)
80037 FORMAT (1H ,16X,10HCOMPUTED= ,1H(,E12.5,2H, ,E12.5,1H),6X,A31)
80039 FORMAT (1H ,16X,10HCORRECT= ,1H(,E12.5,2H, ,E12.5,1H),6X,A31)
80041 FORMAT (1H ,16X,10HCOMPUTED= ,1H(,F12.5,2H, ,F12.5,1H),6X,A31)
80043 FORMAT (1H ,16X,10HCORRECT= ,1H(,F12.5,2H, ,F12.5,1H),6X,A31)
80045 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
11H(,F12.5,2H, ,F12.5,1H)/,1H ,16X,10HCORRECT= ,
21H(,F12.5,2H, ,F12.5,1H))
CBE** ********************** BBCFMAT1 **********************************
CBB** ********************** BBCFMT0B **********************************
C**** FORMAT STATEMENTS FOR PAGE HEADERS
C****
90002 FORMAT (1H1)
90004 FORMAT (1H )
90006 FORMAT (1H ,20X,31HFEDERAL SOFTWARE TESTING CENTER)
90007 FORMAT (1H ,19X,34HFORTRAN COMPILER VALIDATION SYSTEM)
90008 FORMAT (1H ,21X,A13,A17)
90009 FORMAT (1H ,/,2H *,A5,6HBEGIN*,12X,15HTEST RESULTS - ,A5,/)
90010 FORMAT (1H ,8X,16HTEST DATE*TIME= ,A17,15H - COMPILER= ,A20)
90013 FORMAT (1H ,8H TEST ,10HPASS/FAIL ,6X,17HDISPLAYED RESULTS,
1 7X,7HREMARKS,24X)
90014 FORMAT (1H ,46H----------------------------------------------,
1 33H---------------------------------)
90015 FORMAT (1H ,48X,17HTHIS PROGRAM HAS ,I3,6H TESTS,/)
C****
C**** FORMAT STATEMENTS FOR REPORT FOOTINGS
C****
90016 FORMAT (1H ,/,2H *,A5,4HEND*,14X,14HEND OF TEST - ,A5,/)
90018 FORMAT (1H ,A13,13X,A20,7H * ,A10,1H/,
1 A13)
90019 FORMAT (1H ,26HFOR OFFICIAL USE ONLY ,35X,15HCOPYRIGHT 1982)
C****
C**** FORMAT STATEMENTS FOR RUN SUMMARY
C****
90020 FORMAT (1H ,21X,I5,13H TESTS PASSED)
90022 FORMAT (1H ,21X,I5,13H TESTS FAILED)
90024 FORMAT (1H ,21X,I5,14H TESTS DELETED)
90026 FORMAT (1H ,21X,I5,25H TESTS REQUIRE INSPECTION)
90028 FORMAT (1H ,21X,I5,4H OF ,I3,15H TESTS EXECUTED)
CBE** ********************** BBCFMT0B **********************************
C*****
C***** END OF TEST SEGMENT 194
STOP
END
*END-OF,FM823
FM824.f 481036567 170 2 100666 15318 `
*HEADER,FORTR,FM824
*FILES1,FORTR,FM824,X
C***********************************************************************
C***** FORTRAN 77
C***** FM824
C***** YDATAN - (196)
C*****
C***********************************************************************
C***** GENERAL PURPOSE ANS REF
C***** TEST INTRINSIC FUNCTION DATAN, DATAN2 15.3
C***** INTRINSIC FUNCTION DSQRT ASSUMED WORKING TABLE 5
C*****
CBB** ********************** BBCCOMNT **********************************
C****
C**** 1978 FORTRAN COMPILER VALIDATION SYSTEM
C**** VERSION 2.0
C****
C****
C**** SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO
C**** GENERAL SERVICES ADMINISTRATION
C**** FEDERAL SOFTWARE TESTING CENTER
C**** 5203 LEESBURG PIKE, SUITE 1100
C**** FALLS CHURCH, VA. 22041
C****
C**** (703) 756-6153
C****
CBE** ********************** BBCCOMNT **********************************
C*****
C***** S P E C I F I C A T I O N S SEGMENT 196
DOUBLE PRECISION AVD, BVD, CVD, DVCORR
C*****
CBB** ********************** BBCINITA **********************************
C**** SPECIFICATION STATEMENTS
C****
CHARACTER ZVERS*13, ZVERSD*17, ZDATE*17, ZPROG*5, ZCOMPL*20,
1 ZNAME*20, ZTAPE*10, ZPROJ*13, REMRKS*31, ZTAPED*13
CBE** ********************** BBCINITA **********************************
CBB** ********************** BBCINITB **********************************
C**** INITIALIZE SECTION
DATA ZVERS, ZVERSD, ZDATE
1 /'VERSION 2.0 ', '82/08/02*18.33.46', '*NO DATE*TIME'/
DATA ZCOMPL, ZNAME, ZTAPE
1 /'*NONE SPECIFIED*', '*NO COMPANY NAME*', '*NO TAPE*'/
DATA ZPROJ, ZTAPED, ZPROG
1 /'*NO PROJECT*', '*NO TAPE DATE', 'XXXXX'/
DATA REMRKS /' '/
C**** THE FOLLOWING 9 COMMENT LINES (CZ01, CZ02, ...) CAN BE REPLACED
C**** FOR IDENTIFYING THE TEST ENVIRONMENT
C****
CZ01 ZVERS = 'VERSION OF THE COMPILER VALIDATION SYSTEM'
CZ02 ZVERSD = 'CREATION DATE/TIME OF THE COMPILER VALIDATION SYSTEM'
CZ03 ZPROG = 'PROGRAM NAME'
CZ04 ZDATE = 'DATE OF TEST'
CZ05 ZCOMPL = 'COMPILER IDENTIFICATION'
CZ06 ZPROJ = 'PROJECT NUMBER/IDENTIFICATION'
CZ07 ZNAME = 'NAME OF USER'
CZ08 ZTAPE = 'TAPE OWNER/ID'
CZ09 ZTAPED = 'DATE TAPE COPIED'
C
IVPASS = 0
IVFAIL = 0
IVDELE = 0
IVINSP = 0
IVTOTL = 0
IVTOTN = 0
ICZERO = 0
C
C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER.
I01 = 05
C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER.
I02 = 06
C
CX010 REPLACED BY FEXEC X-010 CONTROL CARD (CARD-READER UNIT NUMBER).
C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5
CX011 REPLACED BY FEXEC X-011 CONTROL CARD. CX011 IS FOR SYSTEMS
C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX010.
C
CX020 REPLACED BY FEXEC X-020 CONTROL CARD (PRINTER UNIT NUMBER).
C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02= 6
CX021 REPLACED BY FEXEC X-021 CONTROL CARD. CX021 IS FOR SYSTEMS
C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX020.
C
CBE** ********************** BBCINITB **********************************
NUVI = I02
IVTOTL = 13
ZPROG = 'FM824'
CBB** ********************** BBCHED0A **********************************
C****
C**** WRITE REPORT TITLE
C****
WRITE (I02, 90002)
WRITE (I02, 90006)
WRITE (I02, 90007)
WRITE (I02, 90008) ZVERS, ZVERSD
WRITE (I02, 90009) ZPROG, ZPROG
WRITE (I02, 90010) ZDATE, ZCOMPL
CBE** ********************** BBCHED0A **********************************
C*****
C***** HEADER FOR SEGMENT 196
WRITE(NUVI,19600)
19600 FORMAT(1H , / 36H YDATAN - (196) INTRINSIC FUNCTIONS//
1 45H DATAN, DATAN2 (DOUBLE PRECISION ARCTANGENT)//
2 17H ANS REF. - 15.3)
CBB** ********************** BBCHED0B **********************************
C**** WRITE DETAIL REPORT HEADERS
C****
WRITE (I02,90004)
WRITE (I02,90004)
WRITE (I02,90013)
WRITE (I02,90014)
WRITE (I02,90015) IVTOTL
CBE** ********************** BBCHED0B **********************************
C*****
WRITE(NUVI,19601)
19601 FORMAT(/ 8X, 13HTEST OF DATAN)
C*****
CT001* TEST 1 LARGE ARGUMENT VALUES TO TEST SINGULARITY
IVTNUM = 1
BVD = 500.0D0
AVD = DATAN(BVD)
IF (AVD - 0.1568796328D+01) 20010, 10010, 40010
40010 IF (AVD - 0.1568796331D+01) 10010, 10010, 20010
10010 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0011
20010 IVFAIL = IVFAIL + 1
DVCORR = 1.5687963294632946155D+00
WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR
0011 CONTINUE
CT002* TEST 2 LARGE ARGUMENT VALUES TO TEST SINGULARITY
IVTNUM = 2
AVD = DATAN(-1000.0D0)
IF (AVD + 0.1569796328D+01) 20020, 10020, 40020
40020 IF (AVD + 0.1569796326D+01) 10020, 10020, 20020
10020 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0021
20020 IVFAIL = IVFAIL + 1
DVCORR = -1.5697963271282297525D+00
WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR
0021 CONTINUE
CT003* TEST 3 AN EXPRESSION PRESENTED TO DATAN
IVTNUM = 3
AVD = DATAN(100.0D0 / 100.0D0)
IF (AVD - 0.7853981630D+00) 20030, 10030, 40030
40030 IF (AVD - 0.7853981638D+00) 10030, 10030, 20030
10030 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0031
20030 IVFAIL = IVFAIL + 1
DVCORR = 0.78539816339744830962D+00
WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR
0031 CONTINUE
CT004* TEST 4 THE FUNCTION DSQRT EVALUATED AND PRESENTED
C***** AS AN ARGUMENT
IVTNUM = 4
BVD = -DSQRT(3.0D0)
AVD = DATAN(BVD)
IF (AVD + 0.1047197552D+01) 20040, 10040, 40040
40040 IF (AVD + 0.1047197550D+01) 10040, 10040, 20040
10040 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0041
20040 IVFAIL = IVFAIL + 1
DVCORR = -1.0471975511965977461D+00
WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR
0041 CONTINUE
CT005* TEST 5 AN ARGUMENT OF LOW MAGNITUDE
IVTNUM = 5
AVD = DATAN(1.0D-16)
IF (AVD - 0.9999999995D-16) 20050, 10050, 40050
40050 IF (AVD - 0.1000000001D-15) 10050, 10050, 20050
10050 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0051
20050 IVFAIL = IVFAIL + 1
DVCORR = 1.0000000000000000000D-16
WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR
0051 CONTINUE
CT006* TEST 6 AN ARGUMENT OF HIGH MAGNITUDE
IVTNUM = 6
AVD = DATAN(-2.0D+34)
IF (AVD + 0.1570796328D+01) 20060, 10060, 40060
40060 IF (AVD + 0.1570796326D+01) 10060, 10060, 20060
10060 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0061
20060 IVFAIL = IVFAIL + 1
DVCORR = -1.5707963267948966192D+00
WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR
0061 CONTINUE
C*****
WRITE(NUVI,19608)
19608 FORMAT(/ 08X, 14HTEST OF DATAN2)
CT007* TEST 7 TEST (0,POSITIVE) TO TEST DISCONTINUITY
IVTNUM = 7
BVD = 10.0D0 / 10.0D0
CVD = 0.0D0
AVD = DATAN2(CVD, BVD)
IF (AVD + 0.5000000000D-09) 20070, 10070, 40070
40070 IF (AVD - 0.5000000000D-09) 10070, 10070, 20070
10070 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0071
20070 IVFAIL = IVFAIL + 1
DVCORR = 0.00000000000000000000D+00
WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR
0071 CONTINUE
CT008* TEST 8 TEST (0,NEGATIVE) TO TEST DISCONTINUITY
IVTNUM = 8
BVD = 0.0D0
CVD = -25.0D0 / 2.0D0
AVD = DATAN2(BVD, CVD)
IF (AVD - 0.3141592652D+01) 20080, 10080, 40080
40080 IF (AVD - 0.3141592655D+01) 10080, 10080, 20080
10080 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0081
20080 IVFAIL = IVFAIL + 1
DVCORR = 3.1415926535897932384D+00
WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR
0081 CONTINUE
CT009* TEST 9 AN EXPRESSION PRESENTED TO DATAN2
IVTNUM = 9
BVD = 1.0D0
CVD = BVD + BVD
AVD = DATAN2(BVD * 2.0D0, CVD)
IF (AVD - 0.7853981630D+00) 20090, 10090, 40090
40090 IF (AVD - 0.7853981638D+00) 10090, 10090, 20090
10090 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0091
20090 IVFAIL = IVFAIL + 1
DVCORR = 0.78539816339744830962D+00
WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR
0091 CONTINUE
CT010* TEST 10 ARGUMENTS WHERE (X,Y) X IS NEAR ZERO
IVTNUM = 10
BVD = DASIN(0.6D0)
CVD = DACOS(0.8D0)
AVD = DATAN2(BVD, CVD)
IF (AVD - 0.7853981630D+00) 20100, 10100, 40100
40100 IF (AVD - 0.7853981638D+00) 10100, 10100, 20100
10100 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0101
20100 IVFAIL = IVFAIL + 1
DVCORR = 0.78539816339744830962D+00
WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR
0101 CONTINUE
CT011* TEST 11 WHERE ARGUMENT (X,Y) Y IS NEAR ZERO
IVTNUM = 11
AVD = DATAN2(1.2D0, 0.0D0)
IF (AVD - 0.1570796326D+01) 20110, 10110, 40110
40110 IF (AVD - 0.1570796328D+01) 10110, 10110, 20110
10110 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0111
20110 IVFAIL = IVFAIL + 1
DVCORR = 1.5707963267948966192D+00
WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR
0111 CONTINUE
CT012* TEST 12 WHERE ARGUMENT (X,Y) Y IS NEAR ZERO
IVTNUM = 12
BVD = -2.5D0
CVD = 0.0D0
AVD = DATAN2(BVD, CVD)
IF (AVD + 0.1570796328D+01) 20120, 10120, 40120
40120 IF (AVD + 0.1570796326D+01) 10120, 10120, 20120
10120 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0121
20120 IVFAIL = IVFAIL + 1
DVCORR = -1.5707963267948966192D+00
WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR
0121 CONTINUE
CT013* TEST 13 COMPARISON OF DATAN AND DATAN2
IVTNUM = 13
AVD = (DATAN(DSQRT(3.0D0) / 3.0D0) * 2.0D0) +
1 DATAN2(-DSQRT(3.0D0) / 2.0D0, 1.0D0 / 2.0D0)
IF (AVD + 0.5000000000D-09) 20130, 10130, 40130
40130 IF (AVD - 0.5000000000D-09) 10130, 10130, 20130
10130 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0131
20130 IVFAIL = IVFAIL + 1
DVCORR = 0.00000000000000000000D+00
WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR
0131 CONTINUE
C*****
CBB** ********************** BBCSUM0 **********************************
C**** WRITE OUT TEST SUMMARY
C****
IVTOTN = IVPASS + IVFAIL + IVDELE + IVINSP
WRITE (I02, 90004)
WRITE (I02, 90014)
WRITE (I02, 90004)
WRITE (I02, 90020) IVPASS
WRITE (I02, 90022) IVFAIL
WRITE (I02, 90024) IVDELE
WRITE (I02, 90026) IVINSP
WRITE (I02, 90028) IVTOTN, IVTOTL
CBE** ********************** BBCSUM0 **********************************
CBB** ********************** BBCFOOT0 **********************************
C**** WRITE OUT REPORT FOOTINGS
C****
WRITE (I02,90016) ZPROG, ZPROG
WRITE (I02,90018) ZPROJ, ZNAME, ZTAPE, ZTAPED
WRITE (I02,90019)
CBE** ********************** BBCFOOT0 **********************************
CBB** ********************** BBCFMT0A **********************************
C**** FORMATS FOR TEST DETAIL LINES
C****
80000 FORMAT (1H ,2X,I3,4X,7HDELETED,32X,A31)
80002 FORMAT (1H ,2X,I3,4X,7H PASS ,32X,A31)
80004 FORMAT (1H ,2X,I3,4X,7HINSPECT,32X,A31)
80008 FORMAT (1H ,2X,I3,4X,7H FAIL ,32X,A31)
80010 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,15X,10HCOMPUTED= ,
1I6,/,1H ,15X,10HCORRECT= ,I6)
80012 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
1E12.5,/,1H ,16X,10HCORRECT= ,E12.5)
80018 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
1A21,/,1H ,16X,10HCORRECT= ,A21)
80020 FORMAT (1H ,16X,10HCOMPUTED= ,A21,1X,A31)
80022 FORMAT (1H ,16X,10HCORRECT= ,A21,1X,A31)
80024 FORMAT (1H ,16X,10HCOMPUTED= ,I6,16X,A31)
80026 FORMAT (1H ,16X,10HCORRECT= ,I6,16X,A31)
80028 FORMAT (1H ,16X,10HCOMPUTED= ,E12.5,10X,A31)
80030 FORMAT (1H ,16X,10HCORRECT= ,E12.5,10X,A31)
80050 FORMAT (1H ,48X,A31)
CBE** ********************** BBCFMT0A **********************************
CBB** ********************** BBCFMAT1 **********************************
C**** FORMATS FOR TEST DETAIL LINES - FULL LANGUAGE
C****
80031 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
1D17.10,/,1H ,16X,10HCORRECT= ,D17.10)
80033 FORMAT (1H ,16X,10HCOMPUTED= ,D17.10,10X,A31)
80035 FORMAT (1H ,16X,10HCORRECT= ,D17.10,10X,A31)
80037 FORMAT (1H ,16X,10HCOMPUTED= ,1H(,E12.5,2H, ,E12.5,1H),6X,A31)
80039 FORMAT (1H ,16X,10HCORRECT= ,1H(,E12.5,2H, ,E12.5,1H),6X,A31)
80041 FORMAT (1H ,16X,10HCOMPUTED= ,1H(,F12.5,2H, ,F12.5,1H),6X,A31)
80043 FORMAT (1H ,16X,10HCORRECT= ,1H(,F12.5,2H, ,F12.5,1H),6X,A31)
80045 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
11H(,F12.5,2H, ,F12.5,1H)/,1H ,16X,10HCORRECT= ,
21H(,F12.5,2H, ,F12.5,1H))
CBE** ********************** BBCFMAT1 **********************************
CBB** ********************** BBCFMT0B **********************************
C**** FORMAT STATEMENTS FOR PAGE HEADERS
C****
90002 FORMAT (1H1)
90004 FORMAT (1H )
90006 FORMAT (1H ,20X,31HFEDERAL SOFTWARE TESTING CENTER)
90007 FORMAT (1H ,19X,34HFORTRAN COMPILER VALIDATION SYSTEM)
90008 FORMAT (1H ,21X,A13,A17)
90009 FORMAT (1H ,/,2H *,A5,6HBEGIN*,12X,15HTEST RESULTS - ,A5,/)
90010 FORMAT (1H ,8X,16HTEST DATE*TIME= ,A17,15H - COMPILER= ,A20)
90013 FORMAT (1H ,8H TEST ,10HPASS/FAIL ,6X,17HDISPLAYED RESULTS,
1 7X,7HREMARKS,24X)
90014 FORMAT (1H ,46H----------------------------------------------,
1 33H---------------------------------)
90015 FORMAT (1H ,48X,17HTHIS PROGRAM HAS ,I3,6H TESTS,/)
C****
C**** FORMAT STATEMENTS FOR REPORT FOOTINGS
C****
90016 FORMAT (1H ,/,2H *,A5,4HEND*,14X,14HEND OF TEST - ,A5,/)
90018 FORMAT (1H ,A13,13X,A20,7H * ,A10,1H/,
1 A13)
90019 FORMAT (1H ,26HFOR OFFICIAL USE ONLY ,35X,15HCOPYRIGHT 1982)
C****
C**** FORMAT STATEMENTS FOR RUN SUMMARY
C****
90020 FORMAT (1H ,21X,I5,13H TESTS PASSED)
90022 FORMAT (1H ,21X,I5,13H TESTS FAILED)
90024 FORMAT (1H ,21X,I5,14H TESTS DELETED)
90026 FORMAT (1H ,21X,I5,25H TESTS REQUIRE INSPECTION)
90028 FORMAT (1H ,21X,I5,4H OF ,I3,15H TESTS EXECUTED)
CBE** ********************** BBCFMT0B **********************************
C*****
C***** END OF TEST SEGMENT 196
STOP
END
*END-OF,FM824
FM825.f 481036573 170 2 100666 16796 `
*HEADER,FORTR,FM825
*FILES1,FORTR,FM825,X
C***********************************************************************
C***** FORTRAN 77
C***** FM825
C***** YDSINH - (198)
C*****
C***********************************************************************
C***** GENERAL PURPOSE ANS REF
C***** TEST INTRINSIC FUNCTION DSINH, DCOSH 15.3
C***** TABLE 5
CBB** ********************** BBCCOMNT **********************************
C****
C**** 1978 FORTRAN COMPILER VALIDATION SYSTEM
C**** VERSION 2.0
C****
C****
C**** SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO
C**** GENERAL SERVICES ADMINISTRATION
C**** FEDERAL SOFTWARE TESTING CENTER
C**** 5203 LEESBURG PIKE, SUITE 1100
C**** FALLS CHURCH, VA. 22041
C****
C**** (703) 756-6153
C****
CBE** ********************** BBCCOMNT **********************************
C*****
C***** S P E C I F I C A T I O N S SEGMENT 198
DOUBLE PRECISION AVD, BVD, CVD, DVCORR
C*****
CBB** ********************** BBCINITA **********************************
C**** SPECIFICATION STATEMENTS
C****
CHARACTER ZVERS*13, ZVERSD*17, ZDATE*17, ZPROG*5, ZCOMPL*20,
1 ZNAME*20, ZTAPE*10, ZPROJ*13, REMRKS*31, ZTAPED*13
CBE** ********************** BBCINITA **********************************
CBB** ********************** BBCINITB **********************************
C**** INITIALIZE SECTION
DATA ZVERS, ZVERSD, ZDATE
1 /'VERSION 2.0 ', '82/08/02*18.33.46', '*NO DATE*TIME'/
DATA ZCOMPL, ZNAME, ZTAPE
1 /'*NONE SPECIFIED*', '*NO COMPANY NAME*', '*NO TAPE*'/
DATA ZPROJ, ZTAPED, ZPROG
1 /'*NO PROJECT*', '*NO TAPE DATE', 'XXXXX'/
DATA REMRKS /' '/
C**** THE FOLLOWING 9 COMMENT LINES (CZ01, CZ02, ...) CAN BE REPLACED
C**** FOR IDENTIFYING THE TEST ENVIRONMENT
C****
CZ01 ZVERS = 'VERSION OF THE COMPILER VALIDATION SYSTEM'
CZ02 ZVERSD = 'CREATION DATE/TIME OF THE COMPILER VALIDATION SYSTEM'
CZ03 ZPROG = 'PROGRAM NAME'
CZ04 ZDATE = 'DATE OF TEST'
CZ05 ZCOMPL = 'COMPILER IDENTIFICATION'
CZ06 ZPROJ = 'PROJECT NUMBER/IDENTIFICATION'
CZ07 ZNAME = 'NAME OF USER'
CZ08 ZTAPE = 'TAPE OWNER/ID'
CZ09 ZTAPED = 'DATE TAPE COPIED'
C
IVPASS = 0
IVFAIL = 0
IVDELE = 0
IVINSP = 0
IVTOTL = 0
IVTOTN = 0
ICZERO = 0
C
C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER.
I01 = 05
C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER.
I02 = 06
C
CX010 REPLACED BY FEXEC X-010 CONTROL CARD (CARD-READER UNIT NUMBER).
C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5
CX011 REPLACED BY FEXEC X-011 CONTROL CARD. CX011 IS FOR SYSTEMS
C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX010.
C
CX020 REPLACED BY FEXEC X-020 CONTROL CARD (PRINTER UNIT NUMBER).
C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02= 6
CX021 REPLACED BY FEXEC X-021 CONTROL CARD. CX021 IS FOR SYSTEMS
C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX020.
C
CBE** ********************** BBCINITB **********************************
NUVI = I02
IVTOTL = 16
ZPROG = 'FM825'
CBB** ********************** BBCHED0A **********************************
C****
C**** WRITE REPORT TITLE
C****
WRITE (I02, 90002)
WRITE (I02, 90006)
WRITE (I02, 90007)
WRITE (I02, 90008) ZVERS, ZVERSD
WRITE (I02, 90009) ZPROG, ZPROG
WRITE (I02, 90010) ZDATE, ZCOMPL
CBE** ********************** BBCHED0A **********************************
C*****
C***** HEADER FOR SEGMENT 198
WRITE(NUVI,19800)
19800 FORMAT(1H , / 36H YDSINH - (198) INTRINSIC FUNCTIONS//
1 57H DSINH, DCOSH (DOUBLE PRECISION HYPERBOLIC SINE, COSINE)//
2 17H ANS REF. - 15.3)
CBB** ********************** BBCHED0B **********************************
C**** WRITE DETAIL REPORT HEADERS
C****
WRITE (I02,90004)
WRITE (I02,90004)
WRITE (I02,90013)
WRITE (I02,90014)
WRITE (I02,90015) IVTOTL
CBE** ********************** BBCHED0B **********************************
C*****
WRITE(NUVI,19801)
19801 FORMAT(/ 8X, 13HTEST OF DSINH)
C*****
CT001* TEST 1 TEST AT ZERO (0.0D0)
IVTNUM = 1
BVD = 0.0D0
AVD = DSINH(BVD)
IF (AVD + 0.5000000000D-09) 20010, 10010, 40010
40010 IF (AVD - 0.5000000000D-09) 10010, 10010, 20010
10010 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0011
20010 IVFAIL = IVFAIL + 1
DVCORR = 0.00000000000000000000D+00
WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR
0011 CONTINUE
CT002* TEST 2 TEST ARGUMENTS CLOSE TO 1.0D0
IVTNUM = 2
AVD = DSINH(15.0D0 / 16.0D0)
IF (AVD - 0.1080991915D+01) 20020, 10020, 40020
40020 IF (AVD - 0.1080991917D+01) 10020, 10020, 20020
10020 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0021
20020 IVFAIL = IVFAIL + 1
DVCORR = 1.0809919156930639401D+00
WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR
0021 CONTINUE
CT003* TEST 3 TEST AT 1.0D0
IVTNUM = 3
BVD = 1.0D0
AVD = DSINH(BVD)
IF (AVD - 0.1175201193D+01) 20030, 10030, 40030
40030 IF (AVD - 0.1175201195D+01) 10030, 10030, 20030
10030 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0031
20030 IVFAIL = IVFAIL + 1
DVCORR = 1.1752011936438014569D+00
WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR
0031 CONTINUE
CT004* TEST 4 TEST ARGUMENTS CLOSE TO 1.0D0
IVTNUM = 4
AVD = DSINH(33.0D0 / 32.0D0)
IF (AVD - 0.1224004187D+01) 20040, 10040, 40040
40040 IF (AVD - 0.1224004189D+01) 10040, 10040, 20040
10040 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0041
20040 IVFAIL = IVFAIL + 1
DVCORR = 1.2240041877866398138D+00
WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR
0041 CONTINUE
CT005* TEST 5 TEST AT 2.0D0
IVTNUM = 5
BVD = 2.0D0
AVD = DSINH(BVD)
IF (AVD - 0.3626860406D+01) 20050, 10050, 40050
40050 IF (AVD - 0.3626860410D+01) 10050, 10050, 20050
10050 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0051
20050 IVFAIL = IVFAIL + 1
DVCORR = 3.6268604078470187677D+00
WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR
0051 CONTINUE
CT006* TEST 6 A NEGATIVE ARGUMENT
IVTNUM = 6
AVD = DSINH(-2.0D0)
IF (AVD + 0.3626860410D+01) 20060, 10060, 40060
40060 IF (AVD + 0.3626860406D+01) 10060, 10060, 20060
10060 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0061
20060 IVFAIL = IVFAIL + 1
DVCORR = -3.6268604078470187677D+00
WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR
0061 CONTINUE
CT007* TEST 7 AN ARGUMENT OF LOW MAGNITUDE
IVTNUM = 7
AVD = DSINH(1.0D-14)
IF (AVD - 0.9999999995D-14) 20070, 10070, 40070
40070 IF (AVD - 0.1000000001D-13) 10070, 10070, 20070
10070 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0071
20070 IVFAIL = IVFAIL + 1
DVCORR = 1.0000000000000000000D-14
WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR
0071 CONTINUE
C*****
WRITE (NUVI, 90002)
WRITE (NUVI, 90013)
WRITE (NUVI, 90014)
C*****
WRITE(NUVI,19809)
19809 FORMAT(/ 08X, 13HTEST OF DCOSH)
C*****
CT008* TEST 8 TEST AT ZERO (0.0D0)
IVTNUM = 8
BVD = 0.0D0
AVD = DCOSH(BVD)
IF (AVD - 0.9999999995D+00) 20080, 10080, 40080
40080 IF (AVD - 0.1000000001D+01) 10080, 10080, 20080
10080 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0081
20080 IVFAIL = IVFAIL + 1
DVCORR = 1.0000000000000000000D+00
WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR
0081 CONTINUE
CT009* TEST 9 VALUES CLOSE TO 1.0D0
IVTNUM = 9
AVD = DCOSH(15.0D0 / 16.0D0)
IF (AVD - 0.1472597541D+01) 20090, 10090, 40090
40090 IF (AVD - 0.1472597543D+01) 10090, 10090, 20090
10090 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0091
20090 IVFAIL = IVFAIL + 1
DVCORR = 1.4725975423698629333D+00
WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR
0091 CONTINUE
CT010* TEST 10 TEST ARGUMENTS CLOSE TO 1.0D0
IVTNUM = 10
BVD = 1.0D0
AVD = DCOSH(BVD)
IF (AVD - 0.1543080634D+01) 20100, 10100, 40100
40100 IF (AVD - 0.1543080636D+01) 10100, 10100, 20100
10100 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0101
20100 IVFAIL = IVFAIL + 1
DVCORR = 1.5430806348152437785D+00
WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR
0101 CONTINUE
CT011* TEST 11 TEST ARGUMENTS CLOSE TO 1.0D0
IVTNUM = 11
AVD = DCOSH(33.0D0 / 32.0D0)
IF (AVD - 0.1580565167D+01) 20110, 10110, 40110
40110 IF (AVD - 0.1580565170D+01) 10110, 10110, 20110
10110 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0111
20110 IVFAIL = IVFAIL + 1
DVCORR = 1.5805651684505867982D+00
WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR
0111 CONTINUE
CT012* TEST 12 TEST AT 2.0D0
IVTNUM = 12
BVD = 2.0D0
AVD = DCOSH(BVD)
IF (AVD - 0.3762195689D+01) 20120, 10120, 40120
40120 IF (AVD - 0.3762195693D+01) 10120, 10120, 20120
10120 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0121
20120 IVFAIL = IVFAIL + 1
DVCORR = 3.7621956910836314596D+00
WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR
0121 CONTINUE
CT013* TEST 13 A NEGATIVE ARGUMENT
IVTNUM = 13
AVD = DCOSH(-2.0D0)
IF (AVD - 0.3762195689D+01) 20130, 10130, 40130
40130 IF (AVD - 0.3762195693D+01) 10130, 10130, 20130
10130 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0131
20130 IVFAIL = IVFAIL + 1
DVCORR = 3.7621956910836314596D+00
WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR
0131 CONTINUE
CT014* TEST 14 AN ARGUMENT OF LOW MAGNITUDE
IVTNUM = 14
AVD = DCOSH(-1.0D-14)
IF (AVD - 0.9999999995D+00) 20140, 10140, 40140
40140 IF (AVD - 0.1000000001D+01) 10140, 10140, 20140
10140 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0141
20140 IVFAIL = IVFAIL + 1
DVCORR = 1.0000000000000000000D+00
WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR
0141 CONTINUE
CT015* TEST 15 NEGATIVE VALUES SUPPLIED AS ARGUMENTS
C***** TO BOTH FUNCTIONS IN AN EXPRESSION
IVTNUM = 15
BVD = DSINH(-3.145D0) ** 2
CVD = DCOSH(-3.145D0) ** 2
AVD = CVD - BVD
IF (AVD - 0.9999999990D+00) 20150, 10150, 40150
40150 IF (AVD - 0.1000000001D+01) 10150, 10150, 20150
10150 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0151
20150 IVFAIL = IVFAIL + 1
DVCORR = 1.0000000000000000000D+00
WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR
0151 CONTINUE
CT016* TEST 16 POSITIVE VALUES SUPPLIED AS ARGUMENTS
C***** TO BOTH FUNCTIONS IN AN EXPRESSION
IVTNUM = 16
AVD = DSINH(3.25D0) + DCOSH(3.25D0)
IF (AVD - 0.2579033990D+02) 20160, 10160, 40160
40160 IF (AVD - 0.2579033993D+02) 10160, 10160, 20160
10160 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0161
20160 IVFAIL = IVFAIL + 1
DVCORR = 25.790339917193062089D+00
WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR
0161 CONTINUE
C*****
CBB** ********************** BBCSUM0 **********************************
C**** WRITE OUT TEST SUMMARY
C****
IVTOTN = IVPASS + IVFAIL + IVDELE + IVINSP
WRITE (I02, 90004)
WRITE (I02, 90014)
WRITE (I02, 90004)
WRITE (I02, 90020) IVPASS
WRITE (I02, 90022) IVFAIL
WRITE (I02, 90024) IVDELE
WRITE (I02, 90026) IVINSP
WRITE (I02, 90028) IVTOTN, IVTOTL
CBE** ********************** BBCSUM0 **********************************
CBB** ********************** BBCFOOT0 **********************************
C**** WRITE OUT REPORT FOOTINGS
C****
WRITE (I02,90016) ZPROG, ZPROG
WRITE (I02,90018) ZPROJ, ZNAME, ZTAPE, ZTAPED
WRITE (I02,90019)
CBE** ********************** BBCFOOT0 **********************************
CBB** ********************** BBCFMT0A **********************************
C**** FORMATS FOR TEST DETAIL LINES
C****
80000 FORMAT (1H ,2X,I3,4X,7HDELETED,32X,A31)
80002 FORMAT (1H ,2X,I3,4X,7H PASS ,32X,A31)
80004 FORMAT (1H ,2X,I3,4X,7HINSPECT,32X,A31)
80008 FORMAT (1H ,2X,I3,4X,7H FAIL ,32X,A31)
80010 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,15X,10HCOMPUTED= ,
1I6,/,1H ,15X,10HCORRECT= ,I6)
80012 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
1E12.5,/,1H ,16X,10HCORRECT= ,E12.5)
80018 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
1A21,/,1H ,16X,10HCORRECT= ,A21)
80020 FORMAT (1H ,16X,10HCOMPUTED= ,A21,1X,A31)
80022 FORMAT (1H ,16X,10HCORRECT= ,A21,1X,A31)
80024 FORMAT (1H ,16X,10HCOMPUTED= ,I6,16X,A31)
80026 FORMAT (1H ,16X,10HCORRECT= ,I6,16X,A31)
80028 FORMAT (1H ,16X,10HCOMPUTED= ,E12.5,10X,A31)
80030 FORMAT (1H ,16X,10HCORRECT= ,E12.5,10X,A31)
80050 FORMAT (1H ,48X,A31)
CBE** ********************** BBCFMT0A **********************************
CBB** ********************** BBCFMAT1 **********************************
C**** FORMATS FOR TEST DETAIL LINES - FULL LANGUAGE
C****
80031 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
1D17.10,/,1H ,16X,10HCORRECT= ,D17.10)
80033 FORMAT (1H ,16X,10HCOMPUTED= ,D17.10,10X,A31)
80035 FORMAT (1H ,16X,10HCORRECT= ,D17.10,10X,A31)
80037 FORMAT (1H ,16X,10HCOMPUTED= ,1H(,E12.5,2H, ,E12.5,1H),6X,A31)
80039 FORMAT (1H ,16X,10HCORRECT= ,1H(,E12.5,2H, ,E12.5,1H),6X,A31)
80041 FORMAT (1H ,16X,10HCOMPUTED= ,1H(,F12.5,2H, ,F12.5,1H),6X,A31)
80043 FORMAT (1H ,16X,10HCORRECT= ,1H(,F12.5,2H, ,F12.5,1H),6X,A31)
80045 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
11H(,F12.5,2H, ,F12.5,1H)/,1H ,16X,10HCORRECT= ,
21H(,F12.5,2H, ,F12.5,1H))
CBE** ********************** BBCFMAT1 **********************************
CBB** ********************** BBCFMT0B **********************************
C**** FORMAT STATEMENTS FOR PAGE HEADERS
C****
90002 FORMAT (1H1)
90004 FORMAT (1H )
90006 FORMAT (1H ,20X,31HFEDERAL SOFTWARE TESTING CENTER)
90007 FORMAT (1H ,19X,34HFORTRAN COMPILER VALIDATION SYSTEM)
90008 FORMAT (1H ,21X,A13,A17)
90009 FORMAT (1H ,/,2H *,A5,6HBEGIN*,12X,15HTEST RESULTS - ,A5,/)
90010 FORMAT (1H ,8X,16HTEST DATE*TIME= ,A17,15H - COMPILER= ,A20)
90013 FORMAT (1H ,8H TEST ,10HPASS/FAIL ,6X,17HDISPLAYED RESULTS,
1 7X,7HREMARKS,24X)
90014 FORMAT (1H ,46H----------------------------------------------,
1 33H---------------------------------)
90015 FORMAT (1H ,48X,17HTHIS PROGRAM HAS ,I3,6H TESTS,/)
C****
C**** FORMAT STATEMENTS FOR REPORT FOOTINGS
C****
90016 FORMAT (1H ,/,2H *,A5,4HEND*,14X,14HEND OF TEST - ,A5,/)
90018 FORMAT (1H ,A13,13X,A20,7H * ,A10,1H/,
1 A13)
90019 FORMAT (1H ,26HFOR OFFICIAL USE ONLY ,35X,15HCOPYRIGHT 1982)
C****
C**** FORMAT STATEMENTS FOR RUN SUMMARY
C****
90020 FORMAT (1H ,21X,I5,13H TESTS PASSED)
90022 FORMAT (1H ,21X,I5,13H TESTS FAILED)
90024 FORMAT (1H ,21X,I5,14H TESTS DELETED)
90026 FORMAT (1H ,21X,I5,25H TESTS REQUIRE INSPECTION)
90028 FORMAT (1H ,21X,I5,4H OF ,I3,15H TESTS EXECUTED)
CBE** ********************** BBCFMT0B **********************************
C*****
C***** END OF TEST SEGMENT 198
STOP
END
*END-OF,FM825
FM826.f 481036577 170 2 100666 12936 `
*HEADER,FORTR,FM826
*FILES1,FORTR,FM826,X
C***********************************************************************
C***** FORTRAN 77
C***** FM826
C***** YDTANH - (200)
C*****
C***********************************************************************
C***** GENERAL PURPOSE ANS REF
C***** TEST INTRINSIC FUNCTION DTANH 15.3
C***** TABLE 5
C*****
CBB** ********************** BBCCOMNT **********************************
C****
C**** 1978 FORTRAN COMPILER VALIDATION SYSTEM
C**** VERSION 2.0
C****
C****
C**** SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO
C**** GENERAL SERVICES ADMINISTRATION
C**** FEDERAL SOFTWARE TESTING CENTER
C**** 5203 LEESBURG PIKE, SUITE 1100
C**** FALLS CHURCH, VA. 22041
C****
C**** (703) 756-6153
C****
CBE** ********************** BBCCOMNT **********************************
C*****
C***** S P E C I F I C A T I O N S SEGMENT 200
DOUBLE PRECISION AVD, BVD, DVCORR
C*****
CBB** ********************** BBCINITA **********************************
C**** SPECIFICATION STATEMENTS
C****
CHARACTER ZVERS*13, ZVERSD*17, ZDATE*17, ZPROG*5, ZCOMPL*20,
1 ZNAME*20, ZTAPE*10, ZPROJ*13, REMRKS*31, ZTAPED*13
CBE** ********************** BBCINITA **********************************
CBB** ********************** BBCINITB **********************************
C**** INITIALIZE SECTION
DATA ZVERS, ZVERSD, ZDATE
1 /'VERSION 2.0 ', '82/08/02*18.33.46', '*NO DATE*TIME'/
DATA ZCOMPL, ZNAME, ZTAPE
1 /'*NONE SPECIFIED*', '*NO COMPANY NAME*', '*NO TAPE*'/
DATA ZPROJ, ZTAPED, ZPROG
1 /'*NO PROJECT*', '*NO TAPE DATE', 'XXXXX'/
DATA REMRKS /' '/
C**** THE FOLLOWING 9 COMMENT LINES (CZ01, CZ02, ...) CAN BE REPLACED
C**** FOR IDENTIFYING THE TEST ENVIRONMENT
C****
CZ01 ZVERS = 'VERSION OF THE COMPILER VALIDATION SYSTEM'
CZ02 ZVERSD = 'CREATION DATE/TIME OF THE COMPILER VALIDATION SYSTEM'
CZ03 ZPROG = 'PROGRAM NAME'
CZ04 ZDATE = 'DATE OF TEST'
CZ05 ZCOMPL = 'COMPILER IDENTIFICATION'
CZ06 ZPROJ = 'PROJECT NUMBER/IDENTIFICATION'
CZ07 ZNAME = 'NAME OF USER'
CZ08 ZTAPE = 'TAPE OWNER/ID'
CZ09 ZTAPED = 'DATE TAPE COPIED'
C
IVPASS = 0
IVFAIL = 0
IVDELE = 0
IVINSP = 0
IVTOTL = 0
IVTOTN = 0
ICZERO = 0
C
C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER.
I01 = 05
C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER.
I02 = 06
C
CX010 REPLACED BY FEXEC X-010 CONTROL CARD (CARD-READER UNIT NUMBER).
C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5
CX011 REPLACED BY FEXEC X-011 CONTROL CARD. CX011 IS FOR SYSTEMS
C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX010.
C
CX020 REPLACED BY FEXEC X-020 CONTROL CARD (PRINTER UNIT NUMBER).
C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02= 6
CX021 REPLACED BY FEXEC X-021 CONTROL CARD. CX021 IS FOR SYSTEMS
C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX020.
C
CBE** ********************** BBCINITB **********************************
NUVI = I02
IVTOTL = 9
ZPROG = 'FM826'
CBB** ********************** BBCHED0A **********************************
C****
C**** WRITE REPORT TITLE
C****
WRITE (I02, 90002)
WRITE (I02, 90006)
WRITE (I02, 90007)
WRITE (I02, 90008) ZVERS, ZVERSD
WRITE (I02, 90009) ZPROG, ZPROG
WRITE (I02, 90010) ZDATE, ZCOMPL
CBE** ********************** BBCHED0A **********************************
C*****
C***** HEADER FOR SEGMENT 200
WRITE(NUVI,20000)
20000 FORMAT(1H , / 36H YDTANH - (200) INTRINSIC FUNCTIONS//
1 46H DTANH (DOUBLE PRECISION HYPERBOLIC TANGENT)//
2 17H ANS REF. - 15.3)
CBB** ********************** BBCHED0B **********************************
C**** WRITE DETAIL REPORT HEADERS
C****
WRITE (I02,90004)
WRITE (I02,90004)
WRITE (I02,90013)
WRITE (I02,90014)
WRITE (I02,90015) IVTOTL
CBE** ********************** BBCHED0B **********************************
C*****
CT001* TEST 1 TEST AT ZERO (0.0)
IVTNUM = 1
BVD = 0.0D0
AVD = DTANH(BVD)
IF (AVD + 0.5000000000D-09) 20010, 10010, 40010
40010 IF (AVD - 0.5000000000D-09) 10010, 10010, 20010
10010 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0011
20010 IVFAIL = IVFAIL + 1
DVCORR = 0.00000000000000000000D+00
WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR
0011 CONTINUE
CT002* TEST 2 A NEGATIVE ARGUMENT
IVTNUM = 2
AVD = DTANH(-2.5D0)
IF (AVD + 0.9866142987D+00) 20020, 10020, 40020
40020 IF (AVD + 0.9866142976D+00) 10020, 10020, 20020
10020 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0021
20020 IVFAIL = IVFAIL + 1
DVCORR = -0.98661429815143028888D+00
WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR
0021 CONTINUE
CT003* TEST 3 A VARIABLE SUPPLIED AS AN ARGUMENT
IVTNUM = 3
BVD = 4.75D0
AVD = DTANH(BVD)
IF (AVD - 0.9998503070D+00) 20030, 10030, 40030
40030 IF (AVD - 0.9998503081D+00) 10030, 10030, 20030
10030 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0031
20030 IVFAIL = IVFAIL + 1
DVCORR = 0.99985030754497877538D+00
WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR
0031 CONTINUE
CT004* TEST 4 A POSITIVE REAL NUMBER SUPPLIED AS AN ARGUMENT
IVTNUM = 4
AVD = DTANH(15.125D0)
IF (AVD - 0.9999999995D+00) 20040, 10040, 40040
40040 IF (AVD - 0.1000000001D+01) 10040, 10040, 20040
10040 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0041
20040 IVFAIL = IVFAIL + 1
DVCORR = 0.99999999999985424552D+00
WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR
0041 CONTINUE
CT005* TEST 5 TEST WITH LARGE VALUES
IVTNUM = 5
BVD = 10.0D0 ** 2
AVD = DTANH(BVD)
IF (AVD - 0.9999999995D+00) 20050, 10050, 40050
40050 IF (AVD - 0.1000000001D+01) 10050, 10050, 20050
10050 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0051
20050 IVFAIL = IVFAIL + 1
DVCORR = 1.0000000000000000000D+00
WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR
0051 CONTINUE
CT006* TEST 6 TEST WITH LARGE VALUES
IVTNUM = 6
BVD = -100.0D0 * 10.0D0
AVD = DTANH(BVD)
IF (AVD + 0.1000000001D+01) 20060, 10060, 40060
40060 IF (AVD + 0.9999999995D+00) 10060, 10060, 20060
10060 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0061
20060 IVFAIL = IVFAIL + 1
DVCORR = -1.0000000000000000000D+00
WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR
0061 CONTINUE
CT007* TEST 7 AN ARGUMENT OF HIGH MAGNITUDE
IVTNUM = 7
BVD = 3.0D+36
AVD = DTANH(BVD)
IF (AVD - 0.9999999995D+00) 20070, 10070, 40070
40070 IF (AVD - 0.1000000001D+01) 10070, 10070, 20070
10070 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0071
20070 IVFAIL = IVFAIL + 1
DVCORR = 1.0000000000000000000D+00
WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR
0071 CONTINUE
CT008* TEST 8 AN ARGUMENT OF LOW MAGNITUDE
IVTNUM = 8
BVD = -1.0D-15
AVD = DTANH(BVD)
IF (AVD + 0.1000000001D-14) 20080, 10080, 40080
40080 IF (AVD + 0.9999999995D-15) 10080, 10080, 20080
10080 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0081
20080 IVFAIL = IVFAIL + 1
DVCORR = -1.0000000000000000000D-15
WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR
0081 CONTINUE
CT009* TEST 9 THE FUNCTION APPLIED TWICE
IVTNUM = 9
AVD = DTANH(0.5D0) * DTANH(0.75D0)
IF (AVD - 0.2935132281D+00) 20090, 10090, 40090
40090 IF (AVD - 0.2935132285D+00) 10090, 10090, 20090
10090 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0091
20090 IVFAIL = IVFAIL + 1
DVCORR = 0.293513228313886504621D+00
WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR
0091 CONTINUE
C*****
CBB** ********************** BBCSUM0 **********************************
C**** WRITE OUT TEST SUMMARY
C****
IVTOTN = IVPASS + IVFAIL + IVDELE + IVINSP
WRITE (I02, 90004)
WRITE (I02, 90014)
WRITE (I02, 90004)
WRITE (I02, 90020) IVPASS
WRITE (I02, 90022) IVFAIL
WRITE (I02, 90024) IVDELE
WRITE (I02, 90026) IVINSP
WRITE (I02, 90028) IVTOTN, IVTOTL
CBE** ********************** BBCSUM0 **********************************
CBB** ********************** BBCFOOT0 **********************************
C**** WRITE OUT REPORT FOOTINGS
C****
WRITE (I02,90016) ZPROG, ZPROG
WRITE (I02,90018) ZPROJ, ZNAME, ZTAPE, ZTAPED
WRITE (I02,90019)
CBE** ********************** BBCFOOT0 **********************************
CBB** ********************** BBCFMT0A **********************************
C**** FORMATS FOR TEST DETAIL LINES
C****
80000 FORMAT (1H ,2X,I3,4X,7HDELETED,32X,A31)
80002 FORMAT (1H ,2X,I3,4X,7H PASS ,32X,A31)
80004 FORMAT (1H ,2X,I3,4X,7HINSPECT,32X,A31)
80008 FORMAT (1H ,2X,I3,4X,7H FAIL ,32X,A31)
80010 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,15X,10HCOMPUTED= ,
1I6,/,1H ,15X,10HCORRECT= ,I6)
80012 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
1E12.5,/,1H ,16X,10HCORRECT= ,E12.5)
80018 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
1A21,/,1H ,16X,10HCORRECT= ,A21)
80020 FORMAT (1H ,16X,10HCOMPUTED= ,A21,1X,A31)
80022 FORMAT (1H ,16X,10HCORRECT= ,A21,1X,A31)
80024 FORMAT (1H ,16X,10HCOMPUTED= ,I6,16X,A31)
80026 FORMAT (1H ,16X,10HCORRECT= ,I6,16X,A31)
80028 FORMAT (1H ,16X,10HCOMPUTED= ,E12.5,10X,A31)
80030 FORMAT (1H ,16X,10HCORRECT= ,E12.5,10X,A31)
80050 FORMAT (1H ,48X,A31)
CBE** ********************** BBCFMT0A **********************************
CBB** ********************** BBCFMAT1 **********************************
C**** FORMATS FOR TEST DETAIL LINES - FULL LANGUAGE
C****
80031 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
1D17.10,/,1H ,16X,10HCORRECT= ,D17.10)
80033 FORMAT (1H ,16X,10HCOMPUTED= ,D17.10,10X,A31)
80035 FORMAT (1H ,16X,10HCORRECT= ,D17.10,10X,A31)
80037 FORMAT (1H ,16X,10HCOMPUTED= ,1H(,E12.5,2H, ,E12.5,1H),6X,A31)
80039 FORMAT (1H ,16X,10HCORRECT= ,1H(,E12.5,2H, ,E12.5,1H),6X,A31)
80041 FORMAT (1H ,16X,10HCOMPUTED= ,1H(,F12.5,2H, ,F12.5,1H),6X,A31)
80043 FORMAT (1H ,16X,10HCORRECT= ,1H(,F12.5,2H, ,F12.5,1H),6X,A31)
80045 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
11H(,F12.5,2H, ,F12.5,1H)/,1H ,16X,10HCORRECT= ,
21H(,F12.5,2H, ,F12.5,1H))
CBE** ********************** BBCFMAT1 **********************************
CBB** ********************** BBCFMT0B **********************************
C**** FORMAT STATEMENTS FOR PAGE HEADERS
C****
90002 FORMAT (1H1)
90004 FORMAT (1H )
90006 FORMAT (1H ,20X,31HFEDERAL SOFTWARE TESTING CENTER)
90007 FORMAT (1H ,19X,34HFORTRAN COMPILER VALIDATION SYSTEM)
90008 FORMAT (1H ,21X,A13,A17)
90009 FORMAT (1H ,/,2H *,A5,6HBEGIN*,12X,15HTEST RESULTS - ,A5,/)
90010 FORMAT (1H ,8X,16HTEST DATE*TIME= ,A17,15H - COMPILER= ,A20)
90013 FORMAT (1H ,8H TEST ,10HPASS/FAIL ,6X,17HDISPLAYED RESULTS,
1 7X,7HREMARKS,24X)
90014 FORMAT (1H ,46H----------------------------------------------,
1 33H---------------------------------)
90015 FORMAT (1H ,48X,17HTHIS PROGRAM HAS ,I3,6H TESTS,/)
C****
C**** FORMAT STATEMENTS FOR REPORT FOOTINGS
C****
90016 FORMAT (1H ,/,2H *,A5,4HEND*,14X,14HEND OF TEST - ,A5,/)
90018 FORMAT (1H ,A13,13X,A20,7H * ,A10,1H/,
1 A13)
90019 FORMAT (1H ,26HFOR OFFICIAL USE ONLY ,35X,15HCOPYRIGHT 1982)
C****
C**** FORMAT STATEMENTS FOR RUN SUMMARY
C****
90020 FORMAT (1H ,21X,I5,13H TESTS PASSED)
90022 FORMAT (1H ,21X,I5,13H TESTS FAILED)
90024 FORMAT (1H ,21X,I5,14H TESTS DELETED)
90026 FORMAT (1H ,21X,I5,25H TESTS REQUIRE INSPECTION)
90028 FORMAT (1H ,21X,I5,4H OF ,I3,15H TESTS EXECUTED)
CBE** ********************** BBCFMT0B **********************************
C*****
C***** END OF TEST SEGMENT 200
STOP
END
*END-OF,FM826
FM827.f 481036580 170 2 100666 13885 `
*HEADER,FORTR,FM827
*FILES1,FORTR,FM827,X
C***********************************************************************
C***** FORTRAN 77
C***** FM827
C***** YDFOR - (202)
C*****
C***********************************************************************
C***** GENERAL PURPOSE ANS REF
C***** TEST DOUBLE PRECISION TRIGONOMETRIC FORMULA 15.3
C***** TABLE 5
CBB** ********************** BBCCOMNT **********************************
C****
C**** 1978 FORTRAN COMPILER VALIDATION SYSTEM
C**** VERSION 2.0
C****
C****
C**** SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO
C**** GENERAL SERVICES ADMINISTRATION
C**** FEDERAL SOFTWARE TESTING CENTER
C**** 5203 LEESBURG PIKE, SUITE 1100
C**** FALLS CHURCH, VA. 22041
C****
C**** (703) 756-6153
C****
CBE** ********************** BBCCOMNT **********************************
C*****
C***** S P E C I F I C A T I O N S SEGMENT 202
DOUBLE PRECISION AVD, BVD, CVD, DVD, PIVD, DVCORR
C*****
CBB** ********************** BBCINITA **********************************
C**** SPECIFICATION STATEMENTS
C****
CHARACTER ZVERS*13, ZVERSD*17, ZDATE*17, ZPROG*5, ZCOMPL*20,
1 ZNAME*20, ZTAPE*10, ZPROJ*13, REMRKS*31, ZTAPED*13
CBE** ********************** BBCINITA **********************************
CBB** ********************** BBCINITB **********************************
C**** INITIALIZE SECTION
DATA ZVERS, ZVERSD, ZDATE
1 /'VERSION 2.0 ', '82/08/02*18.33.46', '*NO DATE*TIME'/
DATA ZCOMPL, ZNAME, ZTAPE
1 /'*NONE SPECIFIED*', '*NO COMPANY NAME*', '*NO TAPE*'/
DATA ZPROJ, ZTAPED, ZPROG
1 /'*NO PROJECT*', '*NO TAPE DATE', 'XXXXX'/
DATA REMRKS /' '/
C**** THE FOLLOWING 9 COMMENT LINES (CZ01, CZ02, ...) CAN BE REPLACED
C**** FOR IDENTIFYING THE TEST ENVIRONMENT
C****
CZ01 ZVERS = 'VERSION OF THE COMPILER VALIDATION SYSTEM'
CZ02 ZVERSD = 'CREATION DATE/TIME OF THE COMPILER VALIDATION SYSTEM'
CZ03 ZPROG = 'PROGRAM NAME'
CZ04 ZDATE = 'DATE OF TEST'
CZ05 ZCOMPL = 'COMPILER IDENTIFICATION'
CZ06 ZPROJ = 'PROJECT NUMBER/IDENTIFICATION'
CZ07 ZNAME = 'NAME OF USER'
CZ08 ZTAPE = 'TAPE OWNER/ID'
CZ09 ZTAPED = 'DATE TAPE COPIED'
C
IVPASS = 0
IVFAIL = 0
IVDELE = 0
IVINSP = 0
IVTOTL = 0
IVTOTN = 0
ICZERO = 0
C
C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER.
I01 = 05
C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER.
I02 = 06
C
CX010 REPLACED BY FEXEC X-010 CONTROL CARD (CARD-READER UNIT NUMBER).
C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5
CX011 REPLACED BY FEXEC X-011 CONTROL CARD. CX011 IS FOR SYSTEMS
C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX010.
C
CX020 REPLACED BY FEXEC X-020 CONTROL CARD (PRINTER UNIT NUMBER).
C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02= 6
CX021 REPLACED BY FEXEC X-021 CONTROL CARD. CX021 IS FOR SYSTEMS
C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX020.
C
CBE** ********************** BBCINITB **********************************
NUVI = I02
IVTOTL = 10
ZPROG = 'FM827'
CBB** ********************** BBCHED0A **********************************
C****
C**** WRITE REPORT TITLE
C****
WRITE (I02, 90002)
WRITE (I02, 90006)
WRITE (I02, 90007)
WRITE (I02, 90008) ZVERS, ZVERSD
WRITE (I02, 90009) ZPROG, ZPROG
WRITE (I02, 90010) ZDATE, ZCOMPL
CBE** ********************** BBCHED0A **********************************
C*****
C***** HEADER FOR SEGMENT 202
WRITE(NUVI,20200)
20200 FORMAT(1H , / 35H YDFOR - (202) INTRINSIC FUNCTIONS//
1 41H DOUBLE PRECISION TRIGONOMETRIC FORMULAE//
2 17H ANS REF. - 15.3)
CBB** ********************** BBCHED0B **********************************
C**** WRITE DETAIL REPORT HEADERS
C****
WRITE (I02,90004)
WRITE (I02,90004)
WRITE (I02,90013)
WRITE (I02,90014)
WRITE (I02,90015) IVTOTL
CBE** ********************** BBCHED0B **********************************
C*****
PIVD = 3.1415926535897932384626434D0
C*****
CT001* TEST 1 LN(EXP(X)) = X
IVTNUM = 1
BVD = 17.5D0
AVD = DLOG(DEXP(1.75D0)) - BVD / 10.0D0
IF (AVD + 0.5000000000D-09) 20010, 10010, 40010
40010 IF (AVD - 0.5000000000D-09) 10010, 10010, 20010
10010 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0011
20010 IVFAIL = IVFAIL + 1
DVCORR = 0.0D+00
WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR
0011 CONTINUE
CT002* TEST 2 SIN**2 + COS**2 = 1
IVTNUM = 2
BVD = 10.0D0 / 4.0D0
CVD = DSIN(BVD) ** 2
DVD = DCOS(BVD) ** 2
AVD = CVD + DVD - 1.0D0
IF (AVD + 0.5000000000D-09) 20020, 10020, 40020
40020 IF (AVD - 0.5000000000D-09) 10020, 10020, 20020
10020 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0021
20020 IVFAIL = IVFAIL + 1
DVCORR = 0.0D+00
WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR
0021 CONTINUE
CT003* TEST 3 SIN(2X) = 2*SIN(X)*COS(X)
IVTNUM = 3
BVD = 8.5D0
CVD = BVD * (-0.5D0)
AVD = (DSIN(-4.25D0) * DCOS(CVD)) * 2.0D0 - DSIN(-8.5D0)
IF (AVD + 0.5000000000D-09) 20030, 10030, 40030
40030 IF (AVD - 0.5000000000D-09) 10030, 10030, 20030
10030 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0031
20030 IVFAIL = IVFAIL + 1
DVCORR = 0.0D+00
WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR
0031 CONTINUE
CT004* TEST 4 ARCSIN(X) = ARCCOS(1 - X**2)
IVTNUM = 4
AVD = DASIN(-0.875D0) + DACOS(DSQRT(1.0D0 - (0.875D0) ** 2))
IF (AVD + 0.5000000000D-09) 20040, 10040, 40040
40040 IF (AVD - 0.5000000000D-09) 10040, 10040, 20040
10040 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0041
20040 IVFAIL = IVFAIL + 1
DVCORR = 0.0D+00
WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR
0041 CONTINUE
CT005* TEST 5 TAN(X)**2 - 1 = -COS(2X)/COS(X)**2
IVTNUM = 5
BVD = 7.0D0
AVD = DCOS(1.75D0) / DCOS(BVD / 8.0D0) ** 2
1 + DTAN(0.875D0) ** 2 - 1.0D0
IF (AVD + 0.5000000000D-09) 20050, 10050, 40050
40050 IF (AVD - 0.5000000000D-09) 10050, 10050, 20050
10050 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0051
20050 IVFAIL = IVFAIL + 1
DVCORR = 0.0D+00
WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR
0051 CONTINUE
CT006* TEST 6 ATAN(X/Y) = ATAN2(X,Y), Y>0
IVTNUM = 6
BVD = 12.0D0
CVD = DATAN2(BVD / 4.0D0, BVD / 3.0D0)
AVD = CVD - DATAN(0.75D0)
IF (AVD + 0.5000000000D-09) 20060, 10060, 40060
40060 IF (AVD - 0.5000000000D-09) 10060, 10060, 20060
10060 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0061
20060 IVFAIL = IVFAIL + 1
DVCORR = 0.0D+00
WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR
0061 CONTINUE
CT007* TEST 7 SQRT(X)**2 = X
IVTNUM = 7
AVD = DSQRT(9.125D0) ** 2 - 9.125D0
IF (AVD + 0.5000000000D-09) 20070, 10070, 40070
40070 IF (AVD - 0.5000000000D-09) 10070, 10070, 20070
10070 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0071
20070 IVFAIL = IVFAIL + 1
DVCORR = 0.0D+00
WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR
0071 CONTINUE
CT008* TEST 8 LN(X) = LN(10) * LOG10(X)
IVTNUM = 8
BVD = 62.5D0 / 1000.0D0
AVD = DLOG10(BVD) * DLOG(10.0D0) - DLOG(0.0625D0)
IF (AVD + 0.5000000000D-09) 20080, 10080, 40080
40080 IF (AVD - 0.5000000000D-09) 10080, 10080, 20080
10080 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0081
20080 IVFAIL = IVFAIL + 1
DVCORR = 0.0D+00
WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR
0081 CONTINUE
CT009* TEST 9 COSH**2 - SINH**2 = 1
IVTNUM = 9
BVD = 0.125D0
CVD = DSINH(2.125D0)
DVD = DCOSH(2.0D0 + BVD)
AVD = DVD ** 2 - CVD ** 2 - DCOSH(0.0D0)
IF (AVD + 0.5000000000D-09) 20090, 10090, 40090
40090 IF (AVD - 0.5000000000D-09) 10090, 10090, 20090
10090 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0091
20090 IVFAIL = IVFAIL + 1
DVCORR = 0.0D+00
WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR
0091 CONTINUE
CT010* TEST 10 TANH(X) = 1 - 2/(EXP(2X)+1)
IVTNUM = 10
BVD = 5.0D0
CVD = 2.0D0
DVD = DLOG10(BVD * CVD) - DSQRT(4.0D0) /
1 (DEXP(2.0D0 * (BVD - CVD)) + DCOS(0.0D0))
AVD = DVD - DTANH(3.0D0)
IF (AVD + 0.5000000000D-09) 20100, 10100, 40100
40100 IF (AVD - 0.5000000000D-09) 10100, 10100, 20100
10100 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0101
20100 IVFAIL = IVFAIL + 1
DVCORR = 0.0D+00
WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR
0101 CONTINUE
C*****
CBB** ********************** BBCSUM0 **********************************
C**** WRITE OUT TEST SUMMARY
C****
IVTOTN = IVPASS + IVFAIL + IVDELE + IVINSP
WRITE (I02, 90004)
WRITE (I02, 90014)
WRITE (I02, 90004)
WRITE (I02, 90020) IVPASS
WRITE (I02, 90022) IVFAIL
WRITE (I02, 90024) IVDELE
WRITE (I02, 90026) IVINSP
WRITE (I02, 90028) IVTOTN, IVTOTL
CBE** ********************** BBCSUM0 **********************************
CBB** ********************** BBCFOOT0 **********************************
C**** WRITE OUT REPORT FOOTINGS
C****
WRITE (I02,90016) ZPROG, ZPROG
WRITE (I02,90018) ZPROJ, ZNAME, ZTAPE, ZTAPED
WRITE (I02,90019)
CBE** ********************** BBCFOOT0 **********************************
CBB** ********************** BBCFMT0A **********************************
C**** FORMATS FOR TEST DETAIL LINES
C****
80000 FORMAT (1H ,2X,I3,4X,7HDELETED,32X,A31)
80002 FORMAT (1H ,2X,I3,4X,7H PASS ,32X,A31)
80004 FORMAT (1H ,2X,I3,4X,7HINSPECT,32X,A31)
80008 FORMAT (1H ,2X,I3,4X,7H FAIL ,32X,A31)
80010 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,15X,10HCOMPUTED= ,
1I6,/,1H ,15X,10HCORRECT= ,I6)
80012 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
1E12.5,/,1H ,16X,10HCORRECT= ,E12.5)
80018 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
1A21,/,1H ,16X,10HCORRECT= ,A21)
80020 FORMAT (1H ,16X,10HCOMPUTED= ,A21,1X,A31)
80022 FORMAT (1H ,16X,10HCORRECT= ,A21,1X,A31)
80024 FORMAT (1H ,16X,10HCOMPUTED= ,I6,16X,A31)
80026 FORMAT (1H ,16X,10HCORRECT= ,I6,16X,A31)
80028 FORMAT (1H ,16X,10HCOMPUTED= ,E12.5,10X,A31)
80030 FORMAT (1H ,16X,10HCORRECT= ,E12.5,10X,A31)
80050 FORMAT (1H ,48X,A31)
CBE** ********************** BBCFMT0A **********************************
CBB** ********************** BBCFMAT1 **********************************
C**** FORMATS FOR TEST DETAIL LINES - FULL LANGUAGE
C****
80031 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
1D17.10,/,1H ,16X,10HCORRECT= ,D17.10)
80033 FORMAT (1H ,16X,10HCOMPUTED= ,D17.10,10X,A31)
80035 FORMAT (1H ,16X,10HCORRECT= ,D17.10,10X,A31)
80037 FORMAT (1H ,16X,10HCOMPUTED= ,1H(,E12.5,2H, ,E12.5,1H),6X,A31)
80039 FORMAT (1H ,16X,10HCORRECT= ,1H(,E12.5,2H, ,E12.5,1H),6X,A31)
80041 FORMAT (1H ,16X,10HCOMPUTED= ,1H(,F12.5,2H, ,F12.5,1H),6X,A31)
80043 FORMAT (1H ,16X,10HCORRECT= ,1H(,F12.5,2H, ,F12.5,1H),6X,A31)
80045 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
11H(,F12.5,2H, ,F12.5,1H)/,1H ,16X,10HCORRECT= ,
21H(,F12.5,2H, ,F12.5,1H))
CBE** ********************** BBCFMAT1 **********************************
CBB** ********************** BBCFMT0B **********************************
C**** FORMAT STATEMENTS FOR PAGE HEADERS
C****
90002 FORMAT (1H1)
90004 FORMAT (1H )
90006 FORMAT (1H ,20X,31HFEDERAL SOFTWARE TESTING CENTER)
90007 FORMAT (1H ,19X,34HFORTRAN COMPILER VALIDATION SYSTEM)
90008 FORMAT (1H ,21X,A13,A17)
90009 FORMAT (1H ,/,2H *,A5,6HBEGIN*,12X,15HTEST RESULTS - ,A5,/)
90010 FORMAT (1H ,8X,16HTEST DATE*TIME= ,A17,15H - COMPILER= ,A20)
90013 FORMAT (1H ,8H TEST ,10HPASS/FAIL ,6X,17HDISPLAYED RESULTS,
1 7X,7HREMARKS,24X)
90014 FORMAT (1H ,46H----------------------------------------------,
1 33H---------------------------------)
90015 FORMAT (1H ,48X,17HTHIS PROGRAM HAS ,I3,6H TESTS,/)
C****
C**** FORMAT STATEMENTS FOR REPORT FOOTINGS
C****
90016 FORMAT (1H ,/,2H *,A5,4HEND*,14X,14HEND OF TEST - ,A5,/)
90018 FORMAT (1H ,A13,13X,A20,7H * ,A10,1H/,
1 A13)
90019 FORMAT (1H ,26HFOR OFFICIAL USE ONLY ,35X,15HCOPYRIGHT 1982)
C****
C**** FORMAT STATEMENTS FOR RUN SUMMARY
C****
90020 FORMAT (1H ,21X,I5,13H TESTS PASSED)
90022 FORMAT (1H ,21X,I5,13H TESTS FAILED)
90024 FORMAT (1H ,21X,I5,14H TESTS DELETED)
90026 FORMAT (1H ,21X,I5,25H TESTS REQUIRE INSPECTION)
90028 FORMAT (1H ,21X,I5,4H OF ,I3,15H TESTS EXECUTED)
CBE** ********************** BBCFMT0B **********************************
C*****
C***** END OF TEST SEGMENT 202
STOP
END
*END-OF,FM827
FM828.f 481036584 170 2 100666 14207 `
*HEADER,FORTR,FM828
*FILES1,FORTR,FM828,X
C***********************************************************************
C***** FORTRAN 77
C***** FM828
C***** YCFOR - (203)
C*****
C***********************************************************************
C***** GENERAL PURPOSE ANS REF
C***** TEST COMPLEX TRIGONOMETRIC FORMULAE 15.3
C***** TABLE 5
CBB** ********************** BBCCOMNT **********************************
C****
C**** 1978 FORTRAN COMPILER VALIDATION SYSTEM
C**** VERSION 2.0
C****
C****
C**** SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO
C**** GENERAL SERVICES ADMINISTRATION
C**** FEDERAL SOFTWARE TESTING CENTER
C**** 5203 LEESBURG PIKE, SUITE 1100
C**** FALLS CHURCH, VA. 22041
C****
C**** (703) 756-6153
C****
CBE** ********************** BBCCOMNT **********************************
C*****
C***** S P E C I F I C A T I O N S SEGMENT 203
COMPLEX AVC, BVC, CVC, DVC, ZVCORR
REAL R2E(2)
EQUIVALENCE (AVC, R2E)
C*****
CBB** ********************** BBCINITA **********************************
C**** SPECIFICATION STATEMENTS
C****
CHARACTER ZVERS*13, ZVERSD*17, ZDATE*17, ZPROG*5, ZCOMPL*20,
1 ZNAME*20, ZTAPE*10, ZPROJ*13, REMRKS*31, ZTAPED*13
CBE** ********************** BBCINITA **********************************
CBB** ********************** BBCINITB **********************************
C**** INITIALIZE SECTION
DATA ZVERS, ZVERSD, ZDATE
1 /'VERSION 2.0 ', '82/08/02*18.33.46', '*NO DATE*TIME'/
DATA ZCOMPL, ZNAME, ZTAPE
1 /'*NONE SPECIFIED*', '*NO COMPANY NAME*', '*NO TAPE*'/
DATA ZPROJ, ZTAPED, ZPROG
1 /'*NO PROJECT*', '*NO TAPE DATE', 'XXXXX'/
DATA REMRKS /' '/
C**** THE FOLLOWING 9 COMMENT LINES (CZ01, CZ02, ...) CAN BE REPLACED
C**** FOR IDENTIFYING THE TEST ENVIRONMENT
C****
CZ01 ZVERS = 'VERSION OF THE COMPILER VALIDATION SYSTEM'
CZ02 ZVERSD = 'CREATION DATE/TIME OF THE COMPILER VALIDATION SYSTEM'
CZ03 ZPROG = 'PROGRAM NAME'
CZ04 ZDATE = 'DATE OF TEST'
CZ05 ZCOMPL = 'COMPILER IDENTIFICATION'
CZ06 ZPROJ = 'PROJECT NUMBER/IDENTIFICATION'
CZ07 ZNAME = 'NAME OF USER'
CZ08 ZTAPE = 'TAPE OWNER/ID'
CZ09 ZTAPED = 'DATE TAPE COPIED'
C
IVPASS = 0
IVFAIL = 0
IVDELE = 0
IVINSP = 0
IVTOTL = 0
IVTOTN = 0
ICZERO = 0
C
C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER.
I01 = 05
C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER.
I02 = 06
C
CX010 REPLACED BY FEXEC X-010 CONTROL CARD (CARD-READER UNIT NUMBER).
C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5
CX011 REPLACED BY FEXEC X-011 CONTROL CARD. CX011 IS FOR SYSTEMS
C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX010.
C
CX020 REPLACED BY FEXEC X-020 CONTROL CARD (PRINTER UNIT NUMBER).
C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02= 6
CX021 REPLACED BY FEXEC X-021 CONTROL CARD. CX021 IS FOR SYSTEMS
C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX020.
C
CBE** ********************** BBCINITB **********************************
NUVI = I02
IVTOTL = 9
ZPROG = 'FM828'
CBB** ********************** BBCHED0A **********************************
C****
C**** WRITE REPORT TITLE
C****
WRITE (I02, 90002)
WRITE (I02, 90006)
WRITE (I02, 90007)
WRITE (I02, 90008) ZVERS, ZVERSD
WRITE (I02, 90009) ZPROG, ZPROG
WRITE (I02, 90010) ZDATE, ZCOMPL
CBE** ********************** BBCHED0A **********************************
C*****
C***** HEADER FOR SEGMENT 203
WRITE(NUVI,20300)
20300 FORMAT(1H , / 35H YCFOR - (203) INTRINSIC FUNCTIONS//
1 32H COMPLEX TRIGONOMETRIC FORMULAE//
2 17H ANS REF. - 15.3)
CBB** ********************** BBCHED0B **********************************
C**** WRITE DETAIL REPORT HEADERS
C****
WRITE (I02,90004)
WRITE (I02,90004)
WRITE (I02,90013)
WRITE (I02,90014)
WRITE (I02,90015) IVTOTL
CBE** ********************** BBCHED0B **********************************
C*****
PIVS = 3.1415926535897932384626434
C*****
CT001* TEST 1 SQRT(Z)**2 = Z
IVTNUM = 1
BVC = (1.0, 0.0) + (0.0, -2.5)
AVC = CSQRT((1.0, -2.5)) ** 2 - BVC
IF (R2E(1) + 0.50000E-04) 20010, 40012, 40011
40011 IF (R2E(1) - 0.50000E-04) 40012, 40012, 20010
40012 IF (R2E(2) + 0.50000E-04) 20010, 10010, 40010
40010 IF (R2E(2) - 0.50000E-04) 10010, 10010, 20010
10010 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0011
20010 IVFAIL = IVFAIL + 1
ZVCORR = (0.0000, 0.0000)
WRITE (NUVI, 80045) IVTNUM, AVC, ZVCORR
0011 CONTINUE
CT002* TEST 2 ANGLE SUBTENDED BY SQRT(Z) IS 1/2 ANGLE SUBTENDED BY Z
IVTNUM = 2
BVC = CSQRT((2.0, 3.25))
CVS = AIMAG(BVC)
DVS = CABS((BVC + CONJG(BVC)) / (2.0, 0.0))
AVS = ATAN2(3.0 + 0.25, 1.0 * 2.0) - 2.0 * ATAN2(CVS, DVS)
IF (AVS + 0.50000E-04) 20020, 10020, 40020
40020 IF (AVS - 0.50000E-04) 10020, 10020, 20020
10020 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0021
20020 IVFAIL = IVFAIL + 1
RVCORR = 0.0000
WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR
0021 CONTINUE
CT003* TEST 3 EXP(LOG(Z)) = Z
IVTNUM = 3
BVC = (0.0, 0.0) - (1.5, 0.75)
AVC = CEXP(CLOG(BVC)) + (1.5, 0.75)
IF (R2E(1) + 0.50000E-04) 20030, 40032, 40031
40031 IF (R2E(1) - 0.50000E-04) 40032, 40032, 20030
40032 IF (R2E(2) + 0.50000E-04) 20030, 10030, 40030
40030 IF (R2E(2) - 0.50000E-04) 10030, 10030, 20030
10030 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0031
20030 IVFAIL = IVFAIL + 1
ZVCORR = (0.0000, 0.0000)
WRITE (NUVI, 80045) IVTNUM, AVC, ZVCORR
0031 CONTINUE
CT004* TEST 4 ABS(EXP(Z)) = EXP(REAL(Z))
IVTNUM = 4
AVS = CABS(CEXP((-2.5, 1.375))) - EXP(5.0 / (-2.0))
IF (AVS + 0.50000E-04) 20040, 10040, 40040
40040 IF (AVS - 0.50000E-04) 10040, 10040, 20040
10040 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0041
20040 IVFAIL = IVFAIL + 1
RVCORR = 0.0000
WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR
0041 CONTINUE
CT005* TEST 5 ANGLE SUBTENDED BY EXP(Z) IS IMAG(Z) MOD 2 PI
IVTNUM = 5
BVC = (0.0625, 0.0)
CVC = CEXP(BVC + (0.0, 1.125))
DVS = ATAN2(AIMAG(CVC), CABS((CVC + CONJG(CVC)) / (2.0, 0.0)))
AVS = DVS - AMOD(AIMAG((0.0625, 1.125)), 2.0 * PIVS)
IF (AVS + 0.50000E-04) 20050, 10050, 40050
40050 IF (AVS - 0.50000E-04) 10050, 10050, 20050
10050 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0051
20050 IVFAIL = IVFAIL + 1
RVCORR = 0.0000
WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR
0051 CONTINUE
CT006* TEST 6 EXP(IY) = COS(Y) + I SIN(Y)
IVTNUM = 6
AVC = CEXP(CMPLX(0.0, 37.5 / 10.0))
1 - CMPLX(COS(3.75), SIN(2.75 + 1.0))
IF (R2E(1) + 0.50000E-04) 20060, 40062, 40061
40061 IF (R2E(1) - 0.50000E-04) 40062, 40062, 20060
40062 IF (R2E(2) + 0.50000E-04) 20060, 10060, 40060
40060 IF (R2E(2) - 0.50000E-04) 10060, 10060, 20060
10060 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0061
20060 IVFAIL = IVFAIL + 1
ZVCORR = (0.0000, 0.0000)
WRITE (NUVI, 80045) IVTNUM, AVC, ZVCORR
0061 CONTINUE
CT007* TEST 7 COS(Z) = 0.5 * (EXP(I*Z) + EXP(-I*Z))
IVTNUM = 7
BVC = CEXP((-1.5, -2.75))
CVC = (BVC + 1 / BVC) / (2.0, 0.0)
DVC = (2.75, -1.5)
AVC = CVC - CCOS(DVC * (-1.0, 0.0))
IF (R2E(1) + 0.50000E-04) 20070, 40072, 40071
40071 IF (R2E(1) - 0.50000E-04) 40072, 40072, 20070
40072 IF (R2E(2) + 0.50000E-04) 20070, 10070, 40070
40070 IF (R2E(2) - 0.50000E-04) 10070, 10070, 20070
10070 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0071
20070 IVFAIL = IVFAIL + 1
ZVCORR = (0.0000, 0.0000)
WRITE (NUVI, 80045) IVTNUM, AVC, ZVCORR
0071 CONTINUE
CT008* TEST 8 ABS(EXP(IY)) = 1.0
IVTNUM = 8
BVC = (3.25, 3.25)
CVC = (3.25, 0.0)
AVC = CABS(CEXP(BVC - CVC)) - COS(0.0)
IF (R2E(1) + 0.50000E-04) 20080, 40082, 40081
40081 IF (R2E(1) - 0.50000E-04) 40082, 40082, 20080
40082 IF (R2E(2) + 0.50000E-04) 20080, 10080, 40080
40080 IF (R2E(2) - 0.50000E-04) 10080, 10080, 20080
10080 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0081
20080 IVFAIL = IVFAIL + 1
ZVCORR = (0.0000, 0.0000)
WRITE (NUVI, 80045) IVTNUM, AVC, ZVCORR
0081 CONTINUE
CT009* TEST 9 DEMOIVRE THEOREM FOR N = 3
IVTNUM = 9
BVS = 3.0/2.0
BVC = CMPLX(COS(1.5), SIN(BVS)) ** 3
AVC = BVC - CMPLX(COS(4.5), -SIN(4.5 + PIVS))
IF (R2E(1) + 0.50000E-04) 20090, 40092, 40091
40091 IF (R2E(1) - 0.50000E-04) 40092, 40092, 20090
40092 IF (R2E(2) + 0.50000E-04) 20090, 10090, 40090
40090 IF (R2E(2) - 0.50000E-04) 10090, 10090, 20090
10090 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0091
20090 IVFAIL = IVFAIL + 1
ZVCORR = (0.0000, 0.0000)
WRITE (NUVI, 80045) IVTNUM, AVC, ZVCORR
0091 CONTINUE
C*****
CBB** ********************** BBCSUM0 **********************************
C**** WRITE OUT TEST SUMMARY
C****
IVTOTN = IVPASS + IVFAIL + IVDELE + IVINSP
WRITE (I02, 90004)
WRITE (I02, 90014)
WRITE (I02, 90004)
WRITE (I02, 90020) IVPASS
WRITE (I02, 90022) IVFAIL
WRITE (I02, 90024) IVDELE
WRITE (I02, 90026) IVINSP
WRITE (I02, 90028) IVTOTN, IVTOTL
CBE** ********************** BBCSUM0 **********************************
CBB** ********************** BBCFOOT0 **********************************
C**** WRITE OUT REPORT FOOTINGS
C****
WRITE (I02,90016) ZPROG, ZPROG
WRITE (I02,90018) ZPROJ, ZNAME, ZTAPE, ZTAPED
WRITE (I02,90019)
CBE** ********************** BBCFOOT0 **********************************
CBB** ********************** BBCFMT0A **********************************
C**** FORMATS FOR TEST DETAIL LINES
C****
80000 FORMAT (1H ,2X,I3,4X,7HDELETED,32X,A31)
80002 FORMAT (1H ,2X,I3,4X,7H PASS ,32X,A31)
80004 FORMAT (1H ,2X,I3,4X,7HINSPECT,32X,A31)
80008 FORMAT (1H ,2X,I3,4X,7H FAIL ,32X,A31)
80010 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,15X,10HCOMPUTED= ,
1I6,/,1H ,15X,10HCORRECT= ,I6)
80012 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
1E12.5,/,1H ,16X,10HCORRECT= ,E12.5)
80018 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
1A21,/,1H ,16X,10HCORRECT= ,A21)
80020 FORMAT (1H ,16X,10HCOMPUTED= ,A21,1X,A31)
80022 FORMAT (1H ,16X,10HCORRECT= ,A21,1X,A31)
80024 FORMAT (1H ,16X,10HCOMPUTED= ,I6,16X,A31)
80026 FORMAT (1H ,16X,10HCORRECT= ,I6,16X,A31)
80028 FORMAT (1H ,16X,10HCOMPUTED= ,E12.5,10X,A31)
80030 FORMAT (1H ,16X,10HCORRECT= ,E12.5,10X,A31)
80050 FORMAT (1H ,48X,A31)
CBE** ********************** BBCFMT0A **********************************
CBB** ********************** BBCFMAT1 **********************************
C**** FORMATS FOR TEST DETAIL LINES - FULL LANGUAGE
C****
80031 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
1D17.10,/,1H ,16X,10HCORRECT= ,D17.10)
80033 FORMAT (1H ,16X,10HCOMPUTED= ,D17.10,10X,A31)
80035 FORMAT (1H ,16X,10HCORRECT= ,D17.10,10X,A31)
80037 FORMAT (1H ,16X,10HCOMPUTED= ,1H(,E12.5,2H, ,E12.5,1H),6X,A31)
80039 FORMAT (1H ,16X,10HCORRECT= ,1H(,E12.5,2H, ,E12.5,1H),6X,A31)
80041 FORMAT (1H ,16X,10HCOMPUTED= ,1H(,F12.5,2H, ,F12.5,1H),6X,A31)
80043 FORMAT (1H ,16X,10HCORRECT= ,1H(,F12.5,2H, ,F12.5,1H),6X,A31)
80045 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
11H(,F12.5,2H, ,F12.5,1H)/,1H ,16X,10HCORRECT= ,
21H(,F12.5,2H, ,F12.5,1H))
CBE** ********************** BBCFMAT1 **********************************
CBB** ********************** BBCFMT0B **********************************
C**** FORMAT STATEMENTS FOR PAGE HEADERS
C****
90002 FORMAT (1H1)
90004 FORMAT (1H )
90006 FORMAT (1H ,20X,31HFEDERAL SOFTWARE TESTING CENTER)
90007 FORMAT (1H ,19X,34HFORTRAN COMPILER VALIDATION SYSTEM)
90008 FORMAT (1H ,21X,A13,A17)
90009 FORMAT (1H ,/,2H *,A5,6HBEGIN*,12X,15HTEST RESULTS - ,A5,/)
90010 FORMAT (1H ,8X,16HTEST DATE*TIME= ,A17,15H - COMPILER= ,A20)
90013 FORMAT (1H ,8H TEST ,10HPASS/FAIL ,6X,17HDISPLAYED RESULTS,
1 7X,7HREMARKS,24X)
90014 FORMAT (1H ,46H----------------------------------------------,
1 33H---------------------------------)
90015 FORMAT (1H ,48X,17HTHIS PROGRAM HAS ,I3,6H TESTS,/)
C****
C**** FORMAT STATEMENTS FOR REPORT FOOTINGS
C****
90016 FORMAT (1H ,/,2H *,A5,4HEND*,14X,14HEND OF TEST - ,A5,/)
90018 FORMAT (1H ,A13,13X,A20,7H * ,A10,1H/,
1 A13)
90019 FORMAT (1H ,26HFOR OFFICIAL USE ONLY ,35X,15HCOPYRIGHT 1982)
C****
C**** FORMAT STATEMENTS FOR RUN SUMMARY
C****
90020 FORMAT (1H ,21X,I5,13H TESTS PASSED)
90022 FORMAT (1H ,21X,I5,13H TESTS FAILED)
90024 FORMAT (1H ,21X,I5,14H TESTS DELETED)
90026 FORMAT (1H ,21X,I5,25H TESTS REQUIRE INSPECTION)
90028 FORMAT (1H ,21X,I5,4H OF ,I3,15H TESTS EXECUTED)
CBE** ********************** BBCFMT0B **********************************
C*****
C***** END OF TEST SEGMENT 203
STOP
END
*END-OF,FM828
FM829.f 481036589 170 2 100666 27051 `
*HEADER,FORTR,FM829
*FILES1,FORTR,FM829,X
C***********************************************************************
C***** FORTRAN 77
C***** FM829
C***** YGEN1 - (206)
C*****
C***********************************************************************
C***** TESTING OF GENERIC FUNCTIONS ANS REF
C***** INT, REAL, DBLE, CMPLX 15.3
C***** TABLE 5
CBB** ********************** BBCCOMNT **********************************
C****
C**** 1978 FORTRAN COMPILER VALIDATION SYSTEM
C**** VERSION 2.0
C****
C****
C**** SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO
C**** GENERAL SERVICES ADMINISTRATION
C**** FEDERAL SOFTWARE TESTING CENTER
C**** 5203 LEESBURG PIKE, SUITE 1100
C**** FALLS CHURCH, VA. 22041
C****
C**** (703) 756-6153
C****
CBE** ********************** BBCCOMNT **********************************
C*****
C***** S P E C I F I C A T I O N S SEGMENT 206
DOUBLE PRECISION AVD, BVD, CVD, DVCORR
COMPLEX AVC, BVC, CVC, ZVCORR
REAL R2E(2)
EQUIVALENCE (BVC, R2E)
C*****
CBB** ********************** BBCINITA **********************************
C**** SPECIFICATION STATEMENTS
C****
CHARACTER ZVERS*13, ZVERSD*17, ZDATE*17, ZPROG*5, ZCOMPL*20,
1 ZNAME*20, ZTAPE*10, ZPROJ*13, REMRKS*31, ZTAPED*13
CBE** ********************** BBCINITA **********************************
CBB** ********************** BBCINITB **********************************
C**** INITIALIZE SECTION
DATA ZVERS, ZVERSD, ZDATE
1 /'VERSION 2.0 ', '82/08/02*18.33.46', '*NO DATE*TIME'/
DATA ZCOMPL, ZNAME, ZTAPE
1 /'*NONE SPECIFIED*', '*NO COMPANY NAME*', '*NO TAPE*'/
DATA ZPROJ, ZTAPED, ZPROG
1 /'*NO PROJECT*', '*NO TAPE DATE', 'XXXXX'/
DATA REMRKS /' '/
C**** THE FOLLOWING 9 COMMENT LINES (CZ01, CZ02, ...) CAN BE REPLACED
C**** FOR IDENTIFYING THE TEST ENVIRONMENT
C****
CZ01 ZVERS = 'VERSION OF THE COMPILER VALIDATION SYSTEM'
CZ02 ZVERSD = 'CREATION DATE/TIME OF THE COMPILER VALIDATION SYSTEM'
CZ03 ZPROG = 'PROGRAM NAME'
CZ04 ZDATE = 'DATE OF TEST'
CZ05 ZCOMPL = 'COMPILER IDENTIFICATION'
CZ06 ZPROJ = 'PROJECT NUMBER/IDENTIFICATION'
CZ07 ZNAME = 'NAME OF USER'
CZ08 ZTAPE = 'TAPE OWNER/ID'
CZ09 ZTAPED = 'DATE TAPE COPIED'
C
IVPASS = 0
IVFAIL = 0
IVDELE = 0
IVINSP = 0
IVTOTL = 0
IVTOTN = 0
ICZERO = 0
C
C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER.
I01 = 05
C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER.
I02 = 06
C
CX010 REPLACED BY FEXEC X-010 CONTROL CARD (CARD-READER UNIT NUMBER).
C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5
CX011 REPLACED BY FEXEC X-011 CONTROL CARD. CX011 IS FOR SYSTEMS
C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX010.
C
CX020 REPLACED BY FEXEC X-020 CONTROL CARD (PRINTER UNIT NUMBER).
C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02= 6
CX021 REPLACED BY FEXEC X-021 CONTROL CARD. CX021 IS FOR SYSTEMS
C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX020.
C
CBE** ********************** BBCINITB **********************************
NUVI = I02
IVTOTL = 35
ZPROG = 'FM829'
CBB** ********************** BBCHED0A **********************************
C****
C**** WRITE REPORT TITLE
C****
WRITE (I02, 90002)
WRITE (I02, 90006)
WRITE (I02, 90007)
WRITE (I02, 90008) ZVERS, ZVERSD
WRITE (I02, 90009) ZPROG, ZPROG
WRITE (I02, 90010) ZDATE, ZCOMPL
CBE** ********************** BBCHED0A **********************************
C*****
C***** HEADER FOR SEGMENT 206
WRITE(NUVI,20600)
20600 FORMAT( 1H , / 35H YGEN1 - (206) GENERIC FUNCTIONS --//
1 24H INT, REAL, DBLE, CMPLX//
2 17H ANS REF. - 15.3)
CBB** ********************** BBCHED0B **********************************
C**** WRITE DETAIL REPORT HEADERS
C****
WRITE (I02,90004)
WRITE (I02,90004)
WRITE (I02,90013)
WRITE (I02,90014)
WRITE (I02,90015) IVTOTL
CBE** ********************** BBCHED0B **********************************
C*****
CT001* TEST 1 TEST OF INT
C***** WITH INTEGER ARG
IVTNUM = 1
LVI = INT(485)
IF (LVI - 485) 20010, 10010, 20010
10010 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0011
20010 IVFAIL = IVFAIL + 1
IVCORR = 485
WRITE (NUVI, 80010) IVTNUM, LVI, IVCORR
0011 CONTINUE
CT002* TEST 2 WITH DOUBLE PREC ARG
IVTNUM = 2
LVI = INT(1.375D0)
IF (LVI - 1) 20020, 10020, 20020
10020 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0021
20020 IVFAIL = IVFAIL + 1
IVCORR = 1
WRITE (NUVI, 80010) IVTNUM, LVI, IVCORR
0021 CONTINUE
CT003* TEST 3 WITH COMPLEX ARG
IVTNUM = 3
LVI = INT((1.24, 5.67))
IF (LVI - 1) 20030, 10030, 20030
10030 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0031
20030 IVFAIL = IVFAIL + 1
IVCORR = 1
WRITE (NUVI, 80010) IVTNUM, LVI, IVCORR
0031 CONTINUE
CT004* TEST 4 TEST OF INT AND IFIX
C***** WITH REAL ARGS
IVTNUM = 4
LVI = INT(6.0001) + IFIX(-1.750)
IF (LVI - 5) 20040, 10040, 20040
10040 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0041
20040 IVFAIL = IVFAIL + 1
IVCORR = 5
WRITE (NUVI, 80010) IVTNUM, LVI, IVCORR
0041 CONTINUE
CT005* TEST 5 TEST OF INT AND IDINT
C***** WITH DOUBLE PREC ARGS
IVTNUM = 5
AVD = -1.11D1
LVI = INT(AVD) * IDINT(3.5D0)
IF (LVI + 33) 20050, 10050, 20050
10050 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0051
20050 IVFAIL = IVFAIL + 1
IVCORR = -33
WRITE (NUVI, 80010) IVTNUM, LVI, IVCORR
0051 CONTINUE
CT006* TEST 6 INTEGER, REAL, DOUBLE PRECISION, AND COMPLEX
C***** ARGUMENTS
IVTNUM = 6
LVI = INT(-327) + INT(6.75) * INT(123) - INT(6.0001D0)
1 / IFIX(13.3) + INT((2.4, 3.5)) + IDINT(-3.375D0)
IF (LVI - 410) 20060, 10060, 20060
10060 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0061
20060 IVFAIL = IVFAIL + 1
IVCORR = 410
WRITE (NUVI, 80010) IVTNUM, LVI, IVCORR
0061 CONTINUE
CT007* TEST 7 TEST OF REAL
C***** WITH REAL ARG
IVTNUM = 7
AVS = -3.0
BVS = REAL(AVS)
IF (BVS + 0.30002E+01) 20070, 10070, 40070
40070 IF (BVS + 0.29998E+01) 10070, 10070, 20070
10070 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0071
20070 IVFAIL = IVFAIL + 1
RVCORR = -3.0
WRITE (NUVI, 80012) IVTNUM, BVS, RVCORR
0071 CONTINUE
CT008* TEST 8 WITH DOUBLE PRECISION
IVTNUM = 8
AVD = 0.96875D0
BVS = REAL(AVD)
IF (BVS - 0.96870E+00) 20080, 10080, 40080
40080 IF (BVS - 0.96880E+00) 10080, 10080, 20080
10080 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0081
20080 IVFAIL = IVFAIL + 1
RVCORR = 0.96875
WRITE (NUVI, 80012) IVTNUM, BVS, RVCORR
0081 CONTINUE
CT009* TEST 9 WITH COMPLEX
IVTNUM = 9
BVS = REAL((2.5, -3.0))
IF (BVS - 0.24998E+01) 20090, 10090, 40090
40090 IF (BVS - 0.25002E+01) 10090, 10090, 20090
10090 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0091
20090 IVFAIL = IVFAIL + 1
RVCORR = 2.5
WRITE (NUVI, 80012) IVTNUM, BVS, RVCORR
0091 CONTINUE
CT010* TEST 10 TEST OF REAL AND FLOAT
IVTNUM = 10
BVS = REAL(6) + FLOAT(8)
IF (BVS - 0.13999E+02) 20100, 10100, 40100
40100 IF (BVS - 0.14001E+02) 10100, 10100, 20100
10100 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0101
20100 IVFAIL = IVFAIL + 1
RVCORR = 14.0
WRITE (NUVI, 80012) IVTNUM, BVS, RVCORR
0101 CONTINUE
CT011* TEST 11 TEST OF REAL AND SNGL
IVTNUM = 11
AVD = 2.5D0
BVS = REAL(AVD) + SNGL(0.35875D2)
IF (BVS - 0.38373E+02) 20110, 10110, 40110
40110 IF (BVS - 0.38377E+02) 10110, 10110, 20110
10110 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0111
20110 IVFAIL = IVFAIL + 1
RVCORR = 38.375
WRITE (NUVI, 80012) IVTNUM, BVS, RVCORR
0111 CONTINUE
CT012* TEST 12 TEST OF REAL, FLOAT, AND SNGL
IVTNUM = 12
BVS = REAL(13) + FLOAT(9) * SNGL(0.7625D1) - REAL(2.625D0) +
1 REAL(3.5) / REAL((2.0, 4.0))
IF (BVS - 0.80746E+02) 20120, 10120, 40120
40120 IF (BVS - 0.80754E+02) 10120, 10120, 20120
10120 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0121
20120 IVFAIL = IVFAIL + 1
RVCORR = 80.75
WRITE (NUVI, 80012) IVTNUM, BVS, RVCORR
0121 CONTINUE
CT013* TEST 13 TEST OF DBLE
C***** WITH INTEGER ARG
IVTNUM = 13
LVI = 9
BVD = DBLE(LVI)
IF (BVD - 0.89995D+01) 20130, 10130, 40130
40130 IF (BVD - 0.90005D+01) 10130, 10130, 20130
10130 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0131
20130 IVFAIL = IVFAIL + 1
DVCORR = 9.0D0
WRITE (NUVI, 80031) IVTNUM, BVD, DVCORR
0131 CONTINUE
CT014* TEST 14 WITH REAL ARG
IVTNUM = 14
AVS = 10.5
BVD = DBLE(AVS)
IF (BVD - 0.10499D+02) 20140, 10140, 40140
40140 IF (BVD - 0.10501D+02) 10140, 10140, 20140
10140 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0141
20140 IVFAIL = IVFAIL + 1
DVCORR = 10.5D0
WRITE (NUVI, 80031) IVTNUM, BVD, DVCORR
0141 CONTINUE
CT015* TEST 15 WITH DOUBLE PREC ARG
IVTNUM = 15
AVD = 9.9D0
BVD = DBLE(AVD)
IF (BVD - 0.9899999995D+01) 20150, 10150, 40150
40150 IF (BVD - 0.9900000005D+01) 10150, 10150, 20150
10150 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0151
20150 IVFAIL = IVFAIL + 1
DVCORR = 9.9D0
WRITE (NUVI, 80031) IVTNUM, BVD, DVCORR
0151 CONTINUE
CT016* TEST 16 WITH COMPLEX ARG
IVTNUM = 16
AVC = (2.5, 5.5)
BVD = DBLE(AVC)
IF (BVD - 0.24998D+01) 20160, 10160, 40160
40160 IF (BVD - 0.25002D+01) 10160, 10160, 20160
10160 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0161
20160 IVFAIL = IVFAIL + 1
DVCORR = 2.5D0
WRITE (NUVI, 80031) IVTNUM, BVD, DVCORR
0161 CONTINUE
CT017* TEST 17 TEST OF CMPLX WITH ONE ARG
C***** WITH INTEGER ARG
IVTNUM = 17
BVC = CMPLX(9)
IF (R2E(1) - 0.89995E+01) 20170, 40172, 40171
40171 IF (R2E(1) - 0.90005E+01) 40172, 40172, 20170
40172 IF (R2E(2) + 0.50000E-04) 20170, 10170, 40170
40170 IF (R2E(2) - 0.50000E-04) 10170, 10170, 20170
10170 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0171
20170 IVFAIL = IVFAIL + 1
ZVCORR = (9,0)
WRITE (NUVI, 80045) IVTNUM, BVC, ZVCORR
0171 CONTINUE
CT018* TEST 18 WITH REAL
IVTNUM = 18
BVC = CMPLX(4.093)
IF (R2E(1) - 0.40928E+01) 20180, 40182, 40181
40181 IF (R2E(1) - 0.40932E+01) 40182, 40182, 20180
40182 IF (R2E(2) + 0.50000E-04) 20180, 10180, 40180
40180 IF (R2E(2) - 0.50000E-04) 10180, 10180, 20180
10180 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0181
20180 IVFAIL = IVFAIL + 1
ZVCORR = (4.093,0.0)
WRITE (NUVI, 80045) IVTNUM, BVC, ZVCORR
0181 CONTINUE
CT019* TEST 19 WITH DOUBLE PREC ARG
IVTNUM = 19
AVD = 0.375D-3
BVC = CMPLX(AVD)
IF (R2E(1) - 0.37498E-03) 20190, 40192, 40191
40191 IF (R2E(1) - 0.37502E-03) 40192, 40192, 20190
40192 IF (R2E(2) + 0.50000E-04) 20190, 10190, 40190
40190 IF (R2E(2) - 0.50000E-04) 10190, 10190, 20190
10190 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0191
20190 IVFAIL = IVFAIL + 1
ZVCORR = (0.375E-3, 0.0E0)
WRITE (NUVI, 80045) IVTNUM, BVC, ZVCORR
0191 CONTINUE
CT020* TEST 20 WITH COMPLEX
IVTNUM = 20
AVC = (4.5, 1.2)
BVC = CMPLX(AVC)
IF (R2E(1) - 0.44997E+01) 20200, 40202, 40201
40201 IF (R2E(1) - 0.45003E+01) 40202, 40202, 20200
40202 IF (R2E(2) - 0.11999E+01) 20200, 10200, 40200
40200 IF (R2E(2) - 0.12001E+01) 10200, 10200, 20200
10200 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0201
20200 IVFAIL = IVFAIL + 1
ZVCORR = (4.5, 1.2)
WRITE (NUVI, 80045) IVTNUM, BVC, ZVCORR
0201 CONTINUE
CT021* TEST 21 TEST OF CMPLX WITH TWO ARGS
C***** WITH INTEGER ARGS
IVTNUM = 21
BVC = CMPLX(3, 1)
IF (R2E(1) - 0.29998E+01) 20210, 40212, 40211
40211 IF (R2E(1) - 0.30002E+01) 40212, 40212, 20210
40212 IF (R2E(2) - 0.99995E+00) 20210, 10210, 40210
40210 IF (R2E(2) - 0.10001E+01) 10210, 10210, 20210
10210 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0211
20210 IVFAIL = IVFAIL + 1
ZVCORR = (3.0, 1.0)
WRITE (NUVI, 80045) IVTNUM, BVC, ZVCORR
0211 CONTINUE
CT022* TEST 22 WITH REAL ARGS
IVTNUM = 22
BVC = CMPLX(8.34, 634.3)
IF (R2E(1) - 0.83395E+01) 20220, 40222, 40221
40221 IF (R2E(1) - 0.83405E+01) 40222, 40222, 20220
40222 IF (R2E(2) - 0.63426E+03) 20220, 10220, 40220
40220 IF (R2E(2) - 0.63434E+03) 10220, 10220, 20220
10220 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0221
20220 IVFAIL = IVFAIL + 1
ZVCORR = (8.34, 634.3)
WRITE (NUVI, 80045) IVTNUM, BVC, ZVCORR
0221 CONTINUE
CT023* TEST 23 WITH DOUBLE PREC ARGS
IVTNUM = 23
AVD = 0.96875D0
BVD = 3.5D-1
BVC = CMPLX(AVD, BVD)
IF (R2E(1) - 0.96870E+00) 20230, 40232, 40231
40231 IF (R2E(1) - 0.96880E+00) 40232, 40232, 20230
40232 IF (R2E(2) - 0.34998E+00) 20230, 10230, 40230
40230 IF (R2E(2) - 0.35002E+00) 10230, 10230, 20230
10230 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0231
20230 IVFAIL = IVFAIL + 1
ZVCORR = (0.96875, 0.35)
WRITE (NUVI, 80045) IVTNUM, BVC, ZVCORR
0231 CONTINUE
CT024* TEST 24 TEST OF INT AND =
C***** WITH REAL EXPR
IVTNUM = 24
CVS = 0.0
CVD = 0.0D0
CVC = (0.0,0.0)
LVI = 0
AVS = 5.0
IVI = 1.0 * 5.0 + 6.0
KVI = LVI + INT(1.0 * AVS + 6.0)
IF (KVI - 11) 20240, 10240, 20240
10240 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0241
20240 IVFAIL = IVFAIL + 1
IVCORR = 11
WRITE (NUVI, 80010) IVTNUM, KVI, IVCORR
0241 CONTINUE
CT025* TEST 25 WITH DOUBLE PREC EXPR
IVTNUM = 25
AVD = 3.48D0
IVI = 3.48D0 * 47.98D0
KVI = LVI + INT(AVD * 47.98D0)
IF (KVI - 166) 20250, 10250, 20250
10250 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0251
20250 IVFAIL = IVFAIL + 1
IVCORR = 166
WRITE (NUVI, 80010) IVTNUM, KVI, IVCORR
0251 CONTINUE
CT026* TEST 26 WITH COMPLEX EXPR
IVTNUM = 26
AVC = (3.9, 5.0)
IVI = (3.4, 4.5) + (3.9, 5.0)
KVI = LVI + INT((3.4, 4.5) + AVC)
IF (KVI - 7) 20260, 10260, 20260
10260 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0261
20260 IVFAIL = IVFAIL + 1
IVCORR = 7
WRITE (NUVI, 80010) IVTNUM, KVI, IVCORR
0261 CONTINUE
CT027* TEST 27 TEST OF REAL AND =
C***** WITH INT EXPR
IVTNUM = 27
IVI = 20
AVS = 20 + 34 / 20
BVS = CVS + REAL(IVI + 34 / IVI)
IF (BVS - 0.20999E+02) 20270, 10270, 40270
40270 IF (BVS - 0.21001E+02) 10270, 10270, 20270
10270 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0271
20270 IVFAIL = IVFAIL + 1
RVCORR = 21.0
WRITE (NUVI, 80012) IVTNUM, BVS, RVCORR
0271 CONTINUE
CT028* TEST 28 WITH DOUBLE PREC EXPR
IVTNUM = 28
JVI = 28
AVD = 0.9834D0
AVS = 3.0748D0 / 0.9834D0
BVS = CVS + REAL(3.0748D0 / AVD)
IF (BVS - 0.31265E+01) 20280, 10280, 40280
40280 IF (BVS - 0.31269E+01) 10280, 10280, 20280
10280 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0281
20280 IVFAIL = IVFAIL + 1
RVCORR = 3.1267033
WRITE (NUVI, 80012) IVTNUM, BVS, RVCORR
0281 CONTINUE
CT029* TEST 29 WITH COMPLEX
IVTNUM = 29
JVI = 29
AVC = (1.0, 384.9)
AVS = (3.495, 98.734) * (1.0, 384.9)
BVS = CVS + REAL((3.495, 98.734) * AVC)
IF (BVS + 0.38001E+05) 20290, 10290, 40290
40290 IF (BVS + 0.37997E+05) 10290, 10290, 20290
10290 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0291
20290 IVFAIL = IVFAIL + 1
RVCORR = -37999.222
WRITE (NUVI, 80012) IVTNUM, BVS, RVCORR
0291 CONTINUE
CT030* TEST 30 TEST OF DBLE AND =
C***** WITH INTEGER EXPR
IVTNUM = 30
JVI = 30
IVI = 5
AVD = 1 * 5 + 6
BVD = CVD + DBLE(1 * IVI + 6)
IF (BVD - 0.10999D+02) 20300, 10300, 40300
40300 IF (BVD - 0.11001D+02) 10300, 10300, 20300
10300 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0301
20300 IVFAIL = IVFAIL + 1
DVCORR = .11000000D+02
WRITE (NUVI, 80031) IVTNUM, BVD, DVCORR
0301 CONTINUE
CT031* TEST 31 WITH REAL EXPR
IVTNUM = 31
JVI = 31
AVS = -4.5
AVD = 1.3 / (-4.5)
BVD = CVD + DBLE(1.3 / AVS)
IF (BVD + 0.28891D+00) 20310, 10310, 40310
40310 IF (BVD + 0.28887D+00) 10310, 10310, 20310
10310 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0311
20310 IVFAIL = IVFAIL + 1
DVCORR = -0.288888888888888889D+00
WRITE (NUVI, 80031) IVTNUM, BVD, DVCORR
0311 CONTINUE
CT032* TEST 32 WITH COMPLEX EXPR
IVTNUM = 32
JVI = 32
AVC = (3.9, 5.0)
AVD = (3.4, 4.5) + (3.9, 5.0)
BVD = CVD + DBLE((3.4, 4.5) + AVC)
IF (BVD - 0.72996D+01) 20320, 10320, 40320
40320 IF (BVD - 0.73004D+01) 10320, 10320, 20320
10320 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0321
20320 IVFAIL = IVFAIL + 1
DVCORR = .73000000D+01
WRITE (NUVI, 80031) IVTNUM, BVD, DVCORR
0321 CONTINUE
CT033* TEST 33 TEST OF CMPLX AND =
C***** WITH INTEGER EXPR
IVTNUM = 33
JVI = 33
IVI = 673
AVC = 394 - 673
BVC = CVC + CMPLX(394 - IVI)
IF (R2E(1) + 0.27902E+03) 20330, 40332, 40331
40331 IF (R2E(1) + 0.27898E+03) 40332, 40332, 20330
40332 IF (R2E(2) + 0.50000E-04) 20330, 10330, 40330
40330 IF (R2E(2) - 0.50000E-04) 10330, 10330, 20330
10330 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0331
20330 IVFAIL = IVFAIL + 1
ZVCORR = (-279.00000, .00000000)
WRITE (NUVI, 80045) IVTNUM, BVC, ZVCORR
0331 CONTINUE
CT034* TEST 34 WITH REAL EXPR
IVTNUM = 34
JVI = 34
AVS = 3.48
AVC = 3.48 * 47.98
BVC = CVC + CMPLX(AVS * 47.98)
IF (R2E(1) - 0.16696E+03) 20340, 40342, 40341
40341 IF (R2E(1) - 0.16698E+03) 40342, 40342, 20340
40342 IF (R2E(2) + 0.50000E-04) 20340, 10340, 40340
40340 IF (R2E(2) - 0.50000E-04) 10340, 10340, 20340
10340 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0341
20340 IVFAIL = IVFAIL + 1
ZVCORR = (166.97040, .00000000)
WRITE (NUVI, 80045) IVTNUM, BVC, ZVCORR
0341 CONTINUE
CT035* TEST 35
IVTNUM = 35
JVI = 35
AVD = 0.94D1
AVC = 3.0283D3 / 0.94D1
BVC = CVC + CMPLX(3.0283D3 / AVD)
IF (R2E(1) - 0.32214E+03) 20350, 40352, 40351
40351 IF (R2E(1) - 0.32218E+03) 40352, 40352, 20350
40352 IF (R2E(2) + 0.50000E-04) 20350, 10350, 40350
40350 IF (R2E(2) - 0.50000E-04) 10350, 10350, 20350
10350 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0351
20350 IVFAIL = IVFAIL + 1
ZVCORR = (322.15957, .000000000)
WRITE (NUVI, 80045) IVTNUM, BVC, ZVCORR
0351 CONTINUE
C*****
CBB** ********************** BBCSUM0 **********************************
C**** WRITE OUT TEST SUMMARY
C****
IVTOTN = IVPASS + IVFAIL + IVDELE + IVINSP
WRITE (I02, 90004)
WRITE (I02, 90014)
WRITE (I02, 90004)
WRITE (I02, 90020) IVPASS
WRITE (I02, 90022) IVFAIL
WRITE (I02, 90024) IVDELE
WRITE (I02, 90026) IVINSP
WRITE (I02, 90028) IVTOTN, IVTOTL
CBE** ********************** BBCSUM0 **********************************
CBB** ********************** BBCFOOT0 **********************************
C**** WRITE OUT REPORT FOOTINGS
C****
WRITE (I02,90016) ZPROG, ZPROG
WRITE (I02,90018) ZPROJ, ZNAME, ZTAPE, ZTAPED
WRITE (I02,90019)
CBE** ********************** BBCFOOT0 **********************************
CBB** ********************** BBCFMT0A **********************************
C**** FORMATS FOR TEST DETAIL LINES
C****
80000 FORMAT (1H ,2X,I3,4X,7HDELETED,32X,A31)
80002 FORMAT (1H ,2X,I3,4X,7H PASS ,32X,A31)
80004 FORMAT (1H ,2X,I3,4X,7HINSPECT,32X,A31)
80008 FORMAT (1H ,2X,I3,4X,7H FAIL ,32X,A31)
80010 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,15X,10HCOMPUTED= ,
1I6,/,1H ,15X,10HCORRECT= ,I6)
80012 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
1E12.5,/,1H ,16X,10HCORRECT= ,E12.5)
80018 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
1A21,/,1H ,16X,10HCORRECT= ,A21)
80020 FORMAT (1H ,16X,10HCOMPUTED= ,A21,1X,A31)
80022 FORMAT (1H ,16X,10HCORRECT= ,A21,1X,A31)
80024 FORMAT (1H ,16X,10HCOMPUTED= ,I6,16X,A31)
80026 FORMAT (1H ,16X,10HCORRECT= ,I6,16X,A31)
80028 FORMAT (1H ,16X,10HCOMPUTED= ,E12.5,10X,A31)
80030 FORMAT (1H ,16X,10HCORRECT= ,E12.5,10X,A31)
80050 FORMAT (1H ,48X,A31)
CBE** ********************** BBCFMT0A **********************************
CBB** ********************** BBCFMAT1 **********************************
C**** FORMATS FOR TEST DETAIL LINES - FULL LANGUAGE
C****
80031 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
1D17.10,/,1H ,16X,10HCORRECT= ,D17.10)
80033 FORMAT (1H ,16X,10HCOMPUTED= ,D17.10,10X,A31)
80035 FORMAT (1H ,16X,10HCORRECT= ,D17.10,10X,A31)
80037 FORMAT (1H ,16X,10HCOMPUTED= ,1H(,E12.5,2H, ,E12.5,1H),6X,A31)
80039 FORMAT (1H ,16X,10HCORRECT= ,1H(,E12.5,2H, ,E12.5,1H),6X,A31)
80041 FORMAT (1H ,16X,10HCOMPUTED= ,1H(,F12.5,2H, ,F12.5,1H),6X,A31)
80043 FORMAT (1H ,16X,10HCORRECT= ,1H(,F12.5,2H, ,F12.5,1H),6X,A31)
80045 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
11H(,F12.5,2H, ,F12.5,1H)/,1H ,16X,10HCORRECT= ,
21H(,F12.5,2H, ,F12.5,1H))
CBE** ********************** BBCFMAT1 **********************************
CBB** ********************** BBCFMT0B **********************************
C**** FORMAT STATEMENTS FOR PAGE HEADERS
C****
90002 FORMAT (1H1)
90004 FORMAT (1H )
90006 FORMAT (1H ,20X,31HFEDERAL SOFTWARE TESTING CENTER)
90007 FORMAT (1H ,19X,34HFORTRAN COMPILER VALIDATION SYSTEM)
90008 FORMAT (1H ,21X,A13,A17)
90009 FORMAT (1H ,/,2H *,A5,6HBEGIN*,12X,15HTEST RESULTS - ,A5,/)
90010 FORMAT (1H ,8X,16HTEST DATE*TIME= ,A17,15H - COMPILER= ,A20)
90013 FORMAT (1H ,8H TEST ,10HPASS/FAIL ,6X,17HDISPLAYED RESULTS,
1 7X,7HREMARKS,24X)
90014 FORMAT (1H ,46H----------------------------------------------,
1 33H---------------------------------)
90015 FORMAT (1H ,48X,17HTHIS PROGRAM HAS ,I3,6H TESTS,/)
C****
C**** FORMAT STATEMENTS FOR REPORT FOOTINGS
C****
90016 FORMAT (1H ,/,2H *,A5,4HEND*,14X,14HEND OF TEST - ,A5,/)
90018 FORMAT (1H ,A13,13X,A20,7H * ,A10,1H/,
1 A13)
90019 FORMAT (1H ,26HFOR OFFICIAL USE ONLY ,35X,15HCOPYRIGHT 1982)
C****
C**** FORMAT STATEMENTS FOR RUN SUMMARY
C****
90020 FORMAT (1H ,21X,I5,13H TESTS PASSED)
90022 FORMAT (1H ,21X,I5,13H TESTS FAILED)
90024 FORMAT (1H ,21X,I5,14H TESTS DELETED)
90026 FORMAT (1H ,21X,I5,25H TESTS REQUIRE INSPECTION)
90028 FORMAT (1H ,21X,I5,4H OF ,I3,15H TESTS EXECUTED)
CBE** ********************** BBCFMT0B **********************************
C*****
C***** END OF TEST SEGMENT 206
STOP
END
*END-OF,FM829
FM830.f 481036593 170 2 100666 13337 `
*HEADER,FORTR,FM830
*FILES1,FORTR,FM830,X
C***********************************************************************
C***** FORTRAN 77
C***** FM830
C***** YGEN2 - (207)
C*****
C***********************************************************************
C***** GENERAL PURPOSE ANS REF
C***** TEST GENERIC FUNCTIONS 15.3
C***** AINT, ANINT, NINT, SQRT, EXP, LOG, LOG10 TABLE 5
C*****
CBB** ********************** BBCCOMNT **********************************
C****
C**** 1978 FORTRAN COMPILER VALIDATION SYSTEM
C**** VERSION 2.0
C****
C****
C**** SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO
C**** GENERAL SERVICES ADMINISTRATION
C**** FEDERAL SOFTWARE TESTING CENTER
C**** 5203 LEESBURG PIKE, SUITE 1100
C**** FALLS CHURCH, VA. 22041
C****
C**** (703) 756-6153
C****
CBE** ********************** BBCCOMNT **********************************
C*****
C***** S P E C I F I C A T I O N S SEGMENT 207
DOUBLE PRECISION AVD, DVCORR
COMPLEX AVC, ZVCORR
REAL R2E(2)
EQUIVALENCE (AVC, R2E)
C*****
CBB** ********************** BBCINITA **********************************
C**** SPECIFICATION STATEMENTS
C****
CHARACTER ZVERS*13, ZVERSD*17, ZDATE*17, ZPROG*5, ZCOMPL*20,
1 ZNAME*20, ZTAPE*10, ZPROJ*13, REMRKS*31, ZTAPED*13
CBE** ********************** BBCINITA **********************************
CBB** ********************** BBCINITB **********************************
C**** INITIALIZE SECTION
DATA ZVERS, ZVERSD, ZDATE
1 /'VERSION 2.0 ', '82/08/02*18.33.46', '*NO DATE*TIME'/
DATA ZCOMPL, ZNAME, ZTAPE
1 /'*NONE SPECIFIED*', '*NO COMPANY NAME*', '*NO TAPE*'/
DATA ZPROJ, ZTAPED, ZPROG
1 /'*NO PROJECT*', '*NO TAPE DATE', 'XXXXX'/
DATA REMRKS /' '/
C**** THE FOLLOWING 9 COMMENT LINES (CZ01, CZ02, ...) CAN BE REPLACED
C**** FOR IDENTIFYING THE TEST ENVIRONMENT
C****
CZ01 ZVERS = 'VERSION OF THE COMPILER VALIDATION SYSTEM'
CZ02 ZVERSD = 'CREATION DATE/TIME OF THE COMPILER VALIDATION SYSTEM'
CZ03 ZPROG = 'PROGRAM NAME'
CZ04 ZDATE = 'DATE OF TEST'
CZ05 ZCOMPL = 'COMPILER IDENTIFICATION'
CZ06 ZPROJ = 'PROJECT NUMBER/IDENTIFICATION'
CZ07 ZNAME = 'NAME OF USER'
CZ08 ZTAPE = 'TAPE OWNER/ID'
CZ09 ZTAPED = 'DATE TAPE COPIED'
C
IVPASS = 0
IVFAIL = 0
IVDELE = 0
IVINSP = 0
IVTOTL = 0
IVTOTN = 0
ICZERO = 0
C
C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER.
I01 = 05
C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER.
I02 = 06
C
CX010 REPLACED BY FEXEC X-010 CONTROL CARD (CARD-READER UNIT NUMBER).
C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5
CX011 REPLACED BY FEXEC X-011 CONTROL CARD. CX011 IS FOR SYSTEMS
C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX010.
C
CX020 REPLACED BY FEXEC X-020 CONTROL CARD (PRINTER UNIT NUMBER).
C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02= 6
CX021 REPLACED BY FEXEC X-021 CONTROL CARD. CX021 IS FOR SYSTEMS
C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX020.
C
CBE** ********************** BBCINITB **********************************
NUVI = I02
IVTOTL = 9
ZPROG = 'FM830'
CBB** ********************** BBCHED0A **********************************
C****
C**** WRITE REPORT TITLE
C****
WRITE (I02, 90002)
WRITE (I02, 90006)
WRITE (I02, 90007)
WRITE (I02, 90008) ZVERS, ZVERSD
WRITE (I02, 90009) ZPROG, ZPROG
WRITE (I02, 90010) ZDATE, ZCOMPL
CBE** ********************** BBCHED0A **********************************
C*****
C***** HEADER FOR SEGMENT 207
WRITE(NUVI,20700)
20700 FORMAT( 1H , / 35H YGEN2 - (207) GENERIC FUNCTIONS --//
1 42H AINT, ANINT, NINT, SQRT, EXP, LOG, LOG10//
2 17H ANS REF. - 15.3)
CBB** ********************** BBCHED0B **********************************
C**** WRITE DETAIL REPORT HEADERS
C****
WRITE (I02,90004)
WRITE (I02,90004)
WRITE (I02,90013)
WRITE (I02,90014)
WRITE (I02,90015) IVTOTL
CBE** ********************** BBCHED0B **********************************
C*****
CT001* TEST 1 TEST OF NINT WITH DOUBLE PREC
IVTNUM = 1
LVI = NINT(27.96875D0)
IF (LVI - 28) 20010, 10010, 20010
10010 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0011
20010 IVFAIL = IVFAIL + 1
IVCORR = 28
WRITE (NUVI, 80010) IVTNUM, LVI, IVCORR
0011 CONTINUE
CT002* TEST 2 TEST OF AINT AND ANINT WITH DOUBLE PREC
IVTNUM = 2
AVD = AINT(-1.375D0) + ANINT(-27.96875D0)
IF (AVD + 0.2900000002D+02) 20020, 10020, 40020
40020 IF (AVD + 0.2899999998D+02) 10020, 10020, 20020
10020 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0021
20020 IVFAIL = IVFAIL + 1
DVCORR = -29.0D0
WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR
0021 CONTINUE
CT003* TEST 3 TEST OF SQRT AND EXP WITH DOUBLE PREC
IVTNUM = 3
AVD = SQRT(16.0D0) - EXP(5.125D0)
IF (AVD + 0.1641741418D+03) 20030, 10030, 40030
40030 IF (AVD + 0.1641741415D+03) 10030, 10030, 20030
10030 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0031
20030 IVFAIL = IVFAIL + 1
DVCORR = -0.16417414165D+03
WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR
0031 CONTINUE
CT004* TEST 4 TEST OF LOG AND LOG10 WITH DOUBLE PREC
IVTNUM = 4
AVD = LOG(9.5D0) * LOG10(25.25D0)
IF (AVD - 0.3156899548D+01) 20040, 10040, 40040
40040 IF (AVD - 0.3156899552D+01) 10040, 10040, 20040
10040 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0041
20040 IVFAIL = IVFAIL + 1
DVCORR = 0.31568995498D+01
WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR
0041 CONTINUE
CT005* TEST 5 TEST OF AINT, SQRT AND LOG10
IVTNUM = 5
AVD = (AINT(2.75D0) + SQRT(17.125D0)) * LOG10(10.0D0)
IF (AVD - 0.6138236337D+01) 20050, 10050, 40050
40050 IF (AVD - 0.6138236343D+01) 10050, 10050, 20050
10050 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0051
20050 IVFAIL = IVFAIL + 1
DVCORR = 0.613823634D+01
WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR
0051 CONTINUE
CT006* TEST 6 TEST OF AINT AND NINT WITH DOUBLE PREC
IVTNUM = 6
AVD = AINT(72.375D0) * NINT(-4.25D0)
IF (AVD + 0.2880000002D+03) 20060, 10060, 40060
40060 IF (AVD + 0.2879999998D+03) 10060, 10060, 20060
10060 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0061
20060 IVFAIL = IVFAIL + 1
DVCORR = -288.0D0
WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR
0061 CONTINUE
CT007* TEST 7 TEST OF SQRT, EXP AND LOG WITH COMPLEX
IVTNUM = 7
AVC = SQRT((-4.0,2.0)) + EXP((2.125,6.75)) * LOG((17.375,2.5))
IF (R2E(1) - 0.21370E+02) 20070, 40072, 40071
40071 IF (R2E(1) - 0.21373E+02) 40072, 40072, 20070
40072 IF (R2E(2) - 0.13922E+02) 20070, 10070, 40070
40070 IF (R2E(2) - 0.13925E+02) 10070, 10070, 20070
10070 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0071
20070 IVFAIL = IVFAIL + 1
ZVCORR = (21.3712104, 13.9235362)
WRITE (NUVI, 80045) IVTNUM, AVC, ZVCORR
0071 CONTINUE
CT008* TEST 8 TEST OF SQRT WITH REAL AND COMPLEX
IVTNUM = 8
AVC = SQRT(77.76953) - SQRT((-22.125, 7.0))
IF (R2E(1) - 0.80831E+01) 20080, 40082, 40081
40081 IF (R2E(1) - 0.80840E+01) 40082, 40082, 20080
40082 IF (R2E(2) + 0.47611E+01) 20080, 10080, 40080
40080 IF (R2E(2) + 0.47605E+01) 10080, 10080, 20080
10080 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0081
20080 IVFAIL = IVFAIL + 1
ZVCORR = (8.0835370, -4.7608266)
WRITE (NUVI, 80045) IVTNUM, AVC, ZVCORR
0081 CONTINUE
CT009* TEST 9 TEST OF AINT, NINT, EXP AND LOG
C***** WITH REAL AND COMPLEX
IVTNUM = 9
AVC = AINT(2.25) * NINT(1.50) + EXP((1.0, 2.0)) - LOG(5.125)
IF (R2E(1) - 0.12346E+01) 20090, 40092, 40091
40091 IF (R2E(1) - 0.12348E+01) 40092, 40092, 20090
40092 IF (R2E(2) - 0.24716E+01) 20090, 10090, 40090
40090 IF (R2E(2) - 0.24719E+01) 10090, 10090, 20090
10090 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0091
20090 IVFAIL = IVFAIL + 1
ZVCORR = (1.234665192, 2.471726672)
WRITE (NUVI, 80045) IVTNUM, AVC, ZVCORR
0091 CONTINUE
C*****
CBB** ********************** BBCSUM0 **********************************
C**** WRITE OUT TEST SUMMARY
C****
IVTOTN = IVPASS + IVFAIL + IVDELE + IVINSP
WRITE (I02, 90004)
WRITE (I02, 90014)
WRITE (I02, 90004)
WRITE (I02, 90020) IVPASS
WRITE (I02, 90022) IVFAIL
WRITE (I02, 90024) IVDELE
WRITE (I02, 90026) IVINSP
WRITE (I02, 90028) IVTOTN, IVTOTL
CBE** ********************** BBCSUM0 **********************************
CBB** ********************** BBCFOOT0 **********************************
C**** WRITE OUT REPORT FOOTINGS
C****
WRITE (I02,90016) ZPROG, ZPROG
WRITE (I02,90018) ZPROJ, ZNAME, ZTAPE, ZTAPED
WRITE (I02,90019)
CBE** ********************** BBCFOOT0 **********************************
CBB** ********************** BBCFMT0A **********************************
C**** FORMATS FOR TEST DETAIL LINES
C****
80000 FORMAT (1H ,2X,I3,4X,7HDELETED,32X,A31)
80002 FORMAT (1H ,2X,I3,4X,7H PASS ,32X,A31)
80004 FORMAT (1H ,2X,I3,4X,7HINSPECT,32X,A31)
80008 FORMAT (1H ,2X,I3,4X,7H FAIL ,32X,A31)
80010 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,15X,10HCOMPUTED= ,
1I6,/,1H ,15X,10HCORRECT= ,I6)
80012 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
1E12.5,/,1H ,16X,10HCORRECT= ,E12.5)
80018 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
1A21,/,1H ,16X,10HCORRECT= ,A21)
80020 FORMAT (1H ,16X,10HCOMPUTED= ,A21,1X,A31)
80022 FORMAT (1H ,16X,10HCORRECT= ,A21,1X,A31)
80024 FORMAT (1H ,16X,10HCOMPUTED= ,I6,16X,A31)
80026 FORMAT (1H ,16X,10HCORRECT= ,I6,16X,A31)
80028 FORMAT (1H ,16X,10HCOMPUTED= ,E12.5,10X,A31)
80030 FORMAT (1H ,16X,10HCORRECT= ,E12.5,10X,A31)
80050 FORMAT (1H ,48X,A31)
CBE** ********************** BBCFMT0A **********************************
CBB** ********************** BBCFMAT1 **********************************
C**** FORMATS FOR TEST DETAIL LINES - FULL LANGUAGE
C****
80031 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
1D17.10,/,1H ,16X,10HCORRECT= ,D17.10)
80033 FORMAT (1H ,16X,10HCOMPUTED= ,D17.10,10X,A31)
80035 FORMAT (1H ,16X,10HCORRECT= ,D17.10,10X,A31)
80037 FORMAT (1H ,16X,10HCOMPUTED= ,1H(,E12.5,2H, ,E12.5,1H),6X,A31)
80039 FORMAT (1H ,16X,10HCORRECT= ,1H(,E12.5,2H, ,E12.5,1H),6X,A31)
80041 FORMAT (1H ,16X,10HCOMPUTED= ,1H(,F12.5,2H, ,F12.5,1H),6X,A31)
80043 FORMAT (1H ,16X,10HCORRECT= ,1H(,F12.5,2H, ,F12.5,1H),6X,A31)
80045 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
11H(,F12.5,2H, ,F12.5,1H)/,1H ,16X,10HCORRECT= ,
21H(,F12.5,2H, ,F12.5,1H))
CBE** ********************** BBCFMAT1 **********************************
CBB** ********************** BBCFMT0B **********************************
C**** FORMAT STATEMENTS FOR PAGE HEADERS
C****
90002 FORMAT (1H1)
90004 FORMAT (1H )
90006 FORMAT (1H ,20X,31HFEDERAL SOFTWARE TESTING CENTER)
90007 FORMAT (1H ,19X,34HFORTRAN COMPILER VALIDATION SYSTEM)
90008 FORMAT (1H ,21X,A13,A17)
90009 FORMAT (1H ,/,2H *,A5,6HBEGIN*,12X,15HTEST RESULTS - ,A5,/)
90010 FORMAT (1H ,8X,16HTEST DATE*TIME= ,A17,15H - COMPILER= ,A20)
90013 FORMAT (1H ,8H TEST ,10HPASS/FAIL ,6X,17HDISPLAYED RESULTS,
1 7X,7HREMARKS,24X)
90014 FORMAT (1H ,46H----------------------------------------------,
1 33H---------------------------------)
90015 FORMAT (1H ,48X,17HTHIS PROGRAM HAS ,I3,6H TESTS,/)
C****
C**** FORMAT STATEMENTS FOR REPORT FOOTINGS
C****
90016 FORMAT (1H ,/,2H *,A5,4HEND*,14X,14HEND OF TEST - ,A5,/)
90018 FORMAT (1H ,A13,13X,A20,7H * ,A10,1H/,
1 A13)
90019 FORMAT (1H ,26HFOR OFFICIAL USE ONLY ,35X,15HCOPYRIGHT 1982)
C****
C**** FORMAT STATEMENTS FOR RUN SUMMARY
C****
90020 FORMAT (1H ,21X,I5,13H TESTS PASSED)
90022 FORMAT (1H ,21X,I5,13H TESTS FAILED)
90024 FORMAT (1H ,21X,I5,14H TESTS DELETED)
90026 FORMAT (1H ,21X,I5,25H TESTS REQUIRE INSPECTION)
90028 FORMAT (1H ,21X,I5,4H OF ,I3,15H TESTS EXECUTED)
CBE** ********************** BBCFMT0B **********************************
C*****
C***** END OF TEST SEGMENT 207
STOP
END
*END-OF,FM830
FM831.f 481036597 170 2 100666 15116 `
*HEADER,FORTR,FM831
*FILES1,FORTR,FM831,X
C***********************************************************************
C***** FORTRAN 77
C***** FM831
C***** YGEN3 - (208)
C*****
C***********************************************************************
C***** GENERAL PURPOSE ANS REF
C***** TEST GENERIC FUNCTIONS 15.3
C***** ABS, MOD, SIGN, SIN, COS, TAN, SINH, COSH, TANH TABLE 5
C*****
CBB** ********************** BBCCOMNT **********************************
C****
C**** 1978 FORTRAN COMPILER VALIDATION SYSTEM
C**** VERSION 2.0
C****
C****
C**** SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO
C**** GENERAL SERVICES ADMINISTRATION
C**** FEDERAL SOFTWARE TESTING CENTER
C**** 5203 LEESBURG PIKE, SUITE 1100
C**** FALLS CHURCH, VA. 22041
C****
C**** (703) 756-6153
C****
CBE** ********************** BBCCOMNT **********************************
C*****
C***** S P E C I F I C A T I O N S SEGMENT 208
DOUBLE PRECISION AVD, CVD, DVD, DVCORR
COMPLEX AVC, CVC, ZVCORR
REAL R2E(2)
EQUIVALENCE (AVC, R2E)
C*****
CBB** ********************** BBCINITA **********************************
C**** SPECIFICATION STATEMENTS
C****
CHARACTER ZVERS*13, ZVERSD*17, ZDATE*17, ZPROG*5, ZCOMPL*20,
1 ZNAME*20, ZTAPE*10, ZPROJ*13, REMRKS*31, ZTAPED*13
CBE** ********************** BBCINITA **********************************
CBB** ********************** BBCINITB **********************************
C**** INITIALIZE SECTION
DATA ZVERS, ZVERSD, ZDATE
1 /'VERSION 2.0 ', '82/08/02*18.33.46', '*NO DATE*TIME'/
DATA ZCOMPL, ZNAME, ZTAPE
1 /'*NONE SPECIFIED*', '*NO COMPANY NAME*', '*NO TAPE*'/
DATA ZPROJ, ZTAPED, ZPROG
1 /'*NO PROJECT*', '*NO TAPE DATE', 'XXXXX'/
DATA REMRKS /' '/
C**** THE FOLLOWING 9 COMMENT LINES (CZ01, CZ02, ...) CAN BE REPLACED
C**** FOR IDENTIFYING THE TEST ENVIRONMENT
C****
CZ01 ZVERS = 'VERSION OF THE COMPILER VALIDATION SYSTEM'
CZ02 ZVERSD = 'CREATION DATE/TIME OF THE COMPILER VALIDATION SYSTEM'
CZ03 ZPROG = 'PROGRAM NAME'
CZ04 ZDATE = 'DATE OF TEST'
CZ05 ZCOMPL = 'COMPILER IDENTIFICATION'
CZ06 ZPROJ = 'PROJECT NUMBER/IDENTIFICATION'
CZ07 ZNAME = 'NAME OF USER'
CZ08 ZTAPE = 'TAPE OWNER/ID'
CZ09 ZTAPED = 'DATE TAPE COPIED'
C
IVPASS = 0
IVFAIL = 0
IVDELE = 0
IVINSP = 0
IVTOTL = 0
IVTOTN = 0
ICZERO = 0
C
C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER.
I01 = 05
C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER.
I02 = 06
C
CX010 REPLACED BY FEXEC X-010 CONTROL CARD (CARD-READER UNIT NUMBER).
C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5
CX011 REPLACED BY FEXEC X-011 CONTROL CARD. CX011 IS FOR SYSTEMS
C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX010.
C
CX020 REPLACED BY FEXEC X-020 CONTROL CARD (PRINTER UNIT NUMBER).
C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02= 6
CX021 REPLACED BY FEXEC X-021 CONTROL CARD. CX021 IS FOR SYSTEMS
C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX020.
C
CBE** ********************** BBCINITB **********************************
NUVI = I02
IVTOTL = 12
ZPROG = 'FM831'
CBB** ********************** BBCHED0A **********************************
C****
C**** WRITE REPORT TITLE
C****
WRITE (I02, 90002)
WRITE (I02, 90006)
WRITE (I02, 90007)
WRITE (I02, 90008) ZVERS, ZVERSD
WRITE (I02, 90009) ZPROG, ZPROG
WRITE (I02, 90010) ZDATE, ZCOMPL
CBE** ********************** BBCHED0A **********************************
C*****
C***** HEADER FOR SEGMENT 208
WRITE(NUVI,20800)
20800 FORMAT( 1H , / 35H YGEN3 - (208) GENERIC FUNCTIONS --//
1 49H ABS, MOD, SIGN, SIN, COS, TAN, SINH, COSH, TANH//
2 17H ANS REF. - 15.3)
CBB** ********************** BBCHED0B **********************************
C**** WRITE DETAIL REPORT HEADERS
C****
WRITE (I02,90004)
WRITE (I02,90004)
WRITE (I02,90013)
WRITE (I02,90014)
WRITE (I02,90015) IVTOTL
CBE** ********************** BBCHED0B **********************************
C*****
CT001* TEST 1 TEST OF ABS AND SIGN WITH INTEGERS
IVTNUM = 1
LVI = ABS(-25) - SIGN(2, -15)
IF (LVI - 27) 20010, 10010, 20010
10010 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0011
20010 IVFAIL = IVFAIL + 1
IVCORR = 27
WRITE (NUVI, 80010) IVTNUM, LVI, IVCORR
0011 CONTINUE
CT002* TEST 2 TEST OF MOD, SIGN AND ABS WITH REALS
IVTNUM = 2
AVS = MOD(24.5, 2.5) + SIGN(-1.50, -5.125) - ABS(-63.5)
IF (AVS + 0.63004E+02) 20020, 10020, 40020
40020 IF (AVS + 0.62996E+02) 10020, 10020, 20020
10020 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0021
20020 IVFAIL = IVFAIL + 1
RVCORR = -63.0
WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR
0021 CONTINUE
CT003* TEST 3 TEST OF SIN AND COS WITH DOUBLE PREC
IVTNUM = 3
CVD = 1.125D0
AVD = (SIN(CVD)) ** 2 + (COS(CVD)) ** 2
IF (AVD - 0.9999999995D+00) 20030, 10030, 40030
40030 IF (AVD - 0.1000000001D+01) 10030, 10030, 20030
10030 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0031
20030 IVFAIL = IVFAIL + 1
DVCORR = 1.0D0
WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR
0031 CONTINUE
CT004* TEST 4 TEST OF TAN AND MOD WITH DOUBLE PREC
IVTNUM = 4
AVD = TAN(3.5D0) * MOD(32.5D0, 5.0D0)
IF (AVD - 0.9364640999D+00) 20040, 10040, 40040
40040 IF (AVD - 0.9364641009D+00) 10040, 10040, 20040
10040 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0041
20040 IVFAIL = IVFAIL + 1
DVCORR = 0.9364641003965D0
WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR
0041 CONTINUE
CT005* TEST 5 TEST OF SINH AND COSH WITH DOUBLE PREC
IVTNUM = 5
CVD = 3.25D0
AVD = (SINH(CVD)) ** 2 - (COSH(CVD)) ** 2
IF (AVD + 0.1000000001D+01) 20050, 10050, 40050
40050 IF (AVD + 0.9999999995D+00) 10050, 10050, 20050
10050 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0051
20050 IVFAIL = IVFAIL + 1
DVCORR = -1.0D0
WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR
0051 CONTINUE
CT006* TEST 6 TEST OF TANH WITH DOUBLE PREC
IVTNUM = 6
AVD = TANH(0.5D0) * TANH(0.75D0)
IF (AVD - 0.2935132281D+00) 20060, 10060, 40060
40060 IF (AVD - 0.2935132285D+00) 10060, 10060, 20060
10060 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0061
20060 IVFAIL = IVFAIL + 1
DVCORR = 0.29351322831389D0
WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR
0061 CONTINUE
CT007* TEST 7 TEST OF ABS AND SIN WITH DOUBLE PREC
IVTNUM = 7
AVD = ABS(4.57812500D0) * SIN(1.125D0)
IF (AVD - 0.4130693827D+01) 20070, 10070, 40070
40070 IF (AVD - 0.4130693832D+01) 10070, 10070, 20070
10070 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0071
20070 IVFAIL = IVFAIL + 1
DVCORR = 4.130693829235D0
WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR
0071 CONTINUE
CT008* TEST 8 TEST OF ABS, MOD AND SIGN
C***** WITH INTEGER, REAL AND DOUBLE PREC
IVTNUM = 8
LVI = -25
AVS = 32.750
BVS = 1.375
CVD = 0.75D0
DVD = 1.125D0
AVD = ABS(LVI) - (MOD(AVS, BVS) * SIGN(CVD, DVD))
IF (AVD - 0.2415624998D+02) 20080, 10080, 40080
40080 IF (AVD - 0.2415625002D+02) 10080, 10080, 20080
10080 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0081
20080 IVFAIL = IVFAIL + 1
DVCORR = 24.15625D0
WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR
0081 CONTINUE
CT009* TEST 9 TEST OF ABS WITH COMPLEX
IVTNUM = 9
AVS = ABS((-2.125, 5.0))
IF (AVS - 0.54325E+01) 20090, 10090, 40090
40090 IF (AVS - 0.54331E+01) 10090, 10090, 20090
10090 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0091
20090 IVFAIL = IVFAIL + 1
RVCORR = 5.4328279
WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR
0091 CONTINUE
CT010* TEST 10 TEST OF SIN AND COS WITH COMPLEX
IVTNUM = 10
AVC = SIN((2.5, 3.5)) * COS((-4.75, 1.25))
IF (R2E(1) + 0.20512E+02) 20100, 40102, 40101
40101 IF (R2E(1) + 0.20510E+02) 40102, 40102, 20100
40102 IF (R2E(2) + 0.16820E+02) 20100, 10100, 40100
40100 IF (R2E(2) + 0.16817E+02) 10100, 10100, 20100
10100 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0101
20100 IVFAIL = IVFAIL + 1
ZVCORR = (-20.5109598, -16.8182771)
WRITE (NUVI, 80045) IVTNUM, AVC, ZVCORR
0101 CONTINUE
CT011* TEST 11 TEST OF SIN, COS AND TAN
C***** WITH REAL AND COMPLEX
IVTNUM = 11
AVS = 2.0
CVC = (3.125, 1.5)
BVS = 3.5
AVC = SIN(AVS) + COS(CVC) + TAN(BVS)
IF (R2E(1) + 0.10683E+01) 20110, 40112, 40111
40111 IF (R2E(1) + 0.10681E+01) 40112, 40112, 20110
40112 IF (R2E(2) + 0.35331E-01) 20110, 10110, 40110
40110 IF (R2E(2) + 0.35327E-01) 10110, 10110, 20110
10110 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0111
20110 IVFAIL = IVFAIL + 1
ZVCORR = (-1.068203, -0.0353288)
WRITE (NUVI, 80045) IVTNUM, AVC, ZVCORR
0111 CONTINUE
CT012* TEST 12 TEST OF ABS, MOD, SIN AND COS
C***** WITH INTEGER, REAL AND COMPLEX
IVTNUM = 12
AVC = ABS(-2) * MOD(17.250, 3.125) + SIN(3.125) -
1 COS((-0.375, 1.625))
IF (R2E(1) - 0.81218E+00) 20120, 40122, 40121
40121 IF (R2E(1) - 0.81227E+00) 40122, 40122, 20120
40122 IF (R2E(2) + 0.89403E+00) 20120, 10120, 40120
40120 IF (R2E(2) + 0.89393E+00) 10120, 10120, 20120
10120 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0121
20120 IVFAIL = IVFAIL + 1
ZVCORR = (0.8122242, -0.893981)
WRITE (NUVI, 80045) IVTNUM, AVC, ZVCORR
0121 CONTINUE
C*****
CBB** ********************** BBCSUM0 **********************************
C**** WRITE OUT TEST SUMMARY
C****
IVTOTN = IVPASS + IVFAIL + IVDELE + IVINSP
WRITE (I02, 90004)
WRITE (I02, 90014)
WRITE (I02, 90004)
WRITE (I02, 90020) IVPASS
WRITE (I02, 90022) IVFAIL
WRITE (I02, 90024) IVDELE
WRITE (I02, 90026) IVINSP
WRITE (I02, 90028) IVTOTN, IVTOTL
CBE** ********************** BBCSUM0 **********************************
CBB** ********************** BBCFOOT0 **********************************
C**** WRITE OUT REPORT FOOTINGS
C****
WRITE (I02,90016) ZPROG, ZPROG
WRITE (I02,90018) ZPROJ, ZNAME, ZTAPE, ZTAPED
WRITE (I02,90019)
CBE** ********************** BBCFOOT0 **********************************
CBB** ********************** BBCFMT0A **********************************
C**** FORMATS FOR TEST DETAIL LINES
C****
80000 FORMAT (1H ,2X,I3,4X,7HDELETED,32X,A31)
80002 FORMAT (1H ,2X,I3,4X,7H PASS ,32X,A31)
80004 FORMAT (1H ,2X,I3,4X,7HINSPECT,32X,A31)
80008 FORMAT (1H ,2X,I3,4X,7H FAIL ,32X,A31)
80010 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,15X,10HCOMPUTED= ,
1I6,/,1H ,15X,10HCORRECT= ,I6)
80012 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
1E12.5,/,1H ,16X,10HCORRECT= ,E12.5)
80018 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
1A21,/,1H ,16X,10HCORRECT= ,A21)
80020 FORMAT (1H ,16X,10HCOMPUTED= ,A21,1X,A31)
80022 FORMAT (1H ,16X,10HCORRECT= ,A21,1X,A31)
80024 FORMAT (1H ,16X,10HCOMPUTED= ,I6,16X,A31)
80026 FORMAT (1H ,16X,10HCORRECT= ,I6,16X,A31)
80028 FORMAT (1H ,16X,10HCOMPUTED= ,E12.5,10X,A31)
80030 FORMAT (1H ,16X,10HCORRECT= ,E12.5,10X,A31)
80050 FORMAT (1H ,48X,A31)
CBE** ********************** BBCFMT0A **********************************
CBB** ********************** BBCFMAT1 **********************************
C**** FORMATS FOR TEST DETAIL LINES - FULL LANGUAGE
C****
80031 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
1D17.10,/,1H ,16X,10HCORRECT= ,D17.10)
80033 FORMAT (1H ,16X,10HCOMPUTED= ,D17.10,10X,A31)
80035 FORMAT (1H ,16X,10HCORRECT= ,D17.10,10X,A31)
80037 FORMAT (1H ,16X,10HCOMPUTED= ,1H(,E12.5,2H, ,E12.5,1H),6X,A31)
80039 FORMAT (1H ,16X,10HCORRECT= ,1H(,E12.5,2H, ,E12.5,1H),6X,A31)
80041 FORMAT (1H ,16X,10HCOMPUTED= ,1H(,F12.5,2H, ,F12.5,1H),6X,A31)
80043 FORMAT (1H ,16X,10HCORRECT= ,1H(,F12.5,2H, ,F12.5,1H),6X,A31)
80045 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
11H(,F12.5,2H, ,F12.5,1H)/,1H ,16X,10HCORRECT= ,
21H(,F12.5,2H, ,F12.5,1H))
CBE** ********************** BBCFMAT1 **********************************
CBB** ********************** BBCFMT0B **********************************
C**** FORMAT STATEMENTS FOR PAGE HEADERS
C****
90002 FORMAT (1H1)
90004 FORMAT (1H )
90006 FORMAT (1H ,20X,31HFEDERAL SOFTWARE TESTING CENTER)
90007 FORMAT (1H ,19X,34HFORTRAN COMPILER VALIDATION SYSTEM)
90008 FORMAT (1H ,21X,A13,A17)
90009 FORMAT (1H ,/,2H *,A5,6HBEGIN*,12X,15HTEST RESULTS - ,A5,/)
90010 FORMAT (1H ,8X,16HTEST DATE*TIME= ,A17,15H - COMPILER= ,A20)
90013 FORMAT (1H ,8H TEST ,10HPASS/FAIL ,6X,17HDISPLAYED RESULTS,
1 7X,7HREMARKS,24X)
90014 FORMAT (1H ,46H----------------------------------------------,
1 33H---------------------------------)
90015 FORMAT (1H ,48X,17HTHIS PROGRAM HAS ,I3,6H TESTS,/)
C****
C**** FORMAT STATEMENTS FOR REPORT FOOTINGS
C****
90016 FORMAT (1H ,/,2H *,A5,4HEND*,14X,14HEND OF TEST - ,A5,/)
90018 FORMAT (1H ,A13,13X,A20,7H * ,A10,1H/,
1 A13)
90019 FORMAT (1H ,26HFOR OFFICIAL USE ONLY ,35X,15HCOPYRIGHT 1982)
C****
C**** FORMAT STATEMENTS FOR RUN SUMMARY
C****
90020 FORMAT (1H ,21X,I5,13H TESTS PASSED)
90022 FORMAT (1H ,21X,I5,13H TESTS FAILED)
90024 FORMAT (1H ,21X,I5,14H TESTS DELETED)
90026 FORMAT (1H ,21X,I5,25H TESTS REQUIRE INSPECTION)
90028 FORMAT (1H ,21X,I5,4H OF ,I3,15H TESTS EXECUTED)
CBE** ********************** BBCFMT0B **********************************
C*****
C***** END OF TEST SEGMENT 208
STOP
END
*END-OF,FM831
FM832.f 481036602 170 2 100666 19069 `
*HEADER,FORTR,FM832
*FILES1,FORTR,FM832,X
C***********************************************************************
C***** FORTRAN 77
C***** FM832
C***** YGEN5 - (210)
C*****
C***********************************************************************
C***** GENERAL PURPOSE ANS REF
C***** TEST GENERIC FUNCTIONS 15.3
C***** SQRT,EXP,LOG,LOG10,COS,SINH,TANH,ASIN,ATAN,ATAN2 TABLE 5
C***** EACH FUNCTION IS FIRST CALLED WITH A REAL VALUE
C***** AND THEN WITH A DOUBLE PRECISION VALUE
C*****
CBB** ********************** BBCCOMNT **********************************
C****
C**** 1978 FORTRAN COMPILER VALIDATION SYSTEM
C**** VERSION 2.0
C****
C****
C**** SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO
C**** GENERAL SERVICES ADMINISTRATION
C**** FEDERAL SOFTWARE TESTING CENTER
C**** 5203 LEESBURG PIKE, SUITE 1100
C**** FALLS CHURCH, VA. 22041
C****
C**** (703) 756-6153
C****
CBE** ********************** BBCCOMNT **********************************
C*****
C***** S P E C I F I C A T I O N S SEGMENT 210
DOUBLE PRECISION AVD, BVD, CVD, DVCORR
C*****
CBB** ********************** BBCINITA **********************************
C**** SPECIFICATION STATEMENTS
C****
CHARACTER ZVERS*13, ZVERSD*17, ZDATE*17, ZPROG*5, ZCOMPL*20,
1 ZNAME*20, ZTAPE*10, ZPROJ*13, REMRKS*31, ZTAPED*13
CBE** ********************** BBCINITA **********************************
CBB** ********************** BBCINITB **********************************
C**** INITIALIZE SECTION
DATA ZVERS, ZVERSD, ZDATE
1 /'VERSION 2.0 ', '82/08/02*18.33.46', '*NO DATE*TIME'/
DATA ZCOMPL, ZNAME, ZTAPE
1 /'*NONE SPECIFIED*', '*NO COMPANY NAME*', '*NO TAPE*'/
DATA ZPROJ, ZTAPED, ZPROG
1 /'*NO PROJECT*', '*NO TAPE DATE', 'XXXXX'/
DATA REMRKS /' '/
C**** THE FOLLOWING 9 COMMENT LINES (CZ01, CZ02, ...) CAN BE REPLACED
C**** FOR IDENTIFYING THE TEST ENVIRONMENT
C****
CZ01 ZVERS = 'VERSION OF THE COMPILER VALIDATION SYSTEM'
CZ02 ZVERSD = 'CREATION DATE/TIME OF THE COMPILER VALIDATION SYSTEM'
CZ03 ZPROG = 'PROGRAM NAME'
CZ04 ZDATE = 'DATE OF TEST'
CZ05 ZCOMPL = 'COMPILER IDENTIFICATION'
CZ06 ZPROJ = 'PROJECT NUMBER/IDENTIFICATION'
CZ07 ZNAME = 'NAME OF USER'
CZ08 ZTAPE = 'TAPE OWNER/ID'
CZ09 ZTAPED = 'DATE TAPE COPIED'
C
IVPASS = 0
IVFAIL = 0
IVDELE = 0
IVINSP = 0
IVTOTL = 0
IVTOTN = 0
ICZERO = 0
C
C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER.
I01 = 05
C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER.
I02 = 06
C
CX010 REPLACED BY FEXEC X-010 CONTROL CARD (CARD-READER UNIT NUMBER).
C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5
CX011 REPLACED BY FEXEC X-011 CONTROL CARD. CX011 IS FOR SYSTEMS
C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX010.
C
CX020 REPLACED BY FEXEC X-020 CONTROL CARD (PRINTER UNIT NUMBER).
C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02= 6
CX021 REPLACED BY FEXEC X-021 CONTROL CARD. CX021 IS FOR SYSTEMS
C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX020.
C
CBE** ********************** BBCINITB **********************************
NUVI = I02
IVTOTL = 20
ZPROG = 'FM832'
CBB** ********************** BBCHED0A **********************************
C****
C**** WRITE REPORT TITLE
C****
WRITE (I02, 90002)
WRITE (I02, 90006)
WRITE (I02, 90007)
WRITE (I02, 90008) ZVERS, ZVERSD
WRITE (I02, 90009) ZPROG, ZPROG
WRITE (I02, 90010) ZDATE, ZCOMPL
CBE** ********************** BBCHED0A **********************************
C*****
C***** HEADER FOR SEGMENT 210
WRITE(NUVI,21000)
21000 FORMAT( 1H , / 35H YGEN5 - (210) GENERIC FUNCTIONS --//
1 50H SQRT,EXP,LOG,LOG10,COS,SINH,TANH,ASIN,ATAN,ATAN2//
2 17H ANS REF. - 15.3)
CBB** ********************** BBCHED0B **********************************
C**** WRITE DETAIL REPORT HEADERS
C****
WRITE (I02,90004)
WRITE (I02,90004)
WRITE (I02,90013)
WRITE (I02,90014)
WRITE (I02,90015) IVTOTL
CBE** ********************** BBCHED0B **********************************
C*****
C***** TEST WITH REAL ARGUMENTS
C*****
WRITE(NUVI, 21001)
21001 FORMAT (/ 8X, 24HTEST WITH REAL ARGUMENTS)
CT001* TEST 1 TEST OF SQRT
IVTNUM = 1
AVS = 2.0
BVS = 1.0
AVD = SQRT(AVS*BVS)
IF (AVD - 0.14141E+01) 20010, 10010, 40010
40010 IF (AVD - 0.14143E+01) 10010, 10010, 20010
10010 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0011
20010 IVFAIL = IVFAIL + 1
RVCORR = 0.14142135381699E+01
WRITE (NUVI, 80012) IVTNUM, AVD, RVCORR
0011 CONTINUE
CT002* TEST 2 TEST OF EXP
IVTNUM = 2
AVS = 10.0
AVD = EXP(AVS / 10.0)
IF (AVD - 0.27181E+01) 20020, 10020, 40020
40020 IF (AVD - 0.27185E+01) 10020, 10020, 20020
10020 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0021
20020 IVFAIL = IVFAIL + 1
RVCORR = 0.27182817459106E+01
WRITE (NUVI, 80012) IVTNUM, AVD, RVCORR
0021 CONTINUE
CT003* TEST 3 TEST OF LOG
IVTNUM = 3
AVS = 0.1234
BVS = .0000567
AVD = LOG(AVS + BVS)
IF (AVD + 0.20920E+01) 20030, 10030, 40030
40030 IF (AVD + 0.20917E+01) 10030, 10030, 20030
10030 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0031
20030 IVFAIL = IVFAIL + 1
RVCORR = -0.20918648242950E+01
WRITE (NUVI, 80012) IVTNUM, AVD, RVCORR
0031 CONTINUE
CT004* TEST 4 TEST OF LOG10
IVTNUM = 4
AVS = 0.375
BVD = 3.75D0
AVD = LOG10(AVS)
IF (AVD + 0.42599E+00) 20040, 10040, 40040
40040 IF (AVD + 0.42594E+00) 10040, 10040, 20040
10040 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0041
20040 IVFAIL = IVFAIL + 1
RVCORR = -0.42596873641014E+00
WRITE (NUVI, 80012) IVTNUM, AVD, RVCORR
0041 CONTINUE
CT005* TEST 5 TEST OF COS
IVTNUM = 5
AVS = .25
AVD = COS(AVS*2)
IF (AVD - 0.87753E+00) 20050, 10050, 40050
40050 IF (AVD - 0.87763E+00) 10050, 10050, 20050
10050 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0051
20050 IVFAIL = IVFAIL + 1
RVCORR = 0.87758255004883E+00
WRITE (NUVI, 80012) IVTNUM, AVD, RVCORR
0051 CONTINUE
CT006* TEST 6 TEST OF SINH
IVTNUM = 6
AVD = SINH(AVS+3.0)
IF (AVD - 0.12875E+02) 20060, 10060, 40060
40060 IF (AVD - 0.12877E+02) 10060, 10060, 20060
10060 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0061
20060 IVFAIL = IVFAIL + 1
RVCORR = 0.12875782966614E+02
WRITE (NUVI, 80012) IVTNUM, AVD, RVCORR
0061 CONTINUE
CT007* TEST 7 TEST OF TANH
IVTNUM = 7
CVD = 0.5D1
AVD = TANH(AVS*20.0)
IF (AVD - 0.99986E+00) 20070, 10070, 40070
40070 IF (AVD - 0.99996E+00) 10070, 10070, 20070
10070 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0071
20070 IVFAIL = IVFAIL + 1
RVCORR = 0.99990922212601E+00
WRITE (NUVI, 80012) IVTNUM, AVD, RVCORR
0071 CONTINUE
CT008* TEST 8 TEST OF ASIN
IVTNUM = 8
AVD = ASIN(AVS*4.0)
IF (AVD - 0.15707E+01) 20080, 10080, 40080
40080 IF (AVD - 0.15709E+01) 10080, 10080, 20080
10080 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0081
20080 IVFAIL = IVFAIL + 1
RVCORR = 0.15707963705063E+01
WRITE (NUVI, 80012) IVTNUM, AVD, RVCORR
0081 CONTINUE
CT009* TEST 9 TEST OF ATAN
IVTNUM = 9
AVS = 500.0
AVD = ATAN(-2.0*AVS)
IF (AVD + 0.15699E+01) 20090, 10090, 40090
40090 IF (AVD + 0.15697E+01) 10090, 10090, 20090
10090 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0091
20090 IVFAIL = IVFAIL + 1
RVCORR = -0.15697963237762E+01
WRITE (NUVI, 80012) IVTNUM, AVD, RVCORR
0091 CONTINUE
CT010* TEST 10 TEST OF ATAN2
IVTNUM = 10
AVS = 0.0
BVS = -5.0
AVD = ATAN2(AVS, BVS)
IF (AVD - 0.31414E+01) 20100, 10100, 40100
40100 IF (AVD - 0.31418E+01) 10100, 10100, 20100
10100 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0101
20100 IVFAIL = IVFAIL + 1
RVCORR = 0.31415927410126E+01
WRITE (NUVI, 80012) IVTNUM, AVD, RVCORR
0101 CONTINUE
C*****
WRITE (NUVI, 90002)
WRITE (NUVI, 90013)
WRITE (NUVI, 90014)
C*****
C***** TEST WITH DOUBLE PRECISION ARGUMENTS
C*****
WRITE (NUVI, 21002)
21002 FORMAT (/ 08X, 36HTEST WITH DOUBLE PRECISION ARGUMENTS)
CT011* TEST 11 TEST OF SQRT
IVTNUM = 11
AVS = 2.0
BVS = 1.0
BVD = SQRT(DBLE(AVS))
IF (BVD - 0.1414213561D+01) 20110, 10110, 40110
40110 IF (BVD - 0.1414213563D+01) 10110, 10110, 20110
10110 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0111
20110 IVFAIL = IVFAIL + 1
DVCORR = 0.14142135623731D+01
WRITE (NUVI, 80031) IVTNUM, BVD, DVCORR
0111 CONTINUE
CT012* TEST 12 TEST OF EXP
IVTNUM = 12
AVS = 10.0
BVD = EXP(1.0D0)
IF (BVD - 0.2718281827D+01) 20120, 10120, 40120
40120 IF (BVD - 0.2718281830D+01) 10120, 10120, 20120
10120 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0121
20120 IVFAIL = IVFAIL + 1
DVCORR = 0.27182818284590D+01
WRITE (NUVI, 80031) IVTNUM, BVD, DVCORR
0121 CONTINUE
CT013* TEST 13 TEST OF LOG
IVTNUM = 13
AVS = 0.1234
BVS = .0000567
BVD = LOG(0.1234567D0)
IF (BVD + 0.2091864793D+01) 20130, 10130, 40130
40130 IF (BVD + 0.2091864790D+01) 10130, 10130, 20130
10130 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0131
20130 IVFAIL = IVFAIL + 1
DVCORR = -0.20918647916786D+01
WRITE (NUVI, 80031) IVTNUM, BVD, DVCORR
0131 CONTINUE
CT014* TEST 14 TEST OF LOG10
IVTNUM = 14
AVS = 0.375
BVD = 3.75D0
BVD = LOG10(BVD / 1.0D1)
IF (BVD + 0.4259687325D+00) 20140, 10140, 40140
40140 IF (BVD + 0.4259687320D+00) 10140, 10140, 20140
10140 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0141
20140 IVFAIL = IVFAIL + 1
DVCORR = -0.42596873227228D+00
WRITE (NUVI, 80031) IVTNUM, BVD, DVCORR
0141 CONTINUE
CT015* TEST 15 TEST OF COS
IVTNUM = 15
AVS = .25
BVD = COS(0.5D0)
IF (BVD - 0.8775825614D+00) 20150, 10150, 40150
40150 IF (BVD - 0.8775825624D+00) 10150, 10150, 20150
10150 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0151
20150 IVFAIL = IVFAIL + 1
DVCORR = 0.87758256189037D+00
WRITE (NUVI, 80031) IVTNUM, BVD, DVCORR
0151 CONTINUE
CT016* TEST 16 TEST OF SINH
IVTNUM = 16
BVD = SINH(3.25D0)
IF (BVD - 0.1287578284D+02) 20160, 10160, 40160
40160 IF (BVD - 0.1287578286D+02) 10160, 10160, 20160
10160 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0161
20160 IVFAIL = IVFAIL + 1
DVCORR = 0.12875782854681D+02
WRITE (NUVI, 80031) IVTNUM, BVD, DVCORR
0161 CONTINUE
CT017* TEST 17 TEST OF TANH
IVTNUM = 17
CVD = 0.5D1
BVD = TANH(CVD)
IF (BVD - 0.9999092037D+00) 20170, 10170, 40170
40170 IF (BVD - 0.9999092048D+00) 10170, 10170, 20170
10170 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0171
20170 IVFAIL = IVFAIL + 1
DVCORR = 0.99990920426260D+00
WRITE (NUVI, 80031) IVTNUM, BVD, DVCORR
0171 CONTINUE
CT018* TEST 18 TEST OF ASIN
IVTNUM = 18
BVD = ASIN(100.0D0 / 1.0D2)
IF (BVD - 0.1570796326D+01) 20180, 10180, 40180
40180 IF (BVD - 0.1570796328D+01) 10180, 10180, 20180
10180 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0181
20180 IVFAIL = IVFAIL + 1
DVCORR = 0.15707963267949D+01
WRITE (NUVI, 80031) IVTNUM, BVD, DVCORR
0181 CONTINUE
CT019* TEST 19 TEST OF ATAN
IVTNUM = 19
AVS = 500.0
BVD = ATAN(-1.0D3)
IF (BVD + 0.1569796328D+01) 20190, 10190, 40190
40190 IF (BVD + 0.1569796326D+01) 10190, 10190, 20190
10190 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0191
20190 IVFAIL = IVFAIL + 1
DVCORR = -0.15697963271282D+01
WRITE (NUVI, 80031) IVTNUM, BVD, DVCORR
0191 CONTINUE
CT020* TEST 20 TEST OF ATAN2
IVTNUM = 20
AVS = 0.0
BVS = -5.0
BVD = ATAN2(0.0D0, -5.0D0)
IF (BVD - 0.3141592652D+01) 20200, 10200, 40200
40200 IF (BVD - 0.3141592655D+01) 10200, 10200, 20200
10200 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0201
20200 IVFAIL = IVFAIL + 1
DVCORR = 0.31415926535898D+01
WRITE (NUVI, 80031) IVTNUM, BVD, DVCORR
0201 CONTINUE
C*****
CBB** ********************** BBCSUM0 **********************************
C**** WRITE OUT TEST SUMMARY
C****
IVTOTN = IVPASS + IVFAIL + IVDELE + IVINSP
WRITE (I02, 90004)
WRITE (I02, 90014)
WRITE (I02, 90004)
WRITE (I02, 90020) IVPASS
WRITE (I02, 90022) IVFAIL
WRITE (I02, 90024) IVDELE
WRITE (I02, 90026) IVINSP
WRITE (I02, 90028) IVTOTN, IVTOTL
CBE** ********************** BBCSUM0 **********************************
CBB** ********************** BBCFOOT0 **********************************
C**** WRITE OUT REPORT FOOTINGS
C****
WRITE (I02,90016) ZPROG, ZPROG
WRITE (I02,90018) ZPROJ, ZNAME, ZTAPE, ZTAPED
WRITE (I02,90019)
CBE** ********************** BBCFOOT0 **********************************
CBB** ********************** BBCFMT0A **********************************
C**** FORMATS FOR TEST DETAIL LINES
C****
80000 FORMAT (1H ,2X,I3,4X,7HDELETED,32X,A31)
80002 FORMAT (1H ,2X,I3,4X,7H PASS ,32X,A31)
80004 FORMAT (1H ,2X,I3,4X,7HINSPECT,32X,A31)
80008 FORMAT (1H ,2X,I3,4X,7H FAIL ,32X,A31)
80010 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,15X,10HCOMPUTED= ,
1I6,/,1H ,15X,10HCORRECT= ,I6)
80012 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
1E12.5,/,1H ,16X,10HCORRECT= ,E12.5)
80018 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
1A21,/,1H ,16X,10HCORRECT= ,A21)
80020 FORMAT (1H ,16X,10HCOMPUTED= ,A21,1X,A31)
80022 FORMAT (1H ,16X,10HCORRECT= ,A21,1X,A31)
80024 FORMAT (1H ,16X,10HCOMPUTED= ,I6,16X,A31)
80026 FORMAT (1H ,16X,10HCORRECT= ,I6,16X,A31)
80028 FORMAT (1H ,16X,10HCOMPUTED= ,E12.5,10X,A31)
80030 FORMAT (1H ,16X,10HCORRECT= ,E12.5,10X,A31)
80050 FORMAT (1H ,48X,A31)
CBE** ********************** BBCFMT0A **********************************
CBB** ********************** BBCFMAT1 **********************************
C**** FORMATS FOR TEST DETAIL LINES - FULL LANGUAGE
C****
80031 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
1D17.10,/,1H ,16X,10HCORRECT= ,D17.10)
80033 FORMAT (1H ,16X,10HCOMPUTED= ,D17.10,10X,A31)
80035 FORMAT (1H ,16X,10HCORRECT= ,D17.10,10X,A31)
80037 FORMAT (1H ,16X,10HCOMPUTED= ,1H(,E12.5,2H, ,E12.5,1H),6X,A31)
80039 FORMAT (1H ,16X,10HCORRECT= ,1H(,E12.5,2H, ,E12.5,1H),6X,A31)
80041 FORMAT (1H ,16X,10HCOMPUTED= ,1H(,F12.5,2H, ,F12.5,1H),6X,A31)
80043 FORMAT (1H ,16X,10HCORRECT= ,1H(,F12.5,2H, ,F12.5,1H),6X,A31)
80045 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
11H(,F12.5,2H, ,F12.5,1H)/,1H ,16X,10HCORRECT= ,
21H(,F12.5,2H, ,F12.5,1H))
CBE** ********************** BBCFMAT1 **********************************
CBB** ********************** BBCFMT0B **********************************
C**** FORMAT STATEMENTS FOR PAGE HEADERS
C****
90002 FORMAT (1H1)
90004 FORMAT (1H )
90006 FORMAT (1H ,20X,31HFEDERAL SOFTWARE TESTING CENTER)
90007 FORMAT (1H ,19X,34HFORTRAN COMPILER VALIDATION SYSTEM)
90008 FORMAT (1H ,21X,A13,A17)
90009 FORMAT (1H ,/,2H *,A5,6HBEGIN*,12X,15HTEST RESULTS - ,A5,/)
90010 FORMAT (1H ,8X,16HTEST DATE*TIME= ,A17,15H - COMPILER= ,A20)
90013 FORMAT (1H ,8H TEST ,10HPASS/FAIL ,6X,17HDISPLAYED RESULTS,
1 7X,7HREMARKS,24X)
90014 FORMAT (1H ,46H----------------------------------------------,
1 33H---------------------------------)
90015 FORMAT (1H ,48X,17HTHIS PROGRAM HAS ,I3,6H TESTS,/)
C****
C**** FORMAT STATEMENTS FOR REPORT FOOTINGS
C****
90016 FORMAT (1H ,/,2H *,A5,4HEND*,14X,14HEND OF TEST - ,A5,/)
90018 FORMAT (1H ,A13,13X,A20,7H * ,A10,1H/,
1 A13)
90019 FORMAT (1H ,26HFOR OFFICIAL USE ONLY ,35X,15HCOPYRIGHT 1982)
C****
C**** FORMAT STATEMENTS FOR RUN SUMMARY
C****
90020 FORMAT (1H ,21X,I5,13H TESTS PASSED)
90022 FORMAT (1H ,21X,I5,13H TESTS FAILED)
90024 FORMAT (1H ,21X,I5,14H TESTS DELETED)
90026 FORMAT (1H ,21X,I5,25H TESTS REQUIRE INSPECTION)
90028 FORMAT (1H ,21X,I5,4H OF ,I3,15H TESTS EXECUTED)
CBE** ********************** BBCFMT0B **********************************
C*****
C***** END OF TEST SEGMENT 210
STOP
END
*END-OF,FM832
FM833.f 481036606 170 2 100666 14538 `
*HEADER,FORTR,FM833
*FILES1,FORTR,FM833,X
C***********************************************************************
C***** FORTRAN 77
C***** FM833
C***** YGEN6 - (211)
C*****
C***********************************************************************
C***** GENERAL PURPOSE ANS REF
C***** TEST GENERIC FUNCTIONS 15.3
C***** SPECIFIC AND GENERIC NAME OF SAME FUNCTION WITH TABLE 5
C***** SAME TYPE OF ARGUMENT IN A STATEMENT
C*****
CBB** ********************** BBCCOMNT **********************************
C****
C**** 1978 FORTRAN COMPILER VALIDATION SYSTEM
C**** VERSION 2.0
C****
C****
C**** SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO
C**** GENERAL SERVICES ADMINISTRATION
C**** FEDERAL SOFTWARE TESTING CENTER
C**** 5203 LEESBURG PIKE, SUITE 1100
C**** FALLS CHURCH, VA. 22041
C****
C**** (703) 756-6153
C****
CBE** ********************** BBCCOMNT **********************************
C*****
C***** S P E C I F I C A T I O N S SEGMENT 211
DOUBLE PRECISION AVD, BVD, CVD, DVCORR
COMPLEX AVC, BVC, ZVCORR
REAL R2E(2)
EQUIVALENCE (AVC, R2E)
C*****
CBB** ********************** BBCINITA **********************************
C**** SPECIFICATION STATEMENTS
C****
CHARACTER ZVERS*13, ZVERSD*17, ZDATE*17, ZPROG*5, ZCOMPL*20,
1 ZNAME*20, ZTAPE*10, ZPROJ*13, REMRKS*31, ZTAPED*13
CBE** ********************** BBCINITA **********************************
CBB** ********************** BBCINITB **********************************
C**** INITIALIZE SECTION
DATA ZVERS, ZVERSD, ZDATE
1 /'VERSION 2.0 ', '82/08/02*18.33.46', '*NO DATE*TIME'/
DATA ZCOMPL, ZNAME, ZTAPE
1 /'*NONE SPECIFIED*', '*NO COMPANY NAME*', '*NO TAPE*'/
DATA ZPROJ, ZTAPED, ZPROG
1 /'*NO PROJECT*', '*NO TAPE DATE', 'XXXXX'/
DATA REMRKS /' '/
C**** THE FOLLOWING 9 COMMENT LINES (CZ01, CZ02, ...) CAN BE REPLACED
C**** FOR IDENTIFYING THE TEST ENVIRONMENT
C****
CZ01 ZVERS = 'VERSION OF THE COMPILER VALIDATION SYSTEM'
CZ02 ZVERSD = 'CREATION DATE/TIME OF THE COMPILER VALIDATION SYSTEM'
CZ03 ZPROG = 'PROGRAM NAME'
CZ04 ZDATE = 'DATE OF TEST'
CZ05 ZCOMPL = 'COMPILER IDENTIFICATION'
CZ06 ZPROJ = 'PROJECT NUMBER/IDENTIFICATION'
CZ07 ZNAME = 'NAME OF USER'
CZ08 ZTAPE = 'TAPE OWNER/ID'
CZ09 ZTAPED = 'DATE TAPE COPIED'
C
IVPASS = 0
IVFAIL = 0
IVDELE = 0
IVINSP = 0
IVTOTL = 0
IVTOTN = 0
ICZERO = 0
C
C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER.
I01 = 05
C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER.
I02 = 06
C
CX010 REPLACED BY FEXEC X-010 CONTROL CARD (CARD-READER UNIT NUMBER).
C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5
CX011 REPLACED BY FEXEC X-011 CONTROL CARD. CX011 IS FOR SYSTEMS
C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX010.
C
CX020 REPLACED BY FEXEC X-020 CONTROL CARD (PRINTER UNIT NUMBER).
C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02= 6
CX021 REPLACED BY FEXEC X-021 CONTROL CARD. CX021 IS FOR SYSTEMS
C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX020.
C
CBE** ********************** BBCINITB **********************************
NUVI = I02
IVTOTL = 11
ZPROG = 'FM833'
CBB** ********************** BBCHED0A **********************************
C****
C**** WRITE REPORT TITLE
C****
WRITE (I02, 90002)
WRITE (I02, 90006)
WRITE (I02, 90007)
WRITE (I02, 90008) ZVERS, ZVERSD
WRITE (I02, 90009) ZPROG, ZPROG
WRITE (I02, 90010) ZDATE, ZCOMPL
CBE** ********************** BBCHED0A **********************************
C*****
C***** HEADER FOR SEGMENT 211
WRITE(NUVI,21100)
21100 FORMAT( 1H , / 35H YGEN6 - (211) GENERIC FUNCTIONS --//
1 59H SPECIFIC AND GENERIC NAME OF SAME FUNCTION IN A STATEMENT//
2 17H ANS REF. - 15.3)
CBB** ********************** BBCHED0B **********************************
C**** WRITE DETAIL REPORT HEADERS
C****
WRITE (I02,90004)
WRITE (I02,90004)
WRITE (I02,90013)
WRITE (I02,90014)
WRITE (I02,90015) IVTOTL
CBE** ********************** BBCHED0B **********************************
C*****
CT001* TEST 1 TEST OF ISIGN AND SIGN WITH INTEGER
IVTNUM = 1
KVI = 5
JVI = -3
LVI = ISIGN(KVI, JVI) - SIGN(KVI, JVI)
IF (LVI - 0) 20010, 10010, 20010
10010 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0011
20010 IVFAIL = IVFAIL + 1
IVCORR = 0
WRITE (NUVI, 80010) IVTNUM, LVI, IVCORR
0011 CONTINUE
CT002* TEST 2 TEST OF AMAX1 AND MAX WITH REALS
IVTNUM = 2
BVS = 2.5
CVS = 3.5
AVS = AMAX1(BVS, CVS) - MAX(BVS, CVS)
IF (AVS + 0.50000E-04) 20020, 10020, 40020
40020 IF (AVS - 0.50000E-04) 10020, 10020, 20020
10020 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0021
20020 IVFAIL = IVFAIL + 1
RVCORR = 0.0000
WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR
0021 CONTINUE
CT003* TEST 3 TEST OF DEXP AND EXP WITH DOUBLE PREC
IVTNUM = 3
BVD = 1.0D0
AVD = DEXP(BVD) - EXP(BVD)
IF (AVD + 0.5000000000D-09) 20030, 10030, 40030
40030 IF (AVD - 0.5000000000D-09) 10030, 10030, 20030
10030 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0031
20030 IVFAIL = IVFAIL + 1
DVCORR = 0.00000000D+00
WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR
0031 CONTINUE
CT004* TEST 4 TEST OF DTANH AND TANH WITH DOUBLE PREC
IVTNUM = 4
BVD = 0.5D0
AVD = DTANH(BVD) - TANH(BVD)
IF (AVD + 0.5000000000D-09) 20040, 10040, 40040
40040 IF (AVD - 0.5000000000D-09) 10040, 10040, 20040
10040 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0041
20040 IVFAIL = IVFAIL + 1
DVCORR = 0.00000000D+00
WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR
0041 CONTINUE
CT005* TEST 5 TEST OF DASIN AND ASIN WITH DOUBLE PREC
IVTNUM = 5
BVD = -1.0D0
AVD = DASIN(BVD) - ASIN(BVD)
IF (AVD + 0.5000000000D-09) 20050, 10050, 40050
40050 IF (AVD - 0.5000000000D-09) 10050, 10050, 20050
10050 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0051
20050 IVFAIL = IVFAIL + 1
DVCORR = 0.00000000D+00
WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR
0051 CONTINUE
CT006* TEST 6 TEST OF DNINT AND ANINT WITH DOUBLE PREC
IVTNUM = 6
BVD = 2.75D0
AVD = DNINT(BVD) - ANINT(BVD)
IF (AVD + 0.5000000000D-09) 20060, 10060, 40060
40060 IF (AVD - 0.5000000000D-09) 10060, 10060, 20060
10060 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0061
20060 IVFAIL = IVFAIL + 1
DVCORR = 0.00000000D+00
WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR
0061 CONTINUE
CT007* TEST 7 TEST OF DMOD AND MOD WITH DOUBLE PREC
IVTNUM = 7
BVD = 6.0D0
CVD = 3.0D0
AVD = DMOD(BVD, CVD) - MOD(BVD, CVD)
IF (AVD + 0.5000000000D-09) 20070, 10070, 40070
40070 IF (AVD - 0.5000000000D-09) 10070, 10070, 20070
10070 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0071
20070 IVFAIL = IVFAIL + 1
DVCORR = 0.00000000D+00
WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR
0071 CONTINUE
CT008* TEST 8 TEST OF CABS AND ABS WITH COMPLEX
IVTNUM = 8
BVC = (4.0, 3.0)
AVC = CABS(BVC) - ABS(BVC)
IF (R2E(1) + 0.50000E-04) 20080, 40082, 40081
40081 IF (R2E(1) - 0.50000E-04) 40082, 40082, 20080
40082 IF (R2E(2) + 0.50000E-04) 20080, 10080, 40080
40080 IF (R2E(2) - 0.50000E-04) 10080, 10080, 20080
10080 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0081
20080 IVFAIL = IVFAIL + 1
ZVCORR = ( 0.0000, 0.0000)
WRITE (NUVI, 80045) IVTNUM, AVC, ZVCORR
0081 CONTINUE
CT009* TEST 9 TEST OF CSQRT AND SQRT WITH COMPLEX
IVTNUM = 9
BVC = (3.0, 4.0)
AVC = CSQRT(BVC) - SQRT(BVC)
IF (R2E(1) + 0.50000E-04) 20090, 40092, 40091
40091 IF (R2E(1) - 0.50000E-04) 40092, 40092, 20090
40092 IF (R2E(2) + 0.50000E-04) 20090, 10090, 40090
40090 IF (R2E(2) - 0.50000E-04) 10090, 10090, 20090
10090 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0091
20090 IVFAIL = IVFAIL + 1
ZVCORR = ( 0.0000, 0.0000)
WRITE (NUVI, 80045) IVTNUM, AVC, ZVCORR
0091 CONTINUE
CT010* TEST 10 TEST OF CLOG AND LOG WITH COMPLEX
IVTNUM = 10
BVC = (1.0, 0.0)
AVC = CLOG(BVC) - LOG(BVC)
IF (R2E(1) + 0.50000E-04) 20100, 40102, 40101
40101 IF (R2E(1) - 0.50000E-04) 40102, 40102, 20100
40102 IF (R2E(2) + 0.50000E-04) 20100, 10100, 40100
40100 IF (R2E(2) - 0.50000E-04) 10100, 10100, 20100
10100 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0101
20100 IVFAIL = IVFAIL + 1
ZVCORR = ( 0.0000, 0.0000)
WRITE (NUVI, 80045) IVTNUM, AVC, ZVCORR
0101 CONTINUE
CT011* TEST 11 TEST OF CSIN AND SIN WITH COMPLEX
IVTNUM = 11
BVC = (1.5, 3.5)
AVC = CSIN(BVC) - SIN(BVC)
IF (R2E(1) + 0.50000E-04) 20110, 40112, 40111
40111 IF (R2E(1) - 0.50000E-04) 40112, 40112, 20110
40112 IF (R2E(2) + 0.50000E-04) 20110, 10110, 40110
40110 IF (R2E(2) - 0.50000E-04) 10110, 10110, 20110
10110 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0111
20110 IVFAIL = IVFAIL + 1
ZVCORR = ( 0.0000, 0.0000)
WRITE (NUVI, 80045) IVTNUM, AVC, ZVCORR
0111 CONTINUE
C*****
CBB** ********************** BBCSUM0 **********************************
C**** WRITE OUT TEST SUMMARY
C****
IVTOTN = IVPASS + IVFAIL + IVDELE + IVINSP
WRITE (I02, 90004)
WRITE (I02, 90014)
WRITE (I02, 90004)
WRITE (I02, 90020) IVPASS
WRITE (I02, 90022) IVFAIL
WRITE (I02, 90024) IVDELE
WRITE (I02, 90026) IVINSP
WRITE (I02, 90028) IVTOTN, IVTOTL
CBE** ********************** BBCSUM0 **********************************
CBB** ********************** BBCFOOT0 **********************************
C**** WRITE OUT REPORT FOOTINGS
C****
WRITE (I02,90016) ZPROG, ZPROG
WRITE (I02,90018) ZPROJ, ZNAME, ZTAPE, ZTAPED
WRITE (I02,90019)
CBE** ********************** BBCFOOT0 **********************************
CBB** ********************** BBCFMT0A **********************************
C**** FORMATS FOR TEST DETAIL LINES
C****
80000 FORMAT (1H ,2X,I3,4X,7HDELETED,32X,A31)
80002 FORMAT (1H ,2X,I3,4X,7H PASS ,32X,A31)
80004 FORMAT (1H ,2X,I3,4X,7HINSPECT,32X,A31)
80008 FORMAT (1H ,2X,I3,4X,7H FAIL ,32X,A31)
80010 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,15X,10HCOMPUTED= ,
1I6,/,1H ,15X,10HCORRECT= ,I6)
80012 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
1E12.5,/,1H ,16X,10HCORRECT= ,E12.5)
80018 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
1A21,/,1H ,16X,10HCORRECT= ,A21)
80020 FORMAT (1H ,16X,10HCOMPUTED= ,A21,1X,A31)
80022 FORMAT (1H ,16X,10HCORRECT= ,A21,1X,A31)
80024 FORMAT (1H ,16X,10HCOMPUTED= ,I6,16X,A31)
80026 FORMAT (1H ,16X,10HCORRECT= ,I6,16X,A31)
80028 FORMAT (1H ,16X,10HCOMPUTED= ,E12.5,10X,A31)
80030 FORMAT (1H ,16X,10HCORRECT= ,E12.5,10X,A31)
80050 FORMAT (1H ,48X,A31)
CBE** ********************** BBCFMT0A **********************************
CBB** ********************** BBCFMAT1 **********************************
C**** FORMATS FOR TEST DETAIL LINES - FULL LANGUAGE
C****
80031 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
1D17.10,/,1H ,16X,10HCORRECT= ,D17.10)
80033 FORMAT (1H ,16X,10HCOMPUTED= ,D17.10,10X,A31)
80035 FORMAT (1H ,16X,10HCORRECT= ,D17.10,10X,A31)
80037 FORMAT (1H ,16X,10HCOMPUTED= ,1H(,E12.5,2H, ,E12.5,1H),6X,A31)
80039 FORMAT (1H ,16X,10HCORRECT= ,1H(,E12.5,2H, ,E12.5,1H),6X,A31)
80041 FORMAT (1H ,16X,10HCOMPUTED= ,1H(,F12.5,2H, ,F12.5,1H),6X,A31)
80043 FORMAT (1H ,16X,10HCORRECT= ,1H(,F12.5,2H, ,F12.5,1H),6X,A31)
80045 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
11H(,F12.5,2H, ,F12.5,1H)/,1H ,16X,10HCORRECT= ,
21H(,F12.5,2H, ,F12.5,1H))
CBE** ********************** BBCFMAT1 **********************************
CBB** ********************** BBCFMT0B **********************************
C**** FORMAT STATEMENTS FOR PAGE HEADERS
C****
90002 FORMAT (1H1)
90004 FORMAT (1H )
90006 FORMAT (1H ,20X,31HFEDERAL SOFTWARE TESTING CENTER)
90007 FORMAT (1H ,19X,34HFORTRAN COMPILER VALIDATION SYSTEM)
90008 FORMAT (1H ,21X,A13,A17)
90009 FORMAT (1H ,/,2H *,A5,6HBEGIN*,12X,15HTEST RESULTS - ,A5,/)
90010 FORMAT (1H ,8X,16HTEST DATE*TIME= ,A17,15H - COMPILER= ,A20)
90013 FORMAT (1H ,8H TEST ,10HPASS/FAIL ,6X,17HDISPLAYED RESULTS,
1 7X,7HREMARKS,24X)
90014 FORMAT (1H ,46H----------------------------------------------,
1 33H---------------------------------)
90015 FORMAT (1H ,48X,17HTHIS PROGRAM HAS ,I3,6H TESTS,/)
C****
C**** FORMAT STATEMENTS FOR REPORT FOOTINGS
C****
90016 FORMAT (1H ,/,2H *,A5,4HEND*,14X,14HEND OF TEST - ,A5,/)
90018 FORMAT (1H ,A13,13X,A20,7H * ,A10,1H/,
1 A13)
90019 FORMAT (1H ,26HFOR OFFICIAL USE ONLY ,35X,15HCOPYRIGHT 1982)
C****
C**** FORMAT STATEMENTS FOR RUN SUMMARY
C****
90020 FORMAT (1H ,21X,I5,13H TESTS PASSED)
90022 FORMAT (1H ,21X,I5,13H TESTS FAILED)
90024 FORMAT (1H ,21X,I5,14H TESTS DELETED)
90026 FORMAT (1H ,21X,I5,25H TESTS REQUIRE INSPECTION)
90028 FORMAT (1H ,21X,I5,4H OF ,I3,15H TESTS EXECUTED)
CBE** ********************** BBCFMT0B **********************************
C*****
C***** END OF TEST SEGMENT 211
STOP
END
*END-OF,FM833
FM834.f 481036610 170 2 100666 11950 `
*HEADER,FORTR,FM834
*FILES1,FORTR,FM834,X
C***********************************************************************
C***** FORTRAN 77
C***** FM834
C***** YGEN7 - (212)
C*****
C***********************************************************************
C***** GENERAL PURPOSE ANS REF
C***** TEST GENERIC FUNCTIONS 15.3
C***** USES GENERIC FUNCTIONS AS ARGUMENTS TO TABLE 5
C***** OTHER GENERIC FUNCTIONS
C*****
CBB** ********************** BBCCOMNT **********************************
C****
C**** 1978 FORTRAN COMPILER VALIDATION SYSTEM
C**** VERSION 2.0
C****
C****
C**** SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO
C**** GENERAL SERVICES ADMINISTRATION
C**** FEDERAL SOFTWARE TESTING CENTER
C**** 5203 LEESBURG PIKE, SUITE 1100
C**** FALLS CHURCH, VA. 22041
C****
C**** (703) 756-6153
C****
CBE** ********************** BBCCOMNT **********************************
C*****
C***** S P E C I F I C A T I O N S SEGMENT 212
DOUBLE PRECISION AVD, DVCORR
COMPLEX AVC, ZVCORR
REAL R2E(2)
EQUIVALENCE (AVC, R2E)
C*****
CBB** ********************** BBCINITA **********************************
C**** SPECIFICATION STATEMENTS
C****
CHARACTER ZVERS*13, ZVERSD*17, ZDATE*17, ZPROG*5, ZCOMPL*20,
1 ZNAME*20, ZTAPE*10, ZPROJ*13, REMRKS*31, ZTAPED*13
CBE** ********************** BBCINITA **********************************
CBB** ********************** BBCINITB **********************************
C**** INITIALIZE SECTION
DATA ZVERS, ZVERSD, ZDATE
1 /'VERSION 2.0 ', '82/08/02*18.33.46', '*NO DATE*TIME'/
DATA ZCOMPL, ZNAME, ZTAPE
1 /'*NONE SPECIFIED*', '*NO COMPANY NAME*', '*NO TAPE*'/
DATA ZPROJ, ZTAPED, ZPROG
1 /'*NO PROJECT*', '*NO TAPE DATE', 'XXXXX'/
DATA REMRKS /' '/
C**** THE FOLLOWING 9 COMMENT LINES (CZ01, CZ02, ...) CAN BE REPLACED
C**** FOR IDENTIFYING THE TEST ENVIRONMENT
C****
CZ01 ZVERS = 'VERSION OF THE COMPILER VALIDATION SYSTEM'
CZ02 ZVERSD = 'CREATION DATE/TIME OF THE COMPILER VALIDATION SYSTEM'
CZ03 ZPROG = 'PROGRAM NAME'
CZ04 ZDATE = 'DATE OF TEST'
CZ05 ZCOMPL = 'COMPILER IDENTIFICATION'
CZ06 ZPROJ = 'PROJECT NUMBER/IDENTIFICATION'
CZ07 ZNAME = 'NAME OF USER'
CZ08 ZTAPE = 'TAPE OWNER/ID'
CZ09 ZTAPED = 'DATE TAPE COPIED'
C
IVPASS = 0
IVFAIL = 0
IVDELE = 0
IVINSP = 0
IVTOTL = 0
IVTOTN = 0
ICZERO = 0
C
C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER.
I01 = 05
C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER.
I02 = 06
C
CX010 REPLACED BY FEXEC X-010 CONTROL CARD (CARD-READER UNIT NUMBER).
C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5
CX011 REPLACED BY FEXEC X-011 CONTROL CARD. CX011 IS FOR SYSTEMS
C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX010.
C
CX020 REPLACED BY FEXEC X-020 CONTROL CARD (PRINTER UNIT NUMBER).
C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02= 6
CX021 REPLACED BY FEXEC X-021 CONTROL CARD. CX021 IS FOR SYSTEMS
C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX020.
C
CBE** ********************** BBCINITB **********************************
NUVI = I02
IVTOTL = 7
ZPROG = 'FM834'
CBB** ********************** BBCHED0A **********************************
C****
C**** WRITE REPORT TITLE
C****
WRITE (I02, 90002)
WRITE (I02, 90006)
WRITE (I02, 90007)
WRITE (I02, 90008) ZVERS, ZVERSD
WRITE (I02, 90009) ZPROG, ZPROG
WRITE (I02, 90010) ZDATE, ZCOMPL
CBE** ********************** BBCHED0A **********************************
C*****
C***** HEADER FOR SEGMENT 212
WRITE(NUVI,21200)
21200 FORMAT( 1H , / 35H YGEN7 - (212) GENERIC FUNCTIONS --//
1 33H AS ARGUMENTS TO OTHER FUNCTIONS//
2 17H ANS REF. - 15.3)
CBB** ********************** BBCHED0B **********************************
C**** WRITE DETAIL REPORT HEADERS
C****
WRITE (I02,90004)
WRITE (I02,90004)
WRITE (I02,90013)
WRITE (I02,90014)
WRITE (I02,90015) IVTOTL
CBE** ********************** BBCHED0B **********************************
C*****
CT001* TEST 1 TEST OF ABS AND MIN WITH INTEGERS
C*****
IVTNUM = 1
LVI = 2 - ABS( MIN( -3, -8))
IF (LVI + 6) 20010, 10010, 20010
10010 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0011
20010 IVFAIL = IVFAIL + 1
IVCORR = -6
WRITE (NUVI, 80010) IVTNUM, LVI, IVCORR
0011 CONTINUE
CT002* TEST 2 TEST OF MOD AND SIGN WITH INTEGERS
IVTNUM = 2
LVI = 25 * MOD( SIGN( 14, -2), 3)
IF (LVI + 50) 20020, 10020, 20020
10020 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0021
20020 IVFAIL = IVFAIL + 1
IVCORR = -50
WRITE (NUVI, 80010) IVTNUM, LVI, IVCORR
0021 CONTINUE
CT003* TEST 3 TEST OF COS AND SQRT WITH REALS
IVTNUM = 3
AVS = 2.0 * COS( 1.25 + SQRT( 3.50))
IF (AVS + 0.19997E+01) 20030, 10030, 40030
40030 IF (AVS + 0.19994E+01) 10030, 10030, 20030
10030 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0031
20030 IVFAIL = IVFAIL + 1
RVCORR = -1.9995689
WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR
0031 CONTINUE
CT004* TEST 4 TEST OF MAX, LOG AND LOG10 WITH REALS
IVTNUM = 4
AVS = MAX( LOG( 274.125), 4.5 * LOG10( 121.75))
IF (AVS - 0.93841E+01) 20040, 10040, 40040
40040 IF (AVS - 0.93851E+01) 10040, 10040, 20040
10040 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0041
20040 IVFAIL = IVFAIL + 1
RVCORR = 9.3846103
WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR
0041 CONTINUE
CT005* TEST 5 TEST OF EXP AND MOD WITH DOUBLE PREC
IVTNUM = 5
AVD = 1.0D0 - EXP(5.25D0 + MOD(76.0D0, 2.5D0))
IF (AVD + 0.5170128250D+03) 20050, 10050, 40050
40050 IF (AVD + 0.5170128244D+03) 10050, 10050, 20050
10050 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0051
20050 IVFAIL = IVFAIL + 1
DVCORR = -517.01282466834D0
WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR
0051 CONTINUE
CT006* TEST 6 TEST OF SINH, ABS, TAN AND ATAN
IVTNUM = 6
AVD = SINH( ABS( TAN( 3.25D0) - ATAN( 1.1D-1)) - 0.01D0)
IF (AVD + 0.9274631705D-02) 20060, 10060, 40060
40060 IF (AVD + 0.9274631695D-02) 10060, 10060, 20060
10060 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0061
20060 IVFAIL = IVFAIL + 1
DVCORR = -0.92746316996764D-2
WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR
0061 CONTINUE
CT007* TEST 7 TEST OF EXP WITH COMPLEX AND COS WITH REAL
IVTNUM = 7
AVC = EXP( CMPLX(3.5, COS(0.925))) * CMPLX(1.0, 1.50)
IF (R2E(1) + 0.82578E+00) 20070, 40072, 40071
40071 IF (R2E(1) + 0.82569E+00) 40072, 40072, 20070
40072 IF (R2E(2) - 0.59691E+02) 20070, 10070, 40070
40070 IF (R2E(2) - 0.59697E+02) 10070, 10070, 20070
10070 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0071
20070 IVFAIL = IVFAIL + 1
ZVCORR = (-0.8257397, 59.6940191)
WRITE (NUVI, 80045) IVTNUM, AVC, ZVCORR
0071 CONTINUE
CBB** ********************** BBCSUM0 **********************************
C**** WRITE OUT TEST SUMMARY
C****
IVTOTN = IVPASS + IVFAIL + IVDELE + IVINSP
WRITE (I02, 90004)
WRITE (I02, 90014)
WRITE (I02, 90004)
WRITE (I02, 90020) IVPASS
WRITE (I02, 90022) IVFAIL
WRITE (I02, 90024) IVDELE
WRITE (I02, 90026) IVINSP
WRITE (I02, 90028) IVTOTN, IVTOTL
CBE** ********************** BBCSUM0 **********************************
CBB** ********************** BBCFOOT0 **********************************
C**** WRITE OUT REPORT FOOTINGS
C****
WRITE (I02,90016) ZPROG, ZPROG
WRITE (I02,90018) ZPROJ, ZNAME, ZTAPE, ZTAPED
WRITE (I02,90019)
CBE** ********************** BBCFOOT0 **********************************
CBB** ********************** BBCFMT0A **********************************
C**** FORMATS FOR TEST DETAIL LINES
C****
80000 FORMAT (1H ,2X,I3,4X,7HDELETED,32X,A31)
80002 FORMAT (1H ,2X,I3,4X,7H PASS ,32X,A31)
80004 FORMAT (1H ,2X,I3,4X,7HINSPECT,32X,A31)
80008 FORMAT (1H ,2X,I3,4X,7H FAIL ,32X,A31)
80010 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,15X,10HCOMPUTED= ,
1I6,/,1H ,15X,10HCORRECT= ,I6)
80012 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
1E12.5,/,1H ,16X,10HCORRECT= ,E12.5)
80018 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
1A21,/,1H ,16X,10HCORRECT= ,A21)
80020 FORMAT (1H ,16X,10HCOMPUTED= ,A21,1X,A31)
80022 FORMAT (1H ,16X,10HCORRECT= ,A21,1X,A31)
80024 FORMAT (1H ,16X,10HCOMPUTED= ,I6,16X,A31)
80026 FORMAT (1H ,16X,10HCORRECT= ,I6,16X,A31)
80028 FORMAT (1H ,16X,10HCOMPUTED= ,E12.5,10X,A31)
80030 FORMAT (1H ,16X,10HCORRECT= ,E12.5,10X,A31)
80050 FORMAT (1H ,48X,A31)
CBE** ********************** BBCFMT0A **********************************
CBB** ********************** BBCFMAT1 **********************************
C**** FORMATS FOR TEST DETAIL LINES - FULL LANGUAGE
C****
80031 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
1D17.10,/,1H ,16X,10HCORRECT= ,D17.10)
80033 FORMAT (1H ,16X,10HCOMPUTED= ,D17.10,10X,A31)
80035 FORMAT (1H ,16X,10HCORRECT= ,D17.10,10X,A31)
80037 FORMAT (1H ,16X,10HCOMPUTED= ,1H(,E12.5,2H, ,E12.5,1H),6X,A31)
80039 FORMAT (1H ,16X,10HCORRECT= ,1H(,E12.5,2H, ,E12.5,1H),6X,A31)
80041 FORMAT (1H ,16X,10HCOMPUTED= ,1H(,F12.5,2H, ,F12.5,1H),6X,A31)
80043 FORMAT (1H ,16X,10HCORRECT= ,1H(,F12.5,2H, ,F12.5,1H),6X,A31)
80045 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
11H(,F12.5,2H, ,F12.5,1H)/,1H ,16X,10HCORRECT= ,
21H(,F12.5,2H, ,F12.5,1H))
CBE** ********************** BBCFMAT1 **********************************
CBB** ********************** BBCFMT0B **********************************
C**** FORMAT STATEMENTS FOR PAGE HEADERS
C****
90002 FORMAT (1H1)
90004 FORMAT (1H )
90006 FORMAT (1H ,20X,31HFEDERAL SOFTWARE TESTING CENTER)
90007 FORMAT (1H ,19X,34HFORTRAN COMPILER VALIDATION SYSTEM)
90008 FORMAT (1H ,21X,A13,A17)
90009 FORMAT (1H ,/,2H *,A5,6HBEGIN*,12X,15HTEST RESULTS - ,A5,/)
90010 FORMAT (1H ,8X,16HTEST DATE*TIME= ,A17,15H - COMPILER= ,A20)
90013 FORMAT (1H ,8H TEST ,10HPASS/FAIL ,6X,17HDISPLAYED RESULTS,
1 7X,7HREMARKS,24X)
90014 FORMAT (1H ,46H----------------------------------------------,
1 33H---------------------------------)
90015 FORMAT (1H ,48X,17HTHIS PROGRAM HAS ,I3,6H TESTS,/)
C****
C**** FORMAT STATEMENTS FOR REPORT FOOTINGS
C****
90016 FORMAT (1H ,/,2H *,A5,4HEND*,14X,14HEND OF TEST - ,A5,/)
90018 FORMAT (1H ,A13,13X,A20,7H * ,A10,1H/,
1 A13)
90019 FORMAT (1H ,26HFOR OFFICIAL USE ONLY ,35X,15HCOPYRIGHT 1982)
C****
C**** FORMAT STATEMENTS FOR RUN SUMMARY
C****
90020 FORMAT (1H ,21X,I5,13H TESTS PASSED)
90022 FORMAT (1H ,21X,I5,13H TESTS FAILED)
90024 FORMAT (1H ,21X,I5,14H TESTS DELETED)
90026 FORMAT (1H ,21X,I5,25H TESTS REQUIRE INSPECTION)
90028 FORMAT (1H ,21X,I5,4H OF ,I3,15H TESTS EXECUTED)
CBE** ********************** BBCFMT0B **********************************
C*****
C***** END OF TEST SEGMENT 212
STOP
END
*END-OF,FM834
FM900.f 481036615 170 2 100666 32148 `
*HEADER,FORTR,FM900
*FILES1,FORTR,FM900,XX
C***********************************************************************
C***** FORTRAN 77
C***** FM900 FMTRWF - (021)
C*****
C***********************************************************************
C***** GENERAL PURPOSE ANS REFS
C***** TO TEST SIMPLE FORMAT AND FORMATTED DATA 12.9.5.2
C***** TRANSFER STATEMENTS IN EXTERNAL SEQUENTIAL I/O SO 13.1.1
C***** THAT THESE FEATURES MAY BE USED IN OTHER TEST 12.8.1
C***** PROGRAM SEGMENTS FOR DOUBLE PRECISION AND COMPLEX
C***** DATA TYPES.
C***** RESTRICTIONS OBSERVED 12.8.2
C***** * ALL FORMAT STATEMENTS ARE LABELED 13.1.1
C***** * H AND X DESCRIPTORS ARE NEVER REPEATED 13.2.1
C***** * FOR W.D DESCRIPTORS, D IS ALWAYS SPECIFIED AND
C***** W IS EQUAL TO OR GREATER THAN D
C***** * FIELD WIDTH IS NEVER ZERO 13.2.1
C***** * IF AN I/O LIST SPECIFIES AT LEAST ONE LIST ITEM 13.3
C***** AT LEAST ONE REPEATABLE EDIT DESCRIPTOR MUST EXIST
C***** IN THE FORMAT SPECIFICATION
C***** * ITEMS IN I/O LIST CORRESPOND TO EDIT DESCRIPTORS 13.3
C***** * NEGATIVE OUTPUT VALUES ARE SIGNED 13.5.9
C***** * FIELD WIDTH NEVER EXCEEDED BY OUTPUT 13.5.9
C***** GENERAL COMMENTS
C***** PLUS SIGNS FOR INPUT FIELDS ARE USUALLY OMITTED 13.5.9
C***** FORMATTED WRITES WITHOUT AN I/O LIST (FORMAT 13.5.2
C***** STATEMENTS TEST H AND X DESCRIPTORS AND SLASH 13.5.3
C***** RECORD DIVIDERS) 13.5.4
C*****
CBB** ********************** BBCCOMNT **********************************
C****
C**** 1978 FORTRAN COMPILER VALIDATION SYSTEM
C**** VERSION 2.0
C****
C****
C**** SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO
C**** GENERAL SERVICES ADMINISTRATION
C**** FEDERAL SOFTWARE TESTING CENTER
C**** 5203 LEESBURG PIKE, SUITE 1100
C**** FALLS CHURCH, VA. 22041
C****
C**** (703) 756-6153
C****
CBE** ********************** BBCCOMNT **********************************
C*****
C INPUT DATA TO THIS SEGMENT CONSISTS OF 17 CARD IMAGES IN COL. 1 - 80
COL. 1----------------------------------------------------------61
CARD 1 1.05.522.066.633.123455.0789
CARD 2 123.00456.88 0.123E+01 +0.987+1 -0.2345+02 -0.6879E+2+0.7E+0
COL 62-----70
CARD 2 3 0.4E+03
COL. 1----------------------------------------------------------61
CARD 3 0.9876543E-04+0.1357913E-04
CARD 4 19.34+0.2468E+02 +.765+287.643.96 0.5407E+0243.96+0.5407E+0
COL. 62-------------78
CARD 4 243.96 0.5407+2
COL. 1----------------------------- ----------------------------61
CARD 5 +0.1D+06
CARD 6 -0.334D-04 -.334-4 +0.7657654D00 0.12345678901D+10
CARD 7 +0.98765432109876D-1+0.98765432109876D-01 .98765432109876
COL. 62-66
CARD 7 -1
COL. 1----------------------------------------------------------61
CARD 8 -.555555542D+03 -0.555555542+3
CARD 9 9.91.19.92.29.93.39.94.49.91.19.92.29.93.39.94.4
CARD 10 9.95.59.96.69.97.79.98.89.95.59.96.69.97.79.98.8
CARD 11 -0.99D+01-0.98D+01-0.97D+01-0.96D+01-0.99D+01 -.98D+01 -.97+
COL. 62-------72
CARD 11 01 -.96+1
CARD 12 +0.99D+01 0.98D+01 +.97D01 +.96D1
CARD 13 +0.99D+01 0.99D+01 0.99D+01+0.99D+01 .99D1
CARD 14 9.95.59.96.69.97.79.98.8
CARD 15 123.45678E2 1234.5678 123.45678 12.345678 1.2345678 .123
COL. 62-66
CARD 15 45678
COL. 1----------------------------------------------------------61
CARD 16 9876.5498.7654E2 9876.54 987.654864786D-486.4786E286.4786
COL. 62---------------80
CARD 16 8657.86D0 9876.54
COL. 1----------------------------------------------------------61
CARD 17 9.8765698.7654E2 9876.54 987.654864786D-386.4786E286.4786
COL. 62---------------80
CARD 17 8657.86D0 9876.54
C*****
C***** S P E C I F I C A T I O N S SEGMENT 021
C*****
DOUBLE PRECISION DPA1D(5),MCA3D(1,4,2),ZZDVD ,A2D(2,2),A3D(2,2,2)
1,AC1D(10),BC2D(7,4),DPAVD,DPBVD
COMPLEX BVC,QAVC,CHAVC,CHBVC,CHCVC,CHDVC
1,LL1C(32),LM2C(8,4),A1C(12),A2C(2,2),B3C(2,2,2),B1C(8)
C*****
CBB** ********************** BBCINITA **********************************
C**** SPECIFICATION STATEMENTS
C****
CHARACTER ZVERS*13, ZVERSD*17, ZDATE*17, ZPROG*5, ZCOMPL*20,
1 ZNAME*20, ZTAPE*10, ZPROJ*13, REMRKS*31, ZTAPED*13
CBE** ********************** BBCINITA **********************************
CBB** ********************** BBCINITB **********************************
C**** INITIALIZE SECTION
DATA ZVERS, ZVERSD, ZDATE
1 /'VERSION 2.0 ', '82/08/02*18.33.46', '*NO DATE*TIME'/
DATA ZCOMPL, ZNAME, ZTAPE
1 /'*NONE SPECIFIED*', '*NO COMPANY NAME*', '*NO TAPE*'/
DATA ZPROJ, ZTAPED, ZPROG
1 /'*NO PROJECT*', '*NO TAPE DATE', 'XXXXX'/
DATA REMRKS /' '/
C**** THE FOLLOWING 9 COMMENT LINES (CZ01, CZ02, ...) CAN BE REPLACED
C**** FOR IDENTIFYING THE TEST ENVIRONMENT
C****
CZ01 ZVERS = 'VERSION OF THE COMPILER VALIDATION SYSTEM'
CZ02 ZVERSD = 'CREATION DATE/TIME OF THE COMPILER VALIDATION SYSTEM'
CZ03 ZPROG = 'PROGRAM NAME'
CZ04 ZDATE = 'DATE OF TEST'
CZ05 ZCOMPL = 'COMPILER IDENTIFICATION'
CZ06 ZPROJ = 'PROJECT NUMBER/IDENTIFICATION'
CZ07 ZNAME = 'NAME OF USER'
CZ08 ZTAPE = 'TAPE OWNER/ID'
CZ09 ZTAPED = 'DATE TAPE COPIED'
C
IVPASS = 0
IVFAIL = 0
IVDELE = 0
IVINSP = 0
IVTOTL = 0
IVTOTN = 0
ICZERO = 0
C
C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER.
I01 = 05
C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER.
I02 = 06
C
CX010 REPLACED BY FEXEC X-010 CONTROL CARD (CARD-READER UNIT NUMBER).
C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5
CX011 REPLACED BY FEXEC X-011 CONTROL CARD. CX011 IS FOR SYSTEMS
C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX010.
C
CX020 REPLACED BY FEXEC X-020 CONTROL CARD (PRINTER UNIT NUMBER).
C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02= 6
CX021 REPLACED BY FEXEC X-021 CONTROL CARD. CX021 IS FOR SYSTEMS
C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX020.
C
CBE** ********************** BBCINITB **********************************
IRVI = I01
NUVI = I02
IVTOTL = 36
ZPROG = 'FM900'
CBB** ********************** BBCHED0A **********************************
C****
C**** WRITE REPORT TITLE
C****
WRITE (I02, 90002)
WRITE (I02, 90006)
WRITE (I02, 90007)
WRITE (I02, 90008) ZVERS, ZVERSD
WRITE (I02, 90009) ZPROG, ZPROG
WRITE (I02, 90010) ZDATE, ZCOMPL
CBE** ********************** BBCHED0A **********************************
C***** HEADER FORMAT STATEMENT
WRITE (NUVI,02100)
02100 FORMAT (1H ,/1X,28HFMTRWF - (021) FORMATTED I/O//2X,
1 25HREFS - 12.9.5 13.3 13.5)
CBB** ********************** BBCHED0B **********************************
C**** WRITE DETAIL REPORT HEADERS
C****
WRITE (I02,90004)
WRITE (I02,90004)
WRITE (I02,90013)
WRITE (I02,90014)
WRITE (I02,90015) IVTOTL
CBE** ********************** BBCHED0B **********************************
C***** TESTS 1 THRU 11:
C***** FORMATTED READ AND WRITE STATEMENTS WITH COMPLEX 12.8.1
C***** VARIABLES AND ARRAY ELEMENTS IN AN I/O LIST. 12.8.2
C***** E AND F CONVERSION ARE USED IN THE FORMAT 13.5.9.2.1-2
C***** STATEMENTS. SOME FORMAT DESCRIPTORS ARE REPEATED 13.5.9.2.1
C*****
02101 FORMAT (/8X,23HCOMPLEX CONVERSION TEST/)
WRITE (NUVI,02101)
C***** INPUT CARD 1
02102 FORMAT ( 2(F3.1) , 2(F4.1), 2(F7.4))
READ (IRVI,02102) CHAVC, CHBVC, A1C(2)
C***** INPUT CARDS 2, 3
02103 FORMAT ( 2F6.2, 2E10.3, 2E11.4, 2E8.1/ 2E14.7)
READ (IRVI,02103) A2C(1,2), B3C(2,2,1), CHCVC, A1C(1), CHDVC
C***** INPUT CARD 4
02104 FORMAT (F5.2, E11.4, E10.3, F4.1, 3(F5.2,E11.4))
READ (IRVI,02104) A2C(2,1), BVC, QAVC, LM2C(1,2), LL1C(2)
CT001* TEST 1
IVTNUM = 1
WRITE (NUVI, 80004) IVTNUM
WRITE (NUVI, 80020)
WRITE (NUVI, 70010) CHAVC
70010 FORMAT (26X,F3.1,2X,F3.1)
IVINSP = IVINSP + 1
WRITE (NUVI, 80022)
WRITE (NUVI, 70011)
70011 FORMAT (26X, 8H1.0 5.5)
CT002* TEST 2
IVTNUM = 2
WRITE (NUVI, 80004) IVTNUM
WRITE (NUVI, 80020)
WRITE (NUVI, 70020) CHBVC
70020 FORMAT (26X,F4.1,2X,F4.1)
IVINSP = IVINSP + 1
WRITE (NUVI, 80022)
WRITE (NUVI, 70021)
70021 FORMAT (26X,10H22.0 66.6)
CT003* TEST 3
IVTNUM = 3
WRITE (NUVI, 80004) IVTNUM
WRITE (NUVI, 80020)
WRITE (NUVI, 70030) A1C(2)
70030 FORMAT (26X,F7.4,2X,F7.4)
IVINSP = IVINSP + 1
WRITE (NUVI, 80022)
WRITE (NUVI, 70031)
70031 FORMAT (26X,16H33.1234 55.0789)
CT004* TEST 4
IVTNUM = 4
WRITE (NUVI, 80004) IVTNUM
WRITE (NUVI, 80020)
WRITE (NUVI, 70040) A2C(1,2)
70040 FORMAT (26X,F6.2,2X,F6.2)
IVINSP = IVINSP + 1
WRITE (NUVI, 80022)
WRITE (NUVI, 70041)
70041 FORMAT (26X,14H123.00 456.88)
CT005* TEST 5
IVTNUM = 5
REMRKS = 'LEADING PLUS SIGN/ZERO OPTIONAL'
WRITE (NUVI, 80004) IVTNUM,REMRKS
WRITE (NUVI, 80020)
WRITE (NUVI, 70050) B3C(2,2,1)
70050 FORMAT (26X,E10.3,2X,E10.3)
IVINSP = IVINSP + 1
WRITE (NUVI, 70051)
70051 FORMAT (1H ,16X,10HCORRECT: ,22X,26H2 CORRECT ANSWERS POSSIB
1LE)
WRITE (NUVI, 70052)
70052 FORMAT (26X,22H+0.123E+01 +0.987E+01/
1 26X,22H+0.123+001 +0.987+001)
CT006* TEST 6
IVTNUM = 6
REMRKS = 'LEADING ZERO OPTIONAL'
WRITE (NUVI, 80004) IVTNUM, REMRKS
WRITE (NUVI, 80020)
WRITE (NUVI, 70060) CHCVC
70060 FORMAT (26X,E11.4,2X,E11.4)
IVINSP = IVINSP + 1
WRITE (NUVI, 70051)
WRITE (NUVI, 70061)
70061 FORMAT (26X,24H-0.2345E+02 -0.6879E+02/
1 26X,24H-0.2345+002 -0.6879+002)
C***** ADVANCE TO TOP-OF-PAGE AND WRITE HEADER
WRITE (NUVI, 90002)
WRITE (NUVI, 90013)
WRITE (NUVI, 90014)
C*****
CT007* TEST 7
IVTNUM = 7
REMRKS = 'LEADING PLUS SIGN/ZERO OPTIONAL'
WRITE (NUVI, 80004) IVTNUM, REMRKS
WRITE (NUVI, 80020)
WRITE (NUVI, 70070) A1C(1)
70070 FORMAT (26X,E8.1,2X,E8.1)
IVINSP = IVINSP + 1
WRITE (NUVI, 70051)
WRITE (NUVI, 70071)
70071 FORMAT (26X,18H+0.7E+03 +0.4E+03/
1 26X,18H+0.7+003 +0.4+003)
CT008* TEST 8
IVTNUM = 8
WRITE (NUVI, 80004) IVTNUM, REMRKS
WRITE (NUVI, 80020)
WRITE (NUVI, 70080) CHDVC
70080 FORMAT (26X,E14.7,2X,E14.7)
IVINSP = IVINSP + 1
WRITE (NUVI, 70051)
WRITE (NUVI, 70081)
70081 FORMAT (26X,30H+0.9876543E-04 +0.1357913E-04/
1 26X,30H+0.9876543-004 +0.1357913-004)
CT009* TEST 9
IVTNUM = 9
WRITE (NUVI, 70090) IVTNUM
70090 FORMAT (1H ,2X,I3,4X,7HINSPECT,32X,31HLEADING PLUS SIGN/ZERO
1OPTIONAL/1H ,48X,21HFOR THE SECOND NUMBER)
WRITE (NUVI, 80020)
WRITE (NUVI, 70091) A2C(2,1)
70091 FORMAT (26X,F5.2,2X,E11.4)
IVINSP = IVINSP + 1
WRITE (NUVI, 70051)
WRITE (NUVI, 70092)
70092 FORMAT (26X,18H19.34 +0.2468E+02/
1 26X,18H19.34 +0.2468+002)
CT010* TEST 10
IVTNUM = 10
WRITE (NUVI, 70100) IVTNUM
70100 FORMAT (1H ,2X,I3,4X,7HINSPECT,32X,31HLEADING PLUS SIGN/ZERO
1OPTIONAL/1H ,48X,20HFOR THE FIRST NUMBER)
WRITE (NUVI, 80020)
WRITE (NUVI, 70101) BVC
70101 FORMAT (26X,E10.3,2X,F4.1)
IVINSP = IVINSP + 1
WRITE (NUVI, 70051)
WRITE (NUVI, 70102)
70102 FORMAT (26X,16H+0.765E+02 87.6/
1 26X,16H+0.765+002 87.6)
CT011* TEST 11
IVTNUM = 11
WRITE (NUVI, 80004) IVTNUM, REMRKS
WRITE (NUVI, 70110)
70110 FORMAT (1H ,16X,9HCOMPUTED:,23X,25H3 COMPUTED LINES EXPECTED)
WRITE (NUVI,70111) QAVC, LM2C(1,2), LL1C(2)
70111 FORMAT (3(26X,F7.2,E11.4/))
IVINSP = IVINSP + 1
WRITE (NUVI, 70112)
70112 FORMAT (1H ,16X,10HCORRECT: ,22X,30HEACH RESULT LINE SHOULD
1MATCH /1H ,48X,30HEITHER ONE OF THE 2 POSSIBLE /
2 1H ,48X,13HANSWERS BELOW)
WRITE (NUVI, 70113)
70113 FORMAT (26X,18H +43.96+0.5407E+02/
1 26X,18H +43.96+0.5407+002)
C***** ADVANCE TO TOP-OF-PAGE AND WRITE HEADER
WRITE (NUVI, 90002)
WRITE (NUVI, 90013)
WRITE (NUVI, 90014)
C*****
C***** TESTS 12 THRU 17:
C***** FORMATTED READ AND WRITE STATEMENTS WITH 12.8.1
C***** DOUBLE PRECISION VARIABLES IN AN I/O LIST. 12.8.2
C***** D CONVERSION IS USED IN THE FORMAT STATEMENTS. 13.5.9.2.2
C***** SOME D FORMAT DESCRIPTORS ARE REPEATED. (FIELD 13.3
C***** WIDTH ALWAYS INCLUDES 6 EXTRA POSITIONS TO 13.5.9
C***** PROVIDE FOR SIGN, DECIMAL POINT AND EXPONENT 13.5.9.2
C***** AND 1 POSITION FOR OPTIONAL DIGIT ZERO BEFORE
C***** THE DECIMAL POINT)
C*****
02109 FORMAT (/8X, 17HD CONVERSION TEST/)
WRITE (NUVI,02109)
C***** INPUT CARD 5
02110 FORMAT ( 2X, D8.1)
READ (IRVI,02110) DPAVD
C***** INPUT CARDS 6, 7, 8
02111 FORMAT ( 2D10.3, D14.7, D18.11/ 3D21.14/ 2D16.9)
READ (IRVI,02111) MCA3D(1,2,2), AC1D(2), BC2D(3,1), AC1D(1),
1 ZZDVD, AC1D(3), DPBVD, MCA3D(1,2,1), BC2D(1,2)
CT012* TEST 12
IVTNUM = 12
WRITE (NUVI, 80004) IVTNUM, REMRKS
WRITE (NUVI, 80020)
WRITE (NUVI,70120) DPAVD
70120 FORMAT (26X,D8.1)
IVINSP = IVINSP + 1
WRITE (NUVI, 70121)
70121 FORMAT (1H ,16X,10HCORRECT: ,22X,26H3 CORRECT ANSWERS POSSIB
1LE)
WRITE (NUVI, 70122)
70122 FORMAT (26X,8H+0.1D+06/26X,8H+0.1E+06/26X,8H+0.1+006)
CT013* TEST 13
IVTNUM = 13
REMRKS = 'LEADING ZERO OPTIONAL'
WRITE (NUVI, 80004) IVTNUM, REMRKS
WRITE (NUVI, 70130)
70130 FORMAT (1H ,16X,9HCOMPUTED:,23X,25H2 COMPUTED LINES EXPECTED)
WRITE (NUVI, 70131) MCA3D(1,2,2), AC1D(2)
70131 FORMAT (26X,D10.3 / 26X,D10.3)
IVINSP = IVINSP + 1
WRITE (NUVI, 70132)
70132 FORMAT (1H ,16X,10HCORRECT: ,22X,30HEACH RESULT LINE SHOULD
1MATCH /1H ,48X,30HONE OF THE 3 POSSIBLE ANSWERS /
2 1H ,48X,5HBELOW)
WRITE (NUVI, 70133)
70133 FORMAT(26X,10H-0.334D-04/26X,10H-0.334E-04/26X,10H-0.334-004)
CT014* TEST 14
IVTNUM = 14
REMRKS = 'LEADING PLUS SIGN/ZERO OPTIONAL'
WRITE (NUVI, 80004) IVTNUM, REMRKS
WRITE (NUVI, 80020)
WRITE (NUVI, 70140) BC2D(3,1)
70140 FORMAT (26X,D14.7)
IVINSP = IVINSP + 1
WRITE (NUVI, 70121)
WRITE (NUVI, 70141)
70141 FORMAT (26X,14H+0.7657654D+00/
1 26X,14H+0.7657654E+00/
2 26X,14H+0.7657654+000)
CT015* TEST 15
IVTNUM = 15
WRITE (NUVI, 80004) IVTNUM, REMRKS
WRITE (NUVI, 80020)
WRITE (NUVI, 70150) AC1D(1)
70150 FORMAT (26X,D18.11)
IVINSP = IVINSP + 1
WRITE (NUVI, 70121)
WRITE (NUVI, 70151)
70151 FORMAT (26X,18H+0.12345678901D+10/
1 26X,18H+0.12345678901E+10/
2 26X,18H+0.12345678901+010)
CT016* TEST 16
IVTNUM = 16
WRITE (NUVI, 80004) IVTNUM, REMRKS
WRITE (NUVI, 70110)
WRITE (NUVI, 70160) ZZDVD,AC1D(3),DPBVD
70160 FORMAT (26X,D21.14 / 26X,D21.14 / 26X,D21.14)
IVINSP = IVINSP + 1
WRITE (NUVI, 70132)
WRITE (NUVI, 70161)
70161 FORMAT (26X,21H+0.98765432109876D-01/
1 26X,21H+0.98765432109876E-01/
2 26X,21H+0.98765432109876-001)
CT017* TEST 17
IVTNUM = 17
REMRKS = 'LEADING ZERO OPTIONAL'
WRITE (NUVI, 80004) IVTNUM, REMRKS
WRITE (NUVI, 70130)
WRITE (NUVI, 70170) MCA3D(1,2,1), BC2D(1,2)
70170 FORMAT (26X,D16.9 /26X,D16.9)
IVINSP = IVINSP + 1
WRITE (NUVI, 70132)
WRITE (NUVI, 70171)
70171 FORMAT (26X,16H-0.555555542D+03/
1 26X,16H-0.555555542E+03/
2 26X,16H-0.555555542+003)
C***** ADVANCE TO TOP-OF-PAGE AND WRITE HEADER
WRITE (NUVI, 90002)
WRITE (NUVI, 90013)
WRITE (NUVI, 90014)
C*****
C***** TESTS 18 THRU 22:
C***** FORMATTED READ AND WRITE STATEMENTS WITH ARRAY 12.8.1
C***** NAMES OF ALL TYPES IN AN I/O LIST. THE NUMBER OF 12.8.2
C***** ITEMS IN THE LIST IS VARIABLE. SOME FIELD 13.3
C***** DESCRIPTORS ARE REPEATED.
C*****
02114 FORMAT (/8X, 44HTEST UNSUBSCRIPTED ARRAY NAMES IN I/O LISTS /)
WRITE (NUVI,02114)
C***** INPUT CARDS 9, 10
02115 FORMAT(2X,8(F3.1),8F3.1/8(2(F3.1)))
READ (IRVI,02115) B1C,B3C
C***** INPUT CARDS 11, 12
02116 FORMAT(4(D9.2),4D9.2/2X,4(D9.2))
READ (IRVI,02116) A3D, A2D
C***** INPUT CARDS 13, 14
02117 FORMAT (2X,4(2X),5(D9.2)/4(2(F3.1)))
READ (IRVI,02117) DPA1D, A2C
CT018* TEST 18
IVTNUM = 18
WRITE (NUVI, 80004) IVTNUM
WRITE (NUVI, 70130)
WRITE (NUVI,70180) B1C
70180 FORMAT (26X,8(F3.1) / 26X,8(F3.1))
IVINSP = IVINSP + 1
WRITE (NUVI, 70181)
70181 FORMAT (1H ,16X,10HCORRECT: ,22X,29HEACH RESULT LINE SHOULD
1EQUAL)
WRITE (NUVI, 70182)
70182 FORMAT (26X, 24H9.91.19.92.29.93.39.94.4)
CT019* TEST 19
IVTNUM = 19
WRITE (NUVI, 80004) IVTNUM, REMRKS
WRITE (NUVI, 70130)
WRITE (NUVI, 70190) A3D
70190 FORMAT (26X,4(D9.2) / 26X,4(D9.2))
IVINSP = IVINSP + 1
WRITE (NUVI, 70132)
WRITE (NUVI, 70191)
70191 FORMAT (26X,36H-0.99D+01-0.98D+01-0.97D+01-0.96D+01/
1 26X,36H-0.99E+01-0.98E+01-0.97E+01-0.96E+01/
2 26X,36H-0.99+001-0.98+001-0.97+001-0.96+001)
CT020* TEST 20
IVTNUM = 20
REMRKS = 'LEADING PLUS SIGN/ZERO OPTIONAL'
WRITE (NUVI, 80004) IVTNUM, REMRKS
WRITE (NUVI, 80020)
WRITE (NUVI,70200) A2D
70200 FORMAT (26X,4(D9.2))
IVINSP = IVINSP + 1
WRITE (NUVI, 70121)
WRITE (NUVI, 70201)
70201 FORMAT (26X,36H+0.99D+01+0.98D+01+0.97D+01+0.96D+01/
1 26X,36H+0.99E+01+0.98E+01+0.97E+01+0.96E+01/
2 26X,36H+0.99+001+0.98+001+0.97+001+0.96+001)
CT021* TEST 21
IVTNUM = 21
WRITE (NUVI, 80004) IVTNUM, REMRKS
WRITE (NUVI, 70210)
70210 FORMAT (1H ,16X,9HCOMPUTED:,23X,25H5 COMPUTED LINES EXPECTED)
WRITE (NUVI,70211) DPA1D
70211 FORMAT (5(26X,D11.2/))
IVINSP = IVINSP + 1
WRITE (NUVI, 70132)
WRITE (NUVI, 70212)
70212 FORMAT (26X,11H +0.99D+01/
1 26X,11H +0.99E+01/
2 26X,11H +0.99+001)
CT022* TEST 22
IVTNUM = 22
WRITE (NUVI, 80004) IVTNUM
WRITE (NUVI, 70110)
WRITE (NUVI,70220) A2C, B3C
70220 FORMAT (26X,8(F3.1) / 26X,8(F3.1) / 26X,8(F3.1))
IVINSP = IVINSP + 1
WRITE (NUVI, 70181)
WRITE (NUVI, 70221)
70221 FORMAT (26X,24H9.95.59.96.69.97.79.98.8)
C***** ADVANCE TO TOP-OF-PAGE AND WRITE HEADER
WRITE (NUVI, 90002)
WRITE (NUVI, 90013)
WRITE (NUVI, 90014)
C*****
C***** TESTS 23 THRU 30:
C***** FORMATTED WRITES TO TEST THAT LEADING BLANKS 13.5.9
C***** ARE INSERTED IN THE OUTPUT FIELD WHEN THE OUTPUT
C***** PRODUCED IS SMALLER THAN THE FIELD WIDTH. (D AND
C***** F DESCRIPTORS ARE TESTED.)
C*****
02121 FORMAT (/8X, 28HLEADING BLANK INSERTION TEST/)
WRITE (NUVI,02121)
CT023* TEST 23
IVTNUM = 23
WRITE (NUVI, 80004) IVTNUM, REMRKS
WRITE (NUVI, 70230)
70230 FORMAT (1H ,48X,27HLEADING BLANKS ARE REQUIRED)
WRITE (NUVI, 80020)
WRITE (NUVI, 70231) AC1D(3)
70231 FORMAT (26X,D9.1)
IVINSP = IVINSP + 1
WRITE (NUVI, 70121)
WRITE (NUVI, 70232)
70232 FORMAT (26X,9H +0.1D+00/26X,9H +0.1E+00/26X,9H +0.1+000)
CT024* TEST 24
IVTNUM = 24
WRITE (NUVI, 80004) IVTNUM, REMRKS
WRITE (NUVI, 70230)
WRITE (NUVI, 80020)
WRITE (NUVI, 70240) ZZDVD
70240 FORMAT (26X,D10.1)
IVINSP = IVINSP + 1
WRITE (NUVI, 70121)
WRITE (NUVI, 70241)
70241 FORMAT(26X,10H +0.1D+00/26X,10H +0.1E+00/26X,10H +0.1+000)
CT025* TEST 25
IVTNUM = 25
WRITE (NUVI, 80004) IVTNUM, REMRKS
WRITE (NUVI, 70230)
WRITE (NUVI, 80020)
WRITE (NUVI, 70250) ZZDVD
70250 FORMAT (26X,D11.1)
IVINSP = IVINSP + 1
WRITE (NUVI, 70121)
WRITE (NUVI, 70251)
70251 FORMAT (26X,11H +0.1D+00/
1 26X,11H +0.1E+00/
2 26X,11H +0.1+000)
CT026* TEST 26
IVTNUM = 26
WRITE (NUVI, 80004) IVTNUM, REMRKS
WRITE (NUVI, 70230)
WRITE (NUVI, 80020)
WRITE (NUVI, 70260) ZZDVD
70260 FORMAT (26X,D12.1)
IVINSP = IVINSP + 1
WRITE (NUVI, 70121)
WRITE (NUVI, 70261)
70261 FORMAT (26X,12H +0.1D+00/
1 26X,12H +0.1E+00/
2 26X,12H +0.1+000)
CT027* TEST 27
IVTNUM = 27
REMRKS = 'LEADING PLUS OPTIONAL'
WRITE (NUVI, 80004) IVTNUM, REMRKS
WRITE (NUVI, 70230)
WRITE (NUVI, 80020)
WRITE (NUVI, 70270) CHAVC
70270 FORMAT (26X,2(F5.1))
IVINSP = IVINSP + 1
WRITE (NUVI, 80022)
WRITE (NUVI, 70271)
70271 FORMAT (26X,10H +1.0 +5.5)
CT028* TEST 28
IVTNUM = 28
WRITE (NUVI, 80004) IVTNUM, REMRKS
WRITE (NUVI, 70230)
WRITE (NUVI, 80020)
WRITE (NUVI, 70280) B3C(1,1,1)
70280 FORMAT (26X,2(F6.1))
IVINSP = IVINSP + 1
WRITE (NUVI, 80022)
WRITE (NUVI, 70281)
70281 FORMAT (26X,12H +9.9 +5.5)
C***** ADVANCE TO TOP-OF-PAGE AND WRITE HEADER
WRITE (NUVI, 90002)
WRITE (NUVI, 90013)
WRITE (NUVI, 90014)
C*****
CT029* TEST 29
IVTNUM = 29
WRITE (NUVI, 80004) IVTNUM, REMRKS
WRITE (NUVI, 70230)
WRITE (NUVI, 80020)
WRITE (NUVI, 70290) B3C(1,1,1)
70290 FORMAT (26X,2(F7.1))
IVINSP = IVINSP + 1
WRITE (NUVI, 80022)
WRITE (NUVI, 70291)
70291 FORMAT (26X,14H +9.9 +5.5)
CT030* TEST 30
IVTNUM = 30
WRITE (NUVI, 80004) IVTNUM, REMRKS
WRITE (NUVI, 70230)
WRITE (NUVI, 80020)
WRITE (NUVI, 70300) CHAVC
70300 FORMAT (26X,2(F8.1))
IVINSP = IVINSP + 1
WRITE (NUVI, 80022)
WRITE (NUVI, 70301)
70301 FORMAT (26X,16H +1.0 +5.5)
C***** TESTS 31 THRU 32:
C***** FORMATS WITH G CONVERSIONS USING COMPLEX DATA 13.5.9.2.3
C*****
C***** INPUT CARD 15
02123 FORMAT( 3(G11.4), 3G11.4)
READ (IRVI,02123) LL1C(1), LL1C(2), LL1C(3)
02124 FORMAT (/8X,17HG CONVERSION TEST/)
WRITE (NUVI, 02124)
CT031* TEST 31
IVTNUM = 31
REMRKS = 'LEADING PLUS SIGN/ZERO OPTIONAL'
WRITE (NUVI, 80004) IVTNUM, REMRKS
WRITE (NUVI, 70130)
WRITE (NUVI, 70310) LL1C(1), LL1C(2), LL1C(3)
70310 FORMAT (26X,G14.4,4X,2G11.4 / 26X,G14.4,4X,2G11.4)
IVINSP = IVINSP + 1
WRITE (NUVI, 70311)
70311 FORMAT(/1H ,16X,10HCORRECT: ,22X,31HCORRESPONDING LINES MUST
1 MATCH ,/1H ,48X,31HEITHER OF THE FOLLOWING TWO ,
2 /1H ,48X,31HCORRECT ANSWERS /)
WRITE (NUVI, 70312)
70312 FORMAT (26X,36H +0.1235E+05 +1235. +123.5/
1 26X,36H +12.35 +1.235 +0.1235//
2 26X,36H +0.1235+005 +1235. +123.5/
3 26X,36H +12.35 +1.235 +0.1235)
C***** TESTS 32 THRU 34:
C***** ON READ, BUT NOT ON WRITE
C***** SCALE FACTOR APPLIED TO F,E,D,G DESCRIPTORS 13.7.5.1
C*****
C***** INPUT CARD 16
02126 FORMAT(2PF8.3,-2PE9.4,F9.4,0PG9.4,D9.4,-2PE9.4,F9.4,D9.4,2PG9.4)
READ(IRVI,02126)BVC, CHAVC, BC2D(1,4), A1C(1), BC2D(2,1), DPAVD
02127 FORMAT(/8X, 20HSCALE FACTOR ON READ/)
WRITE (NUVI, 02127)
CT032* TEST 32
IVTNUM = 32
WRITE (NUVI, 80004) IVTNUM, REMRKS
WRITE (NUVI, 80020)
WRITE (NUVI, 70320) BVC,CHAVC
70320 FORMAT (26X,F12.4,E12.4,F12.2,F12.3)
IVINSP = IVINSP + 1
WRITE (NUVI, 70051)
WRITE (NUVI, 70321)
70321 FORMAT (30X,44H+98.7654 +0.9877E+04 +987654.00 +987.654/
1 30X,44H+98.7654 +0.9877+004 +987654.00 +987.654)
CT033* TEST 33
IVTNUM = 33
WRITE (NUVI, 80004) IVTNUM, REMRKS
WRITE (NUVI, 80020)
WRITE (NUVI, 70330) BC2D(1,4), A1C(1)
70330 FORMAT (26X,D12.4,E12.4,F12.3)
IVINSP = IVINSP + 1
WRITE (NUVI, 70121)
WRITE (NUVI, 70331)
70331 FORMAT (26X,36H +0.8648D-02 +0.8648E+04 +8647.860/
1 26X,36H +0.8648E-02 +0.8648E+04 +8647.860/
2 26X,36H +0.8648-002 +0.8648+004 +8647.860)
CT034* TEST 34
IVTNUM = 34
WRITE (NUVI, 80004) IVTNUM, REMRKS
WRITE (NUVI, 80020)
WRITE (NUVI, 70340) BC2D(2,1), DPAVD
70340 FORMAT (26X,D12.4,G16.4)
IVINSP = IVINSP + 1
WRITE (NUVI, 70121)
WRITE (NUVI, 70341)
70341 FORMAT (26X,24H +0.8658D+04 +98.77/
1 26X,24H +0.8658E+04 +98.77/
2 26X,24H +0.8658+004 +98.77)
C***** ADVANCE TO TOP-OF-PAGE AND WRITE HEADER
WRITE (NUVI, 90002)
WRITE (NUVI, 90013)
WRITE (NUVI, 90014)
C*****
C***** TESTS 35 AND 36:
C***** SCALE FACTOR APPLIED TO F, E, D, G DESCRIPTORS
C***** ON WRITE, BUT, NOT ON READ
C*****
C***** INPUT CARD 17
02128 FORMAT(F8.2,E9.4,F9.2,G9.3,D9.0,E9.4,F9.4,D9.2,G9.4)
READ(IRVI,02128) CHBVC, A2C(2,1), AC1D(4), CHCVC, AC1D(5), DPBVD
02129 FORMAT(/8X, 21HSCALE FACTOR ON WRITE/)
WRITE (NUVI, 02129)
CT035* TEST 35
IVTNUM = 35
WRITE (NUVI, 80004) IVTNUM, REMRKS
WRITE (NUVI, 80020)
WRITE (NUVI, 70350) CHBVC, A2C(2,1), AC1D(4)
70350 FORMAT (26X,2PF12.2,-2PE12.4,F12.4,1PG12.2,D12.4)
IVINSP = IVINSP + 1
WRITE (NUVI, 70121)
WRITE (NUVI, 70351)
70351 FORMAT (28X,58H +987.66 +0.0099E+06 +98.7654 +9.88E+02
1 +8.6479D+02/28X,58H +987.66 +0.0099E+06 +98.7654 +9.88E+02
2 +8.6479E+02/28X,58H +987.66 +0.0099+006 +98.7654 +9.88+002
3 +8.6479+002)
CT036* TEST 36
IVTNUM = 36
WRITE (NUVI, 80004) IVTNUM, REMRKS
WRITE (NUVI, 80020)
WRITE(NUVI,70360) CHCVC, AC1D(5), DPBVD
70360 FORMAT (26X,-2PE12.4,2PF12.2,1PD12.4,2PG16.4)
IVINSP = IVINSP + 1
WRITE (NUVI, 70121)
WRITE (NUVI, 70361)
70361 FORMAT(27X,47H+0.0086E+06 +8647.86 +8.6579D+03 +9877.
1 /27X,47H+0.0086E+06 +8647.86 +8.6579E+03 +9877.
2 /27X,47H+0.0086+006 +8647.86 +8.6579+003 +9877.)
CBB** ********************** BBCSUM0 **********************************
C**** WRITE OUT TEST SUMMARY
C****
IVTOTN = IVPASS + IVFAIL + IVDELE + IVINSP
WRITE (I02, 90004)
WRITE (I02, 90014)
WRITE (I02, 90004)
WRITE (I02, 90020) IVPASS
WRITE (I02, 90022) IVFAIL
WRITE (I02, 90024) IVDELE
WRITE (I02, 90026) IVINSP
WRITE (I02, 90028) IVTOTN, IVTOTL
CBE** ********************** BBCSUM0 **********************************
CBB** ********************** BBCFOOT0 **********************************
C**** WRITE OUT REPORT FOOTINGS
C****
WRITE (I02,90016) ZPROG, ZPROG
WRITE (I02,90018) ZPROJ, ZNAME, ZTAPE, ZTAPED
WRITE (I02,90019)
CBE** ********************** BBCFOOT0 **********************************
CBB** ********************** BBCFMT0A **********************************
C**** FORMATS FOR TEST DETAIL LINES
C****
80000 FORMAT (1H ,2X,I3,4X,7HDELETED,32X,A31)
80002 FORMAT (1H ,2X,I3,4X,7H PASS ,32X,A31)
80004 FORMAT (1H ,2X,I3,4X,7HINSPECT,32X,A31)
80008 FORMAT (1H ,2X,I3,4X,7H FAIL ,32X,A31)
80010 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,15X,10HCOMPUTED= ,
1I6,/,1H ,15X,10HCORRECT= ,I6)
80012 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
1E12.5,/,1H ,16X,10HCORRECT= ,E12.5)
80018 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
1A21,/,1H ,16X,10HCORRECT= ,A21)
80020 FORMAT (1H ,16X,10HCOMPUTED= ,A21,1X,A31)
80022 FORMAT (1H ,16X,10HCORRECT= ,A21,1X,A31)
80024 FORMAT (1H ,16X,10HCOMPUTED= ,I6,16X,A31)
80026 FORMAT (1H ,16X,10HCORRECT= ,I6,16X,A31)
80028 FORMAT (1H ,16X,10HCOMPUTED= ,E12.5,10X,A31)
80030 FORMAT (1H ,16X,10HCORRECT= ,E12.5,10X,A31)
80050 FORMAT (1H ,48X,A31)
CBE** ********************** BBCFMT0A **********************************
CBB** ********************** BBCFMAT1 **********************************
C**** FORMATS FOR TEST DETAIL LINES - FULL LANGUAGE
C****
80031 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
1D17.10,/,1H ,16X,10HCORRECT= ,D17.10)
80033 FORMAT (1H ,16X,10HCOMPUTED= ,D17.10,10X,A31)
80035 FORMAT (1H ,16X,10HCORRECT= ,D17.10,10X,A31)
80037 FORMAT (1H ,16X,10HCOMPUTED= ,1H(,E12.5,2H, ,E12.5,1H),6X,A31)
80039 FORMAT (1H ,16X,10HCORRECT= ,1H(,E12.5,2H, ,E12.5,1H),6X,A31)
80041 FORMAT (1H ,16X,10HCOMPUTED= ,1H(,F12.5,2H, ,F12.5,1H),6X,A31)
80043 FORMAT (1H ,16X,10HCORRECT= ,1H(,F12.5,2H, ,F12.5,1H),6X,A31)
80045 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
11H(,F12.5,2H, ,F12.5,1H)/,1H ,16X,10HCORRECT= ,
21H(,F12.5,2H, ,F12.5,1H))
CBE** ********************** BBCFMAT1 **********************************
CBB** ********************** BBCFMT0B **********************************
C**** FORMAT STATEMENTS FOR PAGE HEADERS
C****
90002 FORMAT (1H1)
90004 FORMAT (1H )
90006 FORMAT (1H ,20X,31HFEDERAL SOFTWARE TESTING CENTER)
90007 FORMAT (1H ,19X,34HFORTRAN COMPILER VALIDATION SYSTEM)
90008 FORMAT (1H ,21X,A13,A17)
90009 FORMAT (1H ,/,2H *,A5,6HBEGIN*,12X,15HTEST RESULTS - ,A5,/)
90010 FORMAT (1H ,8X,16HTEST DATE*TIME= ,A17,15H - COMPILER= ,A20)
90013 FORMAT (1H ,8H TEST ,10HPASS/FAIL ,6X,17HDISPLAYED RESULTS,
1 7X,7HREMARKS,24X)
90014 FORMAT (1H ,46H----------------------------------------------,
1 33H---------------------------------)
90015 FORMAT (1H ,48X,17HTHIS PROGRAM HAS ,I3,6H TESTS,/)
C****
C**** FORMAT STATEMENTS FOR REPORT FOOTINGS
C****
90016 FORMAT (1H ,/,2H *,A5,4HEND*,14X,14HEND OF TEST - ,A5,/)
90018 FORMAT (1H ,A13,13X,A20,7H * ,A10,1H/,
1 A13)
90019 FORMAT (1H ,26HFOR OFFICIAL USE ONLY ,35X,15HCOPYRIGHT 1982)
C****
C**** FORMAT STATEMENTS FOR RUN SUMMARY
C****
90020 FORMAT (1H ,21X,I5,13H TESTS PASSED)
90022 FORMAT (1H ,21X,I5,13H TESTS FAILED)
90024 FORMAT (1H ,21X,I5,14H TESTS DELETED)
90026 FORMAT (1H ,21X,I5,25H TESTS REQUIRE INSPECTION)
90028 FORMAT (1H ,21X,I5,4H OF ,I3,15H TESTS EXECUTED)
CBE** ********************** BBCFMT0B **********************************
C*****
C***** END OF TEST SEGMENT 21
STOP
END
*END-OF,FM900
FM901.f 481036619 170 2 100666 13034 `
*HEADER,FORTR,FM901
*FILES1,FORTR,FM901,XX
C***********************************************************************
C***** FORTRAN 77
C***** FM901 AFMTF - (023)
C*****
C***********************************************************************
C***** GENERAL PURPOSE ANS REFS
C***** TO TEST SIMPLE FORMAT AND FORMATTED DATA 12.9.5.2
C***** TRANSFER STATEMENTS IN EXTERNAL SEQUENTIAL I/O SO 13.1.1
C***** THAT THESE FEATURES MAY BE USED IN OTHER TEST 12.8.1
C***** PROGRAM SEGMENTS FOR CHARACTER DATA TYPES. 4.8
C***** TO TEST READ AND WRITE OF SUBSTRINGS. 5.7
C*****
C***** RESTRICTIONS OBSERVED
C***** * ALL FORMAT STATEMENTS ARE LABELED 12.8.2
C***** * H AND X DESCRIPTORS ARE NEVER REPEATED 13.1.1
C***** * FIELD WIDTH IS NEVER ZERO 13.5.11
C***** * IF AN I/O LIST SPECIFIES AT LEAST ONE LIST ITEM 13.3
C***** AT LEAST ONE REPEATABLE EDIT DESCRIPTOR MUST EXIST
C***** IN THE FORMAT SPECIFICATION.
C***** * ITEMS IN I/O LIST CORRESPOND TO FORMAT DESCRIPTORS 13.3
C*****
CBB** ********************** BBCCOMNT **********************************
C****
C**** 1978 FORTRAN COMPILER VALIDATION SYSTEM
C**** VERSION 2.0
C****
C****
C**** SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO
C**** GENERAL SERVICES ADMINISTRATION
C**** FEDERAL SOFTWARE TESTING CENTER
C**** 5203 LEESBURG PIKE, SUITE 1100
C**** FALLS CHURCH, VA. 22041
C****
C**** (703) 756-6153
C****
CBE** ********************** BBCCOMNT **********************************
C*****
C INPUT DATA TO THIS SEG. CONSISTS OF 5 DATA CARD IMAGES IN COLS. 1 - 52
COL. 1-------------------------------------------------52
CARD 1 XYZ123:45$'),.JKLABCDEF67890MNOPQRSTUVW =+-*/(GHI
CARD 2 ONEFIVENINEELEVENSEVENTHREE
CARD 3 SQUARE THE WORLD IN 40 NIGHTS
CARD 4 DAYS 80AROUND
CARD 5 TO XXXXX NOT TO XXXX- THAT IS THE QUESTIONXXBE ORBE
C*****
C***** S P E C I F I C A T I O N S SEGMENT 023
C*****
CHARACTER*13 A13VK
CHARACTER*27 A27VK
CHARACTER*29 A29VK
CHARACTER*36 A36VK
CHARACTER*43 B43VK
C*****
CBB** ********************** BBCINITA **********************************
C**** SPECIFICATION STATEMENTS
C****
CHARACTER ZVERS*13, ZVERSD*17, ZDATE*17, ZPROG*5, ZCOMPL*20,
1 ZNAME*20, ZTAPE*10, ZPROJ*13, REMRKS*31, ZTAPED*13
CBE** ********************** BBCINITA **********************************
CBB** ********************** BBCINITB **********************************
C**** INITIALIZE SECTION
DATA ZVERS, ZVERSD, ZDATE
1 /'VERSION 2.0 ', '82/08/02*18.33.46', '*NO DATE*TIME'/
DATA ZCOMPL, ZNAME, ZTAPE
1 /'*NONE SPECIFIED*', '*NO COMPANY NAME*', '*NO TAPE*'/
DATA ZPROJ, ZTAPED, ZPROG
1 /'*NO PROJECT*', '*NO TAPE DATE', 'XXXXX'/
DATA REMRKS /' '/
C**** THE FOLLOWING 9 COMMENT LINES (CZ01, CZ02, ...) CAN BE REPLACED
C**** FOR IDENTIFYING THE TEST ENVIRONMENT
C****
CZ01 ZVERS = 'VERSION OF THE COMPILER VALIDATION SYSTEM'
CZ02 ZVERSD = 'CREATION DATE/TIME OF THE COMPILER VALIDATION SYSTEM'
CZ03 ZPROG = 'PROGRAM NAME'
CZ04 ZDATE = 'DATE OF TEST'
CZ05 ZCOMPL = 'COMPILER IDENTIFICATION'
CZ06 ZPROJ = 'PROJECT NUMBER/IDENTIFICATION'
CZ07 ZNAME = 'NAME OF USER'
CZ08 ZTAPE = 'TAPE OWNER/ID'
CZ09 ZTAPED = 'DATE TAPE COPIED'
C
IVPASS = 0
IVFAIL = 0
IVDELE = 0
IVINSP = 0
IVTOTL = 0
IVTOTN = 0
ICZERO = 0
C
C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER.
I01 = 05
C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER.
I02 = 06
C
CX010 REPLACED BY FEXEC X-010 CONTROL CARD (CARD-READER UNIT NUMBER).
C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5
CX011 REPLACED BY FEXEC X-011 CONTROL CARD. CX011 IS FOR SYSTEMS
C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX010.
C
CX020 REPLACED BY FEXEC X-020 CONTROL CARD (PRINTER UNIT NUMBER).
C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02= 6
CX021 REPLACED BY FEXEC X-021 CONTROL CARD. CX021 IS FOR SYSTEMS
C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX020.
C
CBE** ********************** BBCINITB **********************************
IRVI = I01
NUVI = I02
IVTOTL = 4
ZPROG = 'FM901'
CBB** ********************** BBCHED0A **********************************
C****
C**** WRITE REPORT TITLE
C****
WRITE (I02, 90002)
WRITE (I02, 90006)
WRITE (I02, 90007)
WRITE (I02, 90008) ZVERS, ZVERSD
WRITE (I02, 90009) ZPROG, ZPROG
WRITE (I02, 90010) ZDATE, ZCOMPL
CBE** ********************** BBCHED0A **********************************
C*****
C***** HEADER FOR SEGMENT 23
WRITE (NUVI,02300)
02300 FORMAT(1H , /1X,38H AFMTF - (023) FORMATTED DATA TRANSFER//
1 1X,35H USING A-CONVERSION WITH SUBSTRINGS//1X,
2 31H REFS - 12.9.5.2 13.3 13.5.11)
CBB** ********************** BBCHED0B **********************************
C**** WRITE DETAIL REPORT HEADERS
C****
WRITE (I02,90004)
WRITE (I02,90004)
WRITE (I02,90013)
WRITE (I02,90014)
WRITE (I02,90015) IVTOTL
CBE** ********************** BBCHED0B **********************************
C*****
C***** TEST THAT DATA MAY BE READ IN A SERIES OF SUBSTRINGS, 5.7
C***** NOT NECESSARILY IN THE ORDER OF POSITION IN THE STRING, 12.8.2
C***** AND CAN BE WRITTEN AS A CHARACTER STRING. 13.5.11
C***** SHOW ALSO THAT THE FULL FORTRAN CHARACTER SET CAN BE READ 3.1
C***** (INCLUDES $ AND :)
C*****
C***** INPUT CARD 1
READ(IRVI, 02301) A36VK(24:29), A13VK(13:13), A36VK(30:31),
1 A13VK(11:12), A13VK(8:10), A36VK(10:12), A36VK(:6),
2 A36VK(32:), A36VK(13:23), A13VK(1:7), A36VK(7:9)
02301 FORMAT(A6, A1, 2A2, A3, A3, A6, A5, A11, A7, A3)
CT001* TEST 1
IVTNUM = 1
REMRKS = '2 SETS OF 2 COMPUTED LINES '
WRITE (NUVI, 80004) IVTNUM, REMRKS
REMRKS = 'EXPECTED '
WRITE (NUVI, 80050) REMRKS
WRITE (NUVI, 80020)
WRITE (NUVI, 70010) A36VK(1:6), A36VK(7:9), A36VK(10:12),
1 A36VK(13:23), A36VK(24:29), A36VK(30:31), A36VK(32:36),
2 A36VK, A13VK(:7), A13VK(8:10), A13VK(11:12), A13VK(13:),
3 A13VK
70010 FORMAT (26X,A6,2(A3),A11,A6,A2,A5/26X,A36//26X,A7,A3,A2,A1/
1 26X,A13)
IVINSP = IVINSP + 1
WRITE (NUVI, 70011)
70011 FORMAT(1H ,16X,10HCORRECT: ,22X,32HCORRESPONDING LINE(S) MUST M
1ATCH)
WRITE (NUVI, 70012)
70012 FORMAT(26X,36HABCDEFGHIJKLMNOPQRSTUVWXYZ1234567890/
1 26X,13H =+-*/(),.$':)
C*****
C***** TEST THAT A CHARACTER VARIABLE CAN BE OUTPUT AS SUBSTRINGS.
C***** 13.5.11
C***** INPUT CARD 2
READ(IRVI, 02303) A27VK
02303 FORMAT(A27)
CT002* TEST 2
IVTNUM = 2
WRITE (NUVI, 80004) IVTNUM
WRITE (NUVI, 80020)
WRITE(NUVI, 70020) A27VK(1:3), A27VK(23:27), A27VK(4:7),
1 A27VK(18:22), A27VK(8:11), A27VK(12:17)
70020 FORMAT(26X,A3,A6,A5,A6,A5,A7)
IVINSP = IVINSP + 1
WRITE (NUVI, 80022)
WRITE (NUVI, 70022)
70022 FORMAT(26X,32HONE THREE FIVE SEVEN NINE ELEVEN)
C*****
C***** TEST THAT A SUBSTRING CAN BE READ IN, AND PARTIALLY REPLACE
C***** A PREVIOUSLY READ CHARACTER STRING. 13.5.11
C***** THIS SHOWS THAT THE LENGTH IS DERIVED FROM THE SUBSTRING,
C***** AND NOT THE CHARACTER VARIABLE LENGTH.
C*****
C***** INPUT CARDS 3-4
READ(IRVI, 02305) A29VK, A29VK(24:29), A29VK(21:22), A29VK(1:6)
02305 FORMAT(A29/A,2A)
CT003* TEST 3
IVTNUM = 3
WRITE (NUVI, 80004) IVTNUM
WRITE (NUVI, 80020)
WRITE(NUVI, 70030) A29VK(1:3), A29VK(4:21), A29VK(22:29)
70030 FORMAT (26X,3(A))
IVINSP = IVINSP + 1
WRITE (NUVI, 80022)
WRITE (NUVI, 70032)
70032 FORMAT(25X,30H AROUND THE WORLD IN 80 DAYS )
C*****
C***** SPECIFIED FIELD WIDTH IN A A-EDIT DESCRIPTOR
C***** IS DIFFERENT FROM SUBSTRING LENGTH
C*****
C***** INPUT CARD 5
READ(IRVI, 02307) B43VK, B43VK(4:8), B43VK(17:20)
02307 FORMAT(A43, A7, A2)
CT004* TEST 4
IVTNUM = 4
WRITE (NUVI, 80004) IVTNUM
WRITE (NUVI, 80020)
WRITE (NUVI, 70040) B43VK(:)
70040 FORMAT (26X,A20)
IVINSP = IVINSP + 1
WRITE (NUVI, 80022)
WRITE (NUVI, 70042)
70042 FORMAT(26X,20HTO BE OR NOT TO BE )
C*****
CBB** ********************** BBCSUM0 **********************************
C**** WRITE OUT TEST SUMMARY
C****
IVTOTN = IVPASS + IVFAIL + IVDELE + IVINSP
WRITE (I02, 90004)
WRITE (I02, 90014)
WRITE (I02, 90004)
WRITE (I02, 90020) IVPASS
WRITE (I02, 90022) IVFAIL
WRITE (I02, 90024) IVDELE
WRITE (I02, 90026) IVINSP
WRITE (I02, 90028) IVTOTN, IVTOTL
CBE** ********************** BBCSUM0 **********************************
CBB** ********************** BBCFOOT0 **********************************
C**** WRITE OUT REPORT FOOTINGS
C****
WRITE (I02,90016) ZPROG, ZPROG
WRITE (I02,90018) ZPROJ, ZNAME, ZTAPE, ZTAPED
WRITE (I02,90019)
CBE** ********************** BBCFOOT0 **********************************
CBB** ********************** BBCFMT0A **********************************
C**** FORMATS FOR TEST DETAIL LINES
C****
80000 FORMAT (1H ,2X,I3,4X,7HDELETED,32X,A31)
80002 FORMAT (1H ,2X,I3,4X,7H PASS ,32X,A31)
80004 FORMAT (1H ,2X,I3,4X,7HINSPECT,32X,A31)
80008 FORMAT (1H ,2X,I3,4X,7H FAIL ,32X,A31)
80010 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,15X,10HCOMPUTED= ,
1I6,/,1H ,15X,10HCORRECT= ,I6)
80012 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
1E12.5,/,1H ,16X,10HCORRECT= ,E12.5)
80018 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
1A21,/,1H ,16X,10HCORRECT= ,A21)
80020 FORMAT (1H ,16X,10HCOMPUTED= ,A21,1X,A31)
80022 FORMAT (1H ,16X,10HCORRECT= ,A21,1X,A31)
80024 FORMAT (1H ,16X,10HCOMPUTED= ,I6,16X,A31)
80026 FORMAT (1H ,16X,10HCORRECT= ,I6,16X,A31)
80028 FORMAT (1H ,16X,10HCOMPUTED= ,E12.5,10X,A31)
80030 FORMAT (1H ,16X,10HCORRECT= ,E12.5,10X,A31)
80050 FORMAT (1H ,48X,A31)
CBE** ********************** BBCFMT0A **********************************
CBB** ********************** BBCFMAT1 **********************************
C**** FORMATS FOR TEST DETAIL LINES - FULL LANGUAGE
C****
80031 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
1D17.10,/,1H ,16X,10HCORRECT= ,D17.10)
80033 FORMAT (1H ,16X,10HCOMPUTED= ,D17.10,10X,A31)
80035 FORMAT (1H ,16X,10HCORRECT= ,D17.10,10X,A31)
80037 FORMAT (1H ,16X,10HCOMPUTED= ,1H(,E12.5,2H, ,E12.5,1H),6X,A31)
80039 FORMAT (1H ,16X,10HCORRECT= ,1H(,E12.5,2H, ,E12.5,1H),6X,A31)
80041 FORMAT (1H ,16X,10HCOMPUTED= ,1H(,F12.5,2H, ,F12.5,1H),6X,A31)
80043 FORMAT (1H ,16X,10HCORRECT= ,1H(,F12.5,2H, ,F12.5,1H),6X,A31)
80045 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
11H(,F12.5,2H, ,F12.5,1H)/,1H ,16X,10HCORRECT= ,
21H(,F12.5,2H, ,F12.5,1H))
CBE** ********************** BBCFMAT1 **********************************
CBB** ********************** BBCFMT0B **********************************
C**** FORMAT STATEMENTS FOR PAGE HEADERS
C****
90002 FORMAT (1H1)
90004 FORMAT (1H )
90006 FORMAT (1H ,20X,31HFEDERAL SOFTWARE TESTING CENTER)
90007 FORMAT (1H ,19X,34HFORTRAN COMPILER VALIDATION SYSTEM)
90008 FORMAT (1H ,21X,A13,A17)
90009 FORMAT (1H ,/,2H *,A5,6HBEGIN*,12X,15HTEST RESULTS - ,A5,/)
90010 FORMAT (1H ,8X,16HTEST DATE*TIME= ,A17,15H - COMPILER= ,A20)
90013 FORMAT (1H ,8H TEST ,10HPASS/FAIL ,6X,17HDISPLAYED RESULTS,
1 7X,7HREMARKS,24X)
90014 FORMAT (1H ,46H----------------------------------------------,
1 33H---------------------------------)
90015 FORMAT (1H ,48X,17HTHIS PROGRAM HAS ,I3,6H TESTS,/)
C****
C**** FORMAT STATEMENTS FOR REPORT FOOTINGS
C****
90016 FORMAT (1H ,/,2H *,A5,4HEND*,14X,14HEND OF TEST - ,A5,/)
90018 FORMAT (1H ,A13,13X,A20,7H * ,A10,1H/,
1 A13)
90019 FORMAT (1H ,26HFOR OFFICIAL USE ONLY ,35X,15HCOPYRIGHT 1982)
C****
C**** FORMAT STATEMENTS FOR RUN SUMMARY
C****
90020 FORMAT (1H ,21X,I5,13H TESTS PASSED)
90022 FORMAT (1H ,21X,I5,13H TESTS FAILED)
90024 FORMAT (1H ,21X,I5,14H TESTS DELETED)
90026 FORMAT (1H ,21X,I5,25H TESTS REQUIRE INSPECTION)
90028 FORMAT (1H ,21X,I5,4H OF ,I3,15H TESTS EXECUTED)
CBE** ********************** BBCFMT0B **********************************
C*****
C***** END OF TEST SEGMENT 023
STOP
END
*END-OF,FM901
FM903.f 481036625 170 2 100666 24220 `
*HEADER,FORTR,FM903
*FILES1,FORTR,FM903,XX
C***********************************************************************
C***** FORTRAN 77
C***** FM903 IOFMTF - (354)
C***** THIS PROGRAM CALLS SUBROUTINE SN904
C***********************************************************************
C***** GENERAL PURPOSE ANS REFS
C***** TO TEST ADDITIONAL FEATURES OF READ AND WRITE 12.8
C***** STATEMENTS, FORMATTED RECORDS AND FORMAT STATEMENTS 12.1.1
C***** DOUBLE PRECISION AND COMPLEX DATA TYPES.
C***** TO TEST ALL FORMS OF CHARACTER EXPRESSIONS AS 13.1.2
C***** FORMAT SPECIFIERS.
C***** RESTRICTIONS OBSERVED
C***** * H AND X DESCRIPTORS ARE NEVER REPEATED 13.2.1
C***** * FOR W.D DESCRIPTORS, D IS ALWAYS SPECIFIED AND
C***** W IS EQUAL TO OR GREATER THAN D
C***** * FIELD WIDTH IS NEVER ZERO
C***** * IF AN I/O LIST SPECIFIES AT LEAST ONE ITEM 13.3
C***** AT LEAST ONE REPEATABLE EDIT DESCRIPTOR MUST EXIST
C***** IN THE FORMAT SPECIFICATION
C***** * ITEMS IN I/O LIST CORRESPOND TO EDIT DESCRIPTORS
C***** * NEGATIVE OUTPUT VALUES ARE SIGNED 13.5.9
C***** * AN H EDIT DESCRIPTOR IS NEVER USED ON INPUT 13.5.2
C***** * IN THE INPUT FIELD, FOR THE IW EDIT DESCRIPTOR 13.5.9.1
C***** THE CHARACTER STRING MUST BE AN OPTIONALLY SIGNED
C***** INTEGER CONSTANT
C***** GENERAL COMMENTS
C***** PLUS SIGNS FOR INPUT FIELDS ARE USUALLY OMITTED 13.5.9
C*****
C***** CALL SUBROUTINE SN904 (SEGMENT 790)
C*****
CBB** ********************** BBCCOMNT **********************************
C****
C**** 1978 FORTRAN COMPILER VALIDATION SYSTEM
C**** VERSION 2.0
C****
C****
C**** SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO
C**** GENERAL SERVICES ADMINISTRATION
C**** FEDERAL SOFTWARE TESTING CENTER
C**** 5203 LEESBURG PIKE, SUITE 1100
C**** FALLS CHURCH, VA. 22041
C****
C**** (703) 756-6153
C****
CBE** ********************** BBCCOMNT **********************************
C*****
C INPUT DATA TO THIS SEGMENT CONSISTS OF 14 CARD IMAGES IN COL. 1 - 56
COL. 1-----------------------------------------------------56
CARD 1 333144446666225555
CARD 2 1234567890
CARD 3 1234567890
CARD 4 1234567890
CARD 5 1234567890
CARD 6 12345
CARD 7 12345123.5123.45D-01 12345D+01
CARD 8 12 345 678
CARD 9 5-1111 3333-5555 7777-9999
CARD 10 12345678901234567890123456781234567890123456789012345678
CARD 11 12345678901234123456789012341234567890123412345678901234
CARD 12 12345678901234123456789012341234567890123456789012345678
CARD 13 12345678901234567890123456781234567890123456789012345678
CARD 14 12345678901234123456789012341234567890123412345678901234
C*****
C***** S P E C I F I C A T I O N S SEGMENT 354
C*****
INTEGER J1I(6)
INTEGER IA1I(8)
CHARACTER*11 A11VK
CHARACTER*15 C151K(7)
CHARACTER*19 A19VK
CHARACTER*25 C251K(6)
CHARACTER*32 A32VK
CHARACTER*52 A52VK
CHARACTER*65 A65VK
CHARACTER*85 A85VK
DOUBLE PRECISION AVD, A1D(4), B4D(2,1,2,2)
COMPLEX AVC, BVC, CVC, A2C(2,2)
EXTERNAL SN904
C*****
CBB** ********************** BBCINITA **********************************
C**** SPECIFICATION STATEMENTS
C****
CHARACTER ZVERS*13, ZVERSD*17, ZDATE*17, ZPROG*5, ZCOMPL*20,
1 ZNAME*20, ZTAPE*10, ZPROJ*13, REMRKS*31, ZTAPED*13
CBE** ********************** BBCINITA **********************************
CBB** ********************** BBCINITB **********************************
C**** INITIALIZE SECTION
DATA ZVERS, ZVERSD, ZDATE
1 /'VERSION 2.0 ', '82/08/02*18.33.46', '*NO DATE*TIME'/
DATA ZCOMPL, ZNAME, ZTAPE
1 /'*NONE SPECIFIED*', '*NO COMPANY NAME*', '*NO TAPE*'/
DATA ZPROJ, ZTAPED, ZPROG
1 /'*NO PROJECT*', '*NO TAPE DATE', 'XXXXX'/
DATA REMRKS /' '/
C**** THE FOLLOWING 9 COMMENT LINES (CZ01, CZ02, ...) CAN BE REPLACED
C**** FOR IDENTIFYING THE TEST ENVIRONMENT
C****
CZ01 ZVERS = 'VERSION OF THE COMPILER VALIDATION SYSTEM'
CZ02 ZVERSD = 'CREATION DATE/TIME OF THE COMPILER VALIDATION SYSTEM'
CZ03 ZPROG = 'PROGRAM NAME'
CZ04 ZDATE = 'DATE OF TEST'
CZ05 ZCOMPL = 'COMPILER IDENTIFICATION'
CZ06 ZPROJ = 'PROJECT NUMBER/IDENTIFICATION'
CZ07 ZNAME = 'NAME OF USER'
CZ08 ZTAPE = 'TAPE OWNER/ID'
CZ09 ZTAPED = 'DATE TAPE COPIED'
C
IVPASS = 0
IVFAIL = 0
IVDELE = 0
IVINSP = 0
IVTOTL = 0
IVTOTN = 0
ICZERO = 0
C
C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER.
I01 = 05
C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER.
I02 = 06
C
CX010 REPLACED BY FEXEC X-010 CONTROL CARD (CARD-READER UNIT NUMBER).
C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5
CX011 REPLACED BY FEXEC X-011 CONTROL CARD. CX011 IS FOR SYSTEMS
C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX010.
C
CX020 REPLACED BY FEXEC X-020 CONTROL CARD (PRINTER UNIT NUMBER).
C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02= 6
CX021 REPLACED BY FEXEC X-021 CONTROL CARD. CX021 IS FOR SYSTEMS
C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX020.
C
CBE** ********************** BBCINITB **********************************
IRVI = I01
NUVI = I02
IVTOTL = 13
ZPROG = 'FM903'
CBB** ********************** BBCHED0A **********************************
C****
C**** WRITE REPORT TITLE
C****
WRITE (I02, 90002)
WRITE (I02, 90006)
WRITE (I02, 90007)
WRITE (I02, 90008) ZVERS, ZVERSD
WRITE (I02, 90009) ZPROG, ZPROG
WRITE (I02, 90010) ZDATE, ZCOMPL
CBE** ********************** BBCHED0A **********************************
C***** HEADER FORMAT STATEMENT
WRITE(NUVI, 35400)
35400 FORMAT(1H ,/ 1X, 35HIOFMTF - (354) ADDITIONAL FORMATTED//1X,
1 14HDATA TRANSFERS,//1X,
2 31HANS REF. - 12.9.5.2 13.1 13.5)
CBB** ********************** BBCHED0B **********************************
C**** WRITE DETAIL REPORT HEADERS
C****
WRITE (I02,90004)
WRITE (I02,90004)
WRITE (I02,90013)
WRITE (I02,90014)
WRITE (I02,90015) IVTOTL
CBE** ********************** BBCHED0B **********************************
C***** TEST THAT A FORMAT MAY BE A CHARACTER VARIABLE, 12.4.2(3)
C***** A CHARACTER EXPRESSION, A CHARACTER ARRAY, OR A 12.4.2(4)
C***** CHARACTER ARRAY ELEMENT. 13.1.2
C***** NOTE THAT THE LENGTH OF THE FORMAT MAY EXCEED THE
C***** LENGTH OF AN ARRAY ELEMENT IF THE FORMAT SPECIFIER
C***** IS AN ARRAY, BUT NOT IF THE SPECIFIER IS AN ARRAY ELEMENT.
WRITE(NUVI, 35401)
35401 FORMAT(/8X, 30HCHARACTER EXPRESSION AS FORMAT/)
A19VK = '(I3,I1,I4,I4,I2,I4)'
C***** CARD 1
READ(IRVI, A19VK) J1I(3), J1I(1), J1I(4), J1I(6), J1I(2), J1I(5)
CT001* TEST 1 - CHARACTER EXPRESSION AS FORMAT
IVTNUM = 1
REMRKS = 'LEADING PLUS SIGN OPTIONAL'
WRITE (NUVI, 80004) IVTNUM, REMRKS
A65VK = '16X,10HCOMPUTED: /26X,I1, 1X, I2, 1X, I3, 1X, I4, 1X,
1I5, 1X, I6'
A85VK = '16X,10HCORRECT: ,22X,26H2 CORRECT ANSWERS POSSIBLE/26X
1,26H1 22 333 4444 5555 6666'
WRITE(NUVI, '(/1X,' // A65VK // '/1X,' // A85VK // ')') J1I
IVINSP = IVINSP + 1
WRITE (NUVI, 70010)
70010 FORMAT (26X,26H1 22 333 4444 +5555 +6666)
CT002* TEST 2 - CHARACTER ARRAY AS FORMAT
IVTNUM = 2
WRITE (NUVI, 80004) IVTNUM, REMRKS
WRITE (NUVI, 80020)
C251K(1) = '(26X, I6, 1X, I5, 1X, I4,'
C251K(2) = ' 1X, I3, 1X, I2, 1X, I1 /'
C251K(3) = '17X,9HCORRECT: ,22X,26H2 '
C251K(4) = 'CORRECT ANSWERS POSSIBLE/'
C251K(5) = '26X,26H 6666 5555 4444 '
C251K(6) = '333 22 1) '
WRITE(NUVI, C251K) (J1I(7-IVI), IVI=1,6)
IVINSP = IVINSP + 1
WRITE (NUVI, 70020)
70020 FORMAT (26X,26H +6666 +5555 4444 333 22 1)
CT003* TEST 3 - CHARACTER ARRAY ELEMENT AS FORMAT
IVTNUM = 3
WRITE (NUVI, 80004) IVTNUM, REMRKS
WRITE (NUVI, 80020)
C*****
C151K(1) = '(I1,2X,I2)'
C151K(3) = '(2X,I3,1X,I4)'
C151K(5) = '(I5,T1,I1)'
C151K(7) = '(TR4,I2,TL2,I3)'
C***** CARDS 2-5
DO 0032 IVI = 1, 7, 2
READ(IRVI, C151K(IVI)) IA1I(IVI), IA1I(IVI+1)
0032 CONTINUE
WRITE(NUVI, 70030) IA1I
70030 FORMAT (25X, 8(1X, I5))
IVINSP = IVINSP + 1
WRITE (NUVI, 70031)
70031 FORMAT (1H ,16X,10HCORRECT: ,22X,26H2 CORRECT ANSWERS POSSIBLE)
WRITE (NUVI, 70032)
70032 FORMAT(26X, ' 1 45 345 7890 12345 1 56 567'/
1 26X, ' +1 +45 +345 +7890 12345 +1 +56 +567')
C*****
C***** TEST ADDITIONAL INTEGER EDITING FEATURES.
C***** - IW.M EDITING DESCRIPTOR 13.5.9.1
C***** NOTE THAT IF M IS ZERO AND THE VALUE OF THE INTERNAL
C***** DATUM IS ZERO, THE OUTPUT FIELD CONSISTS OF ONLY BLANK
C***** CHARACTERS REGARDLESS OF THE SIGN CONTROL IN EFFECT.
WRITE(NUVI, 35404)
35404 FORMAT(/8X, 32HINTEGER EDITING AND OUT OF RANGE/)
C***** CARD 6
READ(IRVI, 35405) (IA1I(IVI), IVI=1,4)
35405 FORMAT(I6.6, T1, I6.4, TL6, I6.2, TL9, I6.0)
CT004* TEST 4 - INTEGER EDITING
IVTNUM = 4
WRITE (NUVI, 80004) IVTNUM,REMRKS
WRITE (NUVI, 80020)
WRITE(NUVI, 70040) (IA1I(IVI), IVI=1,4)
70040 FORMAT(25X, 4(1X, I6))
IVINSP = IVINSP + 1
WRITE (NUVI, 70031)
WRITE (NUVI, 70041)
70041 FORMAT(26X, 27H 12345 12345 12345 12345/
1 26X, 27H+12345 +12345 +12345 +12345)
CT005* TEST 5 - OUT OF RANGE
IVTNUM = 5
WRITE (NUVI, 80004) IVTNUM
WRITE (NUVI, 80020)
JVI = 0
IVI = 12
WRITE (NUVI, 70050) -IVI, IVI, IVI, IVI, IVI, JVI, JVI, JVI
70050 FORMAT (26X, SS, I5.5, S, 1X, I5.5, SS, 1X, I5.3, 1X, I5.1,
1 1X, I5.0, 1X, 1H(, I5.0, 1H), S, 1X, 1H(, I5.0, 1H),
2 SP, 1X, 1H(, I5.0, 1H))
IVINSP = IVINSP + 1
WRITE (NUVI, 80022)
WRITE (NUVI, 70051)
70051 FORMAT (26X, 45H***** 00012 012 12 12 ( ) ( ),
1 8H ( ))
C ADVANCE TO TOP-OF PAGE AND WRITE HEADERS
WRITE (NUVI, 90002)
WRITE (NUVI, 90013)
WRITE (NUVI, 90014)
C*****
C***** TEST ADDITIONAL DOUBLE PRECISION EDITING FEATURES. 13.5.9.2
C***** - D.P. MAY BE READ, WRITTEN WITH F AND E 13.5.9.2.1
C***** EDIT DESCRIPTOR. 13.5.9.2.2
C***** (D AND G FORMATS ARE TEST IN INTERNAL FILE SEGMENTS
C***** 392 AND 393.)
C***** - FIELD WIDTH TOO SMALL ON F 13.5.9(4)
C***** - EXPONENT WIDTH TOO SMALL ON EW.DE(E) 13.5.9(4)
C***** - IF SP AND FIELD TOO SMALL, THE PLUS IS NOT 13.5.9(5)
C***** OPTIONAL
WRITE(NUVI, 35408)
35408 FORMAT(/8X,41HDOUBLE PRECISION EDITING AND OUT OF RANGE/)
C***** CARD 7
READ(IRVI, 35409) B4D
35409 FORMAT(1X, 2F5.2, F10.2, F10.5, TL40, 1X, 2E5.2, E10.2, E10.5E5)
CT006* TEST 6 - DOUBLE PRECISION EDITING AND OUT OF RANGE
IVTNUM = 6
REMRKS = '2 COMPUTED LINES EXPECTED'
WRITE (NUVI, 80004) IVTNUM,REMRKS
WRITE (NUVI, 80020)
B4D(2,1,2,2) = (B4D(2,1,2,2) * 10) ** 12
WRITE(NUVI, 70060) B4D
70060 FORMAT (26X, SP, F6.2, SS, 1X, F5.5, 1X, F6.3, 1X, F6.4,
1 /26X, 3P, E6.0, 0P, 2(5X, E10.5), 5X, E9.5E1)
IVINSP = IVINSP + 1
WRITE (NUVI, 70061)
70061 FORMAT(/1H ,16X,10HCORRECT: ,22X,31HCORRESPONDING LINES MUST
1 MATCH ,/1H ,48X,31HEITHER OF THE FOLLOWING TWO ,
2 /1H ,48X,31HCORRECT ANSWERS )
WRITE (NUVI, 70062)
70062 FORMAT(26X,26H****** ***** 12.345 1.2345/26X,
1 50H****** .12350E+03 .12345E+02 *********/
2 /26X,26H****** ***** 12.345 1.2345/26X,
3 50H****** .12350+003 .12345+002 *********)
C*****
C***** TEST ADDITIONAL COMPLEX EDITING FEATURES. 13.5.9.2.4
C***** - FIELD WIDTH TOO SMALL ON F 13.5.9(4)
C***** - EXPONENT WIDTH TOO SMALL ON EW.DE(E) 13.5.9(4)
WRITE(NUVI, 35411)
35411 FORMAT(/8X, 32HCOMPLEX EDITING AND OUT OF RANGE/)
CT007* TEST 7 - COMPLEX EDITING AND OUT OF RANGE
IVTNUM = 7
WRITE (NUVI, 80004) IVTNUM, REMRKS
WRITE (NUVI, 80020)
AVC = (25.25, 75.75)
BVC = (0.25E+10, 0.75E+10)
WRITE(NUVI, 70070) AVC, AVC, BVC, BVC
70070 FORMAT (26X, F7.2, 3X, F6.2, 3X, F5.2, 3X, F4.2,
1 /26X, E8.2E3, 3X, E7.2E2, 2(4X, E6.2E1))
IVINSP = IVINSP + 1
WRITE (NUVI, 70061)
WRITE (NUVI, 70071)
70071 FORMAT (26X, 31H 25.25 75.75 25.25 ****/
1 25X, 39H .25E+010 .75E+10 ****** ******//
2 26X, 31H +25.25 +75.75 25.25 ****/
3 25X, 39H .25E+010 .75E+10 ****** ******)
C*****
C***** - TEST BZ, BN EDIT DESCRIPTORS 13.5.8
C***** - TEST T, TL, TR EDIT DESCRIPTORS 13.5.3.1
WRITE(NUVI, 35414)
35414 FORMAT(/8X,36HBZ, BN, T, TL AND TR EDIT DESCRIPTOR/)
CT008* TEST 8 - BZ, BN, T, TL, AND TR EDIT DESCRIPTOR
IVTNUM = 8
REMRKS = 'LEADING PLUS SIGN OPTIONAL'
WRITE (NUVI, 80004) IVTNUM,REMRKS
WRITE (NUVI, 80020)
C***** CARD 8
READ(IRVI, 70080) AVD, B4D(2,1,1,2), A2C(1,1), AVC
70080 FORMAT(BN, D5.2, BZ, D5.2, TL40, 2F5.2, T1, TR1, TL1, BN, 2F5.1)
WRITE(NUVI, 70081) AVD, B4D(2,1,1,2), A2C(1,1), AVC
70081 FORMAT (25X, 2F6.2, (((4(1X, F6.2)))))
IVINSP = IVINSP + 1
WRITE (NUVI, 70031)
WRITE (NUVI, 70082)
70082 FORMAT(25X, TR26, 14H 123.40 567.80, T25, 13H 12.34506.78,
1 1X, 13H120.34 506.78//
2 25X, TR26, 14H 123.40 567.80, T25, 13H +12.34506.78,
3 1X, 13H120.34 506.78)
C*****
C***** PASS A CHARACTER CONSTANT, WHICH IS A LEGITIMATE FORMAT
C***** SPECIFIER TO A SUBROUTINE.
WRITE(NUVI, 35417)
35417 FORMAT(/8X,15HSUBROUTINE CALL/)
CT009* TEST 9 - SUBROUTINE CALL
IVTNUM = 9
WRITE (NUVI, 80004) IVTNUM,REMRKS
C***** CARD 9
A11VK = '(I5, 6(I5))'
CALL SN904(A11VK, IRVI, NUVI)
IVINSP = IVINSP + 1
C*****
C ADVANCE TO TOP-OF PAGE AND WRITE HEADERS
WRITE (NUVI, 90002)
WRITE (NUVI, 90013)
WRITE (NUVI, 90014)
C*****
C***** - TEST SS AND SP EDIT DESCRIPTORS. 13.5.6
C***** - TEST ALSO THAT A FORMAT SPECIFICATION MAY BE 13.1.2
C***** ALTERED BY A CHARACTER SUBSTRING SUBSTITUTION. 5.7
WRITE(NUVI, 35419)
35419 FORMAT(/8X,25HSS AND SP EDIT DESCRIPTOR/)
CT010* TEST 10 - SS AND SP EDIT DESCRIPTORS
IVTNUM = 10
WRITE (NUVI, 80004) IVTNUM, REMRKS
WRITE (NUVI, 80020)
IVI = 12345
AVS = 25.25
A1D(2) = 5.5D0
A2C(2,1) = (3.0, 4.0)
A52VK = '(26X,SP,F5.1,SS,2X,F4.1,SP,(T40,I6,2X,F6.2,SS,F6.1))'
WRITE(NUVI, A52VK) A2C(2,1), IVI, AVS, A1D(2), IVI, AVS, A1D(2)
IVINSP = IVINSP + 1
WRITE (NUVI, 70101)
70101 FORMAT(/1H ,16X,10HCORRECT: ,22X,31HCORRESPONDING LINES MUST
1 MATCH )
WRITE (NUVI, 70102)
70102 FORMAT(26X,' +3.0 4.0 +12345 +25.25 5.5'
1 /T40,' 12345 25.25 5.5')
CT011* TEST 11 - FORMAT ALTERED BY CHARACTER SUBSTRING SUBSTITUTION
IVTNUM = 11
WRITE (NUVI, 80004) IVTNUM, REMRKS
WRITE (NUVI, 80020)
A52VK(7:7) = 'S'
A52VK(14:15) = 'SP'
A52VK(26:26) = 'S'
A52VK(45:45) = 'P'
WRITE(NUVI, A52VK) A2C(2,1), IVI, AVS, A1D(2), IVI, AVS, A1D(2)
IVINSP = IVINSP + 1
WRITE (NUVI, 70101)
WRITE (NUVI, 70111)
70111 FORMAT (26X,' 3.0 +4.0 12345 25.25 +5.5'
1 /T40,'+12345 +25.25 +5.5')
C*****
C***** TEST A COLON EDIT DESCRIPTOR FOLLOWED BY A H-EDIT 13.5.5
C***** DESCRIPTOR TO SHOW THAT THE COLON EDIT DESCRIPTOR
C***** TERMINATED IF THERE ARE NO MORE ITEMS IN THE INPUT/OUTPUT LIST
WRITE(NUVI, 35422)
35422 FORMAT(/8X,'COLON EDIT DESCRIPTOR'/)
CT012* TEST 12
IVTNUM = 12
REMRKS = '2 COMPUTED LINES EXPECTED'
WRITE (NUVI, 80004) IVTNUM, REMRKS
WRITE (NUVI, 80020)
A32VK = 'AAAABBBBCCCCDDDDEEEEFFFFGGGGHHHH'
WRITE(NUVI, 70120) A32VK, A32VK
70120 FORMAT(26X, A32, :, 'IIIIJJJJ')
IVINSP = IVINSP + 1
WRITE (NUVI, 70101)
WRITE (NUVI, 70121)
70121 FORMAT(26X, 'AAAABBBBCCCCDDDDEEEEFFFFGGGGHHHHIIIIJJJJ',
1 /26X, 'AAAABBBBCCCCDDDDEEEEFFFFGGGGHHHH')
C*****
C***** TEST THAT FW.D, EW.DE(E) AND GW.DE(E) MAY HAVE MORE DIGITS ON
C***** INPUT THAN THE PROCESSOR CAN HANDLE FOR D.P. AND COMPLEX
CT013* TEST 13 - LARGE FORMAT SIZE FOR D.P. AND COMPLEX
IVTNUM = 13
WRITE (NUVI, 70131) IVTNUM
70131 FORMAT (/1H ,2X,I3,4X,7HINSPECT,32X,
1 'TEST SUCCESSFUL IF PROCESSOR IS '/1H ,48X,
2 'ABLE TO READ INPUT CARDS 10-14 '/1H ,48X,
3 'UNDER F, E, AND G FORMATS WHICH '/1H ,48X,
4 'HAVE MORE DIGITS THAN THE '/1H ,48X,
5 'PROCESSOR CAN HANDLE FOR D. P. '/1H ,48X,
6 'AND COMPLEX')
IVINSP = IVINSP + 1
C***** CARDS 10-14
READ(IRVI, 70130) B4D(1,1,1,1), AVD, AVC, A2C(2,2), BVC,
1 (B4D(1,1,IVI,1),IVI=1,2), A1D(1), A2C(1,2), CVC
70130 FORMAT(2F28.14, /2(E14.7E2, G14.14E1), /G14.0E3, E14.14E3,
1 E28.0E1, /2G28.14E2, /2(F14.0, F14.14) )
C*****
CBB** ********************** BBCSUM0 **********************************
C**** WRITE OUT TEST SUMMARY
C****
IVTOTN = IVPASS + IVFAIL + IVDELE + IVINSP
WRITE (I02, 90004)
WRITE (I02, 90014)
WRITE (I02, 90004)
WRITE (I02, 90020) IVPASS
WRITE (I02, 90022) IVFAIL
WRITE (I02, 90024) IVDELE
WRITE (I02, 90026) IVINSP
WRITE (I02, 90028) IVTOTN, IVTOTL
CBE** ********************** BBCSUM0 **********************************
CBB** ********************** BBCFOOT0 **********************************
C**** WRITE OUT REPORT FOOTINGS
C****
WRITE (I02,90016) ZPROG, ZPROG
WRITE (I02,90018) ZPROJ, ZNAME, ZTAPE, ZTAPED
WRITE (I02,90019)
CBE** ********************** BBCFOOT0 **********************************
CBB** ********************** BBCFMT0A **********************************
C**** FORMATS FOR TEST DETAIL LINES
C****
80000 FORMAT (1H ,2X,I3,4X,7HDELETED,32X,A31)
80002 FORMAT (1H ,2X,I3,4X,7H PASS ,32X,A31)
80004 FORMAT (1H ,2X,I3,4X,7HINSPECT,32X,A31)
80008 FORMAT (1H ,2X,I3,4X,7H FAIL ,32X,A31)
80010 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,15X,10HCOMPUTED= ,
1I6,/,1H ,15X,10HCORRECT= ,I6)
80012 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
1E12.5,/,1H ,16X,10HCORRECT= ,E12.5)
80018 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
1A21,/,1H ,16X,10HCORRECT= ,A21)
80020 FORMAT (1H ,16X,10HCOMPUTED= ,A21,1X,A31)
80022 FORMAT (1H ,16X,10HCORRECT= ,A21,1X,A31)
80024 FORMAT (1H ,16X,10HCOMPUTED= ,I6,16X,A31)
80026 FORMAT (1H ,16X,10HCORRECT= ,I6,16X,A31)
80028 FORMAT (1H ,16X,10HCOMPUTED= ,E12.5,10X,A31)
80030 FORMAT (1H ,16X,10HCORRECT= ,E12.5,10X,A31)
80050 FORMAT (1H ,48X,A31)
CBE** ********************** BBCFMT0A **********************************
CBB** ********************** BBCFMAT1 **********************************
C**** FORMATS FOR TEST DETAIL LINES - FULL LANGUAGE
C****
80031 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
1D17.10,/,1H ,16X,10HCORRECT= ,D17.10)
80033 FORMAT (1H ,16X,10HCOMPUTED= ,D17.10,10X,A31)
80035 FORMAT (1H ,16X,10HCORRECT= ,D17.10,10X,A31)
80037 FORMAT (1H ,16X,10HCOMPUTED= ,1H(,E12.5,2H, ,E12.5,1H),6X,A31)
80039 FORMAT (1H ,16X,10HCORRECT= ,1H(,E12.5,2H, ,E12.5,1H),6X,A31)
80041 FORMAT (1H ,16X,10HCOMPUTED= ,1H(,F12.5,2H, ,F12.5,1H),6X,A31)
80043 FORMAT (1H ,16X,10HCORRECT= ,1H(,F12.5,2H, ,F12.5,1H),6X,A31)
80045 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
11H(,F12.5,2H, ,F12.5,1H)/,1H ,16X,10HCORRECT= ,
21H(,F12.5,2H, ,F12.5,1H))
CBE** ********************** BBCFMAT1 **********************************
CBB** ********************** BBCFMT0B **********************************
C**** FORMAT STATEMENTS FOR PAGE HEADERS
C****
90002 FORMAT (1H1)
90004 FORMAT (1H )
90006 FORMAT (1H ,20X,31HFEDERAL SOFTWARE TESTING CENTER)
90007 FORMAT (1H ,19X,34HFORTRAN COMPILER VALIDATION SYSTEM)
90008 FORMAT (1H ,21X,A13,A17)
90009 FORMAT (1H ,/,2H *,A5,6HBEGIN*,12X,15HTEST RESULTS - ,A5,/)
90010 FORMAT (1H ,8X,16HTEST DATE*TIME= ,A17,15H - COMPILER= ,A20)
90013 FORMAT (1H ,8H TEST ,10HPASS/FAIL ,6X,17HDISPLAYED RESULTS,
1 7X,7HREMARKS,24X)
90014 FORMAT (1H ,46H----------------------------------------------,
1 33H---------------------------------)
90015 FORMAT (1H ,48X,17HTHIS PROGRAM HAS ,I3,6H TESTS,/)
C****
C**** FORMAT STATEMENTS FOR REPORT FOOTINGS
C****
90016 FORMAT (1H ,/,2H *,A5,4HEND*,14X,14HEND OF TEST - ,A5,/)
90018 FORMAT (1H ,A13,13X,A20,7H * ,A10,1H/,
1 A13)
90019 FORMAT (1H ,26HFOR OFFICIAL USE ONLY ,35X,15HCOPYRIGHT 1982)
C****
C**** FORMAT STATEMENTS FOR RUN SUMMARY
C****
90020 FORMAT (1H ,21X,I5,13H TESTS PASSED)
90022 FORMAT (1H ,21X,I5,13H TESTS FAILED)
90024 FORMAT (1H ,21X,I5,14H TESTS DELETED)
90026 FORMAT (1H ,21X,I5,25H TESTS REQUIRE INSPECTION)
90028 FORMAT (1H ,21X,I5,4H OF ,I3,15H TESTS EXECUTED)
CBE** ********************** BBCFMT0B **********************************
C*****
C***** END OF TEST SEGMENT 354
STOP
END
*HEADER,FORTR,FM903,SUBRTN,FM904
C***********************************************************************
C***** FORTRAN 77
C***** FM904 SN904 - (790)
C***** THIS SUBROUTINE IS CALLED BY FM903
C***********************************************************************
C***** GENERAL PURPOSE ANS REFS
C***** THIS SUBROUTINE IS CALLED BY IOFMTF (354)
C***** IT IS USED PRIMARILY TO TEST THAT A CHARACTER 13.1.2
C***** CONSTANT MAY BE PASSED AS A PARAMETER TO A 15.6.2.3
C***** SUBROUTINE AND USED AS A FORMAT.
C***** IT ALSO TESTS THAT A FORMAT MAY BE DEFINED IN A 9.4
C***** DATA STATEMENT.
C***** RESTRICTIONS OBSERVED
C***** SEE SEGMENT 354
C*****
SUBROUTINE SN904(A0WVK, IRWVI, NUWVI)
C*****
C***** S P E C I F I C A T I O N S SEGMENT 790
C*****
CHARACTER*(*) A0WVK
CHARACTER*130 A130VK
INTEGER I1I(5)
C*****
C***** TESTS THAT
C***** - A FORMAT SPECIFIER MAY BE PASSED AS A CHARACTER 13.1.2
C***** CONSTANT TO A SUBROUTINE. 15.6.2.3
C***** - A FORMAT SPECIFIER MAY BE DEFINED IN A DATA 13.1.2
C***** STATEMENT. 9.4
C***** - AN INPUT LIST MAY CONTAIN AN INTEGER THAT IS USED 12.8.2.3
C***** AS A SUBSCRIPT IN AN IMPLIED DO-LIST.
C***** - AN OUTPUT LIST MAY CONTAIN AN EXPRESSION WITH AN 12.8.2.2
C***** INTRINISC FUNCTION. 15.3
C*****
DATA A130VK/'(16X,10HCOMPUTED: /26X, 3I5/16X,10HCORRECT: ,22X,
1''2 CORRECT ANSWERS POSSIBLE''/26X,'' 1111 3333-5555''/26X,''+1111
2+3333-5555'')'/
READ(IRWVI, A0WVK) IVI, (I1I(JVI),JVI=1,IVI)
WRITE(NUWVI, A130VK) IABS(I1I(1)), MAX0(I1I(2),I1I(5)), I1I(3)
C*****
RETURN
END
*END-OF,FM903
FM905.f 481036628 170 2 100666 13001 `
*HEADER,FORTR,FM905
*FILES1,FORTR,FM905,X
C***********************************************************************
C***** FORTRAN 77
C***** FM905
C***** LSTDO1 - (371)
C*****
C***********************************************************************
C***** GENERAL PURPOSE ANS REF
C***** TEST LIST DIRECTED OUTPUT ON 13.6
C***** INTEGER, REAL, LOGICAL, AND CHARACTER DATA TYPES 12.4
C*****
CBB** ********************** BBCCOMNT **********************************
C****
C**** 1978 FORTRAN COMPILER VALIDATION SYSTEM
C**** VERSION 2.0
C****
C****
C**** SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO
C**** GENERAL SERVICES ADMINISTRATION
C**** FEDERAL SOFTWARE TESTING CENTER
C**** 5203 LEESBURG PIKE, SUITE 1100
C**** FALLS CHURCH, VA. 22041
C****
C**** (703) 756-6153
C****
CBE** ********************** BBCCOMNT **********************************
C*****
C***** S P E C I F I C A T I O N S SEGMENT 371
LOGICAL B1B(3), AVB
CHARACTER A5VK*5, A9VK*9, A33VK*33, A82VK*82
CHARACTER A51K(4)*5
C*****
CBB** ********************** BBCINITA **********************************
C**** SPECIFICATION STATEMENTS
C****
CHARACTER ZVERS*13, ZVERSD*17, ZDATE*17, ZPROG*5, ZCOMPL*20,
1 ZNAME*20, ZTAPE*10, ZPROJ*13, REMRKS*31, ZTAPED*13
CBE** ********************** BBCINITA **********************************
CBB** ********************** BBCINITB **********************************
C**** INITIALIZE SECTION
DATA ZVERS, ZVERSD, ZDATE
1 /'VERSION 2.0 ', '82/08/02*18.33.46', '*NO DATE*TIME'/
DATA ZCOMPL, ZNAME, ZTAPE
1 /'*NONE SPECIFIED*', '*NO COMPANY NAME*', '*NO TAPE*'/
DATA ZPROJ, ZTAPED, ZPROG
1 /'*NO PROJECT*', '*NO TAPE DATE', 'XXXXX'/
DATA REMRKS /' '/
C**** THE FOLLOWING 9 COMMENT LINES (CZ01, CZ02, ...) CAN BE REPLACED
C**** FOR IDENTIFYING THE TEST ENVIRONMENT
C****
CZ01 ZVERS = 'VERSION OF THE COMPILER VALIDATION SYSTEM'
CZ02 ZVERSD = 'CREATION DATE/TIME OF THE COMPILER VALIDATION SYSTEM'
CZ03 ZPROG = 'PROGRAM NAME'
CZ04 ZDATE = 'DATE OF TEST'
CZ05 ZCOMPL = 'COMPILER IDENTIFICATION'
CZ06 ZPROJ = 'PROJECT NUMBER/IDENTIFICATION'
CZ07 ZNAME = 'NAME OF USER'
CZ08 ZTAPE = 'TAPE OWNER/ID'
CZ09 ZTAPED = 'DATE TAPE COPIED'
C
IVPASS = 0
IVFAIL = 0
IVDELE = 0
IVINSP = 0
IVTOTL = 0
IVTOTN = 0
ICZERO = 0
C
C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER.
I01 = 05
C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER.
I02 = 06
C
CX010 REPLACED BY FEXEC X-010 CONTROL CARD (CARD-READER UNIT NUMBER).
C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5
CX011 REPLACED BY FEXEC X-011 CONTROL CARD. CX011 IS FOR SYSTEMS
C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX010.
C
CX020 REPLACED BY FEXEC X-020 CONTROL CARD (PRINTER UNIT NUMBER).
C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02= 6
CX021 REPLACED BY FEXEC X-021 CONTROL CARD. CX021 IS FOR SYSTEMS
C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX020.
C
CBE** ********************** BBCINITB **********************************
NUVI = I02
IVTOTL = 10
ZPROG = 'FM905'
CBB** ********************** BBCHED0A **********************************
C****
C**** WRITE REPORT TITLE
C****
WRITE (I02, 90002)
WRITE (I02, 90006)
WRITE (I02, 90007)
WRITE (I02, 90008) ZVERS, ZVERSD
WRITE (I02, 90009) ZPROG, ZPROG
WRITE (I02, 90010) ZDATE, ZCOMPL
CBE** ********************** BBCHED0A **********************************
C*****
C***** HEADING FOR SEGMENT 371
WRITE(NUVI,37100)
37100 FORMAT(1H , /16H LSTDO1 - (371) ,
1 43H LIST DIRECTED OUTPUT FOR SUBSET DATA TYPES//
2 22H ANS REF. - 13.6 12.4)
CBB** ********************** BBCHED0B **********************************
C**** WRITE DETAIL REPORT HEADERS
C****
WRITE (I02,90004)
WRITE (I02,90004)
WRITE (I02,90013)
WRITE (I02,90014)
WRITE (I02,90015) IVTOTL
CBE** ********************** BBCHED0B **********************************
WRITE (NUVI, 70000)
70000 FORMAT (1H ,48X,31HTHE CORRECT LINE OF EACH TEST /
1 1H ,48X,31HIS HOLLERITH INFORMATION. /
2 1H ,48X,31HCOLUMN SPACING, LINE BREAKS, /
3 1H ,48X,31HAND THE NUMBER OF DECIMAL /
4 1H ,48X,31HPLACES FOR REAL NUMBERS ARE /
5 1H ,48X,31HPROCESSOR DEPENDENT. /
6 1H ,48X,31HEITHER E OR F FORMAT MAY BE /
7 1H ,48X,31HUSED FOR REAL NUMBERS. /)
CT001* TEST 1 - INTEGER
IVTNUM = 1
WRITE (NUVI, 80004) IVTNUM
WRITE (NUVI, 80020)
IVI = 2
WRITE(NUVI, *) IVI
IVINSP = IVINSP + 1
WRITE (NUVI, 80022)
WRITE (NUVI, 70011)
70011 FORMAT (1H ,6X,1H2)
CT002* TEST 2 - SEVERAL INTEGERS
IVTNUM = 2
WRITE (NUVI, 80004) IVTNUM
WRITE (NUVI, 80020)
IVI = 1
JVI = 3
KVI = 5
LVI = 7
MVI = 9
WRITE(NUVI, *) IVI, JVI, KVI, LVI, MVI
IVINSP = IVINSP + 1
WRITE (NUVI, 80022)
WRITE (NUVI, 70021)
70021 FORMAT (1H ,6X,13H1 3 5 7 9)
CT003* TEST 3 - REAL
IVTNUM = 3
WRITE (NUVI, 80004) IVTNUM
WRITE (NUVI, 80020)
AVS = 2.5
WRITE(NUVI, *) AVS
IVINSP = IVINSP + 1
WRITE (NUVI, 80022)
WRITE (NUVI, 70031)
70031 FORMAT (1H ,6X,3H2.5)
CT004* TEST 4 - SEVERAL REALS
IVTNUM = 4
WRITE (NUVI, 80004) IVTNUM
WRITE (NUVI, 80020)
AVS = 0.25E-10
BVS = 0.25
CVS = 0.25E+3
DVS = 0.25E+10
WRITE(NUVI, *) AVS, BVS, CVS, DVS
IVINSP = IVINSP + 1
WRITE (NUVI, 80022)
WRITE (NUVI, 70041)
70041 FORMAT(1H ,6X,31H0.25E-10 0.25 250.0 0.25E+10)
CT005* TEST 5 - IMPLIED-DO TO PRINT ARRAY OF LOGICALS
IVTNUM = 5
WRITE (NUVI, 80004) IVTNUM
WRITE (NUVI, 80020)
B1B(1) = .TRUE.
B1B(2) = .FALSE.
B1B(3) = .TRUE.
WRITE(NUVI, *) (B1B(IVI), IVI = 1,3)
IVINSP = IVINSP + 1
WRITE (NUVI, 80022)
WRITE (NUVI, 70051)
70051 FORMAT(1H ,6X,7HT F T)
CT006* TEST 6 - LIST OF CHARACTER VALUES, USING ARRAY NAME
IVTNUM = 6
WRITE (NUVI, 80004) IVTNUM
WRITE (NUVI, 80020)
A51K(1) = 'ONE '
A51K(2) = 'TWO '
A51K(3) = 'THREE'
A51K(4) = 'FOUR '
WRITE(NUVI, *) A51K
IVINSP = IVINSP + 1
WRITE (NUVI, 80022)
WRITE (NUVI, 70061)
70061 FORMAT(1H ,6X,20HONE TWO THREEFOUR )
CT007* TEST 7 - MIXED LIST
IVTNUM = 7
WRITE (NUVI, 80004) IVTNUM
WRITE (NUVI, 80020)
IVI = -3
AVS = 15.25
AVB = .TRUE.
A5VK = 'HELLO'
WRITE(NUVI,*) IVI, AVS, A5VK, AVB
IVINSP = IVINSP + 1
WRITE (NUVI, 80022)
WRITE (NUVI, 70071)
70071 FORMAT(1H ,6X,19H-3 15.25 HELLO T)
CT008* TEST 8 - CHARACTER CONSTANT CONTAINING EMBEDDED '
IVTNUM = 8
WRITE (NUVI, 80004) IVTNUM
WRITE (NUVI, 80020)
A9VK = '5 O''CLOCK'
WRITE(NUVI, *) A9VK
IVINSP = IVINSP + 1
WRITE (NUVI, 80022)
WRITE (NUVI, 70081)
70081 FORMAT(1H ,6X,9H5 O'CLOCK)
CT009* TEST 9 - CHARACTER CONSTANT SPILLING OVER RECORD BOUNDARY
IVTNUM = 9
WRITE (NUVI, 80004) IVTNUM
WRITE (NUVI, 80020)
A5VK = 'SHORT'
A33VK = 'THIS IS A LONGER CHARACTER STRING'
A82VK = '1234567890123456789012345678901234567890123456789012345
167890123456789012'
WRITE(NUVI, *) A5VK, A33VK, A82VK
IVINSP = IVINSP + 1
WRITE (NUVI, 80022)
WRITE (NUVI, 70091)
70091 FORMAT(1H , 40HSHORT THIS IS A LONGER CHARACTER STRING,
1 40H 123456789012345678901234567890123456789/
2 1H ,33H012345678901234567890123456789012)
CT010* TEST 10 - SEVERAL IDENTICAL VALUES
IVTNUM = 10
WRITE (NUVI, 80004) IVTNUM
WRITE (NUVI, 80020)
IVI = 5
JVI = 5
KVI = 5
LVI = 5
MVI = 5
WRITE(NUVI, *) IVI, JVI, KVI, LVI, MVI
IVINSP = IVINSP + 1
WRITE (NUVI, 80022)
WRITE (NUVI, 70101)
70101 FORMAT(1H ,6X,22H5 5 5 5 5 OR 5*5)
CBB** ********************** BBCSUM0 **********************************
C**** WRITE OUT TEST SUMMARY
C****
IVTOTN = IVPASS + IVFAIL + IVDELE + IVINSP
WRITE (I02, 90004)
WRITE (I02, 90014)
WRITE (I02, 90004)
WRITE (I02, 90020) IVPASS
WRITE (I02, 90022) IVFAIL
WRITE (I02, 90024) IVDELE
WRITE (I02, 90026) IVINSP
WRITE (I02, 90028) IVTOTN, IVTOTL
CBE** ********************** BBCSUM0 **********************************
CBB** ********************** BBCFOOT0 **********************************
C**** WRITE OUT REPORT FOOTINGS
C****
WRITE (I02,90016) ZPROG, ZPROG
WRITE (I02,90018) ZPROJ, ZNAME, ZTAPE, ZTAPED
WRITE (I02,90019)
CBE** ********************** BBCFOOT0 **********************************
CBB** ********************** BBCFMT0A **********************************
C**** FORMATS FOR TEST DETAIL LINES
C****
80000 FORMAT (1H ,2X,I3,4X,7HDELETED,32X,A31)
80002 FORMAT (1H ,2X,I3,4X,7H PASS ,32X,A31)
80004 FORMAT (1H ,2X,I3,4X,7HINSPECT,32X,A31)
80008 FORMAT (1H ,2X,I3,4X,7H FAIL ,32X,A31)
80010 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,15X,10HCOMPUTED= ,
1I6,/,1H ,15X,10HCORRECT= ,I6)
80012 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
1E12.5,/,1H ,16X,10HCORRECT= ,E12.5)
80018 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
1A21,/,1H ,16X,10HCORRECT= ,A21)
80020 FORMAT (1H ,16X,10HCOMPUTED= ,A21,1X,A31)
80022 FORMAT (1H ,16X,10HCORRECT= ,A21,1X,A31)
80024 FORMAT (1H ,16X,10HCOMPUTED= ,I6,16X,A31)
80026 FORMAT (1H ,16X,10HCORRECT= ,I6,16X,A31)
80028 FORMAT (1H ,16X,10HCOMPUTED= ,E12.5,10X,A31)
80030 FORMAT (1H ,16X,10HCORRECT= ,E12.5,10X,A31)
80050 FORMAT (1H ,48X,A31)
CBE** ********************** BBCFMT0A **********************************
CBB** ********************** BBCFMAT1 **********************************
C**** FORMATS FOR TEST DETAIL LINES - FULL LANGUAGE
C****
80031 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
1D17.10,/,1H ,16X,10HCORRECT= ,D17.10)
80033 FORMAT (1H ,16X,10HCOMPUTED= ,D17.10,10X,A31)
80035 FORMAT (1H ,16X,10HCORRECT= ,D17.10,10X,A31)
80037 FORMAT (1H ,16X,10HCOMPUTED= ,1H(,E12.5,2H, ,E12.5,1H),6X,A31)
80039 FORMAT (1H ,16X,10HCORRECT= ,1H(,E12.5,2H, ,E12.5,1H),6X,A31)
80041 FORMAT (1H ,16X,10HCOMPUTED= ,1H(,F12.5,2H, ,F12.5,1H),6X,A31)
80043 FORMAT (1H ,16X,10HCORRECT= ,1H(,F12.5,2H, ,F12.5,1H),6X,A31)
80045 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
11H(,F12.5,2H, ,F12.5,1H)/,1H ,16X,10HCORRECT= ,
21H(,F12.5,2H, ,F12.5,1H))
CBE** ********************** BBCFMAT1 **********************************
CBB** ********************** BBCFMT0B **********************************
C**** FORMAT STATEMENTS FOR PAGE HEADERS
C****
90002 FORMAT (1H1)
90004 FORMAT (1H )
90006 FORMAT (1H ,20X,31HFEDERAL SOFTWARE TESTING CENTER)
90007 FORMAT (1H ,19X,34HFORTRAN COMPILER VALIDATION SYSTEM)
90008 FORMAT (1H ,21X,A13,A17)
90009 FORMAT (1H ,/,2H *,A5,6HBEGIN*,12X,15HTEST RESULTS - ,A5,/)
90010 FORMAT (1H ,8X,16HTEST DATE*TIME= ,A17,15H - COMPILER= ,A20)
90013 FORMAT (1H ,8H TEST ,10HPASS/FAIL ,6X,17HDISPLAYED RESULTS,
1 7X,7HREMARKS,24X)
90014 FORMAT (1H ,46H----------------------------------------------,
1 33H---------------------------------)
90015 FORMAT (1H ,48X,17HTHIS PROGRAM HAS ,I3,6H TESTS,/)
C****
C**** FORMAT STATEMENTS FOR REPORT FOOTINGS
C****
90016 FORMAT (1H ,/,2H *,A5,4HEND*,14X,14HEND OF TEST - ,A5,/)
90018 FORMAT (1H ,A13,13X,A20,7H * ,A10,1H/,
1 A13)
90019 FORMAT (1H ,26HFOR OFFICIAL USE ONLY ,35X,15HCOPYRIGHT 1982)
C****
C**** FORMAT STATEMENTS FOR RUN SUMMARY
C****
90020 FORMAT (1H ,21X,I5,13H TESTS PASSED)
90022 FORMAT (1H ,21X,I5,13H TESTS FAILED)
90024 FORMAT (1H ,21X,I5,14H TESTS DELETED)
90026 FORMAT (1H ,21X,I5,25H TESTS REQUIRE INSPECTION)
90028 FORMAT (1H ,21X,I5,4H OF ,I3,15H TESTS EXECUTED)
CBE** ********************** BBCFMT0B **********************************
C*****
C***** END OF TEST SEGMENT 371
STOP
END
*END-OF,FM905
FM906.f 481036634 170 2 100666 22200 `
*HEADER,FORTR,FM906
*FILES1,FORTR,FM906,XX
C***********************************************************************
C***** FORTRAN 77
C***** FM906
C***** LSTDI2 - (372)
C*****
C***********************************************************************
C***** GENERAL PURPOSE ANS REF
C***** TEST LIST DIRECTED INPUT 13.6
C***** DOUBLE PRECISION, COMPLEX DATA TYPES INCLUDED 12.4
C*****
CBB** ********************** BBCCOMNT **********************************
C****
C**** 1978 FORTRAN COMPILER VALIDATION SYSTEM
C**** VERSION 2.0
C****
C****
C**** SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO
C**** GENERAL SERVICES ADMINISTRATION
C**** FEDERAL SOFTWARE TESTING CENTER
C**** 5203 LEESBURG PIKE, SUITE 1100
C**** FALLS CHURCH, VA. 22041
C****
C**** (703) 756-6153
C****
CBE** ********************** BBCCOMNT **********************************
C*****
C INPUT DATA TO THIS SEGMENT CONSISTS OF 12 CARD IMAGES IN COL. 1-44
COL. 1-----------------------------------------44
CARD 1 2.5D0
CARD 2 1.5 2.5D0 3.5E0
CARD 3 (3.0,4.0)
CARD 4 (1.0,0.0) (0.0,0.0) (0.0,3.0)
CARD 5 2, 2.5D0, 2.5D0, T, (3.0,4.0), 'TEST'
CARD 6 ( 2.5 , 3.5 )
CARD 7 (1.0 ,
CARD 8 2.0)
CARD 9 , (2.0, 3.0),,6.0D0, 2*,
CARD 10 1.0D0 (2.0, 2.0) 3.0D0 (4.0, 4.0) 5.0D0
CARD 11 6.0D0 (7.0, 7.0) / 8.0D0 (9.0, 9.0) 10.0D0
CARD 12 2.0D0 4.0D0 / 6.0D0 8.0D0 10.0D0
C*****
C***** S P E C I F I C A T I O N S SEGMENT 372
LOGICAL AVB
CHARACTER A4VK*4,CVCORR*4
DOUBLE PRECISION AVD, BVD, CVD, DVCORR
DOUBLE PRECISION A1D(4)
COMPLEX AVC, BVC, CVC, ZVCORR
REAL R2E(6)
EQUIVALENCE (AVC,R2E(1)),(BVC,R2E(3)),(CVC,R2E(5))
C*****
CBB** ********************** BBCINITA **********************************
C**** SPECIFICATION STATEMENTS
C****
CHARACTER ZVERS*13, ZVERSD*17, ZDATE*17, ZPROG*5, ZCOMPL*20,
1 ZNAME*20, ZTAPE*10, ZPROJ*13, REMRKS*31, ZTAPED*13
CBE** ********************** BBCINITA **********************************
CBB** ********************** BBCINITB **********************************
C**** INITIALIZE SECTION
DATA ZVERS, ZVERSD, ZDATE
1 /'VERSION 2.0 ', '82/08/02*18.33.46', '*NO DATE*TIME'/
DATA ZCOMPL, ZNAME, ZTAPE
1 /'*NONE SPECIFIED*', '*NO COMPANY NAME*', '*NO TAPE*'/
DATA ZPROJ, ZTAPED, ZPROG
1 /'*NO PROJECT*', '*NO TAPE DATE', 'XXXXX'/
DATA REMRKS /' '/
C**** THE FOLLOWING 9 COMMENT LINES (CZ01, CZ02, ...) CAN BE REPLACED
C**** FOR IDENTIFYING THE TEST ENVIRONMENT
C****
CZ01 ZVERS = 'VERSION OF THE COMPILER VALIDATION SYSTEM'
CZ02 ZVERSD = 'CREATION DATE/TIME OF THE COMPILER VALIDATION SYSTEM'
CZ03 ZPROG = 'PROGRAM NAME'
CZ04 ZDATE = 'DATE OF TEST'
CZ05 ZCOMPL = 'COMPILER IDENTIFICATION'
CZ06 ZPROJ = 'PROJECT NUMBER/IDENTIFICATION'
CZ07 ZNAME = 'NAME OF USER'
CZ08 ZTAPE = 'TAPE OWNER/ID'
CZ09 ZTAPED = 'DATE TAPE COPIED'
C
IVPASS = 0
IVFAIL = 0
IVDELE = 0
IVINSP = 0
IVTOTL = 0
IVTOTN = 0
ICZERO = 0
C
C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER.
I01 = 05
C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER.
I02 = 06
C
CX010 REPLACED BY FEXEC X-010 CONTROL CARD (CARD-READER UNIT NUMBER).
C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5
CX011 REPLACED BY FEXEC X-011 CONTROL CARD. CX011 IS FOR SYSTEMS
C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX010.
C
CX020 REPLACED BY FEXEC X-020 CONTROL CARD (PRINTER UNIT NUMBER).
C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02= 6
CX021 REPLACED BY FEXEC X-021 CONTROL CARD. CX021 IS FOR SYSTEMS
C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX020.
C
CBE** ********************** BBCINITB **********************************
IRVI = I01
NUVI = I02
IVTOTL = 28
ZPROG = 'FM906'
CBB** ********************** BBCHED0A **********************************
C****
C**** WRITE REPORT TITLE
C****
WRITE (I02, 90002)
WRITE (I02, 90006)
WRITE (I02, 90007)
WRITE (I02, 90008) ZVERS, ZVERSD
WRITE (I02, 90009) ZPROG, ZPROG
WRITE (I02, 90010) ZDATE, ZCOMPL
CBE** ********************** BBCHED0A **********************************
C*****
C***** HEADING FOR SEGMENT 372
WRITE(NUVI,37200)
37200 FORMAT(1H , /16H LSTDI2 - (372) ,
1 20H LIST DIRECTED INPUT,
2 32H FOR D.P. AND COMPLEX DATA TYPES//
3 22H ANS REF. - 13.6 12.4)
CBB** ********************** BBCHED0B **********************************
C**** WRITE DETAIL REPORT HEADERS
C****
WRITE (I02,90004)
WRITE (I02,90004)
WRITE (I02,90013)
WRITE (I02,90014)
WRITE (I02,90015) IVTOTL
CBE** ********************** BBCHED0B **********************************
CT001* TEST 1 - CARD 1 DOUBLE PRECISION
IVTNUM = 1
READ(IRVI, *) AVD
IF (AVD - 0.2499999998D+01) 20010, 10010, 40010
40010 IF (AVD - 0.2500000002D+01) 10010, 10010, 20010
10010 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0011
20010 IVFAIL = IVFAIL + 1
DVCORR = 2.5D0
WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR
0011 CONTINUE
C***** TESTS 2 THRU 4 - CARD 2 SEVERAL DOUBLE PRECISION
CT002* TEST 2
IVTNUM = 2
READ(IRVI, *) AVD, BVD, CVD
IF (AVD - 0.1499999999D+01) 20020, 10020, 40020
40020 IF (AVD - 0.1500000001D+01) 10020, 10020, 20020
10020 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0021
20020 IVFAIL = IVFAIL + 1
DVCORR = 1.5D0
WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR
0021 CONTINUE
CT003* TEST 3
IVTNUM = 3
IF (BVD - 0.2499999998D+01) 20030, 10030, 40030
40030 IF (BVD - 0.2500000002D+01) 10030, 10030, 20030
10030 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0031
20030 IVFAIL = IVFAIL + 1
DVCORR = 2.5D0
WRITE (NUVI, 80031) IVTNUM, BVD, DVCORR
0031 CONTINUE
CT004* TEST 4
IVTNUM = 4
IF (CVD - 0.3499999998D+01) 20040, 10040, 40040
40040 IF (CVD - 0.3500000002D+01) 10040, 10040, 20040
10040 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0041
20040 IVFAIL = IVFAIL + 1
DVCORR = 3.5D0
WRITE (NUVI, 80031) IVTNUM, CVD, DVCORR
0041 CONTINUE
CT005* TEST 5 - CARD 3 COMPLEX
IVTNUM = 5
READ(IRVI, *) AVC
IF (R2E(1) - 0.29998E+01) 20050, 40052, 40051
40051 IF (R2E(1) - 0.30002E+01) 40052, 40052, 20050
40052 IF (R2E(2) - 0.39998E+01) 20050, 10050, 40050
40050 IF (R2E(2) - 0.40002E+01) 10050, 10050, 20050
10050 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0051
20050 IVFAIL = IVFAIL + 1
ZVCORR = (3.0, 4.0)
WRITE (NUVI, 80045) IVTNUM, AVC, ZVCORR
0051 CONTINUE
C***** TESTS 6 THRU 8 - CARD 4 SEVERAL COMPLEX
CT006* TEST 6
IVTNUM = 6
READ(IRVI, *) AVC, BVC, CVC
IF (R2E(1) - 0.99995E+00) 20060, 40062, 40061
40061 IF (R2E(1) - 0.10001E+01) 40062, 40062, 20060
40062 IF (R2E(2) + 0.50000E-04) 20060, 10060, 40060
40060 IF (R2E(2) - 0.50000E-04) 10060, 10060, 20060
10060 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0061
20060 IVFAIL = IVFAIL + 1
ZVCORR = (1.0, 0.0)
WRITE (NUVI, 80045) IVTNUM, AVC, ZVCORR
0061 CONTINUE
CT007* TEST 7
IVTNUM = 7
IF (R2E(3) + 0.50000E-04) 20070, 40072, 40071
40071 IF (R2E(3) - 0.50000E-04) 40072, 40072, 20070
40072 IF (R2E(4) + 0.50000E-04) 20070, 10070, 40070
40070 IF (R2E(4) - 0.50000E-04) 10070, 10070, 20070
10070 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0071
20070 IVFAIL = IVFAIL + 1
ZVCORR = (0.0, 0.0)
WRITE (NUVI, 80045) IVTNUM, BVC, ZVCORR
0071 CONTINUE
CT008* TEST 8
IVTNUM = 8
IF (R2E(5) + 0.50000E-04) 20080, 40082, 40081
40081 IF (R2E(5) - 0.50000E-04) 40082, 40082, 20080
40082 IF (R2E(6) - 0.29998E+01) 20080, 10080, 40080
40080 IF (R2E(6) - 0.30002E+01) 10080, 10080, 20080
10080 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0081
20080 IVFAIL = IVFAIL + 1
ZVCORR = (0.0, 3.0)
WRITE (NUVI, 80045) IVTNUM, CVC, ZVCORR
0081 CONTINUE
C***** TESTS 9 THRU 14 - CARD 5 MIXED LIST
CT009* TEST 9
IVTNUM = 9
READ(IRVI, *) IVI, AVD, AVS, AVB, AVC, A4VK
IF (IVI - 2) 20090, 10090, 20090
10090 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0091
20090 IVFAIL = IVFAIL + 1
IVCORR = 2
WRITE (NUVI, 80010) IVTNUM, IVI, IVCORR
0091 CONTINUE
CT010* TEST 10
IVTNUM = 10
IF (AVD - 0.2499999998D+01) 20100, 10100, 40100
40100 IF (AVD - 0.2500000002D+01) 10100, 10100, 20100
10100 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0101
20100 IVFAIL = IVFAIL + 1
DVCORR = 2.5D0
WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR
0101 CONTINUE
CT011* TEST 11
IVTNUM = 11
IF (AVS - 0.24998E+01) 20110, 10110, 40110
40110 IF (AVS - 0.25002E+01) 10110, 10110, 20110
10110 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0111
20110 IVFAIL = IVFAIL + 1
RVCORR = 2.5
WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR
0111 CONTINUE
CT012* TEST 12
IVTNUM = 12
IVCOMP = 0
IF (AVB) IVCOMP = 1
IF (IVCOMP - 1) 20120, 10120, 20120
10120 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0121
20120 IVFAIL = IVFAIL + 1
LVCORR = 1
REMRKS = '1 = TRUE ; 0 = FALSE'
WRITE (NUVI, 80008) IVTNUM, REMRKS
WRITE (NUVI, 80024) IVCOMP
WRITE (NUVI, 80026) LVCORR
0121 CONTINUE
C***** ADVANCE TO TOP-OF-PAGE AND WRITE HEADERS
WRITE (NUVI, 90002)
WRITE (NUVI, 90013)
WRITE (NUVI, 90014)
CT013* TEST 13
IVTNUM = 13
IF (R2E(1) - 0.29998E+01) 20130, 40132, 40131
40131 IF (R2E(1) - 0.30002E+01) 40132, 40132, 20130
40132 IF (R2E(2) - 0.39998E+01) 20130, 10130, 40130
40130 IF (R2E(2) - 0.40002E+01) 10130, 10130, 20130
10130 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0131
20130 IVFAIL = IVFAIL + 1
ZVCORR = (3.0, 4.0)
WRITE (NUVI, 80045) IVTNUM, AVC, ZVCORR
0131 CONTINUE
CT014* TEST 14
IVTNUM = 14
IVCOMP = 0
IF (A4VK.EQ.'TEST') IVCOMP = 1
IF (IVCOMP - 1) 20140, 10140, 20140
10140 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0141
20140 IVFAIL = IVFAIL + 1
CVCORR = 'TEST'
WRITE (NUVI, 80018) IVTNUM, A4VK, CVCORR
0141 CONTINUE
CT015* TEST 15 - CARD 6 COMPLEX CONSTANT W/EMBEDDED BLANKS
IVTNUM = 15
READ(IRVI, *) AVC
IF (R2E(1) - 0.24998E+01) 20150, 40152, 40151
40151 IF (R2E(1) - 0.25002E+01) 40152, 40152, 20150
40152 IF (R2E(2) - 0.34998E+01) 20150, 10150, 40150
40150 IF (R2E(2) - 0.35002E+01) 10150, 10150, 20150
10150 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0151
20150 IVFAIL = IVFAIL + 1
ZVCORR = (2.5, 3.5)
WRITE (NUVI, 80045) IVTNUM, AVC, ZVCORR
0151 CONTINUE
CT016* TEST 16 - CARDS 7-8 COMPLEX WITH EMBEDDED END-OF-RECORD
IVTNUM = 16
READ(IRVI, *) AVC
IF (R2E(1) - 0.99995E+00) 20160, 40162, 40161
40161 IF (R2E(1) - 0.10001E+01) 40162, 40162, 20160
40162 IF (R2E(2) - 0.19999E+01) 20160, 10160, 40160
40160 IF (R2E(2) - 0.20001E+01) 10160, 10160, 20160
10160 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0161
20160 IVFAIL = IVFAIL + 1
ZVCORR = (1.0, 2.0)
WRITE (NUVI, 80045) IVTNUM, AVC, ZVCORR
0161 CONTINUE
C***** TESTS 17 THRU 22 - CARD 9 NULL VALUES
CT017* TEST 17
IVTNUM = 17
AVD = 1.0D0
BVC = (4.0, 5.0)
CVC = (7.0, 8.0)
CVD = 9.0D0
READ(IRVI, *) AVD, AVC, BVC, BVD, CVC, CVD
IF (AVD - 0.9999999995D+00) 20170, 10170, 40170
40170 IF (AVD - 0.1000000001D+01) 10170, 10170, 20170
10170 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0171
20170 IVFAIL = IVFAIL + 1
DVCORR = 1.0D0
WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR
0171 CONTINUE
CT018* TEST 18
IVTNUM = 18
IF (R2E(1) - 0.19999E+01) 20180, 40182, 40181
40181 IF (R2E(1) - 0.20001E+01) 40182, 40182, 20180
40182 IF (R2E(2) - 0.29998E+01) 20180, 10180, 40180
40180 IF (R2E(2) - 0.30002E+01) 10180, 10180, 20180
10180 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0181
20180 IVFAIL = IVFAIL + 1
ZVCORR = (2.0, 3.0)
WRITE (NUVI, 80045) IVTNUM, AVC, ZVCORR
0181 CONTINUE
CT019* TEST 19
IVTNUM = 19
IF (R2E(3) - 0.39998E+01) 20190, 40192, 40191
40191 IF (R2E(3) - 0.40002E+01) 40192, 40192, 20190
40192 IF (R2E(4) - 0.49997E+01) 20190, 10190, 40190
40190 IF (R2E(4) - 0.50003E+01) 10190, 10190, 20190
10190 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0191
20190 IVFAIL = IVFAIL + 1
ZVCORR = (4.0, 5.0)
WRITE (NUVI, 80045) IVTNUM, BVC, ZVCORR
0191 CONTINUE
CT020* TEST 20
IVTNUM = 20
IF (BVD - 0.5999999997D+01) 20200, 10200, 40200
40200 IF (BVD - 0.6000000003D+01) 10200, 10200, 20200
10200 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0201
20200 IVFAIL = IVFAIL + 1
DVCORR = 6.0D0
WRITE (NUVI, 80031) IVTNUM, BVD, DVCORR
0201 CONTINUE
CT021* TEST 21
IVTNUM = 21
IF (R2E(5) - 0.69996E+01) 20210, 40212, 40211
40211 IF (R2E(5) - 0.70004E+01) 40212, 40212, 20210
40212 IF (R2E(6) - 0.79996E+01) 20210, 10210, 40210
40210 IF (R2E(6) - 0.80004E+01) 10210, 10210, 20210
10210 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0211
20210 IVFAIL = IVFAIL + 1
ZVCORR = (7.0, 8.0)
WRITE (NUVI, 80045) IVTNUM, CVC, ZVCORR
0211 CONTINUE
CT022* TEST 22
IVTNUM = 22
IF (CVD - 0.8999999995D+01) 20220, 10220, 40220
40220 IF (CVD - 0.9000000005D+01) 10220, 10220, 20220
10220 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0221
20220 IVFAIL = IVFAIL + 1
DVCORR = 9.0D0
WRITE (NUVI, 80031) IVTNUM, CVD, DVCORR
0221 CONTINUE
C***** TESTS 23 THRU 27 - CARDS 10-11 SLASH TERMINATOR
CT023* TEST 23
IVTNUM = 23
READ(IRVI, *) AVD, AVC, BVD, BVC, CVD
READ(IRVI, *) AVD, AVC, BVD, BVC, CVD
IF (AVD - 0.5999999997D+01) 20230, 10230, 40230
40230 IF (AVD - 0.6000000003D+01) 10230, 10230, 20230
10230 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0231
20230 IVFAIL = IVFAIL + 1
DVCORR = 6.0D0
WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR
0231 CONTINUE
CT024* TEST 24
IVTNUM = 24
IF (R2E(1) - 0.69996E+01) 20240, 40242, 40241
40241 IF (R2E(1) - 0.70004E+01) 40242, 40242, 20240
40242 IF (R2E(2) - 0.69996E+01) 20240, 10240, 40240
40240 IF (R2E(2) - 0.70004E+01) 10240, 10240, 20240
10240 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0241
20240 IVFAIL = IVFAIL + 1
ZVCORR = (7.0, 7.0)
WRITE (NUVI, 80045) IVTNUM, AVC, ZVCORR
0241 CONTINUE
CT025* TEST 25
IVTNUM = 25
IF (BVD - 0.2999999998D+01) 20250, 10250, 40250
40250 IF (BVD - 0.3000000002D+01) 10250, 10250, 20250
10250 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0251
20250 IVFAIL = IVFAIL + 1
DVCORR = 3.0D0
WRITE (NUVI, 80031) IVTNUM, BVD, DVCORR
0251 CONTINUE
CT026* TEST 26
IVTNUM = 26
IF (R2E(3) - 0.39998E+01) 20260, 40262, 40261
40261 IF (R2E(3) - 0.40002E+01) 40262, 40262, 20260
40262 IF (R2E(4) - 0.39998E+01) 20260, 10260, 40260
40260 IF (R2E(4) - 0.40002E+01) 10260, 10260, 20260
10260 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0261
20260 IVFAIL = IVFAIL + 1
ZVCORR = (4.0, 4.0)
WRITE (NUVI, 80045) IVTNUM, BVC, ZVCORR
0261 CONTINUE
CT027* TEST 27
IVTNUM = 27
IF (CVD - 0.4999999997D+01) 20270, 10270, 40270
40270 IF (CVD - 0.5000000003D+01) 10270, 10270, 20270
10270 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0271
20270 IVFAIL = IVFAIL + 1
DVCORR = 5.0D0
WRITE (NUVI, 80031) IVTNUM, CVD, DVCORR
0271 CONTINUE
CT028* TEST 28
IVTNUM = 28
A1D(3) = 3.0D0
READ(IRVI, *) (A1D(IVI), IVI=1,4)
IF (A1D(3) - 0.2999999998D+01) 20280, 10280, 40280
40280 IF (A1D(3) - 0.3000000002D+01) 10280, 10280, 20280
10280 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0281
20280 IVFAIL = IVFAIL + 1
DVCORR = 3.0D0
WRITE (NUVI, 80031) IVTNUM, A1D(3), DVCORR
0281 CONTINUE
CBB** ********************** BBCSUM0 **********************************
C**** WRITE OUT TEST SUMMARY
C****
IVTOTN = IVPASS + IVFAIL + IVDELE + IVINSP
WRITE (I02, 90004)
WRITE (I02, 90014)
WRITE (I02, 90004)
WRITE (I02, 90020) IVPASS
WRITE (I02, 90022) IVFAIL
WRITE (I02, 90024) IVDELE
WRITE (I02, 90026) IVINSP
WRITE (I02, 90028) IVTOTN, IVTOTL
CBE** ********************** BBCSUM0 **********************************
CBB** ********************** BBCFOOT0 **********************************
C**** WRITE OUT REPORT FOOTINGS
C****
WRITE (I02,90016) ZPROG, ZPROG
WRITE (I02,90018) ZPROJ, ZNAME, ZTAPE, ZTAPED
WRITE (I02,90019)
CBE** ********************** BBCFOOT0 **********************************
CBB** ********************** BBCFMT0A **********************************
C**** FORMATS FOR TEST DETAIL LINES
C****
80000 FORMAT (1H ,2X,I3,4X,7HDELETED,32X,A31)
80002 FORMAT (1H ,2X,I3,4X,7H PASS ,32X,A31)
80004 FORMAT (1H ,2X,I3,4X,7HINSPECT,32X,A31)
80008 FORMAT (1H ,2X,I3,4X,7H FAIL ,32X,A31)
80010 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,15X,10HCOMPUTED= ,
1I6,/,1H ,15X,10HCORRECT= ,I6)
80012 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
1E12.5,/,1H ,16X,10HCORRECT= ,E12.5)
80018 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
1A21,/,1H ,16X,10HCORRECT= ,A21)
80020 FORMAT (1H ,16X,10HCOMPUTED= ,A21,1X,A31)
80022 FORMAT (1H ,16X,10HCORRECT= ,A21,1X,A31)
80024 FORMAT (1H ,16X,10HCOMPUTED= ,I6,16X,A31)
80026 FORMAT (1H ,16X,10HCORRECT= ,I6,16X,A31)
80028 FORMAT (1H ,16X,10HCOMPUTED= ,E12.5,10X,A31)
80030 FORMAT (1H ,16X,10HCORRECT= ,E12.5,10X,A31)
80050 FORMAT (1H ,48X,A31)
CBE** ********************** BBCFMT0A **********************************
CBB** ********************** BBCFMAT1 **********************************
C**** FORMATS FOR TEST DETAIL LINES - FULL LANGUAGE
C****
80031 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
1D17.10,/,1H ,16X,10HCORRECT= ,D17.10)
80033 FORMAT (1H ,16X,10HCOMPUTED= ,D17.10,10X,A31)
80035 FORMAT (1H ,16X,10HCORRECT= ,D17.10,10X,A31)
80037 FORMAT (1H ,16X,10HCOMPUTED= ,1H(,E12.5,2H, ,E12.5,1H),6X,A31)
80039 FORMAT (1H ,16X,10HCORRECT= ,1H(,E12.5,2H, ,E12.5,1H),6X,A31)
80041 FORMAT (1H ,16X,10HCOMPUTED= ,1H(,F12.5,2H, ,F12.5,1H),6X,A31)
80043 FORMAT (1H ,16X,10HCORRECT= ,1H(,F12.5,2H, ,F12.5,1H),6X,A31)
80045 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
11H(,F12.5,2H, ,F12.5,1H)/,1H ,16X,10HCORRECT= ,
21H(,F12.5,2H, ,F12.5,1H))
CBE** ********************** BBCFMAT1 **********************************
CBB** ********************** BBCFMT0B **********************************
C**** FORMAT STATEMENTS FOR PAGE HEADERS
C****
90002 FORMAT (1H1)
90004 FORMAT (1H )
90006 FORMAT (1H ,20X,31HFEDERAL SOFTWARE TESTING CENTER)
90007 FORMAT (1H ,19X,34HFORTRAN COMPILER VALIDATION SYSTEM)
90008 FORMAT (1H ,21X,A13,A17)
90009 FORMAT (1H ,/,2H *,A5,6HBEGIN*,12X,15HTEST RESULTS - ,A5,/)
90010 FORMAT (1H ,8X,16HTEST DATE*TIME= ,A17,15H - COMPILER= ,A20)
90013 FORMAT (1H ,8H TEST ,10HPASS/FAIL ,6X,17HDISPLAYED RESULTS,
1 7X,7HREMARKS,24X)
90014 FORMAT (1H ,46H----------------------------------------------,
1 33H---------------------------------)
90015 FORMAT (1H ,48X,17HTHIS PROGRAM HAS ,I3,6H TESTS,/)
C****
C**** FORMAT STATEMENTS FOR REPORT FOOTINGS
C****
90016 FORMAT (1H ,/,2H *,A5,4HEND*,14X,14HEND OF TEST - ,A5,/)
90018 FORMAT (1H ,A13,13X,A20,7H * ,A10,1H/,
1 A13)
90019 FORMAT (1H ,26HFOR OFFICIAL USE ONLY ,35X,15HCOPYRIGHT 1982)
C****
C**** FORMAT STATEMENTS FOR RUN SUMMARY
C****
90020 FORMAT (1H ,21X,I5,13H TESTS PASSED)
90022 FORMAT (1H ,21X,I5,13H TESTS FAILED)
90024 FORMAT (1H ,21X,I5,14H TESTS DELETED)
90026 FORMAT (1H ,21X,I5,25H TESTS REQUIRE INSPECTION)
90028 FORMAT (1H ,21X,I5,4H OF ,I3,15H TESTS EXECUTED)
CBE** ********************** BBCFMT0B **********************************
C*****
C***** END OF TEST SEGMENT 372
STOP
END
*END-OF,FM906
FM907.f 481036638 170 2 100666 12105 `
*HEADER,FORTR,FM907
*FILES1,FORTR,FM907,X
C***********************************************************************
C***** FORTRAN 77
C***** FM907
C***** LSTDO2 - (373)
C*****
C***********************************************************************
C***** GENERAL PURPOSE ANS REF
C***** TEST LIST DIRECTED OUTPUT 13.6
C***** DOUBLE PRECISION AND COMPLEX DATA TYPES INCLUDED 12.4
C*****
CBB** ********************** BBCCOMNT **********************************
C****
C**** 1978 FORTRAN COMPILER VALIDATION SYSTEM
C**** VERSION 2.0
C****
C****
C**** SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO
C**** GENERAL SERVICES ADMINISTRATION
C**** FEDERAL SOFTWARE TESTING CENTER
C**** 5203 LEESBURG PIKE, SUITE 1100
C**** FALLS CHURCH, VA. 22041
C****
C**** (703) 756-6153
C****
CBE** ********************** BBCCOMNT **********************************
C*****
C***** S P E C I F I C A T I O N S SEGMENT 373
DOUBLE PRECISION AVD, BVD, CVD
COMPLEX AVC, BVC, CVC, DVC
CHARACTER A4VK*4
C*****
CBB** ********************** BBCINITA **********************************
C**** SPECIFICATION STATEMENTS
C****
CHARACTER ZVERS*13, ZVERSD*17, ZDATE*17, ZPROG*5, ZCOMPL*20,
1 ZNAME*20, ZTAPE*10, ZPROJ*13, REMRKS*31, ZTAPED*13
CBE** ********************** BBCINITA **********************************
CBB** ********************** BBCINITB **********************************
C**** INITIALIZE SECTION
DATA ZVERS, ZVERSD, ZDATE
1 /'VERSION 2.0 ', '82/08/02*18.33.46', '*NO DATE*TIME'/
DATA ZCOMPL, ZNAME, ZTAPE
1 /'*NONE SPECIFIED*', '*NO COMPANY NAME*', '*NO TAPE*'/
DATA ZPROJ, ZTAPED, ZPROG
1 /'*NO PROJECT*', '*NO TAPE DATE', 'XXXXX'/
DATA REMRKS /' '/
C**** THE FOLLOWING 9 COMMENT LINES (CZ01, CZ02, ...) CAN BE REPLACED
C**** FOR IDENTIFYING THE TEST ENVIRONMENT
C****
CZ01 ZVERS = 'VERSION OF THE COMPILER VALIDATION SYSTEM'
CZ02 ZVERSD = 'CREATION DATE/TIME OF THE COMPILER VALIDATION SYSTEM'
CZ03 ZPROG = 'PROGRAM NAME'
CZ04 ZDATE = 'DATE OF TEST'
CZ05 ZCOMPL = 'COMPILER IDENTIFICATION'
CZ06 ZPROJ = 'PROJECT NUMBER/IDENTIFICATION'
CZ07 ZNAME = 'NAME OF USER'
CZ08 ZTAPE = 'TAPE OWNER/ID'
CZ09 ZTAPED = 'DATE TAPE COPIED'
C
IVPASS = 0
IVFAIL = 0
IVDELE = 0
IVINSP = 0
IVTOTL = 0
IVTOTN = 0
ICZERO = 0
C
C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER.
I01 = 05
C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER.
I02 = 06
C
CX010 REPLACED BY FEXEC X-010 CONTROL CARD (CARD-READER UNIT NUMBER).
C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5
CX011 REPLACED BY FEXEC X-011 CONTROL CARD. CX011 IS FOR SYSTEMS
C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX010.
C
CX020 REPLACED BY FEXEC X-020 CONTROL CARD (PRINTER UNIT NUMBER).
C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02= 6
CX021 REPLACED BY FEXEC X-021 CONTROL CARD. CX021 IS FOR SYSTEMS
C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX020.
C
CBE** ********************** BBCINITB **********************************
NUVI = I02
IVTOTL = 8
ZPROG = 'FM907'
CBB** ********************** BBCHED0A **********************************
C****
C**** WRITE REPORT TITLE
C****
WRITE (I02, 90002)
WRITE (I02, 90006)
WRITE (I02, 90007)
WRITE (I02, 90008) ZVERS, ZVERSD
WRITE (I02, 90009) ZPROG, ZPROG
WRITE (I02, 90010) ZDATE, ZCOMPL
CBE** ********************** BBCHED0A **********************************
C*****
C***** HEADING FOR SEGMENT 373
WRITE(NUVI,37300)
37300 FORMAT(1H , /16H LSTDO2 - (373) ,
1 21H LIST DIRECTED OUTPUT,
2 32H FOR D.P. AND COMPLEX DATA TYPES//
3 22H ANS REF. - 13.6 12.4)
CBB** ********************** BBCHED0B **********************************
C**** WRITE DETAIL REPORT HEADERS
C****
WRITE (I02,90004)
WRITE (I02,90004)
WRITE (I02,90013)
WRITE (I02,90014)
WRITE (I02,90015) IVTOTL
CBE** ********************** BBCHED0B **********************************
WRITE (NUVI, 70000)
70000 FORMAT (1H ,48X,31HTHE CORRECT LINE OF EACH TEST /
1 1H ,48X,31HIS HOLLERITH INFORMATION. /
2 1H ,48X,31HCOLUMN SPACING, LINE BREAKS, /
3 1H ,48X,31HAND THE NUMBER OF DECIMAL /
4 1H ,48X,31HPLACES FOR DOUBLE PRECISION /
5 1H ,48X,31HOR COMPLEX NUMBERS ARE /
6 1H ,48X,31HPROCESSOR DEPENDENT. /
7 1H ,48X,31HEITHER E OR F FORMAT MAY BE /
8 1H ,48X,31HUSED FOR DOUBLE PRECISION OR /
9 1H ,48X,31HCOMPLEX NUMBERS. /)
CT001* TEST 1 - DOUBLE PRECISION
IVTNUM = 1
WRITE (NUVI, 80004) IVTNUM
WRITE (NUVI, 80020)
AVD = 2.5D0
WRITE(NUVI, *) AVD
IVINSP = IVINSP + 1
WRITE (NUVI, 80022)
WRITE (NUVI, 70011)
70011 FORMAT (1H ,6X,3H2.5)
CT002* TEST 2 - COMPLEX
IVTNUM = 2
WRITE (NUVI, 80004) IVTNUM
WRITE (NUVI, 80020)
AVC = (3.0, 4.0)
WRITE(NUVI, *) AVC
IVINSP = IVINSP + 1
WRITE (NUVI, 80022)
WRITE (NUVI, 70021)
70021 FORMAT(1H ,6X,10H (3.0,4.0))
CT003* TEST 3 - SEVERAL DOUBLE PRECISION
IVTNUM = 3
WRITE (NUVI, 80004) IVTNUM
WRITE (NUVI, 80020)
AVD = 2.5D0
BVD = 2.5D-10
CVD = 2.5D+10
WRITE(NUVI, *) AVD, BVD, CVD
IVINSP = IVINSP + 1
WRITE (NUVI, 80022)
WRITE (NUVI, 70031)
70031 FORMAT(1H ,6X,21H2.5 2.5D-10 2.5D+10)
CT004* TEST 4 - SEVERAL COMPLEX
IVTNUM = 4
WRITE (NUVI, 80004) IVTNUM
WRITE (NUVI, 80020)
AVC = (0.0, 1.0)
BVC = (8.0, 10.0)
CVC = (-5.0, 0.0)
DVC = (0.0, 0.0)
WRITE(NUVI,*) AVC, BVC, CVC, DVC
IVINSP = IVINSP + 1
WRITE (NUVI, 80022)
WRITE (NUVI, 70041)
70041 FORMAT(1H ,6X,48H (0.0,1.0) (8.0,10.0) (-5.0,0.0) (0.0,
10.0))
CT005* TEST 5 - MIXED LIST
IVTNUM = 5
WRITE (NUVI, 80004) IVTNUM
WRITE (NUVI, 80020)
AVC = (3.0, 4.0)
BVC = (-3.0, -4.0)
AVD = 5.0D0
BVD = -5.0D0
WRITE(NUVI,*) AVC, AVD, BVD, BVC
IVINSP = IVINSP + 1
WRITE (NUVI, 80022)
WRITE (NUVI, 70051)
70051 FORMAT(1H ,6X,35H (3.0,4.0) 5.0 -5.0 (-3.0,-4.0))
CT006* TEST 6 - MIXED MODE EXPRESSION
IVTNUM = 6
WRITE (NUVI, 80004) IVTNUM
WRITE (NUVI, 80020)
AVC = (2.0, 3.0)
IVI = 3
WRITE(NUVI, *) AVC * IVI
IVINSP = IVINSP + 1
WRITE (NUVI, 80022)
WRITE (NUVI, 70061)
70061 FORMAT(1H ,6X,10H (6.0,9.0))
CT007* TEST 7 - MIXED MODE EXPRESSION
IVTNUM = 7
WRITE (NUVI, 80004) IVTNUM
WRITE (NUVI, 80020)
IVI = 2
AVS = 6.5
WRITE(NUVI, *) AVS / IVI
IVINSP = IVINSP + 1
WRITE (NUVI, 80022)
WRITE (NUVI, 70071)
70071 FORMAT(1H ,6X,4H3.25)
CT008* TEST 8 - MIXED LIST
IVTNUM = 8
WRITE (NUVI, 80004) IVTNUM
WRITE (NUVI, 80020)
A4VK = 'GOOD'
AVS = 2.5
AVC = (4, -6)
WRITE(NUVI, *) AVC / 2, .TRUE., AVS ** 3, A4VK // 'BYE',
1 ' FOR NOW'
IVINSP = IVINSP + 1
WRITE (NUVI, 80022)
WRITE (NUVI, 70081)
70081 FORMAT(1H ,6X,40H (2.0,-3.0) T 15.625 GOODBYE FOR NOW)
CBB** ********************** BBCSUM0 **********************************
C**** WRITE OUT TEST SUMMARY
C****
IVTOTN = IVPASS + IVFAIL + IVDELE + IVINSP
WRITE (I02, 90004)
WRITE (I02, 90014)
WRITE (I02, 90004)
WRITE (I02, 90020) IVPASS
WRITE (I02, 90022) IVFAIL
WRITE (I02, 90024) IVDELE
WRITE (I02, 90026) IVINSP
WRITE (I02, 90028) IVTOTN, IVTOTL
CBE** ********************** BBCSUM0 **********************************
CBB** ********************** BBCFOOT0 **********************************
C**** WRITE OUT REPORT FOOTINGS
C****
WRITE (I02,90016) ZPROG, ZPROG
WRITE (I02,90018) ZPROJ, ZNAME, ZTAPE, ZTAPED
WRITE (I02,90019)
CBE** ********************** BBCFOOT0 **********************************
CBB** ********************** BBCFMT0A **********************************
C**** FORMATS FOR TEST DETAIL LINES
C****
80000 FORMAT (1H ,2X,I3,4X,7HDELETED,32X,A31)
80002 FORMAT (1H ,2X,I3,4X,7H PASS ,32X,A31)
80004 FORMAT (1H ,2X,I3,4X,7HINSPECT,32X,A31)
80008 FORMAT (1H ,2X,I3,4X,7H FAIL ,32X,A31)
80010 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,15X,10HCOMPUTED= ,
1I6,/,1H ,15X,10HCORRECT= ,I6)
80012 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
1E12.5,/,1H ,16X,10HCORRECT= ,E12.5)
80018 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
1A21,/,1H ,16X,10HCORRECT= ,A21)
80020 FORMAT (1H ,16X,10HCOMPUTED= ,A21,1X,A31)
80022 FORMAT (1H ,16X,10HCORRECT= ,A21,1X,A31)
80024 FORMAT (1H ,16X,10HCOMPUTED= ,I6,16X,A31)
80026 FORMAT (1H ,16X,10HCORRECT= ,I6,16X,A31)
80028 FORMAT (1H ,16X,10HCOMPUTED= ,E12.5,10X,A31)
80030 FORMAT (1H ,16X,10HCORRECT= ,E12.5,10X,A31)
80050 FORMAT (1H ,48X,A31)
CBE** ********************** BBCFMT0A **********************************
CBB** ********************** BBCFMAT1 **********************************
C**** FORMATS FOR TEST DETAIL LINES - FULL LANGUAGE
C****
80031 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
1D17.10,/,1H ,16X,10HCORRECT= ,D17.10)
80033 FORMAT (1H ,16X,10HCOMPUTED= ,D17.10,10X,A31)
80035 FORMAT (1H ,16X,10HCORRECT= ,D17.10,10X,A31)
80037 FORMAT (1H ,16X,10HCOMPUTED= ,1H(,E12.5,2H, ,E12.5,1H),6X,A31)
80039 FORMAT (1H ,16X,10HCORRECT= ,1H(,E12.5,2H, ,E12.5,1H),6X,A31)
80041 FORMAT (1H ,16X,10HCOMPUTED= ,1H(,F12.5,2H, ,F12.5,1H),6X,A31)
80043 FORMAT (1H ,16X,10HCORRECT= ,1H(,F12.5,2H, ,F12.5,1H),6X,A31)
80045 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
11H(,F12.5,2H, ,F12.5,1H)/,1H ,16X,10HCORRECT= ,
21H(,F12.5,2H, ,F12.5,1H))
CBE** ********************** BBCFMAT1 **********************************
CBB** ********************** BBCFMT0B **********************************
C**** FORMAT STATEMENTS FOR PAGE HEADERS
C****
90002 FORMAT (1H1)
90004 FORMAT (1H )
90006 FORMAT (1H ,20X,31HFEDERAL SOFTWARE TESTING CENTER)
90007 FORMAT (1H ,19X,34HFORTRAN COMPILER VALIDATION SYSTEM)
90008 FORMAT (1H ,21X,A13,A17)
90009 FORMAT (1H ,/,2H *,A5,6HBEGIN*,12X,15HTEST RESULTS - ,A5,/)
90010 FORMAT (1H ,8X,16HTEST DATE*TIME= ,A17,15H - COMPILER= ,A20)
90013 FORMAT (1H ,8H TEST ,10HPASS/FAIL ,6X,17HDISPLAYED RESULTS,
1 7X,7HREMARKS,24X)
90014 FORMAT (1H ,46H----------------------------------------------,
1 33H---------------------------------)
90015 FORMAT (1H ,48X,17HTHIS PROGRAM HAS ,I3,6H TESTS,/)
C****
C**** FORMAT STATEMENTS FOR REPORT FOOTINGS
C****
90016 FORMAT (1H ,/,2H *,A5,4HEND*,14X,14HEND OF TEST - ,A5,/)
90018 FORMAT (1H ,A13,13X,A20,7H * ,A10,1H/,
1 A13)
90019 FORMAT (1H ,26HFOR OFFICIAL USE ONLY ,35X,15HCOPYRIGHT 1982)
C****
C**** FORMAT STATEMENTS FOR RUN SUMMARY
C****
90020 FORMAT (1H ,21X,I5,13H TESTS PASSED)
90022 FORMAT (1H ,21X,I5,13H TESTS FAILED)
90024 FORMAT (1H ,21X,I5,14H TESTS DELETED)
90026 FORMAT (1H ,21X,I5,25H TESTS REQUIRE INSPECTION)
90028 FORMAT (1H ,21X,I5,4H OF ,I3,15H TESTS EXECUTED)
CBE** ********************** BBCFMT0B **********************************
C*****
C***** END OF TEST SEGMENT 373
STOP
END
*END-OF,FM907
FM908.f 481036643 170 2 100666 35071 `
*HEADER,FORTR,FM908
*FILES1,FORTR,FM908,X
C***********************************************************************
C***** FORTRAN 77
C***** FM908
C***** INTER3 - (392)
C*****
C***********************************************************************
C***** TESTING OF INTERNAL FILES - ANS. REF
C***** USING READ 12.2.5
C*****
CBB** ********************** BBCCOMNT **********************************
C****
C**** 1978 FORTRAN COMPILER VALIDATION SYSTEM
C**** VERSION 2.0
C****
C****
C**** SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO
C**** GENERAL SERVICES ADMINISTRATION
C**** FEDERAL SOFTWARE TESTING CENTER
C**** 5203 LEESBURG PIKE, SUITE 1100
C**** FALLS CHURCH, VA. 22041
C****
C**** (703) 756-6153
C****
CBE** ********************** BBCCOMNT **********************************
C*****
C***** S P E C I F I C A T I O N S SEGMENT 392
C*****
DOUBLE PRECISION AVD, BVD, CVD, DVD, EVD, DVCORR
LOGICAL AVB
CHARACTER*43 A43VK, D43VK, F43VK, G43VK, K43VK, N43VK
CHARACTER A8VK*8, E51VK*51, L53VK*53, I82VK*82
CHARACTER J97VK*97, C431K(2)*43, CVCORR*30
CHARACTER*29 B291K(5), M291K(5), H131K(2)*13
COMPLEX AVC, BVC, CVC, DVC, ZVCORR
REAL R2E(8)
EQUIVALENCE (R2E(1),AVC),(R2E(3),BVC),(R2E(5),CVC),(R2E(7),DVC)
C*****
CBB** ********************** BBCINITA **********************************
C**** SPECIFICATION STATEMENTS
C****
CHARACTER ZVERS*13, ZVERSD*17, ZDATE*17, ZPROG*5, ZCOMPL*20,
1 ZNAME*20, ZTAPE*10, ZPROJ*13, REMRKS*31, ZTAPED*13
CBE** ********************** BBCINITA **********************************
CBB** ********************** BBCINITB **********************************
C**** INITIALIZE SECTION
DATA ZVERS, ZVERSD, ZDATE
1 /'VERSION 2.0 ', '82/08/02*18.33.46', '*NO DATE*TIME'/
DATA ZCOMPL, ZNAME, ZTAPE
1 /'*NONE SPECIFIED*', '*NO COMPANY NAME*', '*NO TAPE*'/
DATA ZPROJ, ZTAPED, ZPROG
1 /'*NO PROJECT*', '*NO TAPE DATE', 'XXXXX'/
DATA REMRKS /' '/
C**** THE FOLLOWING 9 COMMENT LINES (CZ01, CZ02, ...) CAN BE REPLACED
C**** FOR IDENTIFYING THE TEST ENVIRONMENT
C****
CZ01 ZVERS = 'VERSION OF THE COMPILER VALIDATION SYSTEM'
CZ02 ZVERSD = 'CREATION DATE/TIME OF THE COMPILER VALIDATION SYSTEM'
CZ03 ZPROG = 'PROGRAM NAME'
CZ04 ZDATE = 'DATE OF TEST'
CZ05 ZCOMPL = 'COMPILER IDENTIFICATION'
CZ06 ZPROJ = 'PROJECT NUMBER/IDENTIFICATION'
CZ07 ZNAME = 'NAME OF USER'
CZ08 ZTAPE = 'TAPE OWNER/ID'
CZ09 ZTAPED = 'DATE TAPE COPIED'
C
IVPASS = 0
IVFAIL = 0
IVDELE = 0
IVINSP = 0
IVTOTL = 0
IVTOTN = 0
ICZERO = 0
C
C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER.
I01 = 05
C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER.
I02 = 06
C
CX010 REPLACED BY FEXEC X-010 CONTROL CARD (CARD-READER UNIT NUMBER).
C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5
CX011 REPLACED BY FEXEC X-011 CONTROL CARD. CX011 IS FOR SYSTEMS
C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX010.
C
CX020 REPLACED BY FEXEC X-020 CONTROL CARD (PRINTER UNIT NUMBER).
C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02= 6
CX021 REPLACED BY FEXEC X-021 CONTROL CARD. CX021 IS FOR SYSTEMS
C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX020.
C
CBE** ********************** BBCINITB **********************************
NUVI = I02
IVTOTL = 54
ZPROG = 'FM908'
CBB** ********************** BBCHED0A **********************************
C****
C**** WRITE REPORT TITLE
C****
WRITE (I02, 90002)
WRITE (I02, 90006)
WRITE (I02, 90007)
WRITE (I02, 90008) ZVERS, ZVERSD
WRITE (I02, 90009) ZPROG, ZPROG
WRITE (I02, 90010) ZDATE, ZCOMPL
CBE** ********************** BBCHED0A **********************************
C*****
C***** HEADER FOR SEGMENT 392
C*****
WRITE(NUVI,39200)
39200 FORMAT(1H ,/ 44H INTER3 - (392) INTERNAL FILES -- USING READ
1 //19H ANS. REF. - 12.2.5)
CBB** ********************** BBCHED0B **********************************
C**** WRITE DETAIL REPORT HEADERS
C****
WRITE (I02,90004)
WRITE (I02,90004)
WRITE (I02,90013)
WRITE (I02,90014)
WRITE (I02,90015) IVTOTL
CBE** ********************** BBCHED0B **********************************
A43VK = ' 2.1000000D1 23.45600D3 23.450000000D2'
D43VK = '34.58673D2 3458.67300 34.58673D2 3458.673 '
F43VK = 'T 10.98THISISIT 3.4945D2 3 '
G43VK = ' 2.343 34.394 '
K43VK = ' 0.934, 34.567 34.65 0.63540D1 '
N43VK = '34 34.98395.83000D2 F.FALSE.13.45300E+2 '
E51VK = ' 348 3.4783E1384.3847D1 T 3.48570 KDFJ D/.'
L53VK = ' 0.345 ,3.4345E01,F, 34.85900D-1, 10.000012345678'
I82VK = ' 2.34 , 2.456 2.34 , 2.456 0.234E01, 2.456E00
1 0.234E+001, 2.456E-000'
J97VK = ' 5.67980, 0.9876 5.67980, 0.9876 05.6798E0
10, 9.8760E-1 5.67980E0000,0.09876E+001'
B291K(1) = '34.38457D1 34.38457D1 '
B291K(2) = '34.38457D1 '
B291K(3) = '34.38457D1 34.38457D1 '
B291K(4) = ' '
B291K(5) = '34.38457D1 '
M291K(1) = ' 98 '
M291K(2) = '8.40485D02 '
M291K(3) = ' '
M291K(4) = ' .TRUE. 340.435E-1, 3.494E+1'
M291K(5) = '87654321 '
C431K(1) = ' 2.1000000D1 23.45600D3 23.450000000D2'
C431K(2) = ' '
H131K(1) = '34.84'
H131K(2) = '349.887'
CT001* TEST 1 DOUBLE PRECISION FROM VARIABLE
IVTNUM = 1
READ(UNIT=A43VK,FMT=39201) AVD
39201 FORMAT(13X,D10.5)
IF (AVD - 0.2345599998D+05) 20010, 10010, 40010
40010 IF (AVD - 0.2345600002D+05) 10010, 10010, 20010
10010 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0011
20010 IVFAIL = IVFAIL + 1
DVCORR = 23.456D3
WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR
0011 CONTINUE
CT002* TEST 2 FROM ELEMENT
IVTNUM = 2
READ(UNIT=C431K(1),FMT=39204) AVD
39204 FORMAT(D12.7)
IF (AVD - 0.2099999999D+02) 20020, 10020, 40020
40020 IF (AVD - 0.2100000001D+02) 10020, 10020, 20020
10020 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0021
20020 IVFAIL = IVFAIL + 1
DVCORR = 2.1D1
WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR
0021 CONTINUE
CT003* TEST 3 FROM SUBSTRING
IVTNUM = 3
READ(UNIT=A43VK(19:),FMT=39206) AVD
39206 FORMAT(11X,D14.9)
IF (AVD - 0.2344999998D+04) 20030, 10030, 40030
40030 IF (AVD - 0.2345000002D+04) 10030, 10030, 20030
10030 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0031
20030 IVFAIL = IVFAIL + 1
DVCORR = 23.45D2
WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR
0031 CONTINUE
CT004* TEST 4 FROM ARRAY
IVTNUM = 4
READ(UNIT=C431K,FMT=39208) CVD
39208 FORMAT(25X,D18.10)
IF (CVD - 0.2344999998D+04) 20040, 10040, 40040
40040 IF (CVD - 0.2345000002D+04) 10040, 10040, 20040
10040 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0041
20040 IVFAIL = IVFAIL + 1
DVCORR = 23.45D2
WRITE (NUVI, 80031) IVTNUM, CVD, DVCORR
0041 CONTINUE
C*****
C***** TESTS 5 THRU 9 - LIST FROM ARRAY
C*****
CT005* TEST 5
IVTNUM = 5
READ(UNIT=B291K,FMT=39210) AVD, BVD, CVD, DVD, EVD
39210 FORMAT(D10.5,1X,D10.5,/,D10.5,/,D10.5,//,D10.5)
IF (AVD - 0.3438456998D+03) 20050, 10050, 40050
40050 IF (AVD - 0.3438457002D+03) 10050, 10050, 20050
10050 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0051
20050 IVFAIL = IVFAIL + 1
DVCORR = 34.38457D1
WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR
0051 CONTINUE
CT006* TEST 6
IVTNUM = 6
IF (BVD - 0.3438456998D+03) 20060, 10060, 40060
40060 IF (BVD - 0.3438457002D+03) 10060, 10060, 20060
10060 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0061
20060 IVFAIL = IVFAIL + 1
DVCORR = 34.38457D1
WRITE (NUVI, 80031) IVTNUM, BVD, DVCORR
0061 CONTINUE
CT007* TEST 7
IVTNUM = 7
IF (CVD - 0.3438456998D+03) 20070, 10070, 40070
40070 IF (CVD - 0.3438457002D+03) 10070, 10070, 20070
10070 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0071
20070 IVFAIL = IVFAIL + 1
DVCORR = 34.38457D1
WRITE (NUVI, 80031) IVTNUM, CVD, DVCORR
0071 CONTINUE
CT008* TEST 8
IVTNUM = 8
IF (DVD - 0.3438456998D+03) 20080, 10080, 40080
40080 IF (DVD - 0.3438457002D+03) 10080, 10080, 20080
10080 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0081
20080 IVFAIL = IVFAIL + 1
DVCORR = 34.38457D1
WRITE (NUVI, 80031) IVTNUM, DVD, DVCORR
0081 CONTINUE
CT009* TEST 9
IVTNUM = 9
IF (EVD - 0.3438456998D+03) 20090, 10090, 40090
40090 IF (EVD - 0.3438457002D+03) 10090, 10090, 20090
10090 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0091
20090 IVFAIL = IVFAIL + 1
DVCORR = 34.38457D1
WRITE (NUVI, 80031) IVTNUM, EVD, DVCORR
0091 CONTINUE
C*****
C***** TESTS 10 THRU 13 - LIST FROM VARIABLE WITH DIFFERENT FORMATS
C*****
CT010* TEST 10
IVTNUM = 10
READ(UNIT=D43VK,FMT=39212) AVD, BVD, CVD, DVD
39212 FORMAT(D10.5,1X,F10.5,D11.5,G11.5)
IF (AVD - 0.3458672998D+04) 20100, 10100, 40100
40100 IF (AVD - 0.3458673002D+04) 10100, 10100, 20100
10100 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0101
20100 IVFAIL = IVFAIL + 1
DVCORR = 34.58673D2
WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR
0101 CONTINUE
CT011* TEST 11
IVTNUM = 11
IF (BVD - 0.3458672998D+04) 20110, 10110, 40110
40110 IF (BVD - 0.3458673002D+04) 10110, 10110, 20110
10110 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0111
20110 IVFAIL = IVFAIL + 1
DVCORR = 34.58673D2
WRITE (NUVI, 80031) IVTNUM, BVD, DVCORR
0111 CONTINUE
CT012* TEST 12
IVTNUM = 12
IF (CVD - 0.3458672998D+04) 20120, 10120, 40120
40120 IF (CVD - 0.3458673002D+04) 10120, 10120, 20120
10120 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0121
20120 IVFAIL = IVFAIL + 1
DVCORR = 34.58673D2
WRITE (NUVI, 80031) IVTNUM, CVD, DVCORR
0121 CONTINUE
CT013* TEST 13
IVTNUM = 13
IF (DVD - 0.3458672998D+04) 20130, 10130, 40130
40130 IF (DVD - 0.3458673002D+04) 10130, 10130, 20130
10130 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0131
20130 IVFAIL = IVFAIL + 1
DVCORR = 34.58673D2
WRITE (NUVI, 80031) IVTNUM, DVD, DVCORR
0131 CONTINUE
C*****
WRITE (NUVI, 90002)
WRITE (NUVI, 90013)
WRITE (NUVI, 90014)
C*****
C***** TESTS 14 THRU 19 - MIXED TYPES
C*****
CT014* TEST 14
IVTNUM = 14
READ(UNIT=E51VK,FMT=39214) KVI, AVS, AVD, AVB, BVS, A8VK
39214 FORMAT(I4,1X,E9.4,D10.4,1X,L4,1X,F12.5,1X,A8)
IF (KVI - 348) 20140, 10140, 20140
10140 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0141
20140 IVFAIL = IVFAIL + 1
IVCORR = 348
WRITE (NUVI, 80010) IVTNUM, KVI, IVCORR
0141 CONTINUE
CT015* TEST 15
IVTNUM = 15
IF (AVS - 0.34781E+02) 20150, 10150, 40150
40150 IF (AVS - 0.34785E+02) 10150, 10150, 20150
10150 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0151
20150 IVFAIL = IVFAIL + 1
RVCORR = 34.783
WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR
0151 CONTINUE
CT016* TEST 16
IVTNUM = 16
IF (AVD - 0.3843846998D+04) 20160, 10160, 40160
40160 IF (AVD - 0.3843847002D+04) 10160, 10160, 20160
10160 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0161
20160 IVFAIL = IVFAIL + 1
DVCORR = 384.3847D1
WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR
0161 CONTINUE
CT017* TEST 17
IVTNUM = 17
IVCOMP = 0
IF (AVB) IVCOMP = 1
IF (IVCOMP - 1) 20170, 10170, 20170
10170 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0171
20170 IVFAIL = IVFAIL + 1
LVCORR = 1
REMRKS = '1 = TRUE ; 0 = FALSE'
WRITE (NUVI, 80008) IVTNUM, REMRKS
WRITE (NUVI, 80024) IVCOMP
WRITE (NUVI, 80026) LVCORR
0171 CONTINUE
CT018* TEST 18
IVTNUM = 18
IF (BVS - 0.34855E+01) 20180, 10180, 40180
40180 IF (BVS - 0.34859E+01) 10180, 10180, 20180
10180 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0181
20180 IVFAIL = IVFAIL + 1
RVCORR = 3.4857
WRITE (NUVI, 80012) IVTNUM, BVS, RVCORR
0181 CONTINUE
CT019* TEST 19
IVTNUM = 19
IVCOMP = 0
IF (A8VK.EQ.'KDFJ D/.') IVCOMP = 1
IF (IVCOMP - 1) 20190, 10190, 20190
10190 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0191
20190 IVFAIL = IVFAIL + 1
CVCORR = 'KDFJ D/.'
WRITE (NUVI, 80018) IVTNUM, A8VK, CVCORR
0191 CONTINUE
C*****
C***** TESTS 20 THRU 25 - MIXED TYPES WITH TC, TLC, TRC, AND NX
C*****
CT020* TEST 20
IVTNUM = 20
READ(UNIT=F43VK,FMT=39216) AVB, AVS, A8VK, AVD, BVS, KVI
39216 FORMAT(L1,T5,F5.2,A8,TR2,D8.4,TL8,F6.4,4X,I1)
IVCOMP = 0
IF (AVB) IVCOMP = 1
IF (IVCOMP - 1) 20200, 10200, 20200
10200 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0201
20200 IVFAIL = IVFAIL + 1
LVCORR = 1
REMRKS = '1 = TRUE ; 0 = FALSE'
WRITE (NUVI, 80008) IVTNUM, REMRKS
WRITE (NUVI, 80024) IVCOMP
WRITE (NUVI, 80026) LVCORR
0201 CONTINUE
CT021* TEST 21
IVTNUM = 21
IF (AVS - 0.10979E+02) 20210, 10210, 40210
40210 IF (AVS - 0.10981E+02) 10210, 10210, 20210
10210 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0211
20210 IVFAIL = IVFAIL + 1
RVCORR = 10.98
WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR
0211 CONTINUE
CT022* TEST 22
IVTNUM = 22
IVCOMP = 0
IF (A8VK.EQ.'THISISIT') IVCOMP = 1
IF (IVCOMP - 1) 20220, 10220, 20220
10220 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0221
20220 IVFAIL = IVFAIL + 1
CVCORR = 'THISISIT'
WRITE (NUVI, 80018) IVTNUM, A8VK, CVCORR
0221 CONTINUE
CT023* TEST 23
IVTNUM = 23
IF (AVD - 0.3494499998D+03) 20230, 10230, 40230
40230 IF (AVD - 0.3494500002D+03) 10230, 10230, 20230
10230 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0231
20230 IVFAIL = IVFAIL + 1
DVCORR = 3.4945D2
WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR
0231 CONTINUE
CT024* TEST 24
IVTNUM = 24
IF (BVS - 0.34943E+01) 20240, 10240, 40240
40240 IF (BVS - 0.34947E+01) 10240, 10240, 20240
10240 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0241
20240 IVFAIL = IVFAIL + 1
RVCORR = 3.4945
WRITE (NUVI, 80012) IVTNUM, BVS, RVCORR
0241 CONTINUE
CT025* TEST 25
IVTNUM = 25
IF (KVI - 3) 20250, 10250, 20250
10250 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0251
20250 IVFAIL = IVFAIL + 1
IVCORR = 3
WRITE (NUVI, 80010) IVTNUM, KVI, IVCORR
0251 CONTINUE
CT026* TEST 26 COMPLEX FROM VARIABLE
IVTNUM = 26
READ(UNIT=G43VK,FMT=39218) AVC
39218 FORMAT(F10.5,1X,F10.5)
IF (R2E(1) - 0.23428E+01) 20260, 40262, 40261
40261 IF (R2E(1) - 0.23432E+01) 40262, 40262, 20260
40262 IF (R2E(2) - 0.34392E+02) 20260, 10260, 40260
40260 IF (R2E(2) - 0.34396E+02) 10260, 10260, 20260
10260 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0261
20260 IVFAIL = IVFAIL + 1
ZVCORR = (2.343, 34.394)
WRITE (NUVI, 80045) IVTNUM, AVC, ZVCORR
0261 CONTINUE
CT027* TEST 27 COMPLEX FROM ARRAY
IVTNUM = 27
READ(UNIT=H131K,FMT=39220) AVC
39220 FORMAT(E12.5,/,E12.5)
IF (R2E(1) - 0.34838E+02) 20270, 40272, 40271
40271 IF (R2E(1) - 0.34842E+02) 40272, 40272, 20270
40272 IF (R2E(2) - 0.34987E+03) 20270, 10270, 40270
40270 IF (R2E(2) - 0.34991E+03) 10270, 10270, 20270
10270 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0271
20270 IVFAIL = IVFAIL + 1
ZVCORR = (34.84, 349.887)
WRITE (NUVI, 80045) IVTNUM, AVC, ZVCORR
0271 CONTINUE
C*****
WRITE (NUVI, 90002)
WRITE (NUVI, 90013)
WRITE (NUVI, 90014)
C*****
C***** TESTS 28 THRU 31 - COMPLEX LIST FROM VARIABLE POSITION 1X BEYOND
C***** VARIABLE LENGTH
CT028* TEST 28
IVTNUM = 28
READ(UNIT=I82VK,FMT=39222) AVC, BVC, CVC, DVC
39222 FORMAT(2(2(G7.5,1X),2X),2(G10.4E2,1X),1X,2(G11.7E4,1X))
IF (R2E(1) - 0.23398E+01) 20280, 40282, 40281
40281 IF (R2E(1) - 0.23402E+01) 40282, 40282, 20280
40282 IF (R2E(2) - 0.24558E+01) 20280, 10280, 40280
40280 IF (R2E(2) - 0.24562E+01) 10280, 10280, 20280
10280 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0281
20280 IVFAIL = IVFAIL + 1
ZVCORR = (2.34, 2.456)
WRITE (NUVI, 80045) IVTNUM, AVC, ZVCORR
0281 CONTINUE
CT029* TEST 29
IVTNUM = 29
IF (R2E(3) - 0.23398E+01) 20290, 40292, 40291
40291 IF (R2E(3) - 0.23402E+01) 40292, 40292, 20290
40292 IF (R2E(4) - 0.24558E+01) 20290, 10290, 40290
40290 IF (R2E(4) - 0.24562E+01) 10290, 10290, 20290
10290 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0291
20290 IVFAIL = IVFAIL + 1
ZVCORR = (2.34, 2.456)
WRITE (NUVI, 80045) IVTNUM, BVC, ZVCORR
0291 CONTINUE
CT030* TEST 30
IVTNUM = 30
IF (R2E(5) - 0.23398E+01) 20300, 40302, 40301
40301 IF (R2E(5) - 0.23402E+01) 40302, 40302, 20300
40302 IF (R2E(6) - 0.24558E+01) 20300, 10300, 40300
40300 IF (R2E(6) - 0.24562E+01) 10300, 10300, 20300
10300 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0301
20300 IVFAIL = IVFAIL + 1
ZVCORR = (2.34, 2.456)
WRITE (NUVI, 80045) IVTNUM, CVC, ZVCORR
0301 CONTINUE
CT031* TEST 31
IVTNUM = 31
IF (R2E(7) - 0.23398E+01) 20310, 40312, 40311
40311 IF (R2E(7) - 0.23402E+01) 40312, 40312, 20310
40312 IF (R2E(8) - 0.24558E+01) 20310, 10310, 40310
40310 IF (R2E(8) - 0.24562E+01) 10310, 10310, 20310
10310 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0311
20310 IVFAIL = IVFAIL + 1
ZVCORR = (2.34, 2.456)
WRITE (NUVI, 80045) IVTNUM, DVC, ZVCORR
0311 CONTINUE
C*****
C***** TESTS 32 THRU 35 - COMPLEX LIST USING EW.D AND EW.DEN
C*****
CT032* TEST 32
IVTNUM = 32
READ(UNIT=J97VK(1:),FMT=39224) AVC, BVC, CVC, DVC
39224 FORMAT(2(2(E10.5,1X),2X),2(E10.4E2,1X),1X,2(E12.5E4,1X))
IF (R2E(1) - 0.56795E+01) 20320, 40322, 40321
40321 IF (R2E(1) - 0.56801E+01) 40322, 40322, 20320
40322 IF (R2E(2) - 0.98755E+00) 20320, 10320, 40320
40320 IF (R2E(2) - 0.98765E+00) 10320, 10320, 20320
10320 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0321
20320 IVFAIL = IVFAIL + 1
ZVCORR = (5.6798, 0.9876)
WRITE (NUVI, 80045) IVTNUM, AVC, ZVCORR
0321 CONTINUE
CT033* TEST 33
IVTNUM = 33
IF (R2E(3) - 0.56795E+01) 20330, 40332, 40331
40331 IF (R2E(3) - 0.56801E+01) 40332, 40332, 20330
40332 IF (R2E(4) - 0.98755E+00) 20330, 10330, 40330
40330 IF (R2E(4) - 0.98765E+00) 10330, 10330, 20330
10330 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0331
20330 IVFAIL = IVFAIL + 1
ZVCORR = (5.6798, 0.9876)
WRITE (NUVI, 80045) IVTNUM, BVC, ZVCORR
0331 CONTINUE
CT034* TEST 34
IVTNUM = 34
IF (R2E(5) - 0.56795E+01) 20340, 40342, 40341
40341 IF (R2E(5) - 0.56801E+01) 40342, 40342, 20340
40342 IF (R2E(6) - 0.98755E+00) 20340, 10340, 40340
40340 IF (R2E(6) - 0.98765E+00) 10340, 10340, 20340
10340 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0341
20340 IVFAIL = IVFAIL + 1
ZVCORR = (5.6798, 0.9876)
WRITE (NUVI, 80045) IVTNUM, CVC, ZVCORR
0341 CONTINUE
CT035* TEST 35
IVTNUM = 35
IF (R2E(7) - 0.56795E+01) 20350, 40352, 40351
40351 IF (R2E(7) - 0.56801E+01) 40352, 40352, 20350
40352 IF (R2E(8) - 0.98755E+00) 20350, 10350, 40350
40350 IF (R2E(8) - 0.98765E+00) 10350, 10350, 20350
10350 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0351
20350 IVFAIL = IVFAIL + 1
ZVCORR = (5.6798, 0.9876)
WRITE (NUVI, 80045) IVTNUM, DVC, ZVCORR
0351 CONTINUE
C*****
C***** TESTS 36 THRU 38 - MIXED TYPES FROM VARIABLE
C*****
CT036* TEST 36
IVTNUM = 36
READ(UNIT=K43VK,FMT=39226) AVC, AVS, AVD
39226 FORMAT(F7.3,1X,F7.3,1X,F10.5,1X,D13.5)
IF (R2E(1) - 0.93395E+00) 20360, 40362, 40361
40361 IF (R2E(1) - 0.93405E+00) 40362, 40362, 20360
40362 IF (R2E(2) - 0.34565E+02) 20360, 10360, 40360
40360 IF (R2E(2) - 0.34569E+02) 10360, 10360, 20360
10360 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0361
20360 IVFAIL = IVFAIL + 1
ZVCORR = (0.934, 34.567)
WRITE (NUVI, 80045) IVTNUM, AVC, ZVCORR
0361 CONTINUE
CT037* TEST 37
IVTNUM = 37
IF (AVS - 0.34648E+02) 20370, 10370, 40370
40370 IF (AVS - 0.34652E+02) 10370, 10370, 20370
10370 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0371
20370 IVFAIL = IVFAIL + 1
RVCORR = 34.65
WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR
0371 CONTINUE
CT038* TEST 38
IVTNUM = 38
IF (AVD - 0.6353999996D+01) 20380, 10380, 40380
40380 IF (AVD - 0.6354000004D+01) 10380, 10380, 20380
10380 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0381
20380 IVFAIL = IVFAIL + 1
DVCORR = 0.6354D1
WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR
0381 CONTINUE
C*****
C***** TESTS 39 THRU 43 - MIXED TYPES FROM ARRAY
C*****
CT039* TEST 39
IVTNUM = 39
READ(UNIT=L53VK,FMT=39228) AVC, AVB, AVD, AVS, A8VK
39228 FORMAT(F9.4,1X,E9.4,1X,L1,1X,D12.5,1X,G9.4,A8)
IF (R2E(1) - 0.34498E+00) 20390, 40392, 40391
40391 IF (R2E(1) - 0.34502E+00) 40392, 40392, 20390
40392 IF (R2E(2) - 0.34343E+02) 20390, 10390, 40390
40390 IF (R2E(2) - 0.34347E+02) 10390, 10390, 20390
10390 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0391
20390 IVFAIL = IVFAIL + 1
ZVCORR = (0.345, 34.345)
WRITE (NUVI, 80045) IVTNUM, AVC, ZVCORR
0391 CONTINUE
CT040* TEST 40
IVTNUM = 40
IVCOMP = 0
IF (AVB) IVCOMP = 1
IF (IVCOMP - 0) 20400, 10400, 20400
10400 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0401
20400 IVFAIL = IVFAIL + 1
LVCORR = 0
REMRKS = '1 = TRUE ; 0 = FALSE'
WRITE (NUVI, 80008) IVTNUM, REMRKS
WRITE (NUVI, 80024) IVCOMP
WRITE (NUVI, 80026) LVCORR
0401 CONTINUE
CT041* TEST 41
IVTNUM = 41
IF (AVD - 0.3485899998D+01) 20410, 10410, 40410
40410 IF (AVD - 0.3485900002D+01) 10410, 10410, 20410
10410 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0411
20410 IVFAIL = IVFAIL + 1
DVCORR = 34.859D-1
WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR
0411 CONTINUE
CT042* TEST 42
IVTNUM = 42
IF (AVS - 0.99995E+01) 20420, 10420, 40420
40420 IF (AVS - 0.10001E+02) 10420, 10420, 20420
10420 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0421
20420 IVFAIL = IVFAIL + 1
RVCORR = 10.0
WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR
0421 CONTINUE
CT043* TEST 43
IVTNUM = 43
IVCOMP = 0
IF (A8VK.EQ.'12345678') IVCOMP = 1
IF (IVCOMP - 1) 20430, 10430, 20430
10430 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0431
20430 IVFAIL = IVFAIL + 1
CVCORR = '12345678'
WRITE (NUVI, 80018) IVTNUM, A8VK, CVCORR
0431 CONTINUE
C*****
WRITE (NUVI, 90002)
WRITE (NUVI, 90013)
WRITE (NUVI, 90014)
C*****
C***** TESTS 44 THRU 48 - READ 5 RECORD FROM ARRAY POSITION 1X BEYOND
C***** ARRAY ELEMENT
C*****
CT044* TEST 44
IVTNUM = 44
READ(UNIT=M291K,FMT=39230) KVI, AVD, AVB, AVC, A8VK
39230 FORMAT(I5,/,D10.5,//,1X,L6,1X,2(E10.3,1X),/,A8)
IF (KVI - 98) 20440, 10440, 20440
10440 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0441
20440 IVFAIL = IVFAIL + 1
IVCORR = 98
WRITE (NUVI, 80010) IVTNUM, KVI, IVCORR
0441 CONTINUE
CT045* TEST 45
IVTNUM = 45
IF (AVD - 0.8404849995D+03) 20450, 10450, 40450
40450 IF (AVD - 0.8404850004D+03) 10450, 10450, 20450
10450 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0451
20450 IVFAIL = IVFAIL + 1
DVCORR = 84.0485D1
WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR
0451 CONTINUE
CT046* TEST 46
IVTNUM = 46
IVCOMP = 0
IF (AVB) IVCOMP = 1
IF (IVCOMP - 1) 20460, 10460, 20460
10460 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0461
20460 IVFAIL = IVFAIL + 1
LVCORR = 1
REMRKS = '1 = TRUE ; 0 = FALSE'
WRITE (NUVI, 80008) IVTNUM, REMRKS
WRITE (NUVI, 80024) IVCOMP
WRITE (NUVI, 80026) LVCORR
0461 CONTINUE
CT047* TEST 47
IVTNUM = 47
IF (R2E(1) - 0.34041E+02) 20470, 40472, 40471
40471 IF (R2E(1) - 0.34046E+02) 40472, 40472, 20470
40472 IF (R2E(2) - 0.34938E+02) 20470, 10470, 40470
40470 IF (R2E(2) - 0.34942E+02) 10470, 10470, 20470
10470 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0471
20470 IVFAIL = IVFAIL + 1
ZVCORR = (34.0435, 34.94)
WRITE (NUVI, 80045) IVTNUM, AVC, ZVCORR
0471 CONTINUE
CT048* TEST 48
IVTNUM = 48
IVCOMP = 0
IF (A8VK.EQ.'87654321') IVCOMP = 1
IF (IVCOMP - 1) 20480, 10480, 20480
10480 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0481
20480 IVFAIL = IVFAIL + 1
CVCORR = '87654321'
WRITE (NUVI, 80018) IVTNUM, A8VK, CVCORR
0481 CONTINUE
C*****
C***** TESTS 49 THRU 54 - MIXED TYPES, NX, AND :
C*****
CT049* TEST 49
IVTNUM = 49
READ(UNIT=N43VK,FMT=39232)JVI,AVS,AVD,AVB,A8VK,BVS
39232 FORMAT(I2,1X,F6.3,D10.5,L2,A8,E10.5,:,I5,2X,F10.4)
IF (JVI - 34) 20490, 10490, 20490
10490 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0491
20490 IVFAIL = IVFAIL + 1
IVCORR = 34
WRITE (NUVI, 80010) IVTNUM, JVI, IVCORR
0491 CONTINUE
CT050* TEST 50
IVTNUM = 50
IF (AVS - 0.34981E+02) 20500, 10500, 40500
40500 IF (AVS - 0.34985E+02) 10500, 10500, 20500
10500 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0501
20500 IVFAIL = IVFAIL + 1
RVCORR = 34.983
WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR
0501 CONTINUE
CT051* TEST 51
IVTNUM = 51
IF (AVD - 0.9582999995D+04) 20510, 10510, 40510
40510 IF (AVD - 0.9583000005D+04) 10510, 10510, 20510
10510 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0511
20510 IVFAIL = IVFAIL + 1
DVCORR = 95.83D2
WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR
0511 CONTINUE
CT052* TEST 52
IVTNUM = 52
IVCOMP = 0
IF (AVB) IVCOMP = 1
IF (IVCOMP - 0) 20520, 10520, 20520
10520 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0521
20520 IVFAIL = IVFAIL + 1
LVCORR = 0
REMRKS = '1 = TRUE ; 0 = FALSE'
WRITE (NUVI, 80008) IVTNUM, REMRKS
WRITE (NUVI, 80024) IVCOMP
WRITE (NUVI, 80026) LVCORR
0521 CONTINUE
CT053* TEST 53
IVTNUM = 53
IVCOMP = 0
IF (A8VK.EQ.'.FALSE.1') IVCOMP = 1
IF (IVCOMP - 1) 20530, 10530, 20530
10530 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0531
20530 IVFAIL = IVFAIL + 1
CVCORR = '.FALSE.1'
WRITE (NUVI, 80018) IVTNUM, A8VK, CVCORR
0531 CONTINUE
CT054* TEST 54
IVTNUM = 54
IF (BVS - 0.34528E+03) 20540, 10540, 40540
40540 IF (BVS - 0.34532E+03) 10540, 10540, 20540
10540 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0541
20540 IVFAIL = IVFAIL + 1
RVCORR = 345.3
WRITE (NUVI, 80012) IVTNUM, BVS, RVCORR
0541 CONTINUE
C*****
CBB** ********************** BBCSUM0 **********************************
C**** WRITE OUT TEST SUMMARY
C****
IVTOTN = IVPASS + IVFAIL + IVDELE + IVINSP
WRITE (I02, 90004)
WRITE (I02, 90014)
WRITE (I02, 90004)
WRITE (I02, 90020) IVPASS
WRITE (I02, 90022) IVFAIL
WRITE (I02, 90024) IVDELE
WRITE (I02, 90026) IVINSP
WRITE (I02, 90028) IVTOTN, IVTOTL
CBE** ********************** BBCSUM0 **********************************
CBB** ********************** BBCFOOT0 **********************************
C**** WRITE OUT REPORT FOOTINGS
C****
WRITE (I02,90016) ZPROG, ZPROG
WRITE (I02,90018) ZPROJ, ZNAME, ZTAPE, ZTAPED
WRITE (I02,90019)
CBE** ********************** BBCFOOT0 **********************************
CBB** ********************** BBCFMT0A **********************************
C**** FORMATS FOR TEST DETAIL LINES
C****
80000 FORMAT (1H ,2X,I3,4X,7HDELETED,32X,A31)
80002 FORMAT (1H ,2X,I3,4X,7H PASS ,32X,A31)
80004 FORMAT (1H ,2X,I3,4X,7HINSPECT,32X,A31)
80008 FORMAT (1H ,2X,I3,4X,7H FAIL ,32X,A31)
80010 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,15X,10HCOMPUTED= ,
1I6,/,1H ,15X,10HCORRECT= ,I6)
80012 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
1E12.5,/,1H ,16X,10HCORRECT= ,E12.5)
80018 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
1A21,/,1H ,16X,10HCORRECT= ,A21)
80020 FORMAT (1H ,16X,10HCOMPUTED= ,A21,1X,A31)
80022 FORMAT (1H ,16X,10HCORRECT= ,A21,1X,A31)
80024 FORMAT (1H ,16X,10HCOMPUTED= ,I6,16X,A31)
80026 FORMAT (1H ,16X,10HCORRECT= ,I6,16X,A31)
80028 FORMAT (1H ,16X,10HCOMPUTED= ,E12.5,10X,A31)
80030 FORMAT (1H ,16X,10HCORRECT= ,E12.5,10X,A31)
80050 FORMAT (1H ,48X,A31)
CBE** ********************** BBCFMT0A **********************************
CBB** ********************** BBCFMAT1 **********************************
C**** FORMATS FOR TEST DETAIL LINES - FULL LANGUAGE
C****
80031 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
1D17.10,/,1H ,16X,10HCORRECT= ,D17.10)
80033 FORMAT (1H ,16X,10HCOMPUTED= ,D17.10,10X,A31)
80035 FORMAT (1H ,16X,10HCORRECT= ,D17.10,10X,A31)
80037 FORMAT (1H ,16X,10HCOMPUTED= ,1H(,E12.5,2H, ,E12.5,1H),6X,A31)
80039 FORMAT (1H ,16X,10HCORRECT= ,1H(,E12.5,2H, ,E12.5,1H),6X,A31)
80041 FORMAT (1H ,16X,10HCOMPUTED= ,1H(,F12.5,2H, ,F12.5,1H),6X,A31)
80043 FORMAT (1H ,16X,10HCORRECT= ,1H(,F12.5,2H, ,F12.5,1H),6X,A31)
80045 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
11H(,F12.5,2H, ,F12.5,1H)/,1H ,16X,10HCORRECT= ,
21H(,F12.5,2H, ,F12.5,1H))
CBE** ********************** BBCFMAT1 **********************************
CBB** ********************** BBCFMT0B **********************************
C**** FORMAT STATEMENTS FOR PAGE HEADERS
C****
90002 FORMAT (1H1)
90004 FORMAT (1H )
90006 FORMAT (1H ,20X,31HFEDERAL SOFTWARE TESTING CENTER)
90007 FORMAT (1H ,19X,34HFORTRAN COMPILER VALIDATION SYSTEM)
90008 FORMAT (1H ,21X,A13,A17)
90009 FORMAT (1H ,/,2H *,A5,6HBEGIN*,12X,15HTEST RESULTS - ,A5,/)
90010 FORMAT (1H ,8X,16HTEST DATE*TIME= ,A17,15H - COMPILER= ,A20)
90013 FORMAT (1H ,8H TEST ,10HPASS/FAIL ,6X,17HDISPLAYED RESULTS,
1 7X,7HREMARKS,24X)
90014 FORMAT (1H ,46H----------------------------------------------,
1 33H---------------------------------)
90015 FORMAT (1H ,48X,17HTHIS PROGRAM HAS ,I3,6H TESTS,/)
C****
C**** FORMAT STATEMENTS FOR REPORT FOOTINGS
C****
90016 FORMAT (1H ,/,2H *,A5,4HEND*,14X,14HEND OF TEST - ,A5,/)
90018 FORMAT (1H ,A13,13X,A20,7H * ,A10,1H/,
1 A13)
90019 FORMAT (1H ,26HFOR OFFICIAL USE ONLY ,35X,15HCOPYRIGHT 1982)
C****
C**** FORMAT STATEMENTS FOR RUN SUMMARY
C****
90020 FORMAT (1H ,21X,I5,13H TESTS PASSED)
90022 FORMAT (1H ,21X,I5,13H TESTS FAILED)
90024 FORMAT (1H ,21X,I5,14H TESTS DELETED)
90026 FORMAT (1H ,21X,I5,25H TESTS REQUIRE INSPECTION)
90028 FORMAT (1H ,21X,I5,4H OF ,I3,15H TESTS EXECUTED)
CBE** ********************** BBCFMT0B **********************************
C*****
C***** END OF TEST SEGMENT 392
STOP
END
*END-OF,FM908
FM909.f 481036649 170 2 100666 35099 `
*HEADER,FORTR,FM909
*FILES1,FORTR,FM909,X
C***********************************************************************
C***** FORTRAN 77
C***** FM909
C***** INTER4 - (393)
C*****
C***********************************************************************
C***** TESTING OF INTERNAL FILES - ANS. REF
C***** USING WRITE 12.2.5
C*****
C*****
CBB** ********************** BBCCOMNT **********************************
C****
C**** 1978 FORTRAN COMPILER VALIDATION SYSTEM
C**** VERSION 2.0
C****
C****
C**** SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO
C**** GENERAL SERVICES ADMINISTRATION
C**** FEDERAL SOFTWARE TESTING CENTER
C**** 5203 LEESBURG PIKE, SUITE 1100
C**** FALLS CHURCH, VA. 22041
C****
C**** (703) 756-6153
C****
CBE** ********************** BBCCOMNT **********************************
C*****
C***** S P E C I F I C A T I O N S SEGMENT 393
C*****
LOGICAL AVB
DOUBLE PRECISION AVD, BVD, CVD, DVD, B1D(5)
COMPLEX AVC, BVC, CVC
CHARACTER A8VK*8, A97VK*97, CVCORR*97, AVCORR(24)*97
CHARACTER*29 A291K(5)
CHARACTER*43 A431K(2)
CHARACTER*1 A97E1(97), A97E2(97)
EQUIVALENCE (A97VK, A97E1), (A431K, A97E1)
EQUIVALENCE (CVCORR, A97E2)
C*****
CBB** ********************** BBCINITA **********************************
C**** SPECIFICATION STATEMENTS
C****
CHARACTER ZVERS*13, ZVERSD*17, ZDATE*17, ZPROG*5, ZCOMPL*20,
1 ZNAME*20, ZTAPE*10, ZPROJ*13, REMRKS*31, ZTAPED*13
CBE** ********************** BBCINITA **********************************
CBB** ********************** BBCINITB **********************************
C**** INITIALIZE SECTION
DATA ZVERS, ZVERSD, ZDATE
1 /'VERSION 2.0 ', '82/08/02*18.33.46', '*NO DATE*TIME'/
DATA ZCOMPL, ZNAME, ZTAPE
1 /'*NONE SPECIFIED*', '*NO COMPANY NAME*', '*NO TAPE*'/
DATA ZPROJ, ZTAPED, ZPROG
1 /'*NO PROJECT*', '*NO TAPE DATE', 'XXXXX'/
DATA REMRKS /' '/
C**** THE FOLLOWING 9 COMMENT LINES (CZ01, CZ02, ...) CAN BE REPLACED
C**** FOR IDENTIFYING THE TEST ENVIRONMENT
C****
CZ01 ZVERS = 'VERSION OF THE COMPILER VALIDATION SYSTEM'
CZ02 ZVERSD = 'CREATION DATE/TIME OF THE COMPILER VALIDATION SYSTEM'
CZ03 ZPROG = 'PROGRAM NAME'
CZ04 ZDATE = 'DATE OF TEST'
CZ05 ZCOMPL = 'COMPILER IDENTIFICATION'
CZ06 ZPROJ = 'PROJECT NUMBER/IDENTIFICATION'
CZ07 ZNAME = 'NAME OF USER'
CZ08 ZTAPE = 'TAPE OWNER/ID'
CZ09 ZTAPED = 'DATE TAPE COPIED'
C
IVPASS = 0
IVFAIL = 0
IVDELE = 0
IVINSP = 0
IVTOTL = 0
IVTOTN = 0
ICZERO = 0
C
C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER.
I01 = 05
C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER.
I02 = 06
C
CX010 REPLACED BY FEXEC X-010 CONTROL CARD (CARD-READER UNIT NUMBER).
C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5
CX011 REPLACED BY FEXEC X-011 CONTROL CARD. CX011 IS FOR SYSTEMS
C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX010.
C
CX020 REPLACED BY FEXEC X-020 CONTROL CARD (PRINTER UNIT NUMBER).
C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02= 6
CX021 REPLACED BY FEXEC X-021 CONTROL CARD. CX021 IS FOR SYSTEMS
C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX020.
C
CBE** ********************** BBCINITB **********************************
NUVI = I02
IVTOTL = 27
ZPROG = 'FM909'
CBB** ********************** BBCHED0A **********************************
C****
C**** WRITE REPORT TITLE
C****
WRITE (I02, 90002)
WRITE (I02, 90006)
WRITE (I02, 90007)
WRITE (I02, 90008) ZVERS, ZVERSD
WRITE (I02, 90009) ZPROG, ZPROG
WRITE (I02, 90010) ZDATE, ZCOMPL
CBE** ********************** BBCHED0A **********************************
C*****
C***** HEADER FOR SEGMENT 393
C*****
WRITE(NUVI,39300)
39300 FORMAT(1H ,/ 46H INTER4 - (393) INTERNAL FILES -- USING WRITE
1 //19H ANS. REF. - 12.2.5)
CBB** ********************** BBCHED0B **********************************
C**** WRITE DETAIL REPORT HEADERS
C****
WRITE (I02,90004)
WRITE (I02,90004)
WRITE (I02,90013)
WRITE (I02,90014)
WRITE (I02,90015) IVTOTL
CBE** ********************** BBCHED0B **********************************
WRITE (NUVI, 39199)
39199 FORMAT (1H ,48X,31HNOTE 1: FOR NUMERIC VALUES, /
1 1H ,48X,31H OPTIONAL LEADING ZERO MAY BE/
2 1H ,48X,31H BLANK FOR ABSOLUTE VALUE < 1/
3 1H ,48X,31HNOTE 2: LEADING PLUS SIGN IS /
4 1H ,48X,31H OPTIONAL FOR NUMERIC VALUES /
5 1H ,48X,31HNOTE 3: E FORMAT EXPONENT MAY /
6 1H ,48X,31H BE E+NN OR +0NN FOR REALS /
7 1H ,48X,31HNOTE 4: D FORMAT EXPONENT MAY /
8 1H ,48X,31H BE D+NN, E+NN, OR +0NN FOR /
9 1H ,48X,31H DOUBLE PRECISION VALUES /)
C*****
CT001* TEST 1 DOUBLE PRECISION INTO VARIABLE
IVTNUM = 1
A97VK = 'XXXXXXXXXXXXXXXXXX'
AVD = 23.456D3
WRITE(UNIT=A97VK,FMT=39301) AVD
39301 FORMAT(13X,D10.5)
IVCOMP = 0
AVCORR(1) = ' .23456D+05'
AVCORR(2) = ' .23456E+05'
AVCORR(3) = ' .23456+005'
DO 40011 I = 1, 3
IF (A97VK.EQ.AVCORR(I)) IVCOMP = 1
IF (IVCOMP - 1) 40011, 10010, 40011
40011 CONTINUE
GO TO 20010
10010 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0011
20010 IVFAIL = IVFAIL + 1
CVCORR = ' .23456D+05'
REMRKS = 'COMPUTED VALUE NOT CONSISTENT'
WRITE (NUVI, 80008) IVTNUM, REMRKS
REMRKS = 'WITH PERMISSIBLE OPTIONS ABOVE'
WRITE (NUVI, 80050) REMRKS
WRITE (NUVI, 70010) (A97E1(I), I = 1,54)
70010 FORMAT(1H ,16X,10HCOMPUTED: ,54A1)
WRITE (NUVI, 70020) (A97E1(I), I= 55,97)
70020 FORMAT(1H ,26X,43A1)
WRITE (NUVI, 70030) (A97E2(I), I = 1,54)
70030 FORMAT(1H ,16X,10HCORRECT: ,54A1)
WRITE (NUVI, 70040) (A97E2(I), I= 55,97)
70040 FORMAT(1H ,26X,43A1)
0011 CONTINUE
CT002* TEST 2 INTO ARRAY ELEMENT
IVTNUM = 2
AVD = 2.1D1
A431K(1) = ' '
A431K(2) = 'WRONG'
WRITE(UNIT=A431K(1),FMT=39303) AVD
39303 FORMAT(D12.7)
IVCOMP = 0
AVCORR(1) = '.2100000D+02'
AVCORR(2) = '.2100000E+02'
AVCORR(3) = '.2100000+002'
DO 40021 I = 1, 3
IF (A431K(1).EQ.AVCORR(I)) IVCOMP = 1
IF (IVCOMP - 1) 40021, 10020, 40021
40021 CONTINUE
GO TO 20020
10020 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0021
20020 IVFAIL = IVFAIL + 1
CVCORR = '.2100000D+02'
REMRKS = 'COMPUTED VALUE NOT CONSISTENT'
WRITE (NUVI, 80008) IVTNUM, REMRKS
REMRKS = 'WITH PERMISSIBLE OPTIONS ABOVE'
WRITE (NUVI, 80050) REMRKS
WRITE (NUVI, 80020) A431K(1)
WRITE (NUVI, 80022) CVCORR
0021 CONTINUE
CT003* TEST 3 CHARACTER SUBSTRING
IVTNUM = 3
A97VK = ' SOME WHERE'
AVD = 23.45D2
WRITE(UNIT=A97VK(21:),FMT=39305) AVD
39305 FORMAT(11X,D14.9)
IVCOMP = 0
AVCORR(1) = ' SOME WHERE .234500000D+04'
AVCORR(2) = ' SOME WHERE .234500000E+04'
AVCORR(3) = ' SOME WHERE .234500000+004'
DO 40031 I = 1, 3
IF (A97VK.EQ.AVCORR(I)) IVCOMP = 1
IF (IVCOMP - 1) 40031, 10030, 40031
40031 CONTINUE
GO TO 20030
10030 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0031
20030 IVFAIL = IVFAIL + 1
CVCORR = ' SOME WHERE .234500000D+04'
REMRKS = 'COMPUTED VALUE NOT CONSISTENT'
WRITE (NUVI, 80008) IVTNUM, REMRKS
REMRKS = 'WITH PERMISSIBLE OPTIONS ABOVE'
WRITE (NUVI, 80050) REMRKS
WRITE (NUVI, 70010) (A97E1(I), I = 1,54)
WRITE (NUVI, 70020) (A97E1(I), I= 55,97)
WRITE (NUVI, 70030) (A97E2(I), I = 1,54)
WRITE (NUVI, 70040) (A97E2(I), I= 55,97)
0031 CONTINUE
C***** TESTS 4 - 5 ARRAY, SINGLE RECORD
CT004* TEST 4
IVTNUM = 4
CVD = 23.45D2
A431K(2) = ' '
WRITE(UNIT=A431K,FMT=39306) CVD
39306 FORMAT(24X,D19.10)
IVCOMP = 0
AVCORR(1) = ' 0.2345000000D+04'
AVCORR(2) = ' 0.2345000000E+04'
AVCORR(3) = ' 0.2345000000+004'
AVCORR(4) = ' .2345000000D+04'
AVCORR(5) = ' .2345000000E+04'
AVCORR(6) = ' .2345000000+004'
AVCORR(7) = ' +.2345000000D+04'
AVCORR(8) = ' +.2345000000E+04'
AVCORR(9) = ' +.2345000000+004'
AVCORR(10) = ' +0.2345000000D+04'
AVCORR(11) = ' +0.2345000000E+04'
AVCORR(12) = ' +0.2345000000+004'
DO 40041 I = 1, 12
IF (A431K(1).EQ.AVCORR(I)) IVCOMP = 1
IF (IVCOMP - 1) 40041, 10040, 40041
40041 CONTINUE
GO TO 20040
10040 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0041
20040 IVFAIL = IVFAIL + 1
CVCORR = ' 0.2345000000D+04'
REMRKS = 'COMPUTED VALUE NOT CONSISTENT'
WRITE (NUVI, 80008) IVTNUM, REMRKS
REMRKS = 'WITH PERMISSIBLE OPTIONS ABOVE'
WRITE (NUVI, 80050) REMRKS
WRITE (NUVI, 70050) (A97E1(I), I = 1,43)
WRITE (NUVI, 70060) (A97E2(I), I = 1,43)
70050 FORMAT(1H ,16X,10HCOMPUTED: ,43A1)
70060 FORMAT(1H ,16X,10HCORRECT: ,43A1)
0041 CONTINUE
CT005* TEST 5
IVTNUM = 5
IVCOMP = 0
IF (A431K(2).EQ.' ') IVCOMP = 1
IF (IVCOMP - 1) 20050, 10050, 20050
10050 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0051
20050 IVFAIL = IVFAIL + 1
CVCORR = ' '
WRITE (NUVI, 80018) IVTNUM, A431K(2), CVCORR
0051 CONTINUE
C***** TESTS 6 - 10 ARRAY, 5 RECORDS, ONE BLANK
CT006* TEST 6
IVTNUM = 6
B1D(1) = 11D1
B1D(2) = 21D1
B1D(3) = 31D1
B1D(4) = 32D1
B1D(5) = 51D1
WRITE(UNIT=A291K,FMT=39307) (B1D(JVI), JVI=1,5)
39307 FORMAT(E11.6E2/1X,E10.5E2/2X,2(E9.4E2,3X)//4X,E7.2E2)
IVCOMP = 0
IF (A291K(1).EQ.'.110000E+03') IVCOMP = 1
IF (IVCOMP - 1) 20060, 10060, 20060
10060 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0061
20060 IVFAIL = IVFAIL + 1
CVCORR = '.110000E+03'
WRITE (NUVI, 80018) IVTNUM, A291K(1), CVCORR
0061 CONTINUE
CT007* TEST 7
IVTNUM = 7
IVCOMP = 0
IF (A291K(2).EQ.' .21000E+03') IVCOMP = 1
IF (IVCOMP - 1) 20070, 10070, 20070
10070 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0071
20070 IVFAIL = IVFAIL + 1
CVCORR = ' .21000E+03'
WRITE (NUVI, 80018) IVTNUM, A291K(2), CVCORR
0071 CONTINUE
CT008* TEST 8
IVTNUM = 8
IVCOMP = 0
IF (A291K(3).EQ.' .3100E+03 .3200E+03') IVCOMP = 1
IF (IVCOMP - 1) 20080, 10080, 20080
10080 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0081
20080 IVFAIL = IVFAIL + 1
CVCORR = ' .3100+003 .3200E+03'
WRITE (NUVI, 70070) IVTNUM, A291K(3), CVCORR
70070 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED: ,
1 A29,/,1H ,16X,10HCORRECT: ,A29)
0081 CONTINUE
CT009* TEST 9
IVTNUM = 9
IVCOMP = 0
IF (A291K(4).EQ.' ') IVCOMP = 1
IF (IVCOMP - 1) 20090, 10090, 20090
10090 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0091
20090 IVFAIL = IVFAIL + 1
CVCORR = ' '
WRITE (NUVI, 80018) IVTNUM, A291K(4), CVCORR
0091 CONTINUE
CT010* TEST 10
IVTNUM = 10
IVCOMP = 0
IF (A291K(5).EQ.' .51E+03') IVCOMP = 1
IF (IVCOMP - 1) 20100, 10100, 20100
10100 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0101
20100 IVFAIL = IVFAIL + 1
CVCORR = ' .51E+03'
WRITE (NUVI, 80018) IVTNUM, A291K(5), CVCORR
0101 CONTINUE
C*****
WRITE(NUVI, 90002)
WRITE(NUVI, 90013)
WRITE(NUVI, 90014)
C*****
CT011* TEST 11 VARIABLE, MORE THEN ONE FIELD
IVTNUM = 11
AVD = 34.58673D2
BVD = 34.58673D2
CVD = 34.58673D2
DVD = 34.58673D2
WRITE(UNIT=A97VK,FMT=39309) AVD, BVD, CVD, DVD
39309 FORMAT(D10.5,1X,F10.5,1X,D11.5,G11.5)
IVCOMP = 0
CVCORR = '.34587D+04 3458.67300 0.34587D+04 3458.7'
IF (A97VK.EQ.CVCORR) IVCOMP = 1
IF (IVCOMP - 1) 20110, 10110, 20110
10110 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0111
20110 IVFAIL = IVFAIL + 1
REMRKS = '54 PERMISSIBLE REPRESENTATIONS'
WRITE (NUVI, 80008) IVTNUM, REMRKS
REMRKS = 'SEE NOTES ABOVE'
WRITE (NUVI, 80050) REMRKS
WRITE (NUVI, 70010) (A97E1(I), I = 1,54)
WRITE (NUVI, 70020) (A97E1(I), I= 55,97)
WRITE (NUVI, 70030) (A97E2(I), I = 1,54)
WRITE (NUVI, 70040) (A97E2(I), I= 55,97)
0111 CONTINUE
CT012* TEST 12 GW.D FIELD WITH D.P.
IVTNUM = 12
AVD = 314.5673D0
BVD = 14.45673D-1
CVD = 85.7343D6
WRITE(UNIT=A97VK,FMT=39310) AVD, BVD, CVD
39310 FORMAT(G12.5,1X,G14.5E3,1X,G10.5E2)
IVCOMP = 0
AVCORR(1) = ' 314.57 1.4457 .85734E+08'
AVCORR(2) = ' +314.57 1.4457 .85734E+08'
AVCORR(3) = ' 314.57 +1.4457 .85734E+08'
AVCORR(4) = ' +314.57 +1.4457 .85734E+08'
DO 40121 I = 1, 4
IF (A97VK.EQ.AVCORR(I)) IVCOMP = 1
IF (IVCOMP - 1) 40121, 10120, 40121
40121 CONTINUE
GO TO 20120
10120 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0121
20120 IVFAIL = IVFAIL + 1
CVCORR = ' 314.57 1.4457 .85734E+08'
REMRKS = 'COMPUTED VALUE NOT CONSISTENT'
WRITE (NUVI, 80008) IVTNUM, REMRKS
REMRKS = 'WITH PERMISSIBLE OPTIONS. SEE '
WRITE (NUVI, 80050) REMRKS
REMRKS = 'NOTES ABOVE'
WRITE (NUVI, 80050) REMRKS
WRITE (NUVI, 70010) (A97E1(I), I = 1,54)
WRITE (NUVI, 70020) (A97E1(I), I= 55,97)
WRITE (NUVI, 70030) (A97E2(I), I = 1,54)
WRITE (NUVI, 70040) (A97E2(I), I= 55,97)
0121 CONTINUE
CT013* TEST 13 DIFFERENT TYPES IN SAME RECORD
IVTNUM = 13
KVI = 348
AVS = 34.783
AVD = 384.3847D1
AVB = .TRUE.
BVS = 3.4857
A8VK = 'KDFJ D/.'
WRITE(UNIT=A97VK,FMT=39311) KVI, AVS, AVD, AVB, BVS, A8VK
39311 FORMAT(I4,1X,E9.4,1X,D10.4,1X,L4,1X,F12.5,1X,A8)
IVCOMP = 0
CVCORR = ' 348 .3478E+02 0.3844D+04 T 3.48570 KDFJ D/
1.'
IF (A97VK.EQ.CVCORR) IVCOMP = 1
IF (IVCOMP - 1) 20130, 10130, 20130
10130 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0131
20130 IVFAIL = IVFAIL + 1
REMRKS = '72 PERMISSIBLE REPRESENTATIONS'
WRITE (NUVI, 80008) IVTNUM, REMRKS
REMRKS = 'SEE NOTES ABOVE'
WRITE (NUVI, 80050) REMRKS
WRITE (NUVI, 70010) (A97E1(I), I = 1,54)
WRITE (NUVI, 70020) (A97E1(I), I= 55,97)
WRITE (NUVI, 70030) (A97E2(I), I = 1,54)
WRITE (NUVI, 70040) (A97E2(I), I= 55,97)
0131 CONTINUE
CT014* TEST 14 POSITIONAL EDITING
IVTNUM = 14
AVB = .TRUE.
AVS = 10.98
A8VK = 'THISISIT'
AVD = 3.4945D2
BVS = 3.4945
KVI = 3
WRITE(UNIT=A97VK,FMT=39312) AVB, AVS, A8VK, AVD, BVS, KVI
39312 FORMAT(L1,T5,F5.2,A8,TR2,E10.4E2,TL10,F6.4,6X,I1)
IVCOMP = 0
IF (A97VK.EQ.'T 10.98THISISIT 3.4945E+03 3')
1 IVCOMP = 1
IF (IVCOMP - 1) 20140, 10140, 20140
10140 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0141
20140 IVFAIL = IVFAIL + 1
CVCORR = 'T 10.98THISISIT 3.4945E+03 3'
WRITE (NUVI, 80008) IVTNUM
WRITE (NUVI, 70010) (A97E1(I), I = 1,54)
WRITE (NUVI, 70020) (A97E1(I), I= 55,97)
WRITE (NUVI, 70030) (A97E2(I), I = 1,54)
WRITE (NUVI, 70040) (A97E2(I), I= 55,97)
0141 CONTINUE
CT015* TEST 15 COLON AND SIGN
IVTNUM = 15
AVB = .TRUE.
AVS = 98.11
A8VK = 'THISISIT'
AVD = 3.4945D2
KVI = 33
WRITE(UNIT=A97VK,FMT=39313) AVB, AVS, A8VK, AVD, KVI
39313 FORMAT(L1,S,F7.2,A8,SP,D11.5,6X,SS,I2,:,F9.3)
IVCOMP = 0
AVCORR(1) = 'T 98.11THISISIT+.34945D+03 33'
AVCORR(2) = 'T 98.11THISISIT+.34945E+03 33'
AVCORR(3) = 'T 98.11THISISIT+.34945+003 33'
DO 40151 I = 1, 3
IF (A97VK.EQ.AVCORR(I)) IVCOMP = 1
IF (IVCOMP - 1) 40151, 10150, 40151
40151 CONTINUE
GO TO 20150
10150 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0151
20150 IVFAIL = IVFAIL + 1
CVCORR = 'T 98.11THISISIT+.34945D+03 33'
REMRKS = 'COMPUTED VALUE NOT CONSISTENT'
WRITE (NUVI, 80008) IVTNUM, REMRKS
REMRKS = 'WITH PERMISSIBLE OPTIONS ABOVE'
WRITE (NUVI, 80050) REMRKS
WRITE (NUVI, 70010) (A97E1(I), I = 1,54)
WRITE (NUVI, 70020) (A97E1(I), I= 55,97)
WRITE (NUVI, 70030) (A97E2(I), I = 1,54)
WRITE (NUVI, 70040) (A97E2(I), I= 55,97)
0151 CONTINUE
CT016* TEST 16 COMPLEX TYPES INTO VARIABLE
IVTNUM = 16
AVC = (2.343, 34.394)
WRITE(UNIT=A97VK,FMT=39314) AVC
39314 FORMAT(F10.5,1X,F10.5)
IVCOMP = 0
AVCORR(1) = ' 2.34300 34.39400'
AVCORR(2) = ' 2.34300 +34.39400'
AVCORR(3) = ' +2.34300 34.39400'
AVCORR(4) = ' +2.34300 +34.39400'
DO 40161 I = 1, 4
IF (A97VK.EQ.AVCORR(I)) IVCOMP = 1
IF (IVCOMP - 1) 40161, 10160, 40161
40161 CONTINUE
GO TO 20160
10160 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0161
20160 IVFAIL = IVFAIL + 1
CVCORR = ' +2.34300 +34.39400'
REMRKS = 'COMPUTED VALUE NOT CONSISTENT'
WRITE (NUVI, 80008) IVTNUM, REMRKS
REMRKS = 'WITH PERMISSIBLE OPTIONS ABOVE'
WRITE (NUVI, 80050) REMRKS
WRITE (NUVI, 70010) (A97E1(I), I = 1,54)
WRITE (NUVI, 70020) (A97E1(I), I= 55,97)
WRITE (NUVI, 70030) (A97E2(I), I = 1,54)
WRITE (NUVI, 70040) (A97E2(I), I= 55,97)
0161 CONTINUE
CT017* TEST 17
IVTNUM = 17
AVC = (34.84, 349.887)
WRITE(UNIT=A97VK,FMT=39315) AVC
39315 FORMAT(E12.5,1X,E12.5)
IVCOMP = 0
IF (A97VK.EQ.' 0.34840E+02 0.34989E+03') IVCOMP = 1
IF (IVCOMP - 1) 20170, 10170, 20170
10170 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0171
20170 IVFAIL = IVFAIL + 1
CVCORR = ' 0.34840E+02 0.34989E+03'
REMRKS = '16 PERMISSIBLE REPRESENTATIONS'
WRITE (NUVI, 80008) IVTNUM, REMRKS
REMRKS = 'SEE NOTES ABOVE'
WRITE (NUVI, 80050) REMRKS
WRITE (NUVI, 70010) (A97E1(I), I = 1,54)
WRITE (NUVI, 70020) (A97E1(I), I= 55,97)
WRITE (NUVI, 70030) (A97E2(I), I = 1,54)
WRITE (NUVI, 70040) (A97E2(I), I= 55,97)
0171 CONTINUE
CT018* TEST 18 LIST OF COMPLEX
IVTNUM = 18
AVC = (2.34, 2.456)
BVC = (2.34, 2.456)
CVC = (2.34, 2.456)
WRITE(UNIT=A97VK,FMT=39316) AVC, BVC, CVC
39316 FORMAT(2(G9.4,1X),2(G10.4E2,1X),2(G11.5E3,1X))
IVCOMP = 0
AVCORR(1) = '2.340 2.456 2.340 2.456 2.3400
1 2.4560'
AVCORR(2) = '2.340 2.456 2.340 +2.456 2.3400
1 2.4560'
AVCORR(3) = '2.340 2.456 +2.340 2.456 2.3400
1 2.4560'
AVCORR(4) = '2.340 2.456 +2.340 +2.456 2.3400
1 2.4560'
DO 40181 I = 1, 4
IF (A97VK.EQ.AVCORR(I)) IVCOMP = 1
IF (IVCOMP - 1) 40181, 10180, 40181
40181 CONTINUE
GO TO 20180
10180 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0181
20180 IVFAIL = IVFAIL + 1
CVCORR = '2.340 2.456 2.340 2.456 2.3400
1 2.4560'
REMRKS = 'COMPUTED VALUE NOT CONSISTENT'
WRITE (NUVI, 80008) IVTNUM, REMRKS
REMRKS = 'WITH PERMISSIBLE OPTIONS ABOVE'
WRITE (NUVI, 80050) REMRKS
WRITE (NUVI, 70010) (A97E1(I), I = 1,54)
WRITE (NUVI, 70020) (A97E1(I), I= 55,97)
WRITE (NUVI, 70030) (A97E2(I), I = 1,54)
WRITE (NUVI, 70040) (A97E2(I), I= 55,97)
0181 CONTINUE
CT019* TEST 19 LIST FROM SUBSTRING
IVTNUM = 19
AVC = (5.6798, 0.9876)
BVC = (5.6798, 0.9876)
CVC = (5.6798, 0.9876)
WRITE(UNIT=A97VK(1:),FMT=39317) AVC, BVC, CVC
39317 FORMAT(2(E6.2E1,1X),1X,2(E7.2E2,1X),1X,2(E9.2E3,1X))
IVCOMP = 0
AVCORR(1) = '.57E+1 .99E+0 .57E+01 .99E+00 .57E+001 .99E+
1000'
AVCORR(2) = '.57E+1 .99E+0 .57E+01 .99E+00 .57E+001 0.99E+
1000'
AVCORR(3) = '.57E+1 .99E+0 .57E+01 .99E+00 .57E+001 +.99E+
1000'
AVCORR(4) = '.57E+1 .99E+0 .57E+01 .99E+00 0.57E+001 .99E+
1000'
AVCORR(5) = '.57E+1 .99E+0 .57E+01 .99E+00 0.57E+001 0.99E+
1000'
AVCORR(6) = '.57E+1 .99E+0 .57E+01 .99E+00 0.57E+001 +.99E+
1000'
AVCORR(7) = '.57E+1 .99E+0 .57E+01 .99E+00 +.57E+001 .99E+
1000'
AVCORR(8) = '.57E+1 .99E+0 .57E+01 .99E+00 +.57E+001 0.99E+
1000'
AVCORR(9) = '.57E+1 .99E+0 .57E+01 .99E+00 +.57E+001 +.99E+
1000'
DO 40191 I = 1, 9
IF (A97VK.EQ.AVCORR(I)) IVCOMP = 1
IF (IVCOMP - 1) 40191, 10190, 40191
40191 CONTINUE
GO TO 20190
10190 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0191
20190 IVFAIL = IVFAIL + 1
CVCORR = '.57E+1 .99E+0 .57E+01 .99E+00 0.57E+001 0.99E+000
1'
REMRKS = 'COMPUTED VALUE NOT CONSISTENT'
WRITE (NUVI, 80008) IVTNUM, REMRKS
REMRKS = 'WITH PERMISSIBLE OPTIONS ABOVE'
WRITE (NUVI, 80050) REMRKS
WRITE (NUVI, 70010) (A97E1(I), I = 1,54)
WRITE (NUVI, 70020) (A97E1(I), I= 55,97)
WRITE (NUVI, 70030) (A97E2(I), I = 1,54)
WRITE (NUVI, 70040) (A97E2(I), I= 55,97)
0191 CONTINUE
CT020* TEST 20 MIXED TYPES
IVTNUM = 20
AVC = (0.934, 34.567)
AVS = 34.65
AVD = 0.6354D1
WRITE(UNIT=A97VK,FMT=39318) AVC, AVS, AVD
39318 FORMAT(F7.3,1X,F7.3,1X,F10.5,1X,E13.5E2)
IVCOMP = 0
IF (A97VK.EQ.' 0.934 34.567 34.65000 0.63540E+01') IVCO
1MP = 1
IF (IVCOMP - 1) 20200, 10200, 20200
10200 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0201
20200 IVFAIL = IVFAIL + 1
CVCORR = ' 0.934 34.567 34.65000 0.63540E+01'
REMRKS = '32 PERMISSIBLE REPRESENTATIONS'
WRITE (NUVI, 80008) IVTNUM, REMRKS
REMRKS = 'SEE NOTES ABOVE'
WRITE (NUVI, 80050) REMRKS
WRITE (NUVI, 70010) (A97E1(I), I = 1,54)
WRITE (NUVI, 70020) (A97E1(I), I= 55,97)
WRITE (NUVI, 70030) (A97E2(I), I = 1,54)
WRITE (NUVI, 70040) (A97E2(I), I= 55,97)
0201 CONTINUE
C*****
WRITE(NUVI, 90002)
WRITE(NUVI, 90013)
WRITE(NUVI, 90014)
C*****
CT021* TEST 21 MIXED TYPES WITH POSITIONAL EDITING
IVTNUM = 21
AVC = (0.345, 34.349)
AVB = .FALSE.
AVD = 34.859D-1
AVS = 10.0
A8VK = '12345678'
WRITE(UNIT=A97VK,FMT=39319) AVC, AVB, AVD, AVS, A8VK
39319 FORMAT(F9.4,1X,E9.4,1X,L1,1X,D12.5,1X,G9.4,A8)
IVCOMP = 0
IF (A97VK.EQ.' 0.3450 .3435E+02 F 0.34859D+01 10.00 123
145678') IVCOMP = 1
IF (IVCOMP - 1) 20210, 10210, 20210
10210 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0211
20210 IVFAIL = IVFAIL + 1
CVCORR = ' 0.3450 .3435E+02 F 0.34859D+01 10.00 1234567
18'
REMRKS = '96 PERMISSIBLE REPRESENTATIONS'
WRITE (NUVI, 80008) IVTNUM, REMRKS
REMRKS = 'SEE NOTES ABOVE'
WRITE (NUVI, 80050) REMRKS
WRITE (NUVI, 70010) (A97E1(I), I = 1,54)
WRITE (NUVI, 70020) (A97E1(I), I= 55,97)
WRITE (NUVI, 70030) (A97E2(I), I = 1,54)
WRITE (NUVI, 70040) (A97E2(I), I= 55,97)
0211 CONTINUE
C***** TESTS 22 - 26 MIXED TYPES INTO 5 RECORDS
CT022* TEST 22
IVTNUM = 22
KVI = 98
AVD = 84.0489D1
AVB = .TRUE.
AVC = (34.0435, 34.94)
A8VK = 'THE LAST'
WRITE(UNIT=A291K,FMT=39320) KVI, AVD, AVB, AVC, A8VK
39320 FORMAT(I5/E10.5E2//1X,L6,2(1X,E10.3)/A8)
IVCOMP = 0
AVCORR(1) = ' 98'
AVCORR(2) = ' +98'
DO 40221 I = 1, 2
IF (A291K(1).EQ.AVCORR(I)) IVCOMP = 1
IF (IVCOMP - 1) 40221, 10220, 40221
40221 CONTINUE
GO TO 20220
10220 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0221
20220 IVFAIL = IVFAIL + 1
CVCORR = ' 98'
REMRKS = 'COMPUTED VALUE NOT CONSISTENT'
WRITE (NUVI, 80008) IVTNUM, REMRKS
REMRKS = 'WITH PERMISSIBLE OPTIONS ABOVE'
WRITE (NUVI, 80050) REMRKS
WRITE (NUVI, 80020) A291K(1)
WRITE (NUVI, 80022) CVCORR
0221 CONTINUE
CT023* TEST 23
IVTNUM = 23
IVCOMP = 0
IF (A291K(2).EQ.'.84049E+03') IVCOMP = 1
IF (IVCOMP - 1) 20230, 10230, 20230
10230 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0231
20230 IVFAIL = IVFAIL + 1
CVCORR = '.84049E+03'
WRITE (NUVI, 80018) IVTNUM, A291K(2), CVCORR
0231 CONTINUE
CT024* TEST 24
IVTNUM = 24
IVCOMP = 0
IF (A291K(3).EQ.' ') IVCOMP = 1
IF (IVCOMP - 1) 20240, 10240, 20240
10240 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0241
20240 IVFAIL = IVFAIL + 1
CVCORR = ' '
WRITE (NUVI, 80018) IVTNUM, A291K(3), CVCORR
0241 CONTINUE
CT025* TEST 25
IVTNUM = 25
IVCOMP = 0
IF (A291K(4).EQ.' T 0.340E+02 0.349E+02') IVCOMP = 1
IF (IVCOMP - 1) 20250, 10250, 20250
10250 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0251
20250 IVFAIL = IVFAIL + 1
CVCORR = ' T 0.340E+02 0.349E+02'
REMRKS = '64 PERMISSIBLE REPRESENTATIONS'
WRITE (NUVI, 80008) IVTNUM, REMRKS
REMRKS = 'SEE NOTES ABOVE'
WRITE (NUVI, 80050) REMRKS
WRITE (NUVI, 70080) A291K(4), CVCORR
70080 FORMAT (1H ,16X,10HCOMPUTED: , A29,/
1 1H ,16X,10HCORRECT: ,A29)
0251 CONTINUE
CT026* TEST 26
IVTNUM = 26
IVCOMP = 0
IF (A291K(5).EQ.'THE LAST') IVCOMP = 1
IF (IVCOMP - 1) 20260, 10260, 20260
10260 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0261
20260 IVFAIL = IVFAIL + 1
CVCORR = 'THE LAST'
WRITE (NUVI, 80018) IVTNUM, A291K(5), CVCORR
0261 CONTINUE
CT027* TEST 27 MIXED TYPES WITH SS, SP, NX, AND :
IVTNUM = 27
JVI = 34
AVS = 34.983
BVS = 345.3
AVD = 95.83D2
AVB = .FALSE.
A8VK = '.FALSE.1'
WRITE(UNIT=A97VK,FMT=39321)JVI, AVS, AVD, AVB, A8VK, BVS
39321 FORMAT(S,I2,1X,SP,F7.3,SS,1X,D10.5,L2,1X,A8,1X,E10.5,:,I5,F10.4)
IVCOMP = 0
AVCORR(1) = '34 +34.983 .95830D+04 F .FALSE.1 .34530E+03'
AVCORR(2) = '34 +34.983 .95830D+04 F .FALSE.1 .34530+003'
AVCORR(3) = '34 +34.983 .95830E+04 F .FALSE.1 .34530E+03'
AVCORR(4) = '34 +34.983 .95830E+04 F .FALSE.1 .34530+003'
AVCORR(5) = '34 +34.983 .95830+004 F .FALSE.1 .34530E+03'
AVCORR(6) = '34 +34.983 .95830+004 F .FALSE.1 .34530+003'
DO 40271 I = 1, 6
IF (A97VK.EQ.AVCORR(I)) IVCOMP = 1
IF (IVCOMP - 1) 40271, 10270, 40271
40271 CONTINUE
GO TO 20270
10270 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0271
20270 IVFAIL = IVFAIL + 1
CVCORR = '34 +34.983 .95830D+04 F .FALSE.1 .34530E+03'
REMRKS = 'COMPUTED VALUE NOT CONSISTENT'
WRITE (NUVI, 80008) IVTNUM, REMRKS
REMRKS = 'WITH PERMISSIBLE OPTIONS ABOVE'
WRITE (NUVI, 80050) REMRKS
WRITE (NUVI, 70010) (A97E1(I), I = 1,54)
WRITE (NUVI, 70020) (A97E1(I), I= 55,97)
WRITE (NUVI, 70030) (A97E2(I), I = 1,54)
WRITE (NUVI, 70040) (A97E2(I), I= 55,97)
0271 CONTINUE
C*****
CBB** ********************** BBCSUM0 **********************************
C**** WRITE OUT TEST SUMMARY
C****
IVTOTN = IVPASS + IVFAIL + IVDELE + IVINSP
WRITE (I02, 90004)
WRITE (I02, 90014)
WRITE (I02, 90004)
WRITE (I02, 90020) IVPASS
WRITE (I02, 90022) IVFAIL
WRITE (I02, 90024) IVDELE
WRITE (I02, 90026) IVINSP
WRITE (I02, 90028) IVTOTN, IVTOTL
CBE** ********************** BBCSUM0 **********************************
CBB** ********************** BBCFOOT0 **********************************
C**** WRITE OUT REPORT FOOTINGS
C****
WRITE (I02,90016) ZPROG, ZPROG
WRITE (I02,90018) ZPROJ, ZNAME, ZTAPE, ZTAPED
WRITE (I02,90019)
CBE** ********************** BBCFOOT0 **********************************
CBB** ********************** BBCFMT0A **********************************
C**** FORMATS FOR TEST DETAIL LINES
C****
80000 FORMAT (1H ,2X,I3,4X,7HDELETED,32X,A31)
80002 FORMAT (1H ,2X,I3,4X,7H PASS ,32X,A31)
80004 FORMAT (1H ,2X,I3,4X,7HINSPECT,32X,A31)
80008 FORMAT (1H ,2X,I3,4X,7H FAIL ,32X,A31)
80010 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,15X,10HCOMPUTED= ,
1I6,/,1H ,15X,10HCORRECT= ,I6)
80012 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
1E12.5,/,1H ,16X,10HCORRECT= ,E12.5)
80018 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
1A21,/,1H ,16X,10HCORRECT= ,A21)
80020 FORMAT (1H ,16X,10HCOMPUTED= ,A21,1X,A31)
80022 FORMAT (1H ,16X,10HCORRECT= ,A21,1X,A31)
80024 FORMAT (1H ,16X,10HCOMPUTED= ,I6,16X,A31)
80026 FORMAT (1H ,16X,10HCORRECT= ,I6,16X,A31)
80028 FORMAT (1H ,16X,10HCOMPUTED= ,E12.5,10X,A31)
80030 FORMAT (1H ,16X,10HCORRECT= ,E12.5,10X,A31)
80050 FORMAT (1H ,48X,A31)
CBE** ********************** BBCFMT0A **********************************
CBB** ********************** BBCFMAT1 **********************************
C**** FORMATS FOR TEST DETAIL LINES - FULL LANGUAGE
C****
80031 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
1D17.10,/,1H ,16X,10HCORRECT= ,D17.10)
80033 FORMAT (1H ,16X,10HCOMPUTED= ,D17.10,10X,A31)
80035 FORMAT (1H ,16X,10HCORRECT= ,D17.10,10X,A31)
80037 FORMAT (1H ,16X,10HCOMPUTED= ,1H(,E12.5,2H, ,E12.5,1H),6X,A31)
80039 FORMAT (1H ,16X,10HCORRECT= ,1H(,E12.5,2H, ,E12.5,1H),6X,A31)
80041 FORMAT (1H ,16X,10HCOMPUTED= ,1H(,F12.5,2H, ,F12.5,1H),6X,A31)
80043 FORMAT (1H ,16X,10HCORRECT= ,1H(,F12.5,2H, ,F12.5,1H),6X,A31)
80045 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
11H(,F12.5,2H, ,F12.5,1H)/,1H ,16X,10HCORRECT= ,
21H(,F12.5,2H, ,F12.5,1H))
CBE** ********************** BBCFMAT1 **********************************
CBB** ********************** BBCFMT0B **********************************
C**** FORMAT STATEMENTS FOR PAGE HEADERS
C****
90002 FORMAT (1H1)
90004 FORMAT (1H )
90006 FORMAT (1H ,20X,31HFEDERAL SOFTWARE TESTING CENTER)
90007 FORMAT (1H ,19X,34HFORTRAN COMPILER VALIDATION SYSTEM)
90008 FORMAT (1H ,21X,A13,A17)
90009 FORMAT (1H ,/,2H *,A5,6HBEGIN*,12X,15HTEST RESULTS - ,A5,/)
90010 FORMAT (1H ,8X,16HTEST DATE*TIME= ,A17,15H - COMPILER= ,A20)
90013 FORMAT (1H ,8H TEST ,10HPASS/FAIL ,6X,17HDISPLAYED RESULTS,
1 7X,7HREMARKS,24X)
90014 FORMAT (1H ,46H----------------------------------------------,
1 33H---------------------------------)
90015 FORMAT (1H ,48X,17HTHIS PROGRAM HAS ,I3,6H TESTS,/)
C****
C**** FORMAT STATEMENTS FOR REPORT FOOTINGS
C****
90016 FORMAT (1H ,/,2H *,A5,4HEND*,14X,14HEND OF TEST - ,A5,/)
90018 FORMAT (1H ,A13,13X,A20,7H * ,A10,1H/,
1 A13)
90019 FORMAT (1H ,26HFOR OFFICIAL USE ONLY ,35X,15HCOPYRIGHT 1982)
C****
C**** FORMAT STATEMENTS FOR RUN SUMMARY
C****
90020 FORMAT (1H ,21X,I5,13H TESTS PASSED)
90022 FORMAT (1H ,21X,I5,13H TESTS FAILED)
90024 FORMAT (1H ,21X,I5,14H TESTS DELETED)
90026 FORMAT (1H ,21X,I5,25H TESTS REQUIRE INSPECTION)
90028 FORMAT (1H ,21X,I5,4H OF ,I3,15H TESTS EXECUTED)
CBE** ********************** BBCFMT0B **********************************
C*****
C***** END OF TEST SEGMENT 393
STOP
END
*END-OF,FM909
FM910.f 481036654 170 2 100666 24170 `
*HEADER,FORTR,FM910
*FILES1,FORTR,FM910
C***********************************************************************
C***** FM910
C***** DIRAF2 - (411)
C***** THIS PROGRAM CALLS SUBROUTINE SN911 IN FILE FM911
C***********************************************************************
C***** TESTING OF DIRECT ACCESS FILES ANS REF
C***** UNFORMATTED WITH BOTH SEQUENTIAL AND DIRECT 12.5
C***** ACCESS TO THE SAME FILE
C***** NAMED FILE AND SCRATCH FILE
C*****
C***** USES SUBROUTINE SN911
C*****
CBB** ********************** BBCCOMNT **********************************
C****
C**** 1978 FORTRAN COMPILER VALIDATION SYSTEM
C**** VERSION 2.0
C****
C****
C**** SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO
C**** GENERAL SERVICES ADMINISTRATION
C**** FEDERAL SOFTWARE TESTING CENTER
C**** 5203 LEESBURG PIKE, SUITE 1100
C**** FALLS CHURCH, VA. 22041
C****
C**** (703) 756-6153
C****
CBE** ********************** BBCCOMNT **********************************
C*****
C***** S P E C I F I C A T I O N S SEGMENT 910
DIMENSION L1I(10), N1I(15), F1S(10), H1S(15)
CHARACTER*4 A4VK, B4VK, D4VK, A41K(10), C41K(15)
LOGICAL AVB, BVB, C1B(10), E1B(15)
DOUBLE PRECISION AVD, BVD, D1D(10), B1D(15)
COMPLEX AVC, BVC, C1C(10), D1C(15)
C*****
C***** BELOW CHARACTER STATEMENT ESTABLISHES THE FILE NAME VARIABLES.
CX20 REPLACED BY FEXEC X-20 CONTROL CARD. X-20 IS FOR REPLACING
CHARACTER*15 CDIR
C THE CHARACTER STATEMENT FOR FILE NAMES ASSOCIATED WITH X-100
C (PROGRAM VARIABLE CDIR) IF NOT VALID FOR THE PROCESSOR.
CBB** ********************** BBCINITA **********************************
C**** SPECIFICATION STATEMENTS
C****
CHARACTER ZVERS*13, ZVERSD*17, ZDATE*17, ZPROG*5, ZCOMPL*20,
1 ZNAME*20, ZTAPE*10, ZPROJ*13, REMRKS*31, ZTAPED*13
CBE** ********************** BBCINITA **********************************
CBB** ********************** BBCINITB **********************************
C**** INITIALIZE SECTION
DATA ZVERS, ZVERSD, ZDATE
1 /'VERSION 2.0 ', '82/08/02*18.33.46', '*NO DATE*TIME'/
DATA ZCOMPL, ZNAME, ZTAPE
1 /'*NONE SPECIFIED*', '*NO COMPANY NAME*', '*NO TAPE*'/
DATA ZPROJ, ZTAPED, ZPROG
1 /'*NO PROJECT*', '*NO TAPE DATE', 'XXXXX'/
DATA REMRKS /' '/
C**** THE FOLLOWING 9 COMMENT LINES (CZ01, CZ02, ...) CAN BE REPLACED
C**** FOR IDENTIFYING THE TEST ENVIRONMENT
C****
CZ01 ZVERS = 'VERSION OF THE COMPILER VALIDATION SYSTEM'
CZ02 ZVERSD = 'CREATION DATE/TIME OF THE COMPILER VALIDATION SYSTEM'
CZ03 ZPROG = 'PROGRAM NAME'
CZ04 ZDATE = 'DATE OF TEST'
CZ05 ZCOMPL = 'COMPILER IDENTIFICATION'
CZ06 ZPROJ = 'PROJECT NUMBER/IDENTIFICATION'
CZ07 ZNAME = 'NAME OF USER'
CZ08 ZTAPE = 'TAPE OWNER/ID'
CZ09 ZTAPED = 'DATE TAPE COPIED'
C
IVPASS = 0
IVFAIL = 0
IVDELE = 0
IVINSP = 0
IVTOTL = 0
IVTOTN = 0
ICZERO = 0
C
C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER.
I01 = 05
C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER.
I02 = 06
C
CX010 REPLACED BY FEXEC X-010 CONTROL CARD (CARD-READER UNIT NUMBER).
C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5
CX011 REPLACED BY FEXEC X-011 CONTROL CARD. CX011 IS FOR SYSTEMS
C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX010.
C
CX020 REPLACED BY FEXEC X-020 CONTROL CARD (PRINTER UNIT NUMBER).
C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02= 6
CX021 REPLACED BY FEXEC X-021 CONTROL CARD. CX021 IS FOR SYSTEMS
C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX020.
C
CBE** ********************** BBCINITB **********************************
C*****
C***** THE FOLLOWING STATEMENT MUST BE CHANGED IF THE
C***** UNITS GIVEN ARE NOT CAPABLE OF BEING OPENED AS SPECIFIED.
C*****
C I10 CONTAINS THE UNIT NUMBER FOR A NAMED DIRECT ACCESS FILE.
I10 = 11
CX100 REPLACED BY FEXEC X-100 CONTROL CARD (DIR. FILE UNIT NUMBER).
C SPECIFYING I10 = NN OVERRIDES THE DEFAULT I10 = 24.
C*****
C I11 CONTAINS THE UNIT NUMBER FOR A SCRATCH DIRECT ACCESS FILE.
I11 = 10
CX110 REPLACED BY FEXEC X-110 CONTROL CARD (DIR. FILE UNIT NUMBER).
C SPECIFYING I11 = NN OVERRIDES THE DEFAULT I11 = 25.
C*****
C***** THE FOLLOWING STATEMENT MUST BE CHANGED IF THE NAME
C***** GIVEN IS NOT A VALID FILE SPECIFIER FOR A DIRECT,
C***** UNFORMATTED FILE.
C*****
C CDIR CONTAINS THE FILE NAME FOR UNIT I10.
CDIR = 'DIRFILE'
C
CX201 REPLACED BY FEXEC X-201 CONTROL CARD. CX201 IS FOR SYSTEMS
C REQUIRING A DIFFERENT FILE SPECIFIER FOR FILES ASSOCIATED WITH
C X-100 THAN THE DEFAULT CDIR = ' DIRFILE'.
C***** FILE NUMBER AND NAME ASSIGNMENT
NUVI = I02
IMVI = I10
KMVI = I11
IVTOTL = 6
ZPROG = 'FM910'
CBB** ********************** BBCHED0A **********************************
C****
C**** WRITE REPORT TITLE
C****
WRITE (I02, 90002)
WRITE (I02, 90006)
WRITE (I02, 90007)
WRITE (I02, 90008) ZVERS, ZVERSD
WRITE (I02, 90009) ZPROG, ZPROG
WRITE (I02, 90010) ZDATE, ZCOMPL
CBE** ********************** BBCHED0A **********************************
C*****
C***** HEADER FOR SEGMENT 910
WRITE(NUVI,41100)
41100 FORMAT(1H ,/46H DIRAF2 - (411) DIRECT ACCESS UNFORMATTED FILE//
1 41H WITH OPTION TO OPEN AS A SEQUENTIAL FILE//
2 16H ANS REF. - 12.5)
CBB** ********************** BBCHED0B **********************************
C**** WRITE DETAIL REPORT HEADERS
C****
WRITE (I02,90004)
WRITE (I02,90004)
WRITE (I02,90013)
WRITE (I02,90014)
WRITE (I02,90015) IVTOTL
CBE** ********************** BBCHED0B **********************************
C***** INITIALIZE DATA
CALL SN911(L1I,N1I,F1S,H1S,C1B,E1B,D1D,B1D,C1C,D1C,A41K,C41K)
MMVI = 0
C*****
OPEN(FILE=CDIR, UNIT=IMVI, ACCESS='DIRECT',RECL=132,
1 STATUS='NEW')
C***** WRITE DIRECT FILE IN SEQUENTIAL ORDER
DO 41101 IVI = 1,10
AVS = F1S (IVI)
A4VK = A41K (IVI)
AVB = C1B (IVI)
AVD = D1D (IVI)
AVC = C1C (IVI)
WRITE(UNIT=IMVI, REC= IVI) IVI, AVS, A4VK, AVB, AVD, AVC
41101 CONTINUE
C***** CHECK TO SEE IF IT CAN BE OPEN SEQUENTIAL
INQUIRE(UNIT=IMVI,SEQUENTIAL=D4VK)
CLOSE(UNIT=IMVI)
IF(D4VK .EQ. 'YES ') GOTO 41103
WRITE(NUVI,41102)
41102 FORMAT(1H ,48X,31HTESTS 2 THRU 6 ARE EXPECTED TO /
1 1H ,48X,31HEXECUTE /
2 1H ,48X,31HTEST 1 IS OPTIONAL AND IS NOT /
3 1H ,48X,31HEXECUTED IF DIRECT ACCESS /
4 1H ,48X,31HFILE CANNOT BE REOPENED AS /
5 1H ,48X,31HA SEQUENTIAL FILE )
GOTO 41119
CT001* TEST 1 READ IT SEQUENTIALY
41103 IVTNUM = 1
IVCOMP = 0
OPEN(FILE=CDIR, UNIT=IMVI, ACCESS='SEQUENTIAL', STATUS='OLD',
1 FORM='UNFORMATTED')
REWIND(UNIT=IMVI)
DO 41104 IVI = 1, 10
READ(UNIT=IMVI) KVI, BVS, B4VK, BVB, BVD, BVC
IF (IVI .NE. KVI) GOTO 20010
IF (BVS .LT. F1S(IVI) .OR. BVS .GT. F1S(IVI)) GOTO 20010
IF (B4VK .NE. A41K(IVI)) GOTO 20010
IF ((BVB .AND. .NOT. C1B(IVI)) .OR.
1 (.NOT. BVB .AND. C1B(IVI))) GOTO 20010
IF (BVD .LT. D1D(IVI) .OR. BVD .GT. D1D(IVI)) GOTO 20010
IF ((REAL(BVC) .LT. REAL(C1C(IVI))) .OR. (REAL(BVC) .GT.
1 REAL(C1C(IVI))) .OR. (AIMAG(BVC) .LT. AIMAG(C1C(IVI)))
2 .OR. (AIMAG(BVC) .GT. AIMAG(C1C(IVI)))) GOTO 20010
GO TO 41104
20010 IVCOMP = IVCOMP + 1
IF (IVCOMP .LE. 1) IVFAIL = IVFAIL + 1
WRITE (NUVI, 70010) IVTNUM, IVI
WRITE (NUVI, 70020) KVI, BVS, B4VK, BVB, BVD, BVC, IVI,
1 F1S(IVI), A41K(IVI), C1B(IVI), D1D(IVI),
1 C1C(IVI)
70010 FORMAT (1H ,2X,I3,4X,13H FAIL ON REC ,I2)
70020 FORMAT (1H ,16X,10HCOMPUTED: ,I2,1X,F5.2,1X,A4,1X,L1,1X,
1 D10.3,1X,1H(,F6.3,2H, ,F6.3,1H)/
1 1H ,16X,10HCORRECT: ,I2,1X,F5.2,1X,A4,1X,L1,1X,
1 D10.3,1X,1H(,F6.3,2H, ,F6.3,1H))
41104 CONTINUE
IF (IVCOMP - 0) 0011, 10010, 0011
10010 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
0011 CONTINUE
C*****
41118 CLOSE(UNIT=IMVI)
CT002* TEST 2 REOPEN AS DIRECT FILE,
C***** AND READ IN SEQUENTIAL ORDER
41119 IVTNUM = 2
IVCOMP = 0
C*****
OPEN(FILE=CDIR, UNIT=IMVI, ACCESS='DIRECT', STATUS='OLD',
1 RECL=132)
DO 41120 IVI = 1, 10
READ(UNIT=IMVI, REC = IVI) KVI, BVS, B4VK, BVB, BVD, BVC
IF (IVI .NE. KVI) GOTO 20020
IF (BVS .LT. F1S(IVI) .OR. BVS .GT. F1S(IVI)) GOTO 20020
IF (B4VK .NE. A41K(IVI)) GOTO 20020
IF ((BVB .AND. .NOT. C1B(IVI)) .OR.
1 (.NOT. BVB .AND. C1B(IVI))) GOTO 20020
IF (BVD .LT. D1D(IVI) .OR. BVD .GT. D1D(IVI)) GOTO 20020
IF ((REAL(BVC) .LT. REAL(C1C(IVI))) .OR. (REAL(BVC) .GT.
1 REAL(C1C(IVI))) .OR. (AIMAG(BVC) .LT. AIMAG(C1C(IVI)))
2 .OR. (AIMAG(BVC) .GT. AIMAG(C1C(IVI)))) GOTO 20020
GO TO 41120
20020 IVCOMP = IVCOMP + 1
IF (IVCOMP .LE. 1) IVFAIL = IVFAIL + 1
WRITE (NUVI, 70010) IVTNUM, IVI
WRITE (NUVI, 70020) KVI, BVS, B4VK, BVB, BVD, BVC, IVI,
1 F1S(IVI), A41K(IVI), C1B(IVI), D1D(IVI),
1 C1C(IVI)
41120 CONTINUE
IF (IVCOMP - 0) 0021, 10020, 0021
10020 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
0021 CONTINUE
C*****
41121 CLOSE(UNIT=IMVI)
CT003* TEST 3 READ IT AS DIRECT
C***** FILE IN NONSEQUENTIAL ORDER
IVTNUM = 3
IVCOMP = 0
C*****
OPEN(FILE=CDIR, UNIT=IMVI, ACCESS='DIRECT', STATUS='OLD',
1 RECL=132)
DO 41122 IVI = 1, 10
JVI = L1I(IVI)
READ(UNIT=IMVI, REC = JVI) KVI, BVS, B4VK, BVB, BVD, BVC
IF (KVI .NE. JVI) GOTO 20030
IF (BVS .LT. F1S(JVI) .OR. BVS .GT. F1S(JVI)) GOTO 20030
IF (B4VK .NE. A41K(JVI)) GOTO 20030
IF ((BVB .AND. .NOT. C1B(JVI)) .OR.
1 (.NOT. BVB .AND. C1B(JVI))) GOTO 20030
IF (BVD .LT. D1D(JVI) .OR. BVD .GT. D1D(JVI)) GOTO 20030
IF ((REAL(BVC) .LT. REAL(C1C(JVI))) .OR. (REAL(BVC) .GT.
1 REAL(C1C(JVI))) .OR. (AIMAG(BVC) .LT. AIMAG(C1C(JVI)))
2 .OR. (AIMAG(BVC) .GT. AIMAG(C1C(JVI)))) GOTO 20030
GO TO 41122
20030 IVCOMP = IVCOMP + 1
IF (IVCOMP .LE. 1) IVFAIL = IVFAIL + 1
WRITE (NUVI, 70010) IVTNUM, JVI
WRITE (NUVI, 70020) KVI, BVS, B4VK, BVB, BVD, BVC, JVI,
1 F1S(JVI), A41K(JVI), C1B(JVI), D1D(JVI),
1 C1C(JVI)
41122 CONTINUE
IF (IVCOMP - 0) 0031, 10030, 0031
10030 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
0031 CONTINUE
C*****
41123 OPEN(UNIT=KMVI, ACCESS='DIRECT', RECL=80, STATUS='SCRATCH')
C*****
CT004* TEST 4 CHECK RECL AND NEXTREC ON SCRATCH FILE
IVTNUM = 4
INQUIRE(UNIT=KMVI,RECL=IVI,NEXTREC=KVI)
IF (IVI .NE. 80) GOTO 20040
IF (KVI .NE. 1) GOTO 20040
10040 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0041
20040 IVFAIL = IVFAIL + 1
WRITE (NUVI, 70030) IVTNUM
WRITE (NUVI, 70040) IVI, KVI
70030 FORMAT (1H ,2X,I3,4X,28H FAIL ON RECL AND/OR NEXTREC)
70040 FORMAT (1H ,16X,16HCOMPUTED: RECL=,I4,10H, NEXTREC=,I4/
1 1H ,16X,34HCORRECT: RECL= 80, NEXTREC= 1)
0041 CONTINUE
C*****
C***** WRITE DIRECT ACCESS
C***** SCRATCH FILE IN NONSEQUENTIAL ORDER
DO 41126 IVI = 1,15
JVI = N1I (IVI)
AVS = H1S (JVI)
A4VK = C41K (JVI)
AVB = E1B (JVI)
AVC = D1C(JVI)
AVD = B1D(JVI)
WRITE(UNIT=KMVI, REC= JVI) AVB, AVC, A4VK, JVI, AVD, AVS
41126 CONTINUE
CT005* TEST 5 CHECK DIRECT ACCESS SCRATCH FILE
C***** BY READING IT IN NONSEQUENTIAL ORDER
IVTNUM = 5
IVCOMP = 0
MMVI = -1
DO 41127 IVI = 15,1,-1
JVI = N1I (IVI)
READ(UNIT=KMVI, REC = JVI) BVB, BVC, B4VK, KVI, BVD, BVS
IF (KVI .NE. JVI) GOTO 20050
IF (BVS .LT. H1S(JVI) .OR. BVS .GT. H1S(JVI)) GOTO 20050
IF (B4VK .NE. C41K(JVI)) GOTO 20050
IF ((BVB .AND. .NOT. E1B(JVI)) .OR.
1 (.NOT. BVB .AND. E1B(JVI))) GOTO 20050
IF (BVD .LT. B1D(JVI) .OR. BVD .GT. B1D(JVI)) GOTO 20050
IF ((REAL(BVC) .LT. REAL(D1C(JVI))) .OR. (REAL(BVC) .GT.
1 REAL(D1C(JVI))) .OR. (AIMAG(BVC) .LT. AIMAG(D1C(JVI)))
2 .OR. (AIMAG(BVC) .GT. AIMAG(D1C(JVI)))) GOTO 20050
GO TO 41127
20050 IVCOMP = IVCOMP + 1
IF (IVCOMP .LE. 1) IVFAIL = IVFAIL + 1
WRITE (NUVI, 70010) IVTNUM, JVI
WRITE (NUVI, 70020) KVI, BVS, B4VK, BVB, BVD, BVC, JVI,
1 H1S(JVI), C41K(JVI), E1B(JVI), B1D(JVI),
1 D1C(JVI)
41127 CONTINUE
IF (IVCOMP - 0) 0051, 10050, 0051
10050 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
0051 CONTINUE
C*****
CT006* TEST 6 CHECK RECL AND NEXTREC AFTER READING
IVTNUM = 6
INQUIRE(UNIT=KMVI,RECL=IVI,NEXTREC=KVI)
IF (IVI .NE. 80) GOTO 20060
IF (KVI .NE. 6) GOTO 20060
10060 IVPASS = IVPASS + 1
WRITE (NUVI, 80002) IVTNUM
GO TO 0061
20060 IVFAIL = IVFAIL + 1
WRITE (NUVI, 70050) IVTNUM
WRITE (NUVI, 70060) IVI, KVI
70050 FORMAT (1H ,2X,I3,4X,28H FAIL ON RECL AND/OR NEXTREC)
70060 FORMAT (1H ,16X,16HCOMPUTED: RECL=,I4,10H, NEXTREC=,I4/
1 1H ,16X,34HCORRECT: RECL= 80, NEXTREC= 6)
0061 CONTINUE
C*****
CLOSE (UNIT=KMVI, STATUS = 'DELETE')
C*****
C THE FOLLOWING SOURCE CODE BRACKETED BY THE COMMENT LINES
C ***** BEGIN-FILE-DUMP SECTION ***** AND ***** END-FILE-DUMP
C SECTION ***** IS USED TO DUMP THE DATA FILE USED BY THIS
C ROUTINE. THIS CODE IS OPTIONAL CODE AND IS ONLY USED IF THERE
C IS A NEED TO PRINT THE CONTENT OF THE RECORDS FOR THE FILE.
C THE CODE CAN BE SELECTED BY THE EXECUTIVE ROUTINE TO BE INCLUDED
C IN THE COMPILED PROGRAM FOR EXECUTION BY USING THE *OPT1
C EXECUTIVE ROUTINE CONTROL CARD. IF THE *OPT1 CONTROL CARD IS
C NOT SPECIFIED THE DEFAULT WILL BE TO AUTOMATICALLY CHANGE
C THIS CODE TO PROGRAM COMMENTS. IF THIS CODE IS SELECTED THE
C ROUTINE WILL DUMP THE CONTENTS OF THE FILE TO THE PRINTER FILE
C FOLLOWING THE TEST REPORT AND BEFORE THE TEST REPORT SUMMARY.
C
CDB** *** BEGIN-FILE-DUMP SECTION ***
C ITOTR = 10
C ILUN = I10
C IRLGN = 132
C IRNUM = 1
C7701 FORMAT (132A1)
C7702 FORMAT (1X,132A1)
C DO 7771 IRNUM = 1, ITOTR
C READ (ILUN, REC = IRNUM) (IDUMP(ICH), ICH = 1, IRLGN)
C WRITE (I02,7702) (IDUMP(ICH), ICH = 1, IRLGN)
C7771 CONTINUE
C7772 CONTINUE
CDE** *** END-FILE-DUMP SECTION ***
C****
C*****
C THE FOLLOWING SOURCE CODE BRACKETED BY THE COMMENT LINES
C ***** BEGIN-FILE-DUMP SECTION ***** AND ***** END-FILE-DUMP
C SECTION ***** IS USED TO DUMP THE DATA FILE USED BY THIS
C ROUTINE. THIS CODE IS OPTIONAL CODE AND IS ONLY USED IF THERE
C IS A NEED TO PRINT THE CONTENT OF THE RECORDS FOR THE FILE.
C THE CODE CAN BE SELECTED BY THE EXECUTIVE ROUTINE TO BE INCLUDED
C IN THE COMPILED PROGRAM FOR EXECUTION BY USING THE *OPT1
C EXECUTIVE ROUTINE CONTROL CARD. IF THE *OPT1 CONTROL CARD IS
C NOT SPECIFIED THE DEFAULT WILL BE TO AUTOMATICALLY CHANGE
C THIS CODE TO PROGRAM COMMENTS. IF THIS CODE IS SELECTED THE
C ROUTINE WILL DUMP THE CONTENTS OF THE FILE TO THE PRINTER FILE
C FOLLOWING THE TEST REPORT AND BEFORE THE TEST REPORT SUMMARY.
C
CDB** *** BEGIN-FILE-DUMP SECTION ***
C ITOTR = 15
C ILUN = I11
C IRLGN = 80
C IRNUM = 1
C7702 FORMAT (80A1)
C7704 FORMAT (1X,80A1)
C DO 7773 IRNUM = 1, ITOTR
C READ (ILUN, REC = IRNUM) (IDUMP(ICH), ICH = 1, IRLGN)
C WRITE (I02,7704) (IDUMP(ICH), ICH = 1, IRLGN)
C7773 CONTINUE
C7774 CONTINUE
CDE** *** END-FILE-DUMP SECTION ***
C****
CBB** ********************** BBCSUM0 **********************************
C**** WRITE OUT TEST SUMMARY
C****
IVTOTN = IVPASS + IVFAIL + IVDELE + IVINSP
WRITE (I02, 90004)
WRITE (I02, 90014)
WRITE (I02, 90004)
WRITE (I02, 90020) IVPASS
WRITE (I02, 90022) IVFAIL
WRITE (I02, 90024) IVDELE
WRITE (I02, 90026) IVINSP
WRITE (I02, 90028) IVTOTN, IVTOTL
CBE** ********************** BBCSUM0 **********************************
CBB** ********************** BBCFOOT0 **********************************
C**** WRITE OUT REPORT FOOTINGS
C****
WRITE (I02,90016) ZPROG, ZPROG
WRITE (I02,90018) ZPROJ, ZNAME, ZTAPE, ZTAPED
WRITE (I02,90019)
CBE** ********************** BBCFOOT0 **********************************
CBB** ********************** BBCFMT0A **********************************
C**** FORMATS FOR TEST DETAIL LINES
C****
80000 FORMAT (1H ,2X,I3,4X,7HDELETED,32X,A31)
80002 FORMAT (1H ,2X,I3,4X,7H PASS ,32X,A31)
80004 FORMAT (1H ,2X,I3,4X,7HINSPECT,32X,A31)
80008 FORMAT (1H ,2X,I3,4X,7H FAIL ,32X,A31)
80010 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,15X,10HCOMPUTED= ,
1I6,/,1H ,15X,10HCORRECT= ,I6)
80012 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
1E12.5,/,1H ,16X,10HCORRECT= ,E12.5)
80018 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
1A21,/,1H ,16X,10HCORRECT= ,A21)
80020 FORMAT (1H ,16X,10HCOMPUTED= ,A21,1X,A31)
80022 FORMAT (1H ,16X,10HCORRECT= ,A21,1X,A31)
80024 FORMAT (1H ,16X,10HCOMPUTED= ,I6,16X,A31)
80026 FORMAT (1H ,16X,10HCORRECT= ,I6,16X,A31)
80028 FORMAT (1H ,16X,10HCOMPUTED= ,E12.5,10X,A31)
80030 FORMAT (1H ,16X,10HCORRECT= ,E12.5,10X,A31)
80050 FORMAT (1H ,48X,A31)
CBE** ********************** BBCFMT0A **********************************
CBB** ********************** BBCFMAT1 **********************************
C**** FORMATS FOR TEST DETAIL LINES - FULL LANGUAGE
C****
80031 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
1D17.10,/,1H ,16X,10HCORRECT= ,D17.10)
80033 FORMAT (1H ,16X,10HCOMPUTED= ,D17.10,10X,A31)
80035 FORMAT (1H ,16X,10HCORRECT= ,D17.10,10X,A31)
80037 FORMAT (1H ,16X,10HCOMPUTED= ,1H(,E12.5,2H, ,E12.5,1H),6X,A31)
80039 FORMAT (1H ,16X,10HCORRECT= ,1H(,E12.5,2H, ,E12.5,1H),6X,A31)
80041 FORMAT (1H ,16X,10HCOMPUTED= ,1H(,F12.5,2H, ,F12.5,1H),6X,A31)
80043 FORMAT (1H ,16X,10HCORRECT= ,1H(,F12.5,2H, ,F12.5,1H),6X,A31)
80045 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
11H(,F12.5,2H, ,F12.5,1H)/,1H ,16X,10HCORRECT= ,
21H(,F12.5,2H, ,F12.5,1H))
CBE** ********************** BBCFMAT1 **********************************
CBB** ********************** BBCFMT0B **********************************
C**** FORMAT STATEMENTS FOR PAGE HEADERS
C****
90002 FORMAT (1H1)
90004 FORMAT (1H )
90006 FORMAT (1H ,20X,31HFEDERAL SOFTWARE TESTING CENTER)
90007 FORMAT (1H ,19X,34HFORTRAN COMPILER VALIDATION SYSTEM)
90008 FORMAT (1H ,21X,A13,A17)
90009 FORMAT (1H ,/,2H *,A5,6HBEGIN*,12X,15HTEST RESULTS - ,A5,/)
90010 FORMAT (1H ,8X,16HTEST DATE*TIME= ,A17,15H - COMPILER= ,A20)
90013 FORMAT (1H ,8H TEST ,10HPASS/FAIL ,6X,17HDISPLAYED RESULTS,
1 7X,7HREMARKS,24X)
90014 FORMAT (1H ,46H----------------------------------------------,
1 33H---------------------------------)
90015 FORMAT (1H ,48X,17HTHIS PROGRAM HAS ,I3,6H TESTS,/)
C****
C**** FORMAT STATEMENTS FOR REPORT FOOTINGS
C****
90016 FORMAT (1H ,/,2H *,A5,4HEND*,14X,14HEND OF TEST - ,A5,/)
90018 FORMAT (1H ,A13,13X,A20,7H * ,A10,1H/,
1 A13)
90019 FORMAT (1H ,26HFOR OFFICIAL USE ONLY ,35X,15HCOPYRIGHT 1982)
C****
C**** FORMAT STATEMENTS FOR RUN SUMMARY
C****
90020 FORMAT (1H ,21X,I5,13H TESTS PASSED)
90022 FORMAT (1H ,21X,I5,13H TESTS FAILED)
90024 FORMAT (1H ,21X,I5,14H TESTS DELETED)
90026 FORMAT (1H ,21X,I5,25H TESTS REQUIRE INSPECTION)
90028 FORMAT (1H ,21X,I5,4H OF ,I3,15H TESTS EXECUTED)
CBE** ********************** BBCFMT0B **********************************
C*****
C***** END OF TEST SEGMENT 910
STOP
END
*HEADER,FORTR,FM910,SUBRTN,FM911
C**********************************************************************
C***** FM911
C*****
C***** SN911 EAQ - (806)
C***** THIS SUBROUTINE IS CALLED BY FM910
C**********************************************************************
SUBROUTINE SN911(LW1I, NW1I, FW1S, HW1S, CW1B, EW1B, DW1D,
1 BW1D,CW1C, DW1C, A4W1K, C4W1K)
C*****
C***** SUBROUTINE USED WITH SEGMENT DIRAF2 (411) TO SUPPLY VALUES
C***** TO ARRAYS THRU THE DUMMY ARGUMENT LIST
C*****
DIMENSION LW1I(10),LT1I(10),NT1I(15),NW1I(15)
REAL FT1S(10),FW1S(10),HT1S(15),HW1S(15)
LOGICAL CT1B(10),CW1B(10),ET1B(15),EW1B(15)
DOUBLE PRECISION DT1D(10),DW1D(10),BT1D(15),BW1D(15)
COMPLEX CW1C(10),CT1C(10),DW1C(15),DT1C(15)
CHARACTER*4 A4T1K(10),A4W1K(10),C4T1K(15),C4W1K(15)
C*****
DATA LT1I /2, 3, 1, 3, 10, 8, 9, 6, 7, 5/
DATA NT1I /5, 7, 3, 9, 4, 11, 8, 13, 14, 12, 6, 10, 2, 15, 1/
DATA FT1S /1.0, 2.0, 3.0, 4.0, 5.0, 6.5, 7.1, 8.2, 9.9, 10.0/
DATA HT1S /2.34, 2.3,1.9, 2.3, 9.9, 1.1, 8.8, 7.6, 2.3, 10.1,
1 3.4, 5.60, 34.9, 3.48, 23.8/
DATA A4T1K / 'AAAA', 'BBBB', 'CCCC', 'DDDD', 'EDFG', 'JLKD'
1 , 'CDFE', 'LKJH', 'JHGF', 'LLLL'/
DATA C4T1K / 'HDFK', 'LKJH', 'ASDF', 'LKJH', 'XMNC', 'ALXM'
1 , 'IEOW', 'IERU', 'DJNC', 'DJAL', 'KDFJ', 'ABCD'
2 , 'ASDF', 'GHJK', 'QWER'/
DATA CT1B /.TRUE., .FALSE., .TRUE., .TRUE., .TRUE., .FALSE.,
1 .FALSE., .TRUE., .TRUE., .FALSE./
DATA ET1B /.FALSE., .FALSE., .FALSE., .TRUE., .FALSE., .FALSE.,
1 .TRUE., .TRUE., .FALSE., .TRUE., .TRUE., .TRUE.,
2 .FALSE., .TRUE., .FALSE./
DATA DT1D /1.23D1, 2.34D1, 3.45D3, 4.56D4, 5.602D0, 34.35D1,
1 2.34D1, 398.0D0, 3.49D-1, 0.99D1/
DATA BT1D /3.45D1, 34.5D0, 34.5D4, 2.93D3, 0.09D-2, 3.4D-1,
1 34.0D1, 85.0D1, 3.968D0, 3.48D1, 39.3D4, 0.09D3,
2 389.098D1, 483.98D0, 3456.0D-4/
DATA CT1C /(1.2, 3.4), (9.8, 34.5), (3.4, 34.9), (9.0, 34.9),
1 (2.3, 3.9), (3.98, 8.9), (3.112, 3.4), (8.0, 1.2),
2 (2.56, 2.1), (3.4, 4.5)/
DATA DT1C /(2.3, 3.9), (3.98, 8.9), (3.112, 3.4), (8.0, 1.2),
1 (2.56, 2.1), (3.4, 4.5), (3.4, 34.9), (9.0, 34.9),
2 (1.2, 3.4), (9.8, 34.5), (3.4, 34.9), (9.0, 34.9),
3 (3.112, 3.4), (8.0, 1.2), (3.112, 3.4)/
C*****
DO 1 IVI = 1, 10
LW1I(IVI) = LT1I(IVI)
FW1S(IVI) = FT1S(IVI)
CW1B(IVI) = CT1B(IVI)
DW1D(IVI) = DT1D(IVI)
CW1C(IVI) = CT1C(IVI)
A4W1K(IVI) = A4T1K(IVI)
1 CONTINUE
C*****
DO 2 IVI = 1, 15
NW1I(IVI) = NT1I(IVI)
HW1S(IVI) = HT1S(IVI)
EW1B(IVI) = ET1B(IVI)
BW1D(IVI) = BT1D(IVI)
DW1C(IVI) = DT1C(IVI)
C4W1K(IVI) = C4T1K(IVI)
2 CONTINUE
C*****
RETURN
END
*END-OF,FM910
FM912.f 481036660 170 2 100666 32893 `
*HEADER,FORTR,FM912
*FILES1,FORTR,FM912
C***********************************************************************
C***** FORTRAN 77
C***** FM912
C***** DIRAF3 - (412)
C***** THIS PROGRAM CALLS SUBROUTINE SN913 IN FILE FM913
C***********************************************************************
C***** TESTING OF DIRECT ACCESS FILES ANS REF
C***** FORMATTED, WITH BOTH SEQUENTIAL AND DIRECT 12.5
C***** ACCESS TO THE SAME FILE
C*****
C***** USES SUBROUTINE SN913 FAQ
C*****
C***** S P E C I F I C A T I O N S SEGMENT 412
C***********************************************************************
DIMENSION F1S(10), G1S(10)
CHARACTER*20 A20VK, B20VK, C20VK, A201K(10), B201K(10)
CHARACTER*47 A47VK, B47VK, C47VK
CHARACTER*51 A51VK
CHARACTER*12 A12VK
CHARACTER A120VK*120, B120VK*120, A1VK*1, A4VK*4
CHARACTER*31 REMK,REMK1,REMK2,REMK3,REMK4,REMK5,REMK45
LOGICAL AVB, BVB, CVB, C1B(10), D1B(10)
DOUBLE PRECISION AVD, BVD, CVD, DVD, D1D(10), B1D(15)
C*****
C***** BELOW CHARACTER STATEMENT ESTABLISHES THE FILE NAME VARIABLES.
CX20 REPLACED BY FEXEC X-20 CONTROL CARD. X-20 IS FOR REPLACING
CHARACTER*15 CDIR
C THE CHARACTER STATEMENT FOR FILE NAMES ASSOCIATED WITH X-130
C (PROGRAM VARIABLE CDIR) IF NOT VALID FOR THE PROCESSOR.
CBB** ********************** BBCINITA **********************************
C**** SPECIFICATION STATEMENTS
C****
CHARACTER ZVERS*13, ZVERSD*17, ZDATE*17, ZPROG*5, ZCOMPL*20,
1 ZNAME*20, ZTAPE*10, ZPROJ*13, REMRKS*31, ZTAPED*13
CBE** ********************** BBCINITA **********************************
CBB** ********************** BBCINITB **********************************
C**** INITIALIZE SECTION
DATA ZVERS, ZVERSD, ZDATE
1 /'VERSION 2.0 ', '82/08/02*18.33.46', '*NO DATE*TIME'/
DATA ZCOMPL, ZNAME, ZTAPE
1 /'*NONE SPECIFIED*', '*NO COMPANY NAME*', '*NO TAPE*'/
DATA ZPROJ, ZTAPED, ZPROG
1 /'*NO PROJECT*', '*NO TAPE DATE', 'XXXXX'/
DATA REMRKS /' '/
C**** THE FOLLOWING 9 COMMENT LINES (CZ01, CZ02, ...) CAN BE REPLACED
C**** FOR IDENTIFYING THE TEST ENVIRONMENT
C****
CZ01 ZVERS = 'VERSION OF THE COMPILER VALIDATION SYSTEM'
CZ02 ZVERSD = 'CREATION DATE/TIME OF THE COMPILER VALIDATION SYSTEM'
CZ03 ZPROG = 'PROGRAM NAME'
CZ04 ZDATE = 'DATE OF TEST'
CZ05 ZCOMPL = 'COMPILER IDENTIFICATION'
CZ06 ZPROJ = 'PROJECT NUMBER/IDENTIFICATION'
CZ07 ZNAME = 'NAME OF USER'
CZ08 ZTAPE = 'TAPE OWNER/ID'
CZ09 ZTAPED = 'DATE TAPE COPIED'
C
IVPASS = 0
IVFAIL = 0
IVDELE = 0
IVINSP = 0
IVTOTL = 0
IVTOTN = 0
ICZERO = 0
C
C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER.
I01 = 05
C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER.
I02 = 06
C
CX010 REPLACED BY FEXEC X-010 CONTROL CARD (CARD-READER UNIT NUMBER).
C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5
CX011 REPLACED BY FEXEC X-011 CONTROL CARD. CX011 IS FOR SYSTEMS
C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX010.
C
CX020 REPLACED BY FEXEC X-020 CONTROL CARD (PRINTER UNIT NUMBER).
C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02= 6
CX021 REPLACED BY FEXEC X-021 CONTROL CARD. CX021 IS FOR SYSTEMS
C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX020.
C
CBE** ********************** BBCINITB **********************************
C*****
C***** THE FOLLOWING STATEMENT MUST BE CHANGED IF THE
C***** UNITS GIVEN ARE NOT CAPABLE OF BEING OPENED AS SPECIFIED.
C*****
C I13 CONTAINS THE UNIT NUMBER FOR A NAMED DIRECT ACCESS FILE.
I13 = 24
CX130 REPLACED BY FEXEC X-130 CONTROL CARD (DIR. FILE UNIT NUMBER).
C SPECIFYING I13 = NN OVERRIDES THE DEFAULT I13 = 24.
C
C***** THE FOLLOWING STATEMENT MUST BE CHANGED IF THE NAME
C***** GIVEN IS NOT A VALID FILE SPECIFIER FOR A DIRECT,
C***** FORMATTED FILE.
C*****
C CDIR CONTAINS THE FILE NAME FOR UNIT I13.
CDIR = ' DIRFILE'
C
CX201 REPLACED BY FEXEC X-201 CONTROL CARD. CX201 IS FOR SYSTEMS
C REQUIRING A DIFFERENT FILE SPECIFIER FOR FILES ASSOCIATED WITH
C X-130 THAN THE DEFAULT CDIR = ' DIRFILE'.
C
C***** FILE NUMBER AND NAME ASSIGNMENT
NUVI = I02
KUVI = I13
IVTOTL = 26
ZPROG = 'FM912'
C*****
C***** FILE NUMBER AND NAME ASSIGNMENT
C*****
REMK1='RECORD 1 - ERR PATH TAKEN'
REMK2='RECORD 2 - ERR PATH TAKEN'
REMK3='RECORD 3 - ERR PATH TAKEN'
REMK4='RECORD 4 - ERR PATH TAKEN'
REMK5='RECORD 5 - ERR PATH TAKEN'
REMK45='RECORD 4 + 5 - ERR PATH TAKEN'
CBB** ********************** BBCHED0A **********************************
C****
C**** WRITE REPORT TITLE
C****
WRITE (I02, 90002)
WRITE (I02, 90006)
WRITE (I02, 90007)
WRITE (I02, 90008) ZVERS, ZVERSD
WRITE (I02, 90009) ZPROG, ZPROG
WRITE (I02, 90010) ZDATE, ZCOMPL
CBE** ********************** BBCHED0A **********************************
WRITE(NUVI,41200)
41200 FORMAT( 1H ,/45H DIRAF3 - (412) DIRECT ACCESS FORMATTED FILE/
1 42H WITH OPTION TO OPEN AS A SEQUENTIAL FILE/
2 17H ANS REF. - 12.5)
CBB** ********************** BBCHED0B **********************************
C**** WRITE DETAIL REPORT HEADERS
C****
WRITE (I02,90004)
WRITE (I02,90004)
WRITE (I02,90013)
WRITE (I02,90014)
WRITE (I02,90015) IVTOTL
CBE** ********************** BBCHED0B **********************************
C*****
C***** PLUS OR MINUS VALUES
C*****
CVS = 0.0001
CVD = 0.0001D0
C*****
C***** INITIALIZE DATA ARRAYS
C*****
CALL SN913(F1S,G1S,C1B,D1B,D1D,B1D,A201K,B201K)
C*****
C***** OPEN DIRECT ACCESS FILE - STATUS=NEW
C*****
OPEN(FILE=CDIR, UNIT=KUVI, ACCESS='DIRECT',RECL=120,
1 FORM='FORMATTED',STATUS='NEW')
C*****
CT001* TEST 1 - CHECKS RECL AND NEXTREC
C***** FOR JUST OPENED DIRECT ACCESS FILE
C*****
IVTNUM=1
INQUIRE(UNIT=KUVI, RECL=IVI, NEXTREC=KVI)
IF (IVI .NE. 120) GO TO 33020
IF (KVI .NE. 1) GO TO 33020
WRITE(NUVI,80002)IVTNUM
IVPASS=IVPASS+1
GO TO 33030
33020 REMK='ERROR IN INQUIRE'
WRITE(NUVI,55010)IVTNUM,REMK
55010 FORMAT(1H ,5HTEST ,I3,1X,5H FAIL,34X,A31)
IVFAIL=IVFAIL+1
WRITE(NUVI,55020)IVI,KVI
55020 FORMAT(1H ,/,11X,16HCOMPUTED: RECL=,I6,5X,8HNEXTREC=,I6)
WRITE(NUVI,55030)
55030 FORMAT(1H ,10X,22HCORRECT: RECL= 120,5X,14HNEXTREC= 1/)
C*****
CT002* TEST 2 - WRITES RECORD 1
C*****
33030 IVTNUM=2
IVI = 1
AVS = F1S (IVI)
BVS = F1S(IVI + 1)
A20VK = A201K (IVI)
AVB = C1B (IVI)
AVD = D1D (IVI)
WRITE(UNIT=KUVI,REC=1,FMT=41204,ERR=33040) IVI, AVS, BVS, AVD,
1 AVB, A20VK
41204 FORMAT(I5, F10.5, E14.6, D14.8, L10, A20, 35X, ' LAST RECORD')
WRITE(NUVI,80002)IVTNUM
IVPASS=IVPASS+1
GO TO 33050
33040 WRITE(NUVI,55010)IVTNUM,REMK1
IVFAIL=IVFAIL+1
C*****
CT003* TEST 3 - WRITES RECORD 2
C*****
33050 IVTNUM=3
IVI = IVI + 1
AVS = F1S (IVI)
BVS = F1S(IVI + 1)
A20VK = A201K (IVI)
AVB = C1B (IVI)
AVD = D1D (IVI)
WRITE(UNIT=KUVI,REC=2,FMT=41205,ERR=33060) BVS, AVD, IVI, AVS,
1 AVB, A20VK
41205 FORMAT(E12.6, D15.7, I4, F11.5, L2, A25, 30X, ' LASTS RECORD')
WRITE(NUVI,80002)IVTNUM
IVPASS=IVPASS+1
GO TO 33070
33060 WRITE(NUVI,55010)IVTNUM,REMK2
IVFAIL=IVFAIL+1
C*****
CT004* TEST 4 - WRITES RECORD 3
C*****
33070 IVTNUM=4
IVI = IVI + 1
AVS = F1S (IVI)
BVS = F1S(IVI + 1)
A20VK = A201K (IVI)
AVB = C1B (IVI)
AVD = D1D (IVI)
WRITE(UNIT=KUVI,REC=3,FMT=41206,ERR=33080) IVI, BVS, AVS, AVD,
1 AVB, A20VK
41206 FORMAT(I5, F10.5, E14.6, D14.8, L10, A20, 30X, 'THE LAST REC')
WRITE(NUVI,80002)IVTNUM
IVPASS=IVPASS+1
GO TO 33090
33080 WRITE(NUVI,55010)IVTNUM,REMK3
IVFAIL=IVFAIL+1
C*****
CT005* TEST 5 - WRITES RECORDS 4 AND 5 WITH ONE WRITE
C*****
33090 IVTNUM=5
IVI = IVI + 1
AVS = F1S (IVI)
BVS = F1S(IVI + 1)
A20VK = A201K (IVI)
AVB = C1B (IVI)
AVD = D1D (IVI)
WRITE(UNIT=KUVI,REC=4,FMT=41207,ERR=33100) IVI, AVS, AVD, AVB,
1 A20VK, BVS, BVS, AVD, AVB, IVI, AVS, A20VK
41207 FORMAT(I5, F10.5, D14.8, L10, A20, E14.6, 35X, 'NEXT TO LAST',/
1 E12.6, D15.7, L2, I4, F11.5, A25, 30X, 'THE END')
WRITE(NUVI,80002)IVTNUM
IVPASS=IVPASS+1
GO TO 33290
33100 WRITE(NUVI,55010)IVTNUM,REMK45
IVFAIL=IVFAIL+1
C*****
CT006* TEST 6 - CHECK RECL AND NEXTREC ON OPENED FILE
C*****
33290 IVTNUM=6
INQUIRE(UNIT=KUVI, RECL=IVI, NEXTREC=KVI)
IF (IVI .NE. 120)GO TO 33300
IF(KVI .NE. 6)GO TO 33300
WRITE(NUVI,80002)IVTNUM
IVPASS=IVPASS+1
GO TO 33110
33300 REMK='ERROR IN INQUIRE'
WRITE(NUVI,55010)IVTNUM,REMK
IVFAIL=IVFAIL+1
WRITE(NUVI,55020)IVI,KVI
WRITE(NUVI,55040)
55040 FORMAT(1H ,10X,22HCORRECT: RECL= 120,5X,14HNEXTREC= 6/)
C*****
CT007* TEST 7 - READS RECORD 1
C*****
33110 IVTNUM=7
IVI = 1
READ(UNIT=KUVI,REC=IVI,FMT=41210,ERR=33120) KVI, AVS, BVS, AVD,
1 AVB, A20VK, A47VK
41210 FORMAT(I5, F10.5, E14.6, D14.8, L10, A20, A47)
ISWT=1
GO TO 33220
33120 WRITE(NUVI,55010)IVTNUM,REMK1
IVFAIL=IVFAIL+1
C*****
CT008* TEST 8 - READS RECORD 2
C*****
33130 IVTNUM=8
IVI = 2
READ(UNIT=KUVI,REC=IVI,FMT=41238,ERR=33140) BVS, AVD, KVI, AVS,
1 AVB, A20VK, A51VK
41238 FORMAT(E12.6, D15.7, I4, F11.5, L2, A25, A51)
ISWT=2
GO TO 33230
33140 WRITE(NUVI,55010)IVTNUM,REMK2
IVFAIL=IVFAIL+1
C*****
CT009* TEST 9 - READS RECORD 3
C*****
33150 IVTNUM=9
IVI = 3
READ(UNIT=KUVI,REC=IVI,FMT=41210,ERR=33160) LVI, DVS, GVS, BVD,
1 BVB, B20VK, B47VK
ISWT=3
GO TO 33240
33160 WRITE(NUVI,55010)IVTNUM,REMK3
IVFAIL=IVFAIL+1
C*****
CT010* TEST 10 - READS RECORD 4
C*****
33170 IVTNUM=10
IVI = 4
READ(UNIT=KUVI,REC=IVI,FMT=41241,ERR=33180) NVI, EVS, DVD, CVB,
1 C20VK, FVS, C47VK
41241 FORMAT(I5, F10.5, D14.8, L10, A20, E14.6, A47)
ISWT=4
GO TO 33250
33180 WRITE(NUVI,55010)IVTNUM,REMK4
IVFAIL=IVFAIL+1
C*****
CT011* TEST 11 - READS RECORD 5
C*****
33190 IVTNUM=11
IVI = 5
JVI = 4
READ(UNIT=KUVI,REC=IVI,FMT=41218,ERR=33200) BVS, AVD, AVB, KVI,
1 AVS, A20VK, A51VK
41218 FORMAT(E12.6, D15.7, L2, I4, F11.5, A25, A51)
ISWT=5
GO TO 33260
33200 WRITE(NUVI,55010)IVTNUM,REMK5
IVFAIL=IVFAIL+1
C*****
CT012* TEST 12 - OVERWRITES RECORD 3
C*****
33210 IVTNUM=12
IVI = 3
AVS = G1S (IVI)
BVS = G1S(IVI + 1)
A20VK = B201K (IVI)
AVB = D1B (IVI)
AVD = B1D (IVI)
WRITE(UNIT=KUVI,REC=3,FMT=41251,ERR=33310) IVI, AVS, BVS, AVD,
1 A20VK, AVB
41251 FORMAT(I5, F11.5, E13.6, D14.8, A20, L10, 35X, 'NEW RECORD ')
WRITE(NUVI,80002)IVTNUM
IVPASS=IVPASS+1
GO TO 33320
33310 WRITE(NUVI,55010)IVTNUM,REMK3
IVFAIL=IVFAIL+1
C*****
CT013* TEST 13 - OVERWRITES RECORD 5
C*****
33320 IVTNUM=13
IVI = 5
AVS = G1S (IVI)
BVS = G1S(IVI - 1)
A20VK = B201K (IVI)
AVB = D1B (IVI)
AVD = B1D (IVI)
WRITE(UNIT=KUVI,REC=5,FMT=41252,ERR=33330) AVS, IVI, A20VK, AVD,
1 BVS, AVB
41252 FORMAT(F10.5, I5, A20, D14.8, E14.6, L10, 35X, 'STOP RECORD')
WRITE(NUVI,80002)IVTNUM
IVPASS=IVPASS+1
GO TO 33340
33330 WRITE(NUVI,55010)IVTNUM,REMK5
IVFAIL=IVFAIL+1
C*****
C***** CLOSE AND REOPEN DIRECT ACCESS FILE
C*****
33340 CLOSE(UNIT=KUVI)
OPEN(FILE=CDIR, UNIT=KUVI, ACCESS='DIRECT',STATUS='OLD',
1 FORM='FORMATTED',RECL=120)
C*****
CT014* TEST 14 - READS RECORD 4
C*****
IVTNUM=14
IVI = 4
READ(UNIT=KUVI,REC=IVI,FMT=41241,ERR=33350) NVI, EVS, DVD, CVB,
1 C20VK, FVS, C47VK
ISWT=6
GO TO 33250
33350 WRITE(NUVI,55010)IVTNUM,REMK4
IVFAIL=IVFAIL+1
C*****
CT015* TEST 15 - READS THE CHANGED RECORD 5
C*****
33360 IVTNUM=15
IVI = 5
READ(UNIT=KUVI,REC=IVI,FMT=41254,ERR=33370) AVS, KVI, A20VK,
1 AVD, BVS, AVB, A47VK
41254 FORMAT(F10.5, I5, A20, D14.8, E14.6, L10, A47)
ISWT=7
IF (KVI .NE. IVI) GOTO 41221
IF (AVS .LT. G1S(IVI)-CVS .OR. AVS .GT. G1S(IVI)+CVS) GOTO 41223
IF (BVS.LT.G1S(IVI-1)-CVS .OR. BVS.GT.G1S(IVI-1)+CVS) GOTO 41225
IF (A20VK .NE. B201K(IVI)) GOTO 41229
IF ((AVB .AND. .NOT. D1B(IVI)) .OR.
1 (.NOT. AVB .AND. D1B(IVI))) GOTO 41233
IF (AVD .LT. B1D(IVI)-CVD .OR. AVD .GT. B1D(IVI)+CVD) GOTO 41227
IF (A47VK .NE.
1 ' STOP RECORD') GOTO 41231
WRITE(NUVI,80002)IVTNUM
IVPASS=IVPASS+1
GO TO 33380
33370 WRITE(NUVI,55010)IVTNUM,REMK5
IVFAIL=IVFAIL+1
C*****
CT016* TEST 16 - READS RECORD 2
C*****
33380 IVTNUM=16
IVI = 2
READ(UNIT=KUVI,REC=IVI,FMT=41238,ERR=33390) BVS, AVD, KVI, AVS,
1 AVB, A20VK, A51VK
ISWT=8
GO TO 33230
33390 WRITE(NUVI,55010)IVTNUM,REMK2
IVFAIL=IVFAIL+1
C*****
CT017* TEST 17 - READS THE CHANGED RECORD 3
C*****
33400 IVTNUM=17
IVI = 3
READ(UNIT=KUVI,REC=3,FMT=41256,ERR=33410) KVI, AVS, BVS, AVD,
1 A20VK, AVB, A47VK
41256 FORMAT(I5, F11.5, E13.6, D14.8, A20, L10, A47)
ISWT=9
IF (KVI .NE. IVI) GOTO 41221
IF (AVS .LT. G1S(IVI)-CVS .OR. AVS .GT. G1S(IVI)+CVS) GOTO 41223
IF (BVS.LT.G1S(IVI+1)-CVS .OR. BVS.GT.G1S(IVI+1)+CVS) GOTO 41225
IF (A20VK .NE. B201K(IVI)) GOTO 41229
IF ((AVB .AND. .NOT. D1B(IVI)) .OR.
1 (.NOT. AVB .AND. D1B(IVI))) GOTO 41233
IF (AVD .LT. B1D(IVI)-CVD .OR. AVD .GT. B1D(IVI)+CVD) GOTO 41227
IF (A47VK .NE.
1 ' NEW RECORD ') GOTO 41231
WRITE(NUVI,80002)IVTNUM
IVPASS=IVPASS+1
GO TO 33420
33410 WRITE(NUVI,55010)IVTNUM,REMK3
IVFAIL=IVFAIL+1
C*****
CT018* TEST 18 - READS RECORD 1
C*****
33420 IVTNUM=18
IVI = 1
READ(UNIT=KUVI,REC=IVI,FMT=41210,ERR=33430) KVI, AVS, BVS, AVD,
1 AVB, A20VK, A47VK
ISWT=10
GO TO 33220
33430 WRITE(NUVI,55010)IVTNUM,REMK1
IVFAIL=IVFAIL+1
C*****
CT019* TEST 19 - OVERWRITES RECORD 4
C*****
33440 IVTNUM=19
41258 IVI = 4
KVI = IVI + 1
AVS = F1S (IVI)
BVS = F1S(IVI + 1)
EVS = F1S(IVI) + 2.34
AVD = D1D (IVI)
WRITE(UNIT=KUVI,REC=4,FMT=41259,ERR=33450) IVI, KVI, AVS, BVS,
1 EVS, AVD
41259 FORMAT(I5, I5.3, F10.5, E14.6, E20.1E4, D14.8)
WRITE(NUVI,80002)IVTNUM
IVPASS=IVPASS+1
GO TO 33460
33450 WRITE(NUVI,55010)IVTNUM,REMK4
IVFAIL=IVFAIL+1
C*****
CT020* TEST 20 - OVERWRITES RECORDS 1, 2, AND 3
C*****
33460 IVTNUM=20
IVI = 1
A1VK = 'A'
A4VK = A201K (IVI) (1:4)
AVB = C1B (IVI)
AVD = D1D (IVI)
BVD = D1D (IVI) + 3.234D2
WRITE(UNIT=KUVI,REC=1,FMT=41260,ERR=33470) AVD, BVD, AVB, A1VK,
1 A4VK
41260 FORMAT(G14.8, G20.2E4, L2, A, A4, 'TSAL DROCER',//,
1 10HHOLLERITH , T15, 'ONE', 10X, TL5, 'TWO', TR5,
2 'THREE', :, 'LAST')
WRITE(NUVI,80002)IVTNUM
IVPASS=IVPASS+1
GO TO 33480
33470 WRITE(NUVI,55010)IVTNUM,REMK1
IVFAIL=IVFAIL+1
C*****
CT021* TEST 21 - OVERWRITES RECORD 5
C*****
33480 IVTNUM=21
IVI = 5
BVS = F1S(IVI - 1)
AVD = B1D (4)
WRITE(UNIT=KUVI,REC=5,FMT=41261,ERR=33490) IVI, BVS, IVI, AVD
41261 FORMAT(SP, I5, S, F10.5, SS, I5, 3PE14.6E2)
WRITE(NUVI,80002)IVTNUM
IVPASS=IVPASS+1
GO TO 33500
33490 WRITE(NUVI,55010)IVTNUM,REMK5
IVFAIL=IVFAIL+1
C*****
C***** CLOSE AND REOPEN DIRECT ACCESS FILE
C*****
33500 CLOSE(UNIT=KUVI)
OPEN(FILE=CDIR, UNIT=KUVI, ACCESS='DIRECT',STATUS='OLD',
1 FORM='FORMATTED',RECL=120)
C*****
CT022* TEST 22 - READS RECORD 1
C*****
IVTNUM=22
IVI = 1
READ(UNIT=KUVI,REC=IVI,FMT=41262,ERR=33510) AVD, A20VK, AVB,
1 A1VK, A4VK, A12VK
41262 FORMAT(G14.8, A20, L2, A, A4, A12)
ISWT=1
IF (AVD .LT. D1D(IVI)-CVD .OR. AVD .GT. D1D(IVI)+CVD) GOTO 41277
IF (A20VK(12:20) .NE. '.34E+0003') GOTO 41279
IF ((A1VK .NE. 'A') .OR.
1 (A4VK .NE. A201K(IVI)(1:4)) .OR.
2 (A12VK .NE. 'TSAL DROCER')) GOTO 41229
WRITE(NUVI,80002)IVTNUM
IVPASS=IVPASS+1
GO TO 33520
33510 WRITE(NUVI,55010)IVTNUM,REMK1
IVFAIL=IVFAIL+1
C***** RECORD # 4
CT023* TEST 23 - READS RECORD 4
C*****
33520 IVTNUM=23
IVI = 4
READ(UNIT=KUVI,REC=IVI,FMT=41266,ERR=33530) KVI, A20VK, AVS,
1 BVS, B20VK, AVD
41266 FORMAT(I5, A5, F10.5, E14.6, A20, D14.8)
ISWT=2
IF (A20VK(3:5) .NE. '005') GOTO 41293
IF ((AVS .LT. F1S(IVI)-CVS .OR. AVS .GT. F1S(IVI)+CVS) .OR.
1 (BVS.LT.F1S(IVI+1)-CVS .OR. BVS.GT.F1S(IVI+1)+CVS) .OR.
2 (B20VK(13:20) .NE. '.6E+0001')) GOTO 41225
WRITE(NUVI,80002)IVTNUM
IVPASS=IVPASS+1
GO TO 33540
33530 WRITE(NUVI,55010)IVTNUM,REMK4
IVFAIL=IVFAIL+1
C*****
CT024* TEST 24 - READS RECORD 2 TESTS FOR BLANK RECORD
C*****
33540 IVTNUM=24
B120VK = ' '
IVI = 2
READ(UNIT=KUVI,REC=IVI,FMT=41269,ERR=33550) A120VK
41269 FORMAT(A120)
ISWT=3
IF (A120VK .NE. B120VK) GOTO 41281
WRITE(NUVI,80002)IVTNUM
IVPASS=IVPASS+1
GO TO 33560
33550 WRITE(NUVI,55010)IVTNUM,REMK2
IVFAIL=IVFAIL+1
C*****
CT025* TEST 25 - READS RECORD 5
C*****
33560 IVTNUM=25
IVI = 5
READ(UNIT=KUVI,REC=IVI,FMT=41271,ERR=33570) A20VK(1:5), AVS,
1 B20VK, C20VK
41271 FORMAT(A5, F10.5, BZ, A5, BN, A20)
ISWT=4
IF (A20VK(1:5) .NE. ' +5') GOTO 41283
IF (B20VK(1:5) .NE. ' 5') GOTO 41285
IF (C20VK(1:14) .NE. ' 625.0000E-03') GOTO 41287
WRITE(NUVI,80002)IVTNUM
IVPASS=IVPASS+1
GO TO 33580
33570 WRITE(NUVI,55010)IVTNUM,REMK5
IVFAIL=IVFAIL+1
C*****
CT026* TEST 26 - READS RECORD 3
C*****
33580 IVTNUM=26
IVI = 3
READ(UNIT=KUVI,REC=IVI,FMT=41275,ERR=33590) A120VK
41275 FORMAT(A120)
ISWT=5
IF (A120VK(1:10) .NE. 'HOLLERITH') GOTO 41289
IF (A120VK(11:40) .NE.
1 ' ONE TWO THREE ') GOTO 41291
WRITE(NUVI,80002)IVTNUM
IVPASS=IVPASS+1
GO TO 33600
33590 WRITE(NUVI,55010)IVTNUM,REMK3
IVFAIL=IVFAIL+1
C*****
C***** CLOSE DIRECT ACCESS FILE
C*****
33600 CLOSE(UNIT=KUVI,STATUS='DELETE')
GO TO 33610
C*****
C***** CHECKING RECORD 1
C*****
33220 IF (KVI .NE. IVI) GOTO 41221
IF (AVS .LT. F1S(IVI)-CVS .OR. AVS .GT. F1S(IVI)+CVS) GOTO 41223
IF (BVS.LT.F1S(IVI+1)-CVS .OR. BVS.GT.F1S(IVI+1)+CVS) GOTO 41225
IF (A20VK .NE. A201K(IVI)) GOTO 41229
IF (A47VK .NE.
1 ' LAST RECORD') GOTO 41231
IF ((AVB .AND. .NOT. C1B(IVI)) .OR.
1 (.NOT. AVB .AND. C1B(IVI))) GOTO 41233
IF (AVD .LT. D1D(IVI)-CVD .OR. AVD .GT. D1D(IVI)+CVD) GOTO 41227
WRITE(NUVI,80002)IVTNUM
IVPASS=IVPASS+1
IF (ISWT .EQ. 10)GO TO 33440
GO TO 33130
41221 WRITE(NUVI,41222)IVTNUM,IVI
IVFAIL=IVFAIL+1
GO TO (33130,33150,33170,33190,33210,33360,33380,33400,
1 33420,33440)ISWT
41223 WRITE(NUVI,41224)IVTNUM,IVI
IVFAIL=IVFAIL+1
GO TO (33130,33150,33170,33190,33210,33360,33380,33400,
1 33420,33440)ISWT
41225 WRITE(NUVI,41226)IVTNUM,IVI
IVFAIL=IVFAIL+1
GO TO (33130,33150,33170,33190,33210,33360,33380,33400,
1 33420,33440)ISWT
41227 WRITE(NUVI,41228)IVTNUM,IVI
IVFAIL=IVFAIL+1
GO TO (33130,33150,33170,33190,33210,33360,33380,33400,
1 33420,33440)ISWT
41229 WRITE(NUVI,41230)IVTNUM,IVI
IVFAIL=IVFAIL+1
GO TO (33130,33150,33170,33190,33210,33360,33380,33400,
1 33420,33440)ISWT
41231 WRITE(NUVI,41232)IVTNUM,IVI
IVFAIL=IVFAIL+1
GO TO (33130,33150,33170,33190,33210,33360,33380,33400,
1 33420,33440)ISWT
41233 WRITE(NUVI,41234)IVTNUM,IVI
IVFAIL=IVFAIL+1
GO TO (33130,33150,33170,33190,33210,33360,33380,33400,
1 33420,33440)ISWT
C*****
C***** CHECKING RECORD 2
C*****
33230 IF (KVI .NE. IVI) GOTO 41221
IF (AVS .LT. F1S(IVI)-CVS .OR. AVS .GT. F1S(IVI)+CVS) GOTO 41223
IF (BVS.LT.F1S(IVI+1)-CVS .OR. BVS.GT.F1S(IVI+1)+CVS) GOTO 41225
IF (A20VK .NE. A201K(IVI)) GOTO 41229
IF ((AVB .AND. .NOT. C1B(IVI)) .OR.
1 (.NOT. AVB .AND. C1B(IVI))) GOTO 41233
IF (AVD .LT. D1D(IVI)-CVD .OR. AVD .GT. D1D(IVI)+CVD) GOTO 41227
IF (A51VK .NE.
1 ' LASTS RECORD ')GOTO 41231
WRITE(NUVI,80002)IVTNUM
IVPASS=IVPASS+1
IF (ISWT .EQ. 8)GO TO 33400
GO TO 33150
C*****
C***** CHECKING RECORD 3
C*****
33240 IF (LVI .NE. IVI) GOTO 41221
IF (GVS .LT. F1S(IVI)-CVS .OR. GVS .GT. F1S(IVI)+CVS) GOTO 41223
IF (DVS.LT.F1S(IVI+1)-CVS .OR. DVS.GT.F1S(IVI+1)+CVS) GOTO 41225
IF (B20VK .NE. A201K(IVI)) GOTO 41229
IF ((BVB .AND. .NOT. C1B(IVI)) .OR.
1 (.NOT. BVB .AND. C1B(IVI))) GOTO 41233
IF (BVD .LT. D1D(IVI)-CVD .OR. BVD .GT. D1D(IVI)+CVD) GOTO 41227
IF (B47VK .NE.
1 ' THE LAST REC ') GOTO 41231
WRITE(NUVI,80002)IVTNUM
IVPASS=IVPASS+1
GO TO 33170
C*****
C***** CHECKING RECORD 4
C*****
33250 IF (NVI .NE. IVI) GOTO 41221
IF (EVS .LT. F1S(IVI)-CVS .OR. EVS .GT. F1S(IVI)+CVS) GOTO 41223
IF (FVS.LT.F1S(IVI+1)-CVS .OR. FVS.GT.F1S(IVI+1)+CVS) GOTO 41225
IF (C20VK .NE. A201K(IVI)) GOTO 41229
IF ((CVB .AND. .NOT. C1B(IVI)) .OR.
1 (.NOT. CVB .AND. C1B(IVI))) GOTO 41233
IF (DVD .LT. D1D(IVI)-CVD .OR. DVD .GT. D1D(IVI)+CVD) GOTO 41227
IF (C47VK .NE.
1 ' NEXT TO LAST') GOTO 41231
WRITE(NUVI,80002)IVTNUM
IVPASS=IVPASS+1
IF (ISWT .EQ. 6)GO TO 33360
GO TO 33190
C*****
C***** CHECKING RECORD 5
C*****
33260 IF (KVI .NE. JVI) GOTO 41221
IF (AVS .LT. F1S(JVI)-CVS .OR. AVS .GT. F1S(JVI)+CVS) GOTO 41223
IF (BVS.LT.F1S(JVI+1)-CVS .OR. BVS.GT.F1S(JVI+1)+CVS) GOTO 41225
IF (A20VK .NE. A201K(JVI)) GOTO 41229
IF ((AVB .AND. .NOT. C1B(JVI)) .OR.
1 (.NOT. AVB .AND. C1B(JVI))) GOTO 41233
IF (AVD .LT. D1D(JVI)-CVD .OR. AVD .GT. D1D(JVI)+CVD) GOTO 41227
IF (A51VK .NE.
1 ' THE END ') GOTO 41231
WRITE(NUVI,80002)IVTNUM
IVPASS=IVPASS+1
GO TO 33210
C*****
C*****
C*****
41277 WRITE(NUVI,41278)IVTNUM,IVI
IVFAIL=IVFAIL+1
GO TO(33520,33540,33560,33580,33600)ISWT
41279 WRITE(NUVI,41280)IVTNUM,IVI
IVFAIL=IVFAIL+1
GO TO(33520,33540,33560,33580,33600)ISWT
41281 WRITE(NUVI,41282)IVTNUM,IVI
IVFAIL=IVFAIL+1
GO TO(33520,33540,33560,33580,33600)ISWT
41283 WRITE(NUVI,41284)IVTNUM,IVI
IVFAIL=IVFAIL+1
GO TO(33520,33540,33560,33580,33600)ISWT
41285 WRITE(NUVI,41286)IVTNUM,IVI
IVFAIL=IVFAIL+1
GO TO(33520,33540,33560,33580,33600)ISWT
41287 WRITE(NUVI,41288)IVTNUM,IVI
IVFAIL=IVFAIL+1
GO TO(33520,33540,33560,33580,33600)ISWT
41289 WRITE(NUVI,41290)IVTNUM,IVI
IVFAIL=IVFAIL+1
GO TO(33520,33540,33560,33580,33600)ISWT
41291 WRITE(NUVI,41292)IVTNUM,IVI
IVFAIL=IVFAIL+1
GO TO(33520,33540,33560,33580,33600)ISWT
41293 WRITE(NUVI,41294)IVTNUM,IVI
IVFAIL=IVFAIL+1
GO TO(33520,33540,33560,33580,33600)ISWT
C*****
C*****
C*****
41222 FORMAT(1H ,5HTEST ,I3,6H FAIL,34X,6HRECORD,I2,
1 14H - ON I FORMAT)
41224 FORMAT(1H ,5HTEST ,I3,6H FAIL,34X,6HRECORD,I2,
1 14H - ON F FORMAT)
41226 FORMAT(1H ,5HTEST ,I3,6H FAIL,34X,6HRECORD,I2,
1 14H - ON E FORMAT)
41228 FORMAT(1H ,5HTEST ,I3,6H FAIL,34X,6HRECORD,I2,
1 14H - ON D FORMAT)
41230 FORMAT(1H ,5HTEST ,I3,6H FAIL,34X,6HRECORD,I2,
1 14H - ON A FORMAT)
41232 FORMAT(1H ,5HTEST ,I3,6H FAIL,34X,6HRECORD,I2,
1 20H - ON X AND ' FORMAT)
41234 FORMAT(1H ,5HTEST ,I3,6H FAIL,34X,6HRECORD,I2,
1 14H - ON L FORMAT)
41278 FORMAT(1H ,5HTEST ,I3,6H FAIL,34X,6HRECORD,I2,
1 17H - ON GW.D FORMAT)
41280 FORMAT(1H ,5HTEST ,I3,6H FAIL,34X,6HRECORD,I2,
1 19H - ON GW.DEN FORMAT)
41282 FORMAT(1H ,5HTEST ,I3,6H FAIL,34X,6HRECORD,I2,
1 19H - ON BLANK RECORD )
41284 FORMAT(1H ,5HTEST ,I3,6H FAIL,34X,6HRECORD,I2,
1 19H - ON SP FORMAT )
41286 FORMAT(1H ,5HTEST ,I3,6H FAIL,34X,6HRECORD,I2,
1 21H - ON BZ OR SS FORMAT)
41288 FORMAT(1H ,5HTEST ,I3,6H FAIL,34X,6HRECORD,I2,
1 19H - ON NP FORMAT )
41290 FORMAT(1H ,5HTEST ,I3,6H FAIL,34X,6HRECORD,I2,
1 19H - ON H FORMAT )
41292 FORMAT(1H ,5HTEST ,I3,6H FAIL,34X,6HRECORD,I2,
1 23H - ON TR, TLC, T FORMAT)
41294 FORMAT(1H ,5HTEST ,I3,6H FAIL,34X,6HRECORD,I2,
1 19H - ON IN.N FORMAT )
C*****
C***** END OF TEST SEGMENT 412
C*****
33610 CONTINUE
CBB** ********************** BBCSUM0 **********************************
C**** WRITE OUT TEST SUMMARY
C****
IVTOTN = IVPASS + IVFAIL + IVDELE + IVINSP
WRITE (I02, 90004)
WRITE (I02, 90014)
WRITE (I02, 90004)
WRITE (I02, 90020) IVPASS
WRITE (I02, 90022) IVFAIL
WRITE (I02, 90024) IVDELE
WRITE (I02, 90026) IVINSP
WRITE (I02, 90028) IVTOTN, IVTOTL
CBE** ********************** BBCSUM0 **********************************
CBB** ********************** BBCFOOT0 **********************************
C**** WRITE OUT REPORT FOOTINGS
C****
WRITE (I02,90016) ZPROG, ZPROG
WRITE (I02,90018) ZPROJ, ZNAME, ZTAPE, ZTAPED
WRITE (I02,90019)
CBE** ********************** BBCFOOT0 **********************************
CBB** ********************** BBCFMT0A **********************************
C**** FORMATS FOR TEST DETAIL LINES
C****
80000 FORMAT (1H ,2X,I3,4X,7HDELETED,32X,A31)
80002 FORMAT (1H ,2X,I3,4X,7H PASS ,32X,A31)
80004 FORMAT (1H ,2X,I3,4X,7HINSPECT,32X,A31)
80008 FORMAT (1H ,2X,I3,4X,7H FAIL ,32X,A31)
80010 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,15X,10HCOMPUTED= ,
1I6,/,1H ,15X,10HCORRECT= ,I6)
80012 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
1E12.5,/,1H ,16X,10HCORRECT= ,E12.5)
80018 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
1A21,/,1H ,16X,10HCORRECT= ,A21)
80020 FORMAT (1H ,16X,10HCOMPUTED= ,A21,1X,A31)
80022 FORMAT (1H ,16X,10HCORRECT= ,A21,1X,A31)
80024 FORMAT (1H ,16X,10HCOMPUTED= ,I6,16X,A31)
80026 FORMAT (1H ,16X,10HCORRECT= ,I6,16X,A31)
80028 FORMAT (1H ,16X,10HCOMPUTED= ,E12.5,10X,A31)
80030 FORMAT (1H ,16X,10HCORRECT= ,E12.5,10X,A31)
80050 FORMAT (1H ,48X,A31)
CBE** ********************** BBCFMT0A **********************************
CBB** ********************** BBCFMAT1 **********************************
C**** FORMATS FOR TEST DETAIL LINES - FULL LANGUAGE
C****
80031 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
1D17.10,/,1H ,16X,10HCORRECT= ,D17.10)
80033 FORMAT (1H ,16X,10HCOMPUTED= ,D17.10,10X,A31)
80035 FORMAT (1H ,16X,10HCORRECT= ,D17.10,10X,A31)
80037 FORMAT (1H ,16X,10HCOMPUTED= ,1H(,E12.5,2H, ,E12.5,1H),6X,A31)
80039 FORMAT (1H ,16X,10HCORRECT= ,1H(,E12.5,2H, ,E12.5,1H),6X,A31)
80041 FORMAT (1H ,16X,10HCOMPUTED= ,1H(,F12.5,2H, ,F12.5,1H),6X,A31)
80043 FORMAT (1H ,16X,10HCORRECT= ,1H(,F12.5,2H, ,F12.5,1H),6X,A31)
80045 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
11H(,F12.5,2H, ,F12.5,1H)/,1H ,16X,10HCORRECT= ,
21H(,F12.5,2H, ,F12.5,1H))
CBE** ********************** BBCFMAT1 **********************************
CBB** ********************** BBCFMT0B **********************************
C**** FORMAT STATEMENTS FOR PAGE HEADERS
C****
90002 FORMAT (1H1)
90004 FORMAT (1H )
90006 FORMAT (1H ,20X,31HFEDERAL SOFTWARE TESTING CENTER)
90007 FORMAT (1H ,19X,34HFORTRAN COMPILER VALIDATION SYSTEM)
90008 FORMAT (1H ,21X,A13,A17)
90009 FORMAT (1H ,/,2H *,A5,6HBEGIN*,12X,15HTEST RESULTS - ,A5,/)
90010 FORMAT (1H ,8X,16HTEST DATE*TIME= ,A17,15H - COMPILER= ,A20)
90013 FORMAT (1H ,8H TEST ,10HPASS/FAIL ,6X,17HDISPLAYED RESULTS,
1 7X,7HREMARKS,24X)
90014 FORMAT (1H ,46H----------------------------------------------,
1 33H---------------------------------)
90015 FORMAT (1H ,48X,17HTHIS PROGRAM HAS ,I3,6H TESTS,/)
C****
C**** FORMAT STATEMENTS FOR REPORT FOOTINGS
C****
90016 FORMAT (1H ,/,2H *,A5,4HEND*,14X,14HEND OF TEST - ,A5,/)
90018 FORMAT (1H ,A13,13X,A20,7H * ,A10,1H/,
1 A13)
90019 FORMAT (1H ,26HFOR OFFICIAL USE ONLY ,35X,15HCOPYRIGHT 1982)
C****
C**** FORMAT STATEMENTS FOR RUN SUMMARY
C****
90020 FORMAT (1H ,21X,I5,13H TESTS PASSED)
90022 FORMAT (1H ,21X,I5,13H TESTS FAILED)
90024 FORMAT (1H ,21X,I5,14H TESTS DELETED)
90026 FORMAT (1H ,21X,I5,25H TESTS REQUIRE INSPECTION)
90028 FORMAT (1H ,21X,I5,4H OF ,I3,15H TESTS EXECUTED)
CBE** ********************** BBCFMT0B **********************************
STOP
END
*HEADER,FORTR,FM912,SUBRTN,FM913
C**********************************************************************
C***** FORTRAN 77
C***** FM913
C***** SN913 FAQ - (807)
C***** THIS SUBROUTINE IS CALLED BY PROGRAM FM912
C**********************************************************************
SUBROUTINE SN913(FW1S, GW1S, CW1B, DW1B, DW1D, BW1D,
1 A20W1K, B20W1K)
C*****
C***** SUBROUTINE USED WITH SEGMENT DIRAF3 (412) TO SUPPLY VALUES
C***** TO ARRAYS THRU THE DUMMY ARGUMENT LIST
C*****
REAL FT1S(5),FW1S(5),GT1S(5),GW1S(5)
LOGICAL CT1B(5),CW1B(5),DT1B(5),DW1B(5)
DOUBLE PRECISION DT1D(5),DW1D(5),BT1D(5),BW1D(5)
CHARACTER*20 A20T1K(5),A20W1K(5),B20T1K(5),B20W1K(5)
DATA FT1S /1.0, 2.0, 3.0, 4.0, 5.0/
DATA GT1S /1.2, 2.3, 3.5, 4.45, 45.0/
DATA A20T1K / 'AAAALKJHGFASERTYUIOP', 'KDJFLKJEOITMNV E CJF',
1 'CDFEJHFKLM CNB FHGDC', 'LKJHNHBJMVK,FIJ NVHD',
2 'JHGFKDJJSLDKFJDKJFSL'/
DATA B20T1K / 'AAAALSDEFCASERTYUIOP', 'KDDFFEJEOITMNV E CJF',
1 'CDFEJHFKLM DHGDC', 'L...NHBJMVK,FIJ NVHD',
2 'LKJHDNMVHNEUYHBDGHCJ'/
DATA CT1B /.TRUE., .FALSE., .TRUE., .TRUE., .FALSE./
DATA DT1B /.FALSE., .TRUE., .FALSE., .TRUE., .TRUE./
DATA DT1D /1.23D1, 2.34D1, 3.45D3, 5.602D3, 5.602D0/
DATA BT1D /23.1D1, 34.1D1, 23.45D3, .625D0, 109.384D0/
C*****
C*****
C*****
DO 1 IVI = 1, 5
FW1S(IVI) = FT1S(IVI)
GW1S(IVI) = GT1S(IVI)
CW1B(IVI) = CT1B(IVI)
DW1B(IVI) = DT1B(IVI)
DW1D(IVI) = DT1D(IVI)
BW1D(IVI) = BT1D(IVI)
A20W1K(IVI) = A20T1K(IVI)
B20W1K(IVI) = B20T1K(IVI)
1 CONTINUE
C*****
C*****
C*****
RETURN
END
*END-OF,FM912
FM914.f 481036664 170 2 100666 11061 `
*HEADER,FORTR,FM914
*FILES1,FORTR,FM914,X
C***********************************************************************
C***** FM914
C***** INQU1 - (430)
C*****
C***********************************************************************
C***** GENERAL PURPOSE ANS REF
C***** TEST INQUIRE BY UNIT ON SEQUENTIAL, FORMATTED FILES 12.10.3
C*****
C***** THE TESTS IN THIS UNIT ARE ONLY PERFORMED ON A
C***** UNIT THAT IS CONNECTED FOR SEQUENTIAL, FORMATTED ACCESS
C***** (ANS REF. 12.2.4.1 AND 12.9.5.2)
C***** THIS TEST PERFORMS AN EXPLICIT OPEN, AND PERFORMS
C***** A CLOSE WITH STATUS='DELETE' AT THE END OF THE SEGMENT.
C***********************************************************************
CBB** ********************** BBCCOMNT **********************************
C****
C**** 1978 FORTRAN COMPILER VALIDATION SYSTEM
C**** VERSION 2.0
C****
C****
C**** SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO
C**** GENERAL SERVICES ADMINISTRATION
C**** FEDERAL SOFTWARE TESTING CENTER
C**** 5203 LEESBURG PIKE, SUITE 1100
C**** FALLS CHURCH, VA. 22041
C****
C**** (703) 756-6153
C****
CBE** ********************** BBCCOMNT **********************************
LOGICAL AVB, BVB
CHARACTER*10 B10VK, C10VK, E11VK*11, F10VK, H10VK
CBB** ********************** BBCINITA **********************************
C**** SPECIFICATION STATEMENTS
C****
CHARACTER ZVERS*13, ZVERSD*17, ZDATE*17, ZPROG*5, ZCOMPL*20,
1 ZNAME*20, ZTAPE*10, ZPROJ*13, REMRKS*31, ZTAPED*13
CBE** ********************** BBCINITA **********************************
CBB** ********************** BBCINITB **********************************
C**** INITIALIZE SECTION
DATA ZVERS, ZVERSD, ZDATE
1 /'VERSION 2.0 ', '82/08/02*18.33.46', '*NO DATE*TIME'/
DATA ZCOMPL, ZNAME, ZTAPE
1 /'*NONE SPECIFIED*', '*NO COMPANY NAME*', '*NO TAPE*'/
DATA ZPROJ, ZTAPED, ZPROG
1 /'*NO PROJECT*', '*NO TAPE DATE', 'XXXXX'/
DATA REMRKS /' '/
C**** THE FOLLOWING 9 COMMENT LINES (CZ01, CZ02, ...) CAN BE REPLACED
C**** FOR IDENTIFYING THE TEST ENVIRONMENT
C****
CZ01 ZVERS = 'VERSION OF THE COMPILER VALIDATION SYSTEM'
CZ02 ZVERSD = 'CREATION DATE/TIME OF THE COMPILER VALIDATION SYSTEM'
CZ03 ZPROG = 'PROGRAM NAME'
CZ04 ZDATE = 'DATE OF TEST'
CZ05 ZCOMPL = 'COMPILER IDENTIFICATION'
CZ06 ZPROJ = 'PROJECT NUMBER/IDENTIFICATION'
CZ07 ZNAME = 'NAME OF USER'
CZ08 ZTAPE = 'TAPE OWNER/ID'
CZ09 ZTAPED = 'DATE TAPE COPIED'
C
IVPASS = 0
IVFAIL = 0
IVDELE = 0
IVINSP = 0
IVTOTL = 0
IVTOTN = 0
ICZERO = 0
C
C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER.
I01 = 05
C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER.
I02 = 06
C
CX010 REPLACED BY FEXEC X-010 CONTROL CARD (CARD-READER UNIT NUMBER).
C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5
CX011 REPLACED BY FEXEC X-011 CONTROL CARD. CX011 IS FOR SYSTEMS
C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX010.
C
CX020 REPLACED BY FEXEC X-020 CONTROL CARD (PRINTER UNIT NUMBER).
C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02= 6
CX021 REPLACED BY FEXEC X-021 CONTROL CARD. CX021 IS FOR SYSTEMS
C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX020.
C
CBE** ********************** BBCINITB **********************************
C*****
C I08 CONTAINS THE UNIT NUMBER FOR A SEQUENTIAL FORMATTED FILE.
I08 = 14
CX080 REPLACED BY FEXEC X-080 CONTROL CARD (SEQ. FILE UNIT NUMBER).
C SPECIFYING I08 = NN OVERRIDES THE DEFAULT I08 = 14.
C*****
C***** THE FOLLOWING STATEMENT MUST BE CHANGED IF
C***** THE UNIT GIVEN IS NOT CAPABLE OF BEING OPENED AS A
C***** SEQUENTIAL, FORMATTED FILE.
C*****
NUVI = I02
IMVI = I08
ZPROG = 'FM914'
IVTOTL = 1
CBB** ********************** BBCHED0A **********************************
C****
C**** WRITE REPORT TITLE
C****
WRITE (I02, 90002)
WRITE (I02, 90006)
WRITE (I02, 90007)
WRITE (I02, 90008) ZVERS, ZVERSD
WRITE (I02, 90009) ZPROG, ZPROG
WRITE (I02, 90010) ZDATE, ZCOMPL
CBE** ********************** BBCHED0A **********************************
C*****
WRITE(NUVI,43000)
43000 FORMAT(1H , / 30H INQU1 - (430) INQUIRE BY UNIT//
1 45H SEQUENTIAL FORMATTED FILE, CONNECTED BY OPEN//
2 19H ANS REF. - 12.10.3)
CBB** ********************** BBCHED0B **********************************
C**** WRITE DETAIL REPORT HEADERS
C****
WRITE (I02,90004)
WRITE (I02,90004)
WRITE (I02,90013)
WRITE (I02,90014)
WRITE (I02,90015) IVTOTL
CBE** ********************** BBCHED0B **********************************
C*****
C***** OPEN FILE
C*****
OPEN(UNIT=IMVI, ACCESS='SEQUENTIAL', FORM='FORMATTED',
1 BLANK='NULL')
C*****
CT001* TEST 1 - FIRST INQUIRE (AFTER OPEN)
IVTNUM = 1
INQUIRE(UNIT=IMVI, EXIST=AVB, OPENED=BVB, NUMBER=JVI,
1 ACCESS=B10VK, SEQUENTIAL=C10VK, FORM=E11VK,
2 FORMATTED=F10VK, BLANK=H10VK, ERR=20011, IOSTAT=KVI)
IF (KVI .NE. 0) GO TO 20010
IF (.NOT. AVB) GO TO 20010
IF (.NOT. BVB) GO TO 20010
IF (JVI .NE. IMVI) GO TO 20010
IF (B10VK .NE. 'SEQUENTIAL') GO TO 20010
IF (C10VK .NE. 'YES') GO TO 20010
IF (E11VK .NE. 'FORMATTED') GO TO 20010
IF (F10VK .NE. 'YES' ) GO TO 20010
IF (H10VK .NE. 'NULL') GO TO 20010
WRITE (NUVI, 80002) IVTNUM
IVPASS = IVPASS + 1
GO TO 0011
20011 CONTINUE
WRITE (NUVI, 20021) IVTNUM
20021 FORMAT (1H ,2X,I3,4X,5H FAIL,12X,
1 46HERROR IN EXECUTION OF INQUIRE STATEMENT (ERR=)/)
GO TO 20012
20010 CONTINUE
WRITE (NUVI, 20020) IVTNUM
20020 FORMAT(1H ,2X,I3,4X,5H FAIL,12X,
1 29HERROR IN AN INQUIRE SPECIFIER/)
20012 CONTINUE
IVFAIL = IVFAIL + 1
WRITE (NUVI, 20030) KVI,AVB,BVB,JVI,B10VK,C10VK,E11VK,
1 F10VK,H10VK
20030 FORMAT (1H ,16X,10HCOMPUTED: ,7HIOSTAT=,I1,8H, EXIST=,L1,
1 9H ,OPENED=,L1,9H, NUMBER=,I4,1H,/
2 1H ,26X,7HACCESS=,A10,13H, SEQUENTIAL=,A3,7H, FORM=,
3 A9,1H,/1H ,26X,10HFORMATTED=,A3,8H, BLANK=,A4)
WRITE (NUVI, 20040) IMVI
20040 FORMAT (1H ,16X,10HCORRECT: ,19HIOSTAT=0, EXIST=T, ,
1 17HOPENED=T, NUMBER=,I4,1H,/
2 1H ,26X,40HACCESS=SEQUENTIAL, SEQUENTIAL=YES, FORM=,
3 10HFORMATTED,/1H ,26X,25HFORMATTED=YES, BLANK=NULL)
0011 CONTINUE
C*****
REWIND IMVI
CLOSE(UNIT=IMVI, STATUS='DELETE')
CBB** ********************** BBCSUM0 **********************************
C**** WRITE OUT TEST SUMMARY
C****
IVTOTN = IVPASS + IVFAIL + IVDELE + IVINSP
WRITE (I02, 90004)
WRITE (I02, 90014)
WRITE (I02, 90004)
WRITE (I02, 90020) IVPASS
WRITE (I02, 90022) IVFAIL
WRITE (I02, 90024) IVDELE
WRITE (I02, 90026) IVINSP
WRITE (I02, 90028) IVTOTN, IVTOTL
CBE** ********************** BBCSUM0 **********************************
CBB** ********************** BBCFOOT0 **********************************
C**** WRITE OUT REPORT FOOTINGS
C****
WRITE (I02,90016) ZPROG, ZPROG
WRITE (I02,90018) ZPROJ, ZNAME, ZTAPE, ZTAPED
WRITE (I02,90019)
CBE** ********************** BBCFOOT0 **********************************
CBB** ********************** BBCFMT0A **********************************
C**** FORMATS FOR TEST DETAIL LINES
C****
80000 FORMAT (1H ,2X,I3,4X,7HDELETED,32X,A31)
80002 FORMAT (1H ,2X,I3,4X,7H PASS ,32X,A31)
80004 FORMAT (1H ,2X,I3,4X,7HINSPECT,32X,A31)
80008 FORMAT (1H ,2X,I3,4X,7H FAIL ,32X,A31)
80010 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,15X,10HCOMPUTED= ,
1I6,/,1H ,15X,10HCORRECT= ,I6)
80012 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
1E12.5,/,1H ,16X,10HCORRECT= ,E12.5)
80018 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
1A21,/,1H ,16X,10HCORRECT= ,A21)
80020 FORMAT (1H ,16X,10HCOMPUTED= ,A21,1X,A31)
80022 FORMAT (1H ,16X,10HCORRECT= ,A21,1X,A31)
80024 FORMAT (1H ,16X,10HCOMPUTED= ,I6,16X,A31)
80026 FORMAT (1H ,16X,10HCORRECT= ,I6,16X,A31)
80028 FORMAT (1H ,16X,10HCOMPUTED= ,E12.5,10X,A31)
80030 FORMAT (1H ,16X,10HCORRECT= ,E12.5,10X,A31)
80050 FORMAT (1H ,48X,A31)
CBE** ********************** BBCFMT0A **********************************
CBB** ********************** BBCFMAT1 **********************************
C**** FORMATS FOR TEST DETAIL LINES - FULL LANGUAGE
C****
80031 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
1D17.10,/,1H ,16X,10HCORRECT= ,D17.10)
80033 FORMAT (1H ,16X,10HCOMPUTED= ,D17.10,10X,A31)
80035 FORMAT (1H ,16X,10HCORRECT= ,D17.10,10X,A31)
80037 FORMAT (1H ,16X,10HCOMPUTED= ,1H(,E12.5,2H, ,E12.5,1H),6X,A31)
80039 FORMAT (1H ,16X,10HCORRECT= ,1H(,E12.5,2H, ,E12.5,1H),6X,A31)
80041 FORMAT (1H ,16X,10HCOMPUTED= ,1H(,F12.5,2H, ,F12.5,1H),6X,A31)
80043 FORMAT (1H ,16X,10HCORRECT= ,1H(,F12.5,2H, ,F12.5,1H),6X,A31)
80045 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
11H(,F12.5,2H, ,F12.5,1H)/,1H ,16X,10HCORRECT= ,
21H(,F12.5,2H, ,F12.5,1H))
CBE** ********************** BBCFMAT1 **********************************
CBB** ********************** BBCFMT0B **********************************
C**** FORMAT STATEMENTS FOR PAGE HEADERS
C****
90002 FORMAT (1H1)
90004 FORMAT (1H )
90006 FORMAT (1H ,20X,31HFEDERAL SOFTWARE TESTING CENTER)
90007 FORMAT (1H ,19X,34HFORTRAN COMPILER VALIDATION SYSTEM)
90008 FORMAT (1H ,21X,A13,A17)
90009 FORMAT (1H ,/,2H *,A5,6HBEGIN*,12X,15HTEST RESULTS - ,A5,/)
90010 FORMAT (1H ,8X,16HTEST DATE*TIME= ,A17,15H - COMPILER= ,A20)
90013 FORMAT (1H ,8H TEST ,10HPASS/FAIL ,6X,17HDISPLAYED RESULTS,
1 7X,7HREMARKS,24X)
90014 FORMAT (1H ,46H----------------------------------------------,
1 33H---------------------------------)
90015 FORMAT (1H ,48X,17HTHIS PROGRAM HAS ,I3,6H TESTS,/)
C****
C**** FORMAT STATEMENTS FOR REPORT FOOTINGS
C****
90016 FORMAT (1H ,/,2H *,A5,4HEND*,14X,14HEND OF TEST - ,A5,/)
90018 FORMAT (1H ,A13,13X,A20,7H * ,A10,1H/,
1 A13)
90019 FORMAT (1H ,26HFOR OFFICIAL USE ONLY ,35X,15HCOPYRIGHT 1982)
C****
C**** FORMAT STATEMENTS FOR RUN SUMMARY
C****
90020 FORMAT (1H ,21X,I5,13H TESTS PASSED)
90022 FORMAT (1H ,21X,I5,13H TESTS FAILED)
90024 FORMAT (1H ,21X,I5,14H TESTS DELETED)
90026 FORMAT (1H ,21X,I5,25H TESTS REQUIRE INSPECTION)
90028 FORMAT (1H ,21X,I5,4H OF ,I3,15H TESTS EXECUTED)
CBE** ********************** BBCFMT0B **********************************
C*****
C***** END OF TEST SEGMENT 914
STOP
END
*END-OF,FM914
FM915.f 481036667 170 2 100666 14673 `
*HEADER,FORTR,FM915
*FILES1,FORTR,FM915,X
C***********************************************************************
C***** FORTRAN 77
C***** FM915
C***** INQU2 - (431)
C*****
C***********************************************************************
C***** GENERAL PURPOSE ANS REF
C***** TEST INQUIRE ON SEQUENTIAL, UNFORMATTED FILES 12.10.3
C*****
C***** THE TESTS IN THIS UNIT ARE ONLY PERFORMED ON A
C***** UNIT THAT IS CONNECTED FOR SEQUENTIAL, UNFORMATTED ACCESS
C***** (ANS REF. 12.2.4.1 AND 12.9.5.1)
C***** THIS TEST PERFORMS AN EXPLICIT OPEN, AND PERFORMS
C***** A CLOSE WITH STATUS='DELETE' AT THE END OF THE SEGMENT.
C***** THE SEGMENT TESTS THAT INQUIRE IS PERFORMED CORRECTLY
C***** BEFORE READING OR WRITING TO A FILE, AFTER WRITING TO A FILE
C***** AND AFTER READING FROM A FILE.
C***********************************************************************
CBB** ********************** BBCCOMNT **********************************
C****
C**** 1978 FORTRAN COMPILER VALIDATION SYSTEM
C**** VERSION 2.0
C****
C****
C**** SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO
C**** GENERAL SERVICES ADMINISTRATION
C**** FEDERAL SOFTWARE TESTING CENTER
C**** 5203 LEESBURG PIKE, SUITE 1100
C**** FALLS CHURCH, VA. 22041
C****
C**** (703) 756-6153
C****
CBE** ********************** BBCCOMNT **********************************
LOGICAL AVB, BVB
CHARACTER*10 B10VK, C10VK, E11VK*11, G10VK
C*****
CBB** ********************** BBCINITA **********************************
C**** SPECIFICATION STATEMENTS
C****
CHARACTER ZVERS*13, ZVERSD*17, ZDATE*17, ZPROG*5, ZCOMPL*20,
1 ZNAME*20, ZTAPE*10, ZPROJ*13, REMRKS*31, ZTAPED*13
CBE** ********************** BBCINITA **********************************
CBB** ********************** BBCINITB **********************************
C**** INITIALIZE SECTION
DATA ZVERS, ZVERSD, ZDATE
1 /'VERSION 2.0 ', '82/08/02*18.33.46', '*NO DATE*TIME'/
DATA ZCOMPL, ZNAME, ZTAPE
1 /'*NONE SPECIFIED*', '*NO COMPANY NAME*', '*NO TAPE*'/
DATA ZPROJ, ZTAPED, ZPROG
1 /'*NO PROJECT*', '*NO TAPE DATE', 'XXXXX'/
DATA REMRKS /' '/
C**** THE FOLLOWING 9 COMMENT LINES (CZ01, CZ02, ...) CAN BE REPLACED
C**** FOR IDENTIFYING THE TEST ENVIRONMENT
C****
CZ01 ZVERS = 'VERSION OF THE COMPILER VALIDATION SYSTEM'
CZ02 ZVERSD = 'CREATION DATE/TIME OF THE COMPILER VALIDATION SYSTEM'
CZ03 ZPROG = 'PROGRAM NAME'
CZ04 ZDATE = 'DATE OF TEST'
CZ05 ZCOMPL = 'COMPILER IDENTIFICATION'
CZ06 ZPROJ = 'PROJECT NUMBER/IDENTIFICATION'
CZ07 ZNAME = 'NAME OF USER'
CZ08 ZTAPE = 'TAPE OWNER/ID'
CZ09 ZTAPED = 'DATE TAPE COPIED'
C
IVPASS = 0
IVFAIL = 0
IVDELE = 0
IVINSP = 0
IVTOTL = 0
IVTOTN = 0
ICZERO = 0
C
C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER.
I01 = 05
C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER.
I02 = 06
C
CX010 REPLACED BY FEXEC X-010 CONTROL CARD (CARD-READER UNIT NUMBER).
C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5
CX011 REPLACED BY FEXEC X-011 CONTROL CARD. CX011 IS FOR SYSTEMS
C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX010.
C
CX020 REPLACED BY FEXEC X-020 CONTROL CARD (PRINTER UNIT NUMBER).
C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02= 6
CX021 REPLACED BY FEXEC X-021 CONTROL CARD. CX021 IS FOR SYSTEMS
C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX020.
C
CBE** ********************** BBCINITB **********************************
C*****
C***** THE FOLLOWING STATEMENT MUST BE CHANGED IF
C***** THE UNIT GIVEN IS NOT CAPABLE OF BEING OPENED AS A
C***** SEQUENTIAL, UNFORMATTED FILE.
C I05 CONTAINS THE UNIT NUMBER FOR A SEQUENTIAL UNFORMATTED FILE.
I05 = 14
CX050 REPLACED BY FEXEC X-050 CONTROL CARD (SEQ. FILE UNIT NUMBER).
C SPECIFYING I05 = NN OVERRIDES THE DEFAULT I05 = 14.
C*****
NUVI = I02
IMVI = I05
ZPROG = 'FM915'
IVTOTL = 3
CBB** ********************** BBCHED0A **********************************
C****
C**** WRITE REPORT TITLE
C****
WRITE (I02, 90002)
WRITE (I02, 90006)
WRITE (I02, 90007)
WRITE (I02, 90008) ZVERS, ZVERSD
WRITE (I02, 90009) ZPROG, ZPROG
WRITE (I02, 90010) ZDATE, ZCOMPL
CBE** ********************** BBCHED0A **********************************
C*****
WRITE(NUVI,43100)
43100 FORMAT(1H , / 30H INQU2 - (431) INQUIRE BY UNIT//
1 47H SEQUENTIAL UNFORMATTED FILE, CONNECTED BY OPEN//
2 19H ANS REF. - 12.10.3)
CBB** ********************** BBCHED0B **********************************
C**** WRITE DETAIL REPORT HEADERS
C****
WRITE (I02,90004)
WRITE (I02,90004)
WRITE (I02,90013)
WRITE (I02,90014)
WRITE (I02,90015) IVTOTL
CBE** ********************** BBCHED0B **********************************
C*****
C***** OPEN FILE
C*****
OPEN(UNIT=IMVI, ACCESS='SEQUENTIAL', FORM='UNFORMATTED')
CT001* TEST 1 - FIRST INQUIRE (AFTER OPEN)
IVTNUM = 1
INQUIRE(UNIT=IMVI, EXIST=AVB, OPENED=BVB, NUMBER=JVI,
1 ACCESS=B10VK, SEQUENTIAL=C10VK, FORM=E11VK,
2 UNFORMATTED=G10VK, ERR=20014, IOSTAT=KVI)
C*****
IF (KVI .NE. 0) GO TO 20010
IF (.NOT. AVB) GO TO 20010
IF (.NOT. BVB) GO TO 20010
IF (JVI .NE. IMVI) GO TO 20010
IF (B10VK .NE. 'SEQUENTIAL') GO TO 20010
IF (C10VK. NE. 'YES') GO TO 20010
IF (E11VK .NE. 'UNFORMATTED') GO TO 20010
IF (G10VK .NE. 'YES' ) GO TO 20010
WRITE (NUVI, 80002) IVTNUM
IVPASS = IVPASS + 1
GO TO 0011
20014 CONTINUE
WRITE (NUVI, 20015) IVTNUM
20015 FORMAT (1H ,2X,I3,4X,5H FAIL,12X,
1 46HERROR IN EXECUTION OF INQUIRE STATEMENT (ERR=)/)
GO TO 20016
20010 CONTINUE
WRITE (NUVI, 20011) IVTNUM
20011 FORMAT(1H ,2X,I3,4X,5H FAIL,12X,
1 29HERROR IN AN INQUIRE SPECIFIER/)
20016 IVFAIL = IVFAIL + 1
WRITE (NUVI, 20012) KVI,AVB,BVB,JVI,B10VK,C10VK,E11VK,
1 G10VK
20012 FORMAT (1H ,16X,10HCOMPUTED: ,7HIOSTAT=,I1,8H, EXIST=,L1,
1 9H ,OPENED=,L1,9H, NUMBER=,I4,1H,/
2 1H ,26X,7HACCESS=,A10,13H, SEQUENTIAL=,A3,7H, FORM=,
3 A11,1H,/1H ,26X,12HUNFORMATTED=,A3)
WRITE (NUVI, 20013) IMVI
20013 FORMAT (1H ,16X,10HCORRECT: ,19HIOSTAT=0, EXIST=T, ,
1 17HOPENED=T, NUMBER=,I4,1H,/
2 1H ,26X,40HACCESS=SEQUENTIAL, SEQUENTIAL=YES, FORM=,
3 12HUNFORMATTED,/1H ,26X,15HUNFORMATTED=YES)
0011 CONTINUE
C*****
C***** WRITE TO FILE
C*****
WRITE(IMVI) JVI
CT002* TEST 2 - SECOND INQUIRE (AFTER WRITE)
IVTNUM = 2
INQUIRE(UNIT=IMVI, EXIST=AVB, OPENED=BVB, NUMBER=JVI,
1 ACCESS=B10VK, SEQUENTIAL=C10VK, FORM=E11VK,
2 UNFORMATTED=G10VK, ERR=20024, IOSTAT=KVI)
C*****
IF (KVI .NE. 0) GO TO 20020
IF (.NOT. AVB) GO TO 20020
IF (.NOT. BVB) GO TO 20020
IF (JVI .NE. IMVI) GO TO 20020
IF (B10VK .NE. 'SEQUENTIAL') GO TO 20020
IF (C10VK.NE. 'YES') GO TO 20020
IF (E11VK .NE. 'UNFORMATTED') GO TO 20020
IF (G10VK .NE. 'YES' ) GO TO 20020
WRITE (NUVI, 80002) IVTNUM
IVPASS = IVPASS + 1
GO TO 0021
20024 CONTINUE
WRITE (NUVI, 20025) IVTNUM
20025 FORMAT (1H ,2X,I3,4X,5H FAIL,12X,
1 46HERROR IN EXECUTION OF INQUIRE STATEMENT (ERR=)/)
GO TO 20026
20020 CONTINUE
WRITE (NUVI, 20021) IVTNUM
20021 FORMAT(1H ,2X,I3,4X,5H FAIL,12X,
1 29HERROR IN AN INQUIRE SPECIFIER/)
20026 IVFAIL = IVFAIL + 1
WRITE (NUVI, 20022) KVI,AVB,BVB,JVI,B10VK,C10VK,E11VK,
1 G10VK
20022 FORMAT (1H ,16X,10HCOMPUTED: ,7HIOSTAT=,I1,8H, EXIST=,L1,
1 9H ,OPENED=,L1,9H, NUMBER=,I4,1H,/
2 1H ,26X,7HACCESS=,A10,13H, SEQUENTIAL=,A3,7H, FORM=,
3 A11,1H,/1H ,26X,12HUNFORMATTED=,A3)
WRITE (NUVI, 20023) IMVI
20023 FORMAT (1H ,16X,10HCORRECT: ,19HIOSTAT=0, EXIST=T, ,
1 17HOPENED=T, NUMBER=,I4,1H,/
2 1H ,26X,40HACCESS=SEQUENTIAL, SEQUENTIAL=YES, FORM=,
3 12HUNFORMATTED,/1H ,26X,15HUNFORMATTED=YES)
0021 CONTINUE
C*****
C***** REWIND AND READ FILE
REWIND IMVI
READ(IMVI) JVI
REWIND IMVI
C*****
CT003* TEST 3 - THIRD INQUIRE (AFTER READ)
IVTNUM = 3
INQUIRE(UNIT=IMVI, EXIST=AVB, OPENED=BVB, NUMBER=JVI,
1 ACCESS=B10VK, SEQUENTIAL=C10VK, FORM=E11VK,
2 UNFORMATTED=G10VK, ERR=20034,IOSTAT=KVI)
C*****
IF (KVI .NE. 0) GO TO 20030
IF (.NOT. AVB) GO TO 20030
IF (.NOT. BVB) GO TO 20030
IF (JVI .NE. IMVI) GO TO 20030
IF (B10VK .NE. 'SEQUENTIAL') GO TO 20030
IF (C10VK .NE. 'YES') GO TO 20030
IF (E11VK .NE. 'UNFORMATTED') GO TO 20030
IF (G10VK .NE. 'YES' ) GO TO 20030
WRITE (NUVI, 80002) IVTNUM
IVPASS = IVPASS + 1
GO TO 0031
20034 CONTINUE
WRITE (NUVI, 20035) IVTNUM
20035 FORMAT (1H ,2X,I3,4X,5H FAIL,12X,
1 46HERROR IN EXECUTION OF INQUIRE STATEMENT (ERR=)/)
GO TO 20036
20030 CONTINUE
WRITE (NUVI, 20031) IVTNUM
20031 FORMAT(1H ,2X,I3,4X,5H FAIL,12X,
1 29HERROR IN AN INQUIRE SPECIFIER/)
20036 IVFAIL = IVFAIL + 1
WRITE (NUVI, 20032) KVI,AVB,BVB,JVI,B10VK,C10VK,E11VK,
1 G10VK
20032 FORMAT (1H ,16X,10HCOMPUTED: ,7HIOSTAT=,I1,8H, EXIST=,L1,
1 9H ,OPENED=,L1,9H, NUMBER=,I4,1H,/
2 1H ,26X,7HACCESS=,A10,13H, SEQUENTIAL=,A3,7H, FORM=,
3 A11,1H,/1H ,26X,12HUNFORMATTED=,A3)
WRITE (NUVI, 20033) IMVI
20033 FORMAT (1H ,16X,10HCORRECT: ,19HIOSTAT=0, EXIST=T, ,
1 17HOPENED=T, NUMBER=,I4,1H,/
2 1H ,26X,40HACCESS=SEQUENTIAL, SEQUENTIAL=YES, FORM=,
3 12HUNFORMATTED,/1H ,26X,15HUNFORMATTED=YES)
0031 CONTINUE
CLOSE(UNIT=IMVI, STATUS='DELETE')
C*****
CBB** ********************** BBCSUM0 **********************************
C**** WRITE OUT TEST SUMMARY
C****
IVTOTN = IVPASS + IVFAIL + IVDELE + IVINSP
WRITE (I02, 90004)
WRITE (I02, 90014)
WRITE (I02, 90004)
WRITE (I02, 90020) IVPASS
WRITE (I02, 90022) IVFAIL
WRITE (I02, 90024) IVDELE
WRITE (I02, 90026) IVINSP
WRITE (I02, 90028) IVTOTN, IVTOTL
CBE** ********************** BBCSUM0 **********************************
CBB** ********************** BBCFOOT0 **********************************
C**** WRITE OUT REPORT FOOTINGS
C****
WRITE (I02,90016) ZPROG, ZPROG
WRITE (I02,90018) ZPROJ, ZNAME, ZTAPE, ZTAPED
WRITE (I02,90019)
CBE** ********************** BBCFOOT0 **********************************
CBB** ********************** BBCFMT0A **********************************
C**** FORMATS FOR TEST DETAIL LINES
C****
80000 FORMAT (1H ,2X,I3,4X,7HDELETED,32X,A31)
80002 FORMAT (1H ,2X,I3,4X,7H PASS ,32X,A31)
80004 FORMAT (1H ,2X,I3,4X,7HINSPECT,32X,A31)
80008 FORMAT (1H ,2X,I3,4X,7H FAIL ,32X,A31)
80010 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,15X,10HCOMPUTED= ,
1I6,/,1H ,15X,10HCORRECT= ,I6)
80012 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
1E12.5,/,1H ,16X,10HCORRECT= ,E12.5)
80018 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
1A21,/,1H ,16X,10HCORRECT= ,A21)
80020 FORMAT (1H ,16X,10HCOMPUTED= ,A21,1X,A31)
80022 FORMAT (1H ,16X,10HCORRECT= ,A21,1X,A31)
80024 FORMAT (1H ,16X,10HCOMPUTED= ,I6,16X,A31)
80026 FORMAT (1H ,16X,10HCORRECT= ,I6,16X,A31)
80028 FORMAT (1H ,16X,10HCOMPUTED= ,E12.5,10X,A31)
80030 FORMAT (1H ,16X,10HCORRECT= ,E12.5,10X,A31)
80050 FORMAT (1H ,48X,A31)
CBE** ********************** BBCFMT0A **********************************
CBB** ********************** BBCFMAT1 **********************************
C**** FORMATS FOR TEST DETAIL LINES - FULL LANGUAGE
C****
80031 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
1D17.10,/,1H ,16X,10HCORRECT= ,D17.10)
80033 FORMAT (1H ,16X,10HCOMPUTED= ,D17.10,10X,A31)
80035 FORMAT (1H ,16X,10HCORRECT= ,D17.10,10X,A31)
80037 FORMAT (1H ,16X,10HCOMPUTED= ,1H(,E12.5,2H, ,E12.5,1H),6X,A31)
80039 FORMAT (1H ,16X,10HCORRECT= ,1H(,E12.5,2H, ,E12.5,1H),6X,A31)
80041 FORMAT (1H ,16X,10HCOMPUTED= ,1H(,F12.5,2H, ,F12.5,1H),6X,A31)
80043 FORMAT (1H ,16X,10HCORRECT= ,1H(,F12.5,2H, ,F12.5,1H),6X,A31)
80045 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
11H(,F12.5,2H, ,F12.5,1H)/,1H ,16X,10HCORRECT= ,
21H(,F12.5,2H, ,F12.5,1H))
CBE** ********************** BBCFMAT1 **********************************
CBB** ********************** BBCFMT0B **********************************
C**** FORMAT STATEMENTS FOR PAGE HEADERS
C****
90002 FORMAT (1H1)
90004 FORMAT (1H )
90006 FORMAT (1H ,20X,31HFEDERAL SOFTWARE TESTING CENTER)
90007 FORMAT (1H ,19X,34HFORTRAN COMPILER VALIDATION SYSTEM)
90008 FORMAT (1H ,21X,A13,A17)
90009 FORMAT (1H ,/,2H *,A5,6HBEGIN*,12X,15HTEST RESULTS - ,A5,/)
90010 FORMAT (1H ,8X,16HTEST DATE*TIME= ,A17,15H - COMPILER= ,A20)
90013 FORMAT (1H ,8H TEST ,10HPASS/FAIL ,6X,17HDISPLAYED RESULTS,
1 7X,7HREMARKS,24X)
90014 FORMAT (1H ,46H----------------------------------------------,
1 33H---------------------------------)
90015 FORMAT (1H ,48X,17HTHIS PROGRAM HAS ,I3,6H TESTS,/)
C****
C**** FORMAT STATEMENTS FOR REPORT FOOTINGS
C****
90016 FORMAT (1H ,/,2H *,A5,4HEND*,14X,14HEND OF TEST - ,A5,/)
90018 FORMAT (1H ,A13,13X,A20,7H * ,A10,1H/,
1 A13)
90019 FORMAT (1H ,26HFOR OFFICIAL USE ONLY ,35X,15HCOPYRIGHT 1982)
C****
C**** FORMAT STATEMENTS FOR RUN SUMMARY
C****
90020 FORMAT (1H ,21X,I5,13H TESTS PASSED)
90022 FORMAT (1H ,21X,I5,13H TESTS FAILED)
90024 FORMAT (1H ,21X,I5,14H TESTS DELETED)
90026 FORMAT (1H ,21X,I5,25H TESTS REQUIRE INSPECTION)
90028 FORMAT (1H ,21X,I5,4H OF ,I3,15H TESTS EXECUTED)
CBE** ********************** BBCFMT0B **********************************
C*****
C***** END OF TEST SEGMENT 431
STOP
END
*END-OF,FM915
FM916.f 481036670 170 2 100666 10424 `
*HEADER,FORTR,FM916
*FILES1,FORTR,FM916,X
C***********************************************************************
C***** FORTRAN 77
C***** FM916
C***** INQU3 - (432)
C*****
C***********************************************************************
C***** GENERAL PURPOSE ANS REF
C***** TEST INQUIRE BY UNIT ON DIRECT, FORMATTED FILE 12.10.3
C*****
C***** THE TESTS IN THE UNIT ARE ONLY PERFORMED ON A
C***** UNIT THAT IS CONNECTED FOR FORMATTED, DIRECT ACCESS
C***** (ANS REF. 12.2.4.2 AND 12.9.5.2)
C***** THIS TEST PERFORMS AN EXPLICIT OPEN, AND PERFORMS
C***** A CLOSE WITH STATUS='DELETE' AT THE END OF THE SEGMENT.
C*****
CBB** ********************** BBCCOMNT **********************************
C****
C**** 1978 FORTRAN COMPILER VALIDATION SYSTEM
C**** VERSION 2.0
C****
C****
C**** SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO
C**** GENERAL SERVICES ADMINISTRATION
C**** FEDERAL SOFTWARE TESTING CENTER
C**** 5203 LEESBURG PIKE, SUITE 1100
C**** FALLS CHURCH, VA. 22041
C****
C**** (703) 756-6153
C****
CBE** ********************** BBCCOMNT **********************************
C*****
LOGICAL AVB, BVB
CHARACTER*10 B10VK, D10VK, E11VK*11, F10VK, H10VK
CBB** ********************** BBCINITA **********************************
C**** SPECIFICATION STATEMENTS
C****
CHARACTER ZVERS*13, ZVERSD*17, ZDATE*17, ZPROG*5, ZCOMPL*20,
1 ZNAME*20, ZTAPE*10, ZPROJ*13, REMRKS*31, ZTAPED*13
CBE** ********************** BBCINITA **********************************
CBB** ********************** BBCINITB **********************************
C**** INITIALIZE SECTION
DATA ZVERS, ZVERSD, ZDATE
1 /'VERSION 2.0 ', '82/08/02*18.33.46', '*NO DATE*TIME'/
DATA ZCOMPL, ZNAME, ZTAPE
1 /'*NONE SPECIFIED*', '*NO COMPANY NAME*', '*NO TAPE*'/
DATA ZPROJ, ZTAPED, ZPROG
1 /'*NO PROJECT*', '*NO TAPE DATE', 'XXXXX'/
DATA REMRKS /' '/
C**** THE FOLLOWING 9 COMMENT LINES (CZ01, CZ02, ...) CAN BE REPLACED
C**** FOR IDENTIFYING THE TEST ENVIRONMENT
C****
CZ01 ZVERS = 'VERSION OF THE COMPILER VALIDATION SYSTEM'
CZ02 ZVERSD = 'CREATION DATE/TIME OF THE COMPILER VALIDATION SYSTEM'
CZ03 ZPROG = 'PROGRAM NAME'
CZ04 ZDATE = 'DATE OF TEST'
CZ05 ZCOMPL = 'COMPILER IDENTIFICATION'
CZ06 ZPROJ = 'PROJECT NUMBER/IDENTIFICATION'
CZ07 ZNAME = 'NAME OF USER'
CZ08 ZTAPE = 'TAPE OWNER/ID'
CZ09 ZTAPED = 'DATE TAPE COPIED'
C
IVPASS = 0
IVFAIL = 0
IVDELE = 0
IVINSP = 0
IVTOTL = 0
IVTOTN = 0
ICZERO = 0
C
C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER.
I01 = 05
C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER.
I02 = 06
C
CX010 REPLACED BY FEXEC X-010 CONTROL CARD (CARD-READER UNIT NUMBER).
C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5
CX011 REPLACED BY FEXEC X-011 CONTROL CARD. CX011 IS FOR SYSTEMS
C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX010.
C
CX020 REPLACED BY FEXEC X-020 CONTROL CARD (PRINTER UNIT NUMBER).
C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02= 6
CX021 REPLACED BY FEXEC X-021 CONTROL CARD. CX021 IS FOR SYSTEMS
C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX020.
C
CBE** ********************** BBCINITB **********************************
C*****
C***** THE FOLLOWING STATEMENT MUST BE CHANGED IF
C***** THE UNIT GIVEN IS NOT CAPABLE OF BEING OPENED AS A
C***** DIRECT, FORMATTED FILE.
C***** S C R A T C H D I R E C T A C C E S S U N I T
I14 = 14
CX140 THIS CARD IS REPLACED BY THE CONTENTS OF CARD X-140
C X-140 I14 = NN WILL OVERRIDE I14 = 14
C*****
C***** THE FOLLOWING STATEMENT MUST BE CHANGED IF 40 IS
C***** NOT A VALID RECORD LENGTH.
MVI = 40
C*****
NUVI = I02
IOVI = I14
ZPROG = 'FM916'
IVTOTL = 1
CBB** ********************** BBCHED0A **********************************
C****
C**** WRITE REPORT TITLE
C****
WRITE (I02, 90002)
WRITE (I02, 90006)
WRITE (I02, 90007)
WRITE (I02, 90008) ZVERS, ZVERSD
WRITE (I02, 90009) ZPROG, ZPROG
WRITE (I02, 90010) ZDATE, ZCOMPL
CBE** ********************** BBCHED0A **********************************
C*****
WRITE(NUVI,43200)
43200 FORMAT(1H , / 30H INQU3 - (432) INQUIRE BY UNIT//
1 29H DIRECT ACCESS FORMATTED FILE//
2 19H ANS REF. - 12.10.3)
CBB** ********************** BBCHED0B **********************************
C**** WRITE DETAIL REPORT HEADERS
C****
WRITE (I02,90004)
WRITE (I02,90004)
WRITE (I02,90013)
WRITE (I02,90014)
WRITE (I02,90015) IVTOTL
CBE** ********************** BBCHED0B **********************************
C*****
C***** OPEN FILE
OPEN(UNIT=IOVI, ACCESS='DIRECT', RECL=MVI, FORM='FORMATTED',
1 BLANK='NULL')
C*****
C***** TEST 1 - FIRST INQUIRE (AFTER OPEN)
IVTNUM = 1
INQUIRE(UNIT=IOVI, EXIST=AVB, OPENED=BVB, NUMBER=JVI,
1 ACCESS=B10VK, DIRECT=D10VK, RECL=KVI, NEXTREC=LVI,
2 FORM=E11VK, FORMATTED=F10VK, BLANK=H10VK, ERR=20014,
3 IOSTAT=NVI)
C*****
IF (NVI .NE. 0) GO TO 20010
IF (.NOT. AVB) GO TO 20010
IF (.NOT. BVB) GO TO 20010
IF (JVI .NE. IOVI) GO TO 20010
IF (B10VK .NE. 'DIRECT') GO TO 20010
IF (D10VK .NE. 'YES') GO TO 20010
IF (KVI .NE. MVI) GO TO 20010
IF (LVI .NE. 1) GO TO 20010
IF (E11VK .NE. 'FORMATTED') GO TO 20010
IF (F10VK .NE. 'YES' ) GO TO 20010
IF (H10VK .NE. 'NULL') GO TO 20010
WRITE (NUVI, 80002) IVTNUM
IVPASS = IVPASS + 1
GO TO 0011
20014 CONTINUE
WRITE (NUVI, 20015) IVTNUM
20015 FORMAT (1H ,2X,I3,4X,5H FAIL,12X,
1 46HERROR IN EXECUTION OF INQUIRE STATEMENT (ERR=)/)
GO TO 20016
20010 CONTINUE
WRITE (NUVI, 20011) IVTNUM
20011 FORMAT(1H ,2X,I3,4X,5H FAIL,12X,
1 29HERROR IN AN INQUIRE SPECIFIER/)
20016 IVFAIL = IVFAIL + 1
WRITE (NUVI, 20012) NVI,AVB,BVB,JVI,B10VK,D10VK,
1 KVI,LVI,E11VK,F10VK,H10VK
20012 FORMAT (1H ,16X,10HCOMPUTED: ,7HIOSTAT=,I1,8H, EXIST=,L1,
1 9H ,OPENED=,L1,9H, NUMBER=,I4,1H,/
2 1H ,26X,7HACCESS=,A10,9H, DIRECT=,A3,7H, RECL=,
3 I4,1H,/1H ,26X,8HNEXTREC=,I4,7H, FORM=,
4 A9,1H,/1H ,26X,10HFORMATTED=,A3,8H, BLANK=,A4)
WRITE (NUVI, 20013) IOVI,MVI
20013 FORMAT (1H ,16X,10HCORRECT: ,19HIOSTAT=0, EXIST=T, ,
1 17HOPENED=T, NUMBER=,I4,1H,/
2 1H ,26X,32HACCESS=DIRECT, DIRECT=YES, RECL=,
3 I4,1H,/1H ,26X,26HNEXTREC=1, FORM=FORMATTED,/
4 1H ,26X,25HFORMATTED=YES, BLANK=NULL)
0011 CONTINUE
C*****
CLOSE(UNIT=IOVI, STATUS='DELETE')
C*****
CBB** ********************** BBCSUM0 **********************************
C**** WRITE OUT TEST SUMMARY
C****
IVTOTN = IVPASS + IVFAIL + IVDELE + IVINSP
WRITE (I02, 90004)
WRITE (I02, 90014)
WRITE (I02, 90004)
WRITE (I02, 90020) IVPASS
WRITE (I02, 90022) IVFAIL
WRITE (I02, 90024) IVDELE
WRITE (I02, 90026) IVINSP
WRITE (I02, 90028) IVTOTN, IVTOTL
CBE** ********************** BBCSUM0 **********************************
CBB** ********************** BBCFOOT0 **********************************
C**** WRITE OUT REPORT FOOTINGS
C****
WRITE (I02,90016) ZPROG, ZPROG
WRITE (I02,90018) ZPROJ, ZNAME, ZTAPE, ZTAPED
WRITE (I02,90019)
CBE** ********************** BBCFOOT0 **********************************
CBB** ********************** BBCFMT0A **********************************
C**** FORMATS FOR TEST DETAIL LINES
C****
80000 FORMAT (1H ,2X,I3,4X,7HDELETED,32X,A31)
80002 FORMAT (1H ,2X,I3,4X,7H PASS ,32X,A31)
80004 FORMAT (1H ,2X,I3,4X,7HINSPECT,32X,A31)
80008 FORMAT (1H ,2X,I3,4X,7H FAIL ,32X,A31)
80010 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,15X,10HCOMPUTED= ,
1I6,/,1H ,15X,10HCORRECT= ,I6)
80012 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
1E12.5,/,1H ,16X,10HCORRECT= ,E12.5)
80018 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
1A21,/,1H ,16X,10HCORRECT= ,A21)
80020 FORMAT (1H ,16X,10HCOMPUTED= ,A21,1X,A31)
80022 FORMAT (1H ,16X,10HCORRECT= ,A21,1X,A31)
80024 FORMAT (1H ,16X,10HCOMPUTED= ,I6,16X,A31)
80026 FORMAT (1H ,16X,10HCORRECT= ,I6,16X,A31)
80028 FORMAT (1H ,16X,10HCOMPUTED= ,E12.5,10X,A31)
80030 FORMAT (1H ,16X,10HCORRECT= ,E12.5,10X,A31)
80050 FORMAT (1H ,48X,A31)
CBE** ********************** BBCFMT0A **********************************
CBB** ********************** BBCFMT0B **********************************
C**** FORMAT STATEMENTS FOR PAGE HEADERS
C****
90002 FORMAT (1H1)
90004 FORMAT (1H )
90006 FORMAT (1H ,20X,31HFEDERAL SOFTWARE TESTING CENTER)
90007 FORMAT (1H ,19X,34HFORTRAN COMPILER VALIDATION SYSTEM)
90008 FORMAT (1H ,21X,A13,A17)
90009 FORMAT (1H ,/,2H *,A5,6HBEGIN*,12X,15HTEST RESULTS - ,A5,/)
90010 FORMAT (1H ,8X,16HTEST DATE*TIME= ,A17,15H - COMPILER= ,A20)
90013 FORMAT (1H ,8H TEST ,10HPASS/FAIL ,6X,17HDISPLAYED RESULTS,
1 7X,7HREMARKS,24X)
90014 FORMAT (1H ,46H----------------------------------------------,
1 33H---------------------------------)
90015 FORMAT (1H ,48X,17HTHIS PROGRAM HAS ,I3,6H TESTS,/)
C****
C**** FORMAT STATEMENTS FOR REPORT FOOTINGS
C****
90016 FORMAT (1H ,/,2H *,A5,4HEND*,14X,14HEND OF TEST - ,A5,/)
90018 FORMAT (1H ,A13,13X,A20,7H * ,A10,1H/,
1 A13)
90019 FORMAT (1H ,26HFOR OFFICIAL USE ONLY ,35X,15HCOPYRIGHT 1982)
C****
C**** FORMAT STATEMENTS FOR RUN SUMMARY
C****
90020 FORMAT (1H ,21X,I5,13H TESTS PASSED)
90022 FORMAT (1H ,21X,I5,13H TESTS FAILED)
90024 FORMAT (1H ,21X,I5,14H TESTS DELETED)
90026 FORMAT (1H ,21X,I5,25H TESTS REQUIRE INSPECTION)
90028 FORMAT (1H ,21X,I5,4H OF ,I3,15H TESTS EXECUTED)
CBE** ********************** BBCFMT0B **********************************
C*****
C***** END OF TEST SEGMENT 432
STOP
END
*END-OF,FM916
FM917.f 481036674 170 2 100666 13908 `
*HEADER,FORTR,FM917
*FILES1,FORTR,FM917,X
C***********************************************************************
C***** FORTRAN 77
C***** FM917
C***** INQU4 - (433)
C*****
C***********************************************************************
C***** GENERAL PURPOSE ANS REF
C***** TEST INQUIRE BY UNIT ON DIRECT, UNFORMATTED FILE 12.10.3
C*****
C***** THE TESTS IN THE UNIT ARE ONLY PERFORMED ON A
C***** UNIT THAT IS CONNECTED FOR DIRECT, UNFORMATTED ACCESS
C***** (ANS REF. 12.2.4.2 AND 12.9.5.1)
C***** THIS TEST PERFORMS AN EXPLICIT OPEN, AND PERFORMS
C***** A CLOSE WITH STATUS='DELETE' AT THE END OF THE SEGMENT.
C***** THIS SEGMENT TESTS THAT AN INQUIRE IS PERFORMED CORRECTLY
C***** BEFORE READING OR WRITING TO THE FILE, AFTER WRITING TO
C***** THE FILE, AND AFTER READING FROM THE FILE.
C*****
C***** NOTE:
C***** AN INQUIRE STATEMENT IS NEEDED TO TEST THE READ AND
C***** WRITE OF MORE THAN A SINGLE RECORD AT A TIME, IN ORDER TO
C***** DETERMINE THAT THE RECORD NUMBER IS ADVANCED THE CORRECT
C***** NUMBER (ONE MORE THAN THE RECORD NUMBER LAST READ OR WRITTEN).
C***** THIS TEST WILL BE PERFORMED IN THE SEGMENTS WHICH TEST
C***** DIRECT ACCESS FILES - SEGMENT DIRAF3 (412).
C***********************************************************************
C*****
CBB** ********************** BBCCOMNT **********************************
C****
C**** 1978 FORTRAN COMPILER VALIDATION SYSTEM
C**** VERSION 2.0
C****
C****
C**** SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO
C**** GENERAL SERVICES ADMINISTRATION
C**** FEDERAL SOFTWARE TESTING CENTER
C**** 5203 LEESBURG PIKE, SUITE 1100
C**** FALLS CHURCH, VA. 22041
C****
C**** (703) 756-6153
C****
CBE** ********************** BBCCOMNT **********************************
C*****
LOGICAL AVB, BVB
CHARACTER*10 B10VK, D10VK, E11VK*11, G10VK
C***** BELOW CHARACTER STATEMENT ESTABLISHES THE FILE NAME VARIABLES.
CBB** ********************** BBCINITA **********************************
C**** SPECIFICATION STATEMENTS
C****
CHARACTER ZVERS*13, ZVERSD*17, ZDATE*17, ZPROG*5, ZCOMPL*20,
1 ZNAME*20, ZTAPE*10, ZPROJ*13, REMRKS*31, ZTAPED*13
CBE** ********************** BBCINITA **********************************
CBB** ********************** BBCINITB **********************************
C**** INITIALIZE SECTION
DATA ZVERS, ZVERSD, ZDATE
1 /'VERSION 2.0 ', '82/08/02*18.33.46', '*NO DATE*TIME'/
DATA ZCOMPL, ZNAME, ZTAPE
1 /'*NONE SPECIFIED*', '*NO COMPANY NAME*', '*NO TAPE*'/
DATA ZPROJ, ZTAPED, ZPROG
1 /'*NO PROJECT*', '*NO TAPE DATE', 'XXXXX'/
DATA REMRKS /' '/
C**** THE FOLLOWING 9 COMMENT LINES (CZ01, CZ02, ...) CAN BE REPLACED
C**** FOR IDENTIFYING THE TEST ENVIRONMENT
C****
CZ01 ZVERS = 'VERSION OF THE COMPILER VALIDATION SYSTEM'
CZ02 ZVERSD = 'CREATION DATE/TIME OF THE COMPILER VALIDATION SYSTEM'
CZ03 ZPROG = 'PROGRAM NAME'
CZ04 ZDATE = 'DATE OF TEST'
CZ05 ZCOMPL = 'COMPILER IDENTIFICATION'
CZ06 ZPROJ = 'PROJECT NUMBER/IDENTIFICATION'
CZ07 ZNAME = 'NAME OF USER'
CZ08 ZTAPE = 'TAPE OWNER/ID'
CZ09 ZTAPED = 'DATE TAPE COPIED'
C
IVPASS = 0
IVFAIL = 0
IVDELE = 0
IVINSP = 0
IVTOTL = 0
IVTOTN = 0
ICZERO = 0
C
C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER.
I01 = 05
C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER.
I02 = 06
C
CX010 REPLACED BY FEXEC X-010 CONTROL CARD (CARD-READER UNIT NUMBER).
C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5
CX011 REPLACED BY FEXEC X-011 CONTROL CARD. CX011 IS FOR SYSTEMS
C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX010.
C
CX020 REPLACED BY FEXEC X-020 CONTROL CARD (PRINTER UNIT NUMBER).
C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02= 6
CX021 REPLACED BY FEXEC X-021 CONTROL CARD. CX021 IS FOR SYSTEMS
C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX020.
C
CBE** ********************** BBCINITB **********************************
C*****
C***** THE FOLLOWING STATEMENT MUST BE CHANGED IF
C***** THE UNIT GIVEN IS NOT CAPABLE OF BEING OPENED AS A
C***** DIRECT, UNFORMATTED FILE.
C*****
C I12 CONTAINS THE UNIT NUMBER FOR A DIRECT, UNFORMATTED FILE.
I12 = 14
CX120 REPLACED BY FEXEC X-120 CONTROL CARD (DIR. FILE UNIT NUMBER).
C SPECIFYING I12 = NN OVERRIDES THE DEFAULT I12 = 14.
C*****
C***** THE FOLLOWING STATEMENT MUST BE CHANGED IF THE NAME
C***** GIVEN IS NOT A VALID FILE SPECIFIER FOR A DIRECT,
C***** UNFORMATTED FILE.
C*****
C*****
C***** THE FOLLOWING STATEMENT MUST BE CHANGED IF 40 IS
C***** NOT A VALID RECORD LENGTH.
MVI = 40
C*****
NUVI = I02
IOVI = I12
ZPROG = 'FM917'
IVTOTL = 3
CBB** ********************** BBCHED0A **********************************
C****
C**** WRITE REPORT TITLE
C****
WRITE (I02, 90002)
WRITE (I02, 90006)
WRITE (I02, 90007)
WRITE (I02, 90008) ZVERS, ZVERSD
WRITE (I02, 90009) ZPROG, ZPROG
WRITE (I02, 90010) ZDATE, ZCOMPL
CBE** ********************** BBCHED0A **********************************
C*****
WRITE(NUVI,43300)
43300 FORMAT(1H , / 30H INQU4 - (433) INQUIRE BY UNIT//
1 31H DIRECT ACCESS UNFORMATTED FILE//
2 19H ANS REF. - 12.10.3)
CBB** ********************** BBCHED0B **********************************
C**** WRITE DETAIL REPORT HEADERS
C****
WRITE (I02,90004)
WRITE (I02,90004)
WRITE (I02,90013)
WRITE (I02,90014)
WRITE (I02,90015) IVTOTL
CBE** ********************** BBCHED0B **********************************
C*****
C***** OPEN FILE
OPEN(UNIT=IOVI, ACCESS='DIRECT', RECL=MVI, FORM='UNFORMATTED')
C*****
CT001* TEST 1 - FIRST INQUIRE (AFTER OPEN)
IVTNUM = 1
INQUIRE(UNIT=IOVI, EXIST=AVB, OPENED=BVB, NUMBER=JVI,
1 ACCESS=B10VK, DIRECT=D10VK, RECL=KVI, NEXTREC=LVI,
2 FORM=E11VK, UNFORMATTED=G10VK, ERR=20014,IOSTAT=IVI)
C*****
IF (IVI .NE. 0) GO TO 20010
IF (.NOT. AVB) GO TO 20010
IF (.NOT. BVB) GO TO 20010
IF (JVI .NE. IOVI) GO TO 20010
IF (B10VK .NE. 'DIRECT') GO TO 20010
IF (D10VK .NE. 'YES') GO TO 20010
IF (KVI .NE. MVI) GO TO 20010
IF (LVI .NE. 1) GO TO 20010
IF (E11VK .NE. 'UNFORMATTED') GO TO 20010
IF (G10VK .NE. 'YES' ) GO TO 20010
WRITE (NUVI, 80002) IVTNUM
IVPASS = IVPASS + 1
GO TO 0011
20014 CONTINUE
WRITE (NUVI, 20015) IVTNUM
20015 FORMAT (1H ,2X,I3,4X,5H FAIL,12X,
1 46HERROR IN EXECUTION OF INQUIRE STATEMENT (ERR=)/)
GO TO 20016
20010 CONTINUE
WRITE (NUVI, 20011) IVTNUM
20011 FORMAT(1H ,2X,I3,4X,5H FAIL,12X,
1 29HERROR IN AN INQUIRE SPECIFIER/)
20016 IVFAIL = IVFAIL + 1
WRITE (NUVI, 20012) IVI,AVB,BVB,JVI,B10VK,D10VK,
1 KVI,LVI,E11VK,G10VK
20012 FORMAT (1H ,16X,10HCOMPUTED: ,7HIOSTAT=,I1,8H, EXIST=,L1,
1 9H ,OPENED=,L1,9H, NUMBER=,I4,1H,/
2 1H ,26X,7HACCESS=,A10,9H, DIRECT=,A3,7H, RECL=,
3 I4,1H,/1H ,26X,8HNEXTREC=,I4,7H, FORM=,
4 A11,1H,/1H ,26X,12HUNFORMATTED=,A3)
WRITE (NUVI, 20013) IOVI, MVI
20013 FORMAT (1H ,16X,10HCORRECT: ,19HIOSTAT=0, EXIST=T, ,
1 17HOPENED=T, NUMBER=,I4,1H,/
2 1H ,26X,32HACCESS=DIRECT, DIRECT=YES, RECL=,
3 I4,1H,/1H ,26X,28HNEXTREC=1, FORM=UNFORMATTED,/
4 1H ,26X,15HUNFORMATTED=YES)
0011 CONTINUE
C*****
C***** WRITE A RECORD TO FILE
WRITE(IOVI, REC=1) JVI
C*****
CT002* TEST 2 - SECOND INQUIRE (AFTER WRITE)
IVTNUM = 2
C***** THIS INQUIRE ONLY TESTS THE DIRECT, RECL, AND NEXTREC
C***** AS THE OTHER SPECIFIERS HAVE BEEN PREVIOUSLY TESTED
INQUIRE(UNIT=IOVI, DIRECT=D10VK, RECL=KVI, NEXTREC=LVI,
1 ERR=20024, IOSTAT=IVI)
C*****
IF (IVI .NE. 0) GO TO 20020
IF (D10VK .NE. 'YES') GO TO 20020
IF (KVI .NE. MVI) GO TO 20020
IF (LVI .NE. 2) GO TO 20020
WRITE (NUVI, 80002) IVTNUM
IVPASS = IVPASS + 1
GO TO 0021
20024 CONTINUE
WRITE (NUVI, 20025) IVTNUM
20025 FORMAT (1H ,2X,I3,4X,5H FAIL,12X,
1 46HERROR IN EXECUTION OF INQUIRE STATEMENT (ERR=)/)
GO TO 20026
20020 CONTINUE
WRITE (NUVI, 20021) IVTNUM
20021 FORMAT(1H ,2X,I3,4X,5H FAIL,12X,
1 29HERROR IN AN INQUIRE SPECIFIER/)
20026 IVFAIL = IVFAIL + 1
WRITE (NUVI, 20022) IVI,D10VK,KVI,LVI
20022 FORMAT (1H ,16X,10HCOMPUTED: ,7HIOSTAT=,I1,9H, DIRECT=,A3,
1 7H ,RECL=,I4,10H, NEXTREC=,I4)
WRITE (NUVI, 20023) MVI
20023 FORMAT (1H ,16X,10HCORRECT: ,22HIOSTAT=0, DIRECT=YES, ,
1 5HRECL=,I4,14H, NEXTREC= 2)
0021 CONTINUE
C*****
C***** READ A RECORD FROM FILE
C*****
READ(IOVI, REC=1) JVI
C*****
CT003* TEST 3 - THIRD INQUIRE (AFTER READ)
IVTNUM = 3
C***** THIS INQUIRE ONLY TESTS THE DIRECT, RECL, AND NEXTREC
C***** AS THE OTHER SPECIFIERS HAVE BEEN PREVIOUSLY TESTED
INQUIRE(UNIT=IOVI, DIRECT=D10VK, RECL=KVI, NEXTREC=LVI,
1 ERR=20034, IOSTAT=IVI)
C*****
IF (IVI .NE. 0) GO TO 20030
IF (D10VK .NE. 'YES') GO TO 20030
IF (KVI .NE. MVI) GO TO 20030
IF (LVI .NE. 2) GO TO 20030
WRITE (NUVI, 80002) IVTNUM
IVPASS = IVPASS + 1
GO TO 0031
20034 CONTINUE
WRITE (NUVI, 20035) IVTNUM
20035 FORMAT (1H ,2X,I3,4X,5H FAIL,12X,
1 46HERROR IN EXECUTION OF INQUIRE STATEMENT (ERR=)/)
GO TO 20036
20030 CONTINUE
WRITE (NUVI, 20031) IVTNUM
20031 FORMAT(1H ,2X,I3,4X,5H FAIL,12X,
1 29HERROR IN AN INQUIRE SPECIFIER/)
20036 IVFAIL = IVFAIL + 1
WRITE (NUVI, 20032) IVI,D10VK,KVI,LVI
20032 FORMAT (1H ,16X,10HCOMPUTED: ,7HIOSTAT=,I1,9H, DIRECT=,A3,
1 7H ,RECL=,I4,10H, NEXTREC=,I4)
WRITE (NUVI, 20023) MVI
20033 FORMAT (1H ,16X,10HCORRECT: ,22HIOSTAT=0, DIRECT=YES, ,
1 5HRECL=,I4,14H, NEXTREC= 2)
0031 CONTINUE
C*****
CLOSE(UNIT=IOVI, STATUS='DELETE')
C*****
CBB** ********************** BBCSUM0 **********************************
C**** WRITE OUT TEST SUMMARY
C****
IVTOTN = IVPASS + IVFAIL + IVDELE + IVINSP
WRITE (I02, 90004)
WRITE (I02, 90014)
WRITE (I02, 90004)
WRITE (I02, 90020) IVPASS
WRITE (I02, 90022) IVFAIL
WRITE (I02, 90024) IVDELE
WRITE (I02, 90026) IVINSP
WRITE (I02, 90028) IVTOTN, IVTOTL
CBE** ********************** BBCSUM0 **********************************
CBB** ********************** BBCFOOT0 **********************************
C**** WRITE OUT REPORT FOOTINGS
C****
WRITE (I02,90016) ZPROG, ZPROG
WRITE (I02,90018) ZPROJ, ZNAME, ZTAPE, ZTAPED
WRITE (I02,90019)
CBE** ********************** BBCFOOT0 **********************************
CBB** ********************** BBCFMT0A **********************************
C**** FORMATS FOR TEST DETAIL LINES
C****
80000 FORMAT (1H ,2X,I3,4X,7HDELETED,32X,A31)
80002 FORMAT (1H ,2X,I3,4X,7H PASS ,32X,A31)
80004 FORMAT (1H ,2X,I3,4X,7HINSPECT,32X,A31)
80008 FORMAT (1H ,2X,I3,4X,7H FAIL ,32X,A31)
80010 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,15X,10HCOMPUTED= ,
1I6,/,1H ,15X,10HCORRECT= ,I6)
80012 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
1E12.5,/,1H ,16X,10HCORRECT= ,E12.5)
80018 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
1A21,/,1H ,16X,10HCORRECT= ,A21)
80020 FORMAT (1H ,16X,10HCOMPUTED= ,A21,1X,A31)
80022 FORMAT (1H ,16X,10HCORRECT= ,A21,1X,A31)
80024 FORMAT (1H ,16X,10HCOMPUTED= ,I6,16X,A31)
80026 FORMAT (1H ,16X,10HCORRECT= ,I6,16X,A31)
80028 FORMAT (1H ,16X,10HCOMPUTED= ,E12.5,10X,A31)
80030 FORMAT (1H ,16X,10HCORRECT= ,E12.5,10X,A31)
80050 FORMAT (1H ,48X,A31)
CBE** ********************** BBCFMT0A **********************************
CBB** ********************** BBCFMT0B **********************************
C**** FORMAT STATEMENTS FOR PAGE HEADERS
C****
90002 FORMAT (1H1)
90004 FORMAT (1H )
90006 FORMAT (1H ,20X,31HFEDERAL SOFTWARE TESTING CENTER)
90007 FORMAT (1H ,19X,34HFORTRAN COMPILER VALIDATION SYSTEM)
90008 FORMAT (1H ,21X,A13,A17)
90009 FORMAT (1H ,/,2H *,A5,6HBEGIN*,12X,15HTEST RESULTS - ,A5,/)
90010 FORMAT (1H ,8X,16HTEST DATE*TIME= ,A17,15H - COMPILER= ,A20)
90013 FORMAT (1H ,8H TEST ,10HPASS/FAIL ,6X,17HDISPLAYED RESULTS,
1 7X,7HREMARKS,24X)
90014 FORMAT (1H ,46H----------------------------------------------,
1 33H---------------------------------)
90015 FORMAT (1H ,48X,17HTHIS PROGRAM HAS ,I3,6H TESTS,/)
C****
C**** FORMAT STATEMENTS FOR REPORT FOOTINGS
C****
90016 FORMAT (1H ,/,2H *,A5,4HEND*,14X,14HEND OF TEST - ,A5,/)
90018 FORMAT (1H ,A13,13X,A20,7H * ,A10,1H/,
1 A13)
90019 FORMAT (1H ,26HFOR OFFICIAL USE ONLY ,35X,15HCOPYRIGHT 1982)
C****
C**** FORMAT STATEMENTS FOR RUN SUMMARY
C****
90020 FORMAT (1H ,21X,I5,13H TESTS PASSED)
90022 FORMAT (1H ,21X,I5,13H TESTS FAILED)
90024 FORMAT (1H ,21X,I5,14H TESTS DELETED)
90026 FORMAT (1H ,21X,I5,25H TESTS REQUIRE INSPECTION)
90028 FORMAT (1H ,21X,I5,4H OF ,I3,15H TESTS EXECUTED)
CBE** ********************** BBCFMT0B **********************************
C*****
C***** END OF TEST SEGMENT 433
STOP
END
*END-OF,FM917
FM918.f 481036677 170 2 100666 9770 `
*HEADER,FORTR,FM918
*FILES1,FORTR,FM918,X
C***********************************************************************
C***** FORTRAN 77
C***** FM918
C***** INQU5 - (434)
C*****
C***********************************************************************
C***** GENERAL PURPOSE ANS REF
C***** TEST INQUIRE BY UNIT ON A UNIT THAT IS NOT 12.10.3
C***** CONNECTED TO A FILE.
C*****
C***** THE TESTS IN THIS UNIT ARE ONLY BE PERFORMED ON A
C***** UNIT THAT IS NOT CONNECTED TO A FILE.
C***** THIS TEST PERFORMS AN EXPLICIT OPEN, AND THEN
C***** PERFORMS A CLOSE WITH STATUS='DELETE' IN ORDER TO
C***** ENSURE THAT THE UNIT IS NOT CONNECTED. (ANS REF 12.10.2)
C***********************************************************************
CBB** ********************** BBCCOMNT **********************************
C****
C**** 1978 FORTRAN COMPILER VALIDATION SYSTEM
C**** VERSION 2.0
C****
C****
C**** SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO
C**** GENERAL SERVICES ADMINISTRATION
C**** FEDERAL SOFTWARE TESTING CENTER
C**** 5203 LEESBURG PIKE, SUITE 1100
C**** FALLS CHURCH, VA. 22041
C****
C**** (703) 756-6153
C****
CBE** ********************** BBCCOMNT **********************************
C*****
LOGICAL AVB, BVB
CHARACTER*10 C10VK, D10VK, F10VK, G10VK
C***** BELOW CHARACTER STATEMENT ESTABLISHES THE FILE NAME VARIABLES.
CBB** ********************** BBCINITA **********************************
C**** SPECIFICATION STATEMENTS
C****
CHARACTER ZVERS*13, ZVERSD*17, ZDATE*17, ZPROG*5, ZCOMPL*20,
1 ZNAME*20, ZTAPE*10, ZPROJ*13, REMRKS*31, ZTAPED*13
CBE** ********************** BBCINITA **********************************
CBB** ********************** BBCINITB **********************************
C**** INITIALIZE SECTION
DATA ZVERS, ZVERSD, ZDATE
1 /'VERSION 2.0 ', '82/08/02*18.33.46', '*NO DATE*TIME'/
DATA ZCOMPL, ZNAME, ZTAPE
1 /'*NONE SPECIFIED*', '*NO COMPANY NAME*', '*NO TAPE*'/
DATA ZPROJ, ZTAPED, ZPROG
1 /'*NO PROJECT*', '*NO TAPE DATE', 'XXXXX'/
DATA REMRKS /' '/
C**** THE FOLLOWING 9 COMMENT LINES (CZ01, CZ02, ...) CAN BE REPLACED
C**** FOR IDENTIFYING THE TEST ENVIRONMENT
C****
CZ01 ZVERS = 'VERSION OF THE COMPILER VALIDATION SYSTEM'
CZ02 ZVERSD = 'CREATION DATE/TIME OF THE COMPILER VALIDATION SYSTEM'
CZ03 ZPROG = 'PROGRAM NAME'
CZ04 ZDATE = 'DATE OF TEST'
CZ05 ZCOMPL = 'COMPILER IDENTIFICATION'
CZ06 ZPROJ = 'PROJECT NUMBER/IDENTIFICATION'
CZ07 ZNAME = 'NAME OF USER'
CZ08 ZTAPE = 'TAPE OWNER/ID'
CZ09 ZTAPED = 'DATE TAPE COPIED'
C
IVPASS = 0
IVFAIL = 0
IVDELE = 0
IVINSP = 0
IVTOTL = 0
IVTOTN = 0
ICZERO = 0
C
C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER.
I01 = 05
C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER.
I02 = 06
C
CX010 REPLACED BY FEXEC X-010 CONTROL CARD (CARD-READER UNIT NUMBER).
C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5
CX011 REPLACED BY FEXEC X-011 CONTROL CARD. CX011 IS FOR SYSTEMS
C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX010.
C
CX020 REPLACED BY FEXEC X-020 CONTROL CARD (PRINTER UNIT NUMBER).
C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02= 6
CX021 REPLACED BY FEXEC X-021 CONTROL CARD. CX021 IS FOR SYSTEMS
C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX020.
C
CBE** ********************** BBCINITB **********************************
C*****
C***** THE FOLLOWING STATEMENT MUST BE CHANGED IF
C***** THE UNIT GIVEN IS NOT CAPABLE OF BEING OPENED AS A
C***** SEQUENTIAL, FORMATTED FILE.
C*****
C I15 CONTAINS THE UNIT NUMBER FOR A SEQUENTIAL FORMATTED FILE.
I15 = 14
CX150 REPLACED BY FEXEC X-150 CONTROL CARD (SEQ. FILE UNIT NUMBER).
C SPECIFYING I15 = NN OVERRIDES THE DEFAULT I15 = 14.
C*****
C***** THE FOLLOWING STATEMENT MUST BE CHANGED IF THE NAME
C***** GIVEN IS NOT A VALID FILE SPECIFIER FOR A SEQUENTIAL,
C***** FORMATTED FILE.
C*****
NUVI = I02
IMVI = I15
ZPROG = 'FM918'
IVTOTL = 1
CBB** ********************** BBCHED0A **********************************
C****
C**** WRITE REPORT TITLE
C****
WRITE (I02, 90002)
WRITE (I02, 90006)
WRITE (I02, 90007)
WRITE (I02, 90008) ZVERS, ZVERSD
WRITE (I02, 90009) ZPROG, ZPROG
WRITE (I02, 90010) ZDATE, ZCOMPL
CBE** ********************** BBCHED0A **********************************
C*****
WRITE(NUVI,43400)
43400 FORMAT(1H , / 30H INQU5 - (434) INQUIRE BY UNIT//
1 29H UNIT NOT CONNECTED TO A FILE//
2 19H ANS REF. - 12.10.3)
CBB** ********************** BBCHED0B **********************************
C**** WRITE DETAIL REPORT HEADERS
C****
WRITE (I02,90004)
WRITE (I02,90004)
WRITE (I02,90013)
WRITE (I02,90014)
WRITE (I02,90015) IVTOTL
CBE** ********************** BBCHED0B **********************************
C*****
C***** OPEN FILE
OPEN(UNIT=IMVI, ACCESS='SEQUENTIAL', FORM='FORMATTED')
C***** DIS-CONNECT FILE
CLOSE(UNIT=IMVI, STATUS='DELETE')
C*****
CT001* TEST 1 - INQUIRE ON UNIT NOT CONNECTED TO A FILE
IVTNUM = 1
INQUIRE(UNIT=IMVI, IOSTAT=IVI, EXIST=AVB, OPENED=BVB,
1 SEQUENTIAL=C10VK, DIRECT=D10VK, FORMATTED=F10VK,
2 UNFORMATTED=G10VK, ERR=20014)
C*****
IF (.NOT. AVB) GO TO 20010
IF (BVB) GO TO 20010
IF (IVI .NE. 0) GO TO 20010
WRITE (NUVI, 80002) IVTNUM
IVPASS = IVPASS + 1
GO TO 0011
20014 CONTINUE
WRITE (NUVI, 20015) IVTNUM
20015 FORMAT (1H ,2X,I3,4X,5H FAIL,12X,
1 46HERROR IN EXECUTION OF INQUIRE STATEMENT (ERR=)/)
GO TO 20016
20010 CONTINUE
WRITE (NUVI, 20011) IVTNUM
20011 FORMAT(1H ,2X,I3,4X,5H FAIL,12X,
1 29HERROR IN AN INQUIRE SPECIFIER/)
20016 IVFAIL = IVFAIL + 1
WRITE (NUVI, 20012) IVI,AVB,BVB
20012 FORMAT (1H ,16X,10HCOMPUTED: ,7HIOSTAT=,I1,8H, EXIST=,L1,
1 9H ,OPENED=,L1)
WRITE (NUVI, 20013)
20013 FORMAT (1H ,16X,10HCORRECT: ,19HIOSTAT=0, EXIST=T, ,
1 8HOPENED=F)
0011 CONTINUE
C*****
CBB** ********************** BBCSUM0 **********************************
C**** WRITE OUT TEST SUMMARY
C****
IVTOTN = IVPASS + IVFAIL + IVDELE + IVINSP
WRITE (I02, 90004)
WRITE (I02, 90014)
WRITE (I02, 90004)
WRITE (I02, 90020) IVPASS
WRITE (I02, 90022) IVFAIL
WRITE (I02, 90024) IVDELE
WRITE (I02, 90026) IVINSP
WRITE (I02, 90028) IVTOTN, IVTOTL
CBE** ********************** BBCSUM0 **********************************
CBB** ********************** BBCFOOT0 **********************************
C**** WRITE OUT REPORT FOOTINGS
C****
WRITE (I02,90016) ZPROG, ZPROG
WRITE (I02,90018) ZPROJ, ZNAME, ZTAPE, ZTAPED
WRITE (I02,90019)
CBE** ********************** BBCFOOT0 **********************************
CBB** ********************** BBCFMT0A **********************************
C**** FORMATS FOR TEST DETAIL LINES
C****
80000 FORMAT (1H ,2X,I3,4X,7HDELETED,32X,A31)
80002 FORMAT (1H ,2X,I3,4X,7H PASS ,32X,A31)
80004 FORMAT (1H ,2X,I3,4X,7HINSPECT,32X,A31)
80008 FORMAT (1H ,2X,I3,4X,7H FAIL ,32X,A31)
80010 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,15X,10HCOMPUTED= ,
1I6,/,1H ,15X,10HCORRECT= ,I6)
80012 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
1E12.5,/,1H ,16X,10HCORRECT= ,E12.5)
80018 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
1A21,/,1H ,16X,10HCORRECT= ,A21)
80020 FORMAT (1H ,16X,10HCOMPUTED= ,A21,1X,A31)
80022 FORMAT (1H ,16X,10HCORRECT= ,A21,1X,A31)
80024 FORMAT (1H ,16X,10HCOMPUTED= ,I6,16X,A31)
80026 FORMAT (1H ,16X,10HCORRECT= ,I6,16X,A31)
80028 FORMAT (1H ,16X,10HCOMPUTED= ,E12.5,10X,A31)
80030 FORMAT (1H ,16X,10HCORRECT= ,E12.5,10X,A31)
80050 FORMAT (1H ,48X,A31)
CBE** ********************** BBCFMT0A **********************************
CBB** ********************** BBCFMT0B **********************************
C**** FORMAT STATEMENTS FOR PAGE HEADERS
C****
90002 FORMAT (1H1)
90004 FORMAT (1H )
90006 FORMAT (1H ,20X,31HFEDERAL SOFTWARE TESTING CENTER)
90007 FORMAT (1H ,19X,34HFORTRAN COMPILER VALIDATION SYSTEM)
90008 FORMAT (1H ,21X,A13,A17)
90009 FORMAT (1H ,/,2H *,A5,6HBEGIN*,12X,15HTEST RESULTS - ,A5,/)
90010 FORMAT (1H ,8X,16HTEST DATE*TIME= ,A17,15H - COMPILER= ,A20)
90013 FORMAT (1H ,8H TEST ,10HPASS/FAIL ,6X,17HDISPLAYED RESULTS,
1 7X,7HREMARKS,24X)
90014 FORMAT (1H ,46H----------------------------------------------,
1 33H---------------------------------)
90015 FORMAT (1H ,48X,17HTHIS PROGRAM HAS ,I3,6H TESTS,/)
C****
C**** FORMAT STATEMENTS FOR REPORT FOOTINGS
C****
90016 FORMAT (1H ,/,2H *,A5,4HEND*,14X,14HEND OF TEST - ,A5,/)
90018 FORMAT (1H ,A13,13X,A20,7H * ,A10,1H/,
1 A13)
90019 FORMAT (1H ,26HFOR OFFICIAL USE ONLY ,35X,15HCOPYRIGHT 1982)
C****
C**** FORMAT STATEMENTS FOR RUN SUMMARY
C****
90020 FORMAT (1H ,21X,I5,13H TESTS PASSED)
90022 FORMAT (1H ,21X,I5,13H TESTS FAILED)
90024 FORMAT (1H ,21X,I5,14H TESTS DELETED)
90026 FORMAT (1H ,21X,I5,25H TESTS REQUIRE INSPECTION)
90028 FORMAT (1H ,21X,I5,4H OF ,I3,15H TESTS EXECUTED)
CBE** ********************** BBCFMT0B **********************************
C*****
C***** END OF TEST SEGMENT 434
STOP
END
*END-OF,FM918
FM919.f 481036680 170 2 100666 11013 `
*HEADER,FORTR,FM919
*FILES1,FORTR,FM919,X
C***********************************************************************
C***** FORTRAN 77
C***** FM919
C***** INQF1 - (438)
C*****
C***********************************************************************
C***** GENERAL PURPOSE ANS REF
C***** TEST INQUIRE BY FILE ON SEQUENTIAL, FORMATTED FILES 12.10.3
C*****
C***** THE TESTS IN THIS UNIT ARE ONLY PERFORMED ON A
C***** FILE THAT IS CONNECTED FOR SEQUENTIAL, FORMATTED ACCESS
C***** (ANS REF. 12.2.4.1 AND 12.9.5.2)
C***** THIS TEST PERFORMS AN EXPLICIT OPEN, AND PERFORMS
C***** A CLOSE WITH STATUS='DELETE' AT THE END OF THE SEGMENT.
C***********************************************************************
CBB** ********************** BBCCOMNT **********************************
C****
C**** 1978 FORTRAN COMPILER VALIDATION SYSTEM
C**** VERSION 2.0
C****
C****
C**** SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO
C**** GENERAL SERVICES ADMINISTRATION
C**** FEDERAL SOFTWARE TESTING CENTER
C**** 5203 LEESBURG PIKE, SUITE 1100
C**** FALLS CHURCH, VA. 22041
C****
C**** (703) 756-6153
C****
CBE** ********************** BBCCOMNT **********************************
C*****
LOGICAL AVB, BVB
CHARACTER*10 B10VK, C10VK, E11VK*11, F10VK, H10VK
C***** BELOW CHARACTER STATEMENT ESTABLISHES THE FILE NAME VARIABLES.
CX19 REPLACED BY FEXEC X-19 CONTROL CARD. X-19 IS FOR REPLACING
CHARACTER*15 CSEQ
C THE CHARACTER STATEMENT FOR FILE NAMES ASSOCIATED WITH X-090
C (PROGRAM VARIABLE CSEQ) IF NOT VALID FOR THE PROCESSOR.
CBB** ********************** BBCINITA **********************************
C**** SPECIFICATION STATEMENTS
C****
CHARACTER ZVERS*13, ZVERSD*17, ZDATE*17, ZPROG*5, ZCOMPL*20,
1 ZNAME*20, ZTAPE*10, ZPROJ*13, REMRKS*31, ZTAPED*13
CBE** ********************** BBCINITA **********************************
CBB** ********************** BBCINITB **********************************
C**** INITIALIZE SECTION
DATA ZVERS, ZVERSD, ZDATE
1 /'VERSION 2.0 ', '82/08/02*18.33.46', '*NO DATE*TIME'/
DATA ZCOMPL, ZNAME, ZTAPE
1 /'*NONE SPECIFIED*', '*NO COMPANY NAME*', '*NO TAPE*'/
DATA ZPROJ, ZTAPED, ZPROG
1 /'*NO PROJECT*', '*NO TAPE DATE', 'XXXXX'/
DATA REMRKS /' '/
C**** THE FOLLOWING 9 COMMENT LINES (CZ01, CZ02, ...) CAN BE REPLACED
C**** FOR IDENTIFYING THE TEST ENVIRONMENT
C****
CZ01 ZVERS = 'VERSION OF THE COMPILER VALIDATION SYSTEM'
CZ02 ZVERSD = 'CREATION DATE/TIME OF THE COMPILER VALIDATION SYSTEM'
CZ03 ZPROG = 'PROGRAM NAME'
CZ04 ZDATE = 'DATE OF TEST'
CZ05 ZCOMPL = 'COMPILER IDENTIFICATION'
CZ06 ZPROJ = 'PROJECT NUMBER/IDENTIFICATION'
CZ07 ZNAME = 'NAME OF USER'
CZ08 ZTAPE = 'TAPE OWNER/ID'
CZ09 ZTAPED = 'DATE TAPE COPIED'
C
IVPASS = 0
IVFAIL = 0
IVDELE = 0
IVINSP = 0
IVTOTL = 0
IVTOTN = 0
ICZERO = 0
C
C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER.
I01 = 05
C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER.
I02 = 06
C
CX010 REPLACED BY FEXEC X-010 CONTROL CARD (CARD-READER UNIT NUMBER).
C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5
CX011 REPLACED BY FEXEC X-011 CONTROL CARD. CX011 IS FOR SYSTEMS
C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX010.
C
CX020 REPLACED BY FEXEC X-020 CONTROL CARD (PRINTER UNIT NUMBER).
C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02= 6
CX021 REPLACED BY FEXEC X-021 CONTROL CARD. CX021 IS FOR SYSTEMS
C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX020.
C
CBE** ********************** BBCINITB **********************************
C*****
C***** THE FOLLOWING STATEMENT MUST BE CHANGED IF
C***** THE UNIT GIVEN IS NOT CAPABLE OF BEING OPENED AS A
C***** SEQUENTIAL, FORMATTED FILE.
C*****
I09 = 14
CX090 THIS CARD IS REPLACED BY THE CONTENTS OF CX090
C X-090 I09 = NN WILL OVERRIDE I09 = 14
C*****
C***** THE FOLLOWING STATEMENT MUST BE CHANGED IF THE NAME
C***** GIVEN IS NOT A VALID FILE SPECIFIER FOR A SEQUENTIAL,
C***** FORMATTED FILE.
C*****
C*****
C***** THE FOLLOWING STATEMENT MUST BE CHANGED IF THE NAME
C***** GIVEN IS NOT A VALID FILE SPECIFIER FOR A SEQUENTIAL,
C***** FORMATTED FILE.
C*****
C CSEQ CONTAINS THE FILE NAME FOR UNIT I09.
CSEQ = ' SEQFILE'
C
CX191 REPLACED BY FEXEC X-191 CONTROL CARD. CX191 IS FOR SYSTEMS
C REQUIRING A DIFFERENT FILE SPECIFIER FOR FILES ASSOCIATED WITH
C X-090 THAN THE DEFAULT CSEQ = ' SEQFILE'.
C*****
NUVI = I02
IMVI = I09
ZPROG = 'FM919'
IVTOTL = 1
CBB** ********************** BBCHED0A **********************************
C****
C**** WRITE REPORT TITLE
C****
WRITE (I02, 90002)
WRITE (I02, 90006)
WRITE (I02, 90007)
WRITE (I02, 90008) ZVERS, ZVERSD
WRITE (I02, 90009) ZPROG, ZPROG
WRITE (I02, 90010) ZDATE, ZCOMPL
CBE** ********************** BBCHED0A **********************************
C*****
WRITE(NUVI,43800)
43800 FORMAT(1H , / 30H INQF1 - (438) INQUIRE BY FILE//
1 45H SEQUENTIAL FORMATTED FILE, CONNECTED BY OPEN//
2 19H ANS REF. - 12.10.3)
CBB** ********************** BBCHED0B **********************************
C**** WRITE DETAIL REPORT HEADERS
C****
WRITE (I02,90004)
WRITE (I02,90004)
WRITE (I02,90013)
WRITE (I02,90014)
WRITE (I02,90015) IVTOTL
CBE** ********************** BBCHED0B **********************************
C*****
C***** OPEN FILE
OPEN(FILE=CSEQ, UNIT=IMVI, ACCESS='SEQUENTIAL',
1 FORM='FORMATTED', BLANK='NULL')
C*****
CT001* TEST 1 - FIRST INQUIRE (AFTER OPEN)
IVTNUM = 1
INQUIRE(FILE=CSEQ, EXIST=AVB, OPENED=BVB, NUMBER=JVI,
1 ACCESS=B10VK, SEQUENTIAL=C10VK, FORM=E11VK,
2 FORMATTED=F10VK, BLANK=H10VK, ERR=20014, IOSTAT=IVI)
IF (IVI .NE. 0) GO TO 20010
IF (.NOT. AVB) GO TO 20010
IF (.NOT. BVB) GO TO 20010
IF (JVI .NE. IMVI) GO TO 20010
IF (B10VK .NE. 'SEQUENTIAL') GO TO 20010
IF (C10VK .NE. 'YES') GO TO 20010
IF (E11VK .NE. 'FORMATTED') GO TO 20010
IF (F10VK .NE. 'YES' ) GO TO 20010
IF (H10VK .NE. 'NULL') GO TO 20010
WRITE (NUVI, 80002) IVTNUM
IVPASS = IVPASS + 1
GO TO 0011
20014 CONTINUE
WRITE (NUVI, 20015) IVTNUM
20015 FORMAT (1H ,2X,I3,4X,5H FAIL,12X,
1 46HERROR IN EXECUTION OF INQUIRE STATEMENT (ERR=)/)
GO TO 20016
20010 CONTINUE
WRITE (NUVI, 20011) IVTNUM
20011 FORMAT(1H ,2X,I3,4X,5H FAIL,12X,
1 29HERROR IN AN INQUIRE SPECIFIER/)
20016 IVFAIL = IVFAIL + 1
WRITE (NUVI, 20012) IVI,AVB,BVB,JVI,B10VK,C10VK,E11VK,
1 F10VK,H10VK
20012 FORMAT (1H ,16X,10HCOMPUTED: ,7HIOSTAT=,I1,8H, EXIST=,L1,
1 9H ,OPENED=,L1,9H, NUMBER=,I4,1H,/
2 1H ,26X,7HACCESS=,A10,13H, SEQUENTIAL=,A3,7H, FORM=,
3 A9,1H,/1H ,26X,10HFORMATTED=,A3,8H, BLANK=,A4)
WRITE (NUVI, 20013) IMVI
20013 FORMAT (1H ,16X,10HCORRECT: ,19HIOSTAT=0, EXIST=T, ,
1 17HOPENED=T, NUMBER=,I4,1H,/
2 1H ,26X,40HACCESS=SEQUENTIAL, SEQUENTIAL=YES, FORM=,
3 10HFORMATTED,/1H ,26X,25HFORMATTED=YES, BLANK=NULL)
0011 CONTINUE
C*****
43803 CLOSE(UNIT=IMVI, STATUS='DELETE')
C*****
CBB** ********************** BBCSUM0 **********************************
C**** WRITE OUT TEST SUMMARY
C****
IVTOTN = IVPASS + IVFAIL + IVDELE + IVINSP
WRITE (I02, 90004)
WRITE (I02, 90014)
WRITE (I02, 90004)
WRITE (I02, 90020) IVPASS
WRITE (I02, 90022) IVFAIL
WRITE (I02, 90024) IVDELE
WRITE (I02, 90026) IVINSP
WRITE (I02, 90028) IVTOTN, IVTOTL
CBE** ********************** BBCSUM0 **********************************
CBB** ********************** BBCFOOT0 **********************************
C**** WRITE OUT REPORT FOOTINGS
C****
WRITE (I02,90016) ZPROG, ZPROG
WRITE (I02,90018) ZPROJ, ZNAME, ZTAPE, ZTAPED
WRITE (I02,90019)
CBE** ********************** BBCFOOT0 **********************************
CBB** ********************** BBCFMT0A **********************************
C**** FORMATS FOR TEST DETAIL LINES
C****
80000 FORMAT (1H ,2X,I3,4X,7HDELETED,32X,A31)
80002 FORMAT (1H ,2X,I3,4X,7H PASS ,32X,A31)
80004 FORMAT (1H ,2X,I3,4X,7HINSPECT,32X,A31)
80008 FORMAT (1H ,2X,I3,4X,7H FAIL ,32X,A31)
80010 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,15X,10HCOMPUTED= ,
1I6,/,1H ,15X,10HCORRECT= ,I6)
80012 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
1E12.5,/,1H ,16X,10HCORRECT= ,E12.5)
80018 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
1A21,/,1H ,16X,10HCORRECT= ,A21)
80020 FORMAT (1H ,16X,10HCOMPUTED= ,A21,1X,A31)
80022 FORMAT (1H ,16X,10HCORRECT= ,A21,1X,A31)
80024 FORMAT (1H ,16X,10HCOMPUTED= ,I6,16X,A31)
80026 FORMAT (1H ,16X,10HCORRECT= ,I6,16X,A31)
80028 FORMAT (1H ,16X,10HCOMPUTED= ,E12.5,10X,A31)
80030 FORMAT (1H ,16X,10HCORRECT= ,E12.5,10X,A31)
80050 FORMAT (1H ,48X,A31)
CBE** ********************** BBCFMT0A **********************************
CBB** ********************** BBCFMT0B **********************************
C**** FORMAT STATEMENTS FOR PAGE HEADERS
C****
90002 FORMAT (1H1)
90004 FORMAT (1H )
90006 FORMAT (1H ,20X,31HFEDERAL SOFTWARE TESTING CENTER)
90007 FORMAT (1H ,19X,34HFORTRAN COMPILER VALIDATION SYSTEM)
90008 FORMAT (1H ,21X,A13,A17)
90009 FORMAT (1H ,/,2H *,A5,6HBEGIN*,12X,15HTEST RESULTS - ,A5,/)
90010 FORMAT (1H ,8X,16HTEST DATE*TIME= ,A17,15H - COMPILER= ,A20)
90013 FORMAT (1H ,8H TEST ,10HPASS/FAIL ,6X,17HDISPLAYED RESULTS,
1 7X,7HREMARKS,24X)
90014 FORMAT (1H ,46H----------------------------------------------,
1 33H---------------------------------)
90015 FORMAT (1H ,48X,17HTHIS PROGRAM HAS ,I3,6H TESTS,/)
C****
C**** FORMAT STATEMENTS FOR REPORT FOOTINGS
C****
90016 FORMAT (1H ,/,2H *,A5,4HEND*,14X,14HEND OF TEST - ,A5,/)
90018 FORMAT (1H ,A13,13X,A20,7H * ,A10,1H/,
1 A13)
90019 FORMAT (1H ,26HFOR OFFICIAL USE ONLY ,35X,15HCOPYRIGHT 1982)
C****
C**** FORMAT STATEMENTS FOR RUN SUMMARY
C****
90020 FORMAT (1H ,21X,I5,13H TESTS PASSED)
90022 FORMAT (1H ,21X,I5,13H TESTS FAILED)
90024 FORMAT (1H ,21X,I5,14H TESTS DELETED)
90026 FORMAT (1H ,21X,I5,25H TESTS REQUIRE INSPECTION)
90028 FORMAT (1H ,21X,I5,4H OF ,I3,15H TESTS EXECUTED)
CBE** ********************** BBCFMT0B **********************************
C*****
C***** END OF TEST SEGMENT 438
STOP
END
*END-OF,FM919
FM920.f 481036683 170 2 100666 14529 `
*HEADER,FORTR,FM920
*FILES1,FORTR,FM920,X
C***********************************************************************
C***** FORTRAN 77
C***** FM920
C***** INQF2 - (439)
C*****
C***********************************************************************
C***** GENERAL PURPOSE ANS REF
C***** TEST INQUIRE ON SEQUENTIAL, UNFORMATTED FILES 12.10.3
C*****
C***** THE TESTS IN THIS UNIT ARE ONLY PERFORMED ON A
C***** FILE THAT IS CONNECTED FOR SEQUENTIAL, UNFORMATTED ACCESS
C***** (ANS REF. 12.2.4.1 AND 12.9.5.1)
C***** THIS TEST PERFORMS AN EXPLICIT OPEN, AND PERFORMS
C***** A CLOSE WITH STATUS='DELETE' AT THE END OF THE SEGMENT.
C***** THE SEGMENT TESTS THAT INQUIRE IS PERFORMED CORRECTLY
C***** BEFORE READING OR WRITING TO A FILE, AFTER WRITING TO A FILE
C***** AND AFTER READING FROM A FILE.
C***********************************************************************
C*****
CBB** ********************** BBCCOMNT **********************************
C****
C**** 1978 FORTRAN COMPILER VALIDATION SYSTEM
C**** VERSION 2.0
C****
C****
C**** SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO
C**** GENERAL SERVICES ADMINISTRATION
C**** FEDERAL SOFTWARE TESTING CENTER
C**** 5203 LEESBURG PIKE, SUITE 1100
C**** FALLS CHURCH, VA. 22041
C****
C**** (703) 756-6153
C****
CBE** ********************** BBCCOMNT **********************************
C*****
LOGICAL AVB, BVB
CHARACTER*10 B10VK, C10VK, E11VK*11, G10VK
C***** BELOW CHARACTER STATEMENT ESTABLISHES THE FILE NAME VARIABLES.
CX19 REPLACED BY FEXEC X-19 CONTROL CARD. X-19 IS FOR REPLACING
CHARACTER*15 CSEQ
C THE CHARACTER STATEMENT FOR FILE NAMES ASSOCIATED WITH X-050
C (PROGRAM VARIABLE CSEQ) IF NOT VALID FOR THE PROCESSOR.
C*****
CBB** ********************** BBCINITA **********************************
C**** SPECIFICATION STATEMENTS
C****
CHARACTER ZVERS*13, ZVERSD*17, ZDATE*17, ZPROG*5, ZCOMPL*20,
1 ZNAME*20, ZTAPE*10, ZPROJ*13, REMRKS*31, ZTAPED*13
CBE** ********************** BBCINITA **********************************
CBB** ********************** BBCINITB **********************************
C**** INITIALIZE SECTION
DATA ZVERS, ZVERSD, ZDATE
1 /'VERSION 2.0 ', '82/08/02*18.33.46', '*NO DATE*TIME'/
DATA ZCOMPL, ZNAME, ZTAPE
1 /'*NONE SPECIFIED*', '*NO COMPANY NAME*', '*NO TAPE*'/
DATA ZPROJ, ZTAPED, ZPROG
1 /'*NO PROJECT*', '*NO TAPE DATE', 'XXXXX'/
DATA REMRKS /' '/
C**** THE FOLLOWING 9 COMMENT LINES (CZ01, CZ02, ...) CAN BE REPLACED
C**** FOR IDENTIFYING THE TEST ENVIRONMENT
C****
CZ01 ZVERS = 'VERSION OF THE COMPILER VALIDATION SYSTEM'
CZ02 ZVERSD = 'CREATION DATE/TIME OF THE COMPILER VALIDATION SYSTEM'
CZ03 ZPROG = 'PROGRAM NAME'
CZ04 ZDATE = 'DATE OF TEST'
CZ05 ZCOMPL = 'COMPILER IDENTIFICATION'
CZ06 ZPROJ = 'PROJECT NUMBER/IDENTIFICATION'
CZ07 ZNAME = 'NAME OF USER'
CZ08 ZTAPE = 'TAPE OWNER/ID'
CZ09 ZTAPED = 'DATE TAPE COPIED'
C
IVPASS = 0
IVFAIL = 0
IVDELE = 0
IVINSP = 0
IVTOTL = 0
IVTOTN = 0
ICZERO = 0
C
C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER.
I01 = 05
C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER.
I02 = 06
C
CX010 REPLACED BY FEXEC X-010 CONTROL CARD (CARD-READER UNIT NUMBER).
C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5
CX011 REPLACED BY FEXEC X-011 CONTROL CARD. CX011 IS FOR SYSTEMS
C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX010.
C
CX020 REPLACED BY FEXEC X-020 CONTROL CARD (PRINTER UNIT NUMBER).
C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02= 6
CX021 REPLACED BY FEXEC X-021 CONTROL CARD. CX021 IS FOR SYSTEMS
C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX020.
C
CBE** ********************** BBCINITB **********************************
C*****
C***** THE FOLLOWING STATEMENT MUST BE CHANGED IF
C***** THE UNIT GIVEN IS NOT CAPABLE OF BEING OPENED AS A
C***** SEQUENTIAL, UNFORMATTED FILE.
C*****
I05 = 14
CX050 THIS CARD IS USED TO REPLACE THE CONTENTS OF I05 = 15
C X-050 I05 = NN WILL OVERRIDE DEFAULT I05 = 14
C
C***** THE FOLLOWING STATEMENT MUST BE CHANGED IF THE NAME
C***** GIVEN IS NOT A VALID FILE SPECIFIER FOR A SEQUENTIAL,
C***** UNFORMATTED FILE.
C*****
C CSEQ CONTAINS THE FILE NAME FOR UNIT I05.
CSEQ = ' SEQFILE'
C
CX191 REPLACED BY FEXEC X-191 CONTROL CARD. CX191 IS FOR SYSTEMS
C REQUIRING A DIFFERENT FILE SPECIFIER FOR FILES ASSOCIATED WITH
C X-050 THAN THE DEFAULT CSEQ = ' SEQFILE'.
C*****
NUVI = I02
IMVI = I05
ZPROG = 'FM920'
IVTOTL = 3
CBB** ********************** BBCHED0A **********************************
C****
C**** WRITE REPORT TITLE
C****
WRITE (I02, 90002)
WRITE (I02, 90006)
WRITE (I02, 90007)
WRITE (I02, 90008) ZVERS, ZVERSD
WRITE (I02, 90009) ZPROG, ZPROG
WRITE (I02, 90010) ZDATE, ZCOMPL
CBE** ********************** BBCHED0A **********************************
C*****
WRITE(NUVI,43900)
43900 FORMAT(1H , / 30H INQF2 - (439) INQUIRE BY FILE//
1 47H SEQUENTIAL UNFORMATTED FILE, CONNECTED BY OPEN//
2 19H ANS REF. - 12.10.3)
CBB** ********************** BBCHED0B **********************************
C**** WRITE DETAIL REPORT HEADERS
C****
WRITE (I02,90004)
WRITE (I02,90004)
WRITE (I02,90013)
WRITE (I02,90014)
WRITE (I02,90015) IVTOTL
CBE** ********************** BBCHED0B **********************************
C*****
C***** OPEN FILE
OPEN(FILE=CSEQ, UNIT=IMVI, ACCESS='SEQUENTIAL',
1 FORM='UNFORMATTED')
C*****
CT001* TEST 1 - FIRST INQUIRE (AFTER OPEN)
IVTNUM = 1
INQUIRE(FILE=CSEQ, EXIST=AVB, OPENED=BVB, NUMBER=JVI,
1 ACCESS=B10VK, SEQUENTIAL=C10VK, FORM=E11VK,
2 UNFORMATTED=G10VK, ERR=20014, IOSTAT=IVI)
C*****
IF (IVI .NE. 0) GO TO 20010
IF (.NOT. AVB) GO TO 20010
IF (.NOT. BVB) GO TO 20010
IF (JVI .NE. IMVI) GO TO 20010
IF (B10VK .NE. 'SEQUENTIAL') GO TO 20010
IF (C10VK. NE. 'YES') GO TO 20010
IF (E11VK .NE. 'UNFORMATTED') GO TO 20010
IF (G10VK .NE. 'YES' ) GO TO 20010
WRITE (NUVI, 80002) IVTNUM
IVPASS = IVPASS + 1
GO TO 0011
20014 CONTINUE
WRITE (NUVI, 20015) IVTNUM
20015 FORMAT (1H ,2X,I3,4X,5H FAIL,12X,
1 46HERROR IN EXECUTION OF INQUIRE STATEMENT (ERR=)/)
GO TO 20016
20010 CONTINUE
WRITE (NUVI, 20011) IVTNUM
20011 FORMAT(1H ,2X,I3,4X,5H FAIL,12X,
1 29HERROR IN AN INQUIRE SPECIFIER/)
20016 IVFAIL = IVFAIL + 1
WRITE (NUVI, 20012) IVI,AVB,BVB,JVI,B10VK,C10VK,E11VK,
1 G10VK
20012 FORMAT (1H ,16X,10HCOMPUTED: ,7HIOSTAT=,I1,8H, EXIST=,L1,
1 9H ,OPENED=,L1,9H, NUMBER=,I4,1H,/
2 1H ,26X,7HACCESS=,A10,13H, SEQUENTIAL=,A3,7H, FORM=,
3 A11,1H,/1H ,26X,12HUNFORMATTED=,A3)
WRITE (NUVI, 20013) IMVI
20013 FORMAT (1H ,16X,10HCORRECT: ,19HIOSTAT=0, EXIST=T, ,
1 17HOPENED=T, NUMBER=,I4,1H,/
2 1H ,26X,40HACCESS=SEQUENTIAL, SEQUENTIAL=YES, FORM=,
3 12HUNFORMATTED,/1H ,26X,15HUNFORMATTED=YES)
0011 CONTINUE
C*****
C***** WRITE TO FILE
WRITE(IMVI) JVI
C*****
CT002* TEST 2 - SECOND INQUIRE (AFTER WRITE)
IVTNUM = 2
INQUIRE(FILE=CSEQ, EXIST=AVB, OPENED=BVB, NUMBER=JVI,
1 ACCESS=B10VK, SEQUENTIAL=C10VK, FORM=E11VK,
2 UNFORMATTED=G10VK, ERR=20024, IOSTAT=IVI)
C*****
IF (IVI .NE. 0) GO TO 20020
IF (.NOT. AVB) GO TO 20020
IF (.NOT. BVB) GO TO 20020
IF (JVI .NE. IMVI) GO TO 20020
IF (B10VK .NE. 'SEQUENTIAL') GO TO 20020
IF (C10VK.NE. 'YES') GO TO 20020
IF (E11VK .NE. 'UNFORMATTED') GO TO 20020
IF (G10VK .NE. 'YES' ) GO TO 20020
WRITE (NUVI, 80002) IVTNUM
IVPASS = IVPASS + 1
GO TO 0021
20024 CONTINUE
WRITE (NUVI, 20025) IVTNUM
20025 FORMAT (1H ,2X,I3,4X,5H FAIL,12X,
1 46HERROR IN EXECUTION OF INQUIRE STATEMENT (ERR=)/)
GO TO 20026
20020 CONTINUE
WRITE (NUVI, 20011) IVTNUM
20021 FORMAT(1H ,2X,I3,4X,5H FAIL,12X,
1 29HERROR IN AN INQUIRE SPECIFIER/)
20026 IVFAIL = IVFAIL + 1
WRITE (NUVI, 20022) IVI,AVB,BVB,JVI,B10VK,C10VK,E11VK,
1 G10VK
20022 FORMAT (1H ,16X,10HCOMPUTED: ,7HIOSTAT=,I1,8H, EXIST=,L1,
1 9H ,OPENED=,L1,9H, NUMBER=,I4,1H,/
2 1H ,26X,7HACCESS=,A10,13H, SEQUENTIAL=,A3,7H, FORM=,
3 A11,1H,/1H ,26X,12HUNFORMATTED=,A3)
WRITE (NUVI, 20023) IMVI
20023 FORMAT (1H ,16X,10HCORRECT: ,19HIOSTAT=0, EXIST=T, ,
1 17HOPENED=T, NUMBER=,I4,1H,/
2 1H ,26X,40HACCESS=SEQUENTIAL, SEQUENTIAL=YES, FORM=,
3 12HUNFORMATTED,/1H ,26X,15HUNFORMATTED=YES)
0021 CONTINUE
C*****
C***** REWIND AND READ FILE
REWIND IMVI
READ(IMVI) JVI
REWIND IMVI
C*****
CT003* TEST 3 - THIRD INQUIRE (AFTER READ)
IVTNUM = 3
INQUIRE(FILE=CSEQ, EXIST=AVB, OPENED=BVB, NUMBER=JVI,
1 ACCESS=B10VK, SEQUENTIAL=C10VK, FORM=E11VK,
2 UNFORMATTED=G10VK, ERR=20034, IOSTAT=IVI)
C*****
IF (IVI .NE. 0) GO TO 20030
IF (.NOT. AVB) GO TO 20030
IF (.NOT. BVB) GO TO 20030
IF (JVI .NE. IMVI) GO TO 20030
IF (B10VK .NE. 'SEQUENTIAL') GO TO 20030
IF (C10VK .NE. 'YES') GO TO 20030
IF (E11VK .NE. 'UNFORMATTED') GO TO 20030
IF (G10VK .NE. 'YES' ) GO TO 20030
WRITE (NUVI, 80002) IVTNUM
IVPASS = IVPASS + 1
GO TO 0031
20034 CONTINUE
WRITE (NUVI, 20035) IVTNUM
20035 FORMAT (1H ,2X,I3,4X,5H FAIL,12X,
1 46HERROR IN EXECUTION OF INQUIRE STATEMENT (ERR=)/)
GO TO 20036
20030 CONTINUE
WRITE (NUVI, 20031) IVTNUM
20031 FORMAT(1H ,2X,I3,4X,5H FAIL,12X,
1 29HERROR IN AN INQUIRE SPECIFIER/)
20036 IVFAIL = IVFAIL + 1
WRITE (NUVI, 20032) IVI,AVB,BVB,JVI,B10VK,C10VK,E11VK,
1 G10VK
20032 FORMAT (1H ,16X,10HCOMPUTED: ,7HIOSTAT=,I1,8H, EXIST=,L1,
1 9H ,OPENED=,L1,9H, NUMBER=,I4,1H,/
2 1H ,26X,7HACCESS=,A10,13H, SEQUENTIAL=,A3,7H, FORM=,
3 A11,1H,/1H ,26X,12HUNFORMATTED=,A3)
WRITE (NUVI, 20033) IMVI
20033 FORMAT (1H ,16X,10HCORRECT: ,19HIOSTAT=0, EXIST=T, ,
1 17HOPENED=T, NUMBER=,I4,1H,/
2 1H ,26X,40HACCESS=SEQUENTIAL, SEQUENTIAL=YES, FORM=,
3 12HUNFORMATTED,/1H ,26X,15HUNFORMATTED=YES)
0031 CONTINUE
C*****
CLOSE(UNIT=IMVI, STATUS='DELETE')
C*****
CBB** ********************** BBCSUM0 **********************************
C**** WRITE OUT TEST SUMMARY
C****
IVTOTN = IVPASS + IVFAIL + IVDELE + IVINSP
WRITE (I02, 90004)
WRITE (I02, 90014)
WRITE (I02, 90004)
WRITE (I02, 90020) IVPASS
WRITE (I02, 90022) IVFAIL
WRITE (I02, 90024) IVDELE
WRITE (I02, 90026) IVINSP
WRITE (I02, 90028) IVTOTN, IVTOTL
CBE** ********************** BBCSUM0 **********************************
CBB** ********************** BBCFOOT0 **********************************
C**** WRITE OUT REPORT FOOTINGS
C****
WRITE (I02,90016) ZPROG, ZPROG
WRITE (I02,90018) ZPROJ, ZNAME, ZTAPE, ZTAPED
WRITE (I02,90019)
CBE** ********************** BBCFOOT0 **********************************
CBB** ********************** BBCFMT0A **********************************
C**** FORMATS FOR TEST DETAIL LINES
C****
80000 FORMAT (1H ,2X,I3,4X,7HDELETED,32X,A31)
80002 FORMAT (1H ,2X,I3,4X,7H PASS ,32X,A31)
80004 FORMAT (1H ,2X,I3,4X,7HINSPECT,32X,A31)
80008 FORMAT (1H ,2X,I3,4X,7H FAIL ,32X,A31)
80010 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,15X,10HCOMPUTED= ,
1I6,/,1H ,15X,10HCORRECT= ,I6)
80012 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
1E12.5,/,1H ,16X,10HCORRECT= ,E12.5)
80018 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
1A21,/,1H ,16X,10HCORRECT= ,A21)
80020 FORMAT (1H ,16X,10HCOMPUTED= ,A21,1X,A31)
80022 FORMAT (1H ,16X,10HCORRECT= ,A21,1X,A31)
80024 FORMAT (1H ,16X,10HCOMPUTED= ,I6,16X,A31)
80026 FORMAT (1H ,16X,10HCORRECT= ,I6,16X,A31)
80028 FORMAT (1H ,16X,10HCOMPUTED= ,E12.5,10X,A31)
80030 FORMAT (1H ,16X,10HCORRECT= ,E12.5,10X,A31)
80050 FORMAT (1H ,48X,A31)
CBE** ********************** BBCFMT0A **********************************
CBB** ********************** BBCFMT0B **********************************
C**** FORMAT STATEMENTS FOR PAGE HEADERS
C****
90002 FORMAT (1H1)
90004 FORMAT (1H )
90006 FORMAT (1H ,20X,31HFEDERAL SOFTWARE TESTING CENTER)
90007 FORMAT (1H ,19X,34HFORTRAN COMPILER VALIDATION SYSTEM)
90008 FORMAT (1H ,21X,A13,A17)
90009 FORMAT (1H ,/,2H *,A5,6HBEGIN*,12X,15HTEST RESULTS - ,A5,/)
90010 FORMAT (1H ,8X,16HTEST DATE*TIME= ,A17,15H - COMPILER= ,A20)
90013 FORMAT (1H ,8H TEST ,10HPASS/FAIL ,6X,17HDISPLAYED RESULTS,
1 7X,7HREMARKS,24X)
90014 FORMAT (1H ,46H----------------------------------------------,
1 33H---------------------------------)
90015 FORMAT (1H ,48X,17HTHIS PROGRAM HAS ,I3,6H TESTS,/)
C****
C**** FORMAT STATEMENTS FOR REPORT FOOTINGS
C****
90016 FORMAT (1H ,/,2H *,A5,4HEND*,14X,14HEND OF TEST - ,A5,/)
90018 FORMAT (1H ,A13,13X,A20,7H * ,A10,1H/,
1 A13)
90019 FORMAT (1H ,26HFOR OFFICIAL USE ONLY ,35X,15HCOPYRIGHT 1982)
C****
C**** FORMAT STATEMENTS FOR RUN SUMMARY
C****
90020 FORMAT (1H ,21X,I5,13H TESTS PASSED)
90022 FORMAT (1H ,21X,I5,13H TESTS FAILED)
90024 FORMAT (1H ,21X,I5,14H TESTS DELETED)
90026 FORMAT (1H ,21X,I5,25H TESTS REQUIRE INSPECTION)
90028 FORMAT (1H ,21X,I5,4H OF ,I3,15H TESTS EXECUTED)
CBE** ********************** BBCFMT0B **********************************
C*****
C***** END OF TEST SEGMENT 439
STOP
END
*END-OF,FM920
FM921.f 481036687 170 2 100666 14418 `
*HEADER,FORTR,FM921
*FILES1,FORTR,FM921,X
C***********************************************************************
C***** FORTRAN 77
C***** FM921
C***** INQF4 - (441)
C*****
C***********************************************************************
C***** GENERAL PURPOSE ANS REF
C***** TEST INQUIRE BY FILE ON DIRECT, UNFORMATTED FILE 12.10.3
C*****
C***** THE TESTS IN THE UNIT ARE ONLY PERFORMED ON A
C***** FILE THAT IS CONNECTED FOR DIRECT, UNFORMATTED ACCESS
C***** (ANS REF. 12.2.4.2 AND 12.9.5.1)
C***** THIS TEST PERFORMS AN EXPLICIT OPEN, AND PERFORMS
C***** A CLOSE WITH STATUS='DELETE' AT THE END OF THE SEGMENT.
C***** THIS SEGMENT TESTS THAT AN INQUIRE IS PERFORMED CORRECTLY
C***** BEFORE READING OR WRITING TO THE FILE, AFTER WRITING TO
C***** THE FILE, AND AFTER READING FROM THE FILE.
C*****
C***** NOTE:
C***** AN INQUIRE STATEMENT IS NEEDED TO TEST THE READ AND
C***** WRITE OF MORE THAN A SINGLE RECORD AT A TIME, IN ORDER TO
C***** DETERMINE THAT THE RECORD NUMBER IS ADVANCED THE CORRECT
C***** NUMBER (ONE MORE THAN THE RECORD NUMBER LAST READ OR WRITTEN).
C***** THIS TEST WILL BE PERFORMED IN THE SEGMENTS WHICH TEST
C***** DIRECT ACCESS FILES - DIRAF3 (412).
C***********************************************************************
CBB** ********************** BBCCOMNT **********************************
C****
C**** 1978 FORTRAN COMPILER VALIDATION SYSTEM
C**** VERSION 2.0
C****
C****
C**** SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO
C**** GENERAL SERVICES ADMINISTRATION
C**** FEDERAL SOFTWARE TESTING CENTER
C**** 5203 LEESBURG PIKE, SUITE 1100
C**** FALLS CHURCH, VA. 22041
C****
C**** (703) 756-6153
C****
CBE** ********************** BBCCOMNT **********************************
C*****
LOGICAL AVB, BVB
CHARACTER*10 B10VK, D10VK, E11VK*11, G10VK
C***** BELOW CHARACTER STATEMENT ESTABLISHES THE FILE NAME VARIABLES.
CX20 REPLACED BY FEXEC X-20 CONTROL CARD. X-20 IS FOR REPLACING
CHARACTER*15 CDIR, CSEQ
C THE CHARACTER STATEMENT FOR FILE NAMES ASSOCIATED WITH X-100
C (PROGRAM VARIABLE CDIR) IF NOT VALID FOR THE PROCESSOR.
CBB** ********************** BBCINITA **********************************
C**** SPECIFICATION STATEMENTS
C****
CHARACTER ZVERS*13, ZVERSD*17, ZDATE*17, ZPROG*5, ZCOMPL*20,
1 ZNAME*20, ZTAPE*10, ZPROJ*13, REMRKS*31, ZTAPED*13
CBE** ********************** BBCINITA **********************************
CBB** ********************** BBCINITB **********************************
C**** INITIALIZE SECTION
DATA ZVERS, ZVERSD, ZDATE
1 /'VERSION 2.0 ', '82/08/02*18.33.46', '*NO DATE*TIME'/
DATA ZCOMPL, ZNAME, ZTAPE
1 /'*NONE SPECIFIED*', '*NO COMPANY NAME*', '*NO TAPE*'/
DATA ZPROJ, ZTAPED, ZPROG
1 /'*NO PROJECT*', '*NO TAPE DATE', 'XXXXX'/
DATA REMRKS /' '/
C**** THE FOLLOWING 9 COMMENT LINES (CZ01, CZ02, ...) CAN BE REPLACED
C**** FOR IDENTIFYING THE TEST ENVIRONMENT
C****
CZ01 ZVERS = 'VERSION OF THE COMPILER VALIDATION SYSTEM'
CZ02 ZVERSD = 'CREATION DATE/TIME OF THE COMPILER VALIDATION SYSTEM'
CZ03 ZPROG = 'PROGRAM NAME'
CZ04 ZDATE = 'DATE OF TEST'
CZ05 ZCOMPL = 'COMPILER IDENTIFICATION'
CZ06 ZPROJ = 'PROJECT NUMBER/IDENTIFICATION'
CZ07 ZNAME = 'NAME OF USER'
CZ08 ZTAPE = 'TAPE OWNER/ID'
CZ09 ZTAPED = 'DATE TAPE COPIED'
C
IVPASS = 0
IVFAIL = 0
IVDELE = 0
IVINSP = 0
IVTOTL = 0
IVTOTN = 0
ICZERO = 0
C
C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER.
I01 = 05
C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER.
I02 = 06
C
CX010 REPLACED BY FEXEC X-010 CONTROL CARD (CARD-READER UNIT NUMBER).
C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5
CX011 REPLACED BY FEXEC X-011 CONTROL CARD. CX011 IS FOR SYSTEMS
C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX010.
C
CX020 REPLACED BY FEXEC X-020 CONTROL CARD (PRINTER UNIT NUMBER).
C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02= 6
CX021 REPLACED BY FEXEC X-021 CONTROL CARD. CX021 IS FOR SYSTEMS
C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX020.
C
CBE** ********************** BBCINITB **********************************
C*****
C***** THE FOLLOWING STATEMENT MUST BE CHANGED IF
C***** THE UNIT GIVEN IS NOT CAPABLE OF BEING OPENED AS A
C***** DIRECT, UNFORMATTED FILE.
C*****
C I10 CONTAINS THE UNIT NUMBER FOR A DIRECT, UNFORMATTED FILE.
I10 = 24
CX100 REPLACED BY FEXEC X-100 CONTROL CARD (DIR. FILE UNIT NUMBER).
C SPECIFYING I10 = NN OVERRIDES THE DEFAULT I10 = 24.
C*****
C***** THE FOLLOWING STATEMENT MUST BE CHANGED IF THE NAME
C***** GIVEN IS NOT A VALID FILE SPECIFIER FOR A DIRECT,
C***** UNFORMATTED FILE.
C*****
C CDIR CONTAINS THE FILE NAME FOR UNIT I10.
CDIR = ' DIRFILE'
C
CX201 REPLACED BY FEXEC X-201 CONTROL CARD. CX201 IS FOR SYSTEMS
C REQUIRING A DIFFERENT FILE SPECIFIER FOR FILES ASSOCIATED WITH
C X-100 THAN THE DEFAULT CDIR = ' DIRFILE'.
C*****
C***** THE FOLLOWING STATEMENT MUST BE CHANGED IF 40 IS
C***** NOT A VALID RECORD LENGTH.
MVI = 40
C*****
NUVI = I02
IOVI = I10
ZPROG = 'FM921'
IVTOTL = 3
CBB** ********************** BBCHED0A **********************************
C****
C**** WRITE REPORT TITLE
C****
WRITE (I02, 90002)
WRITE (I02, 90006)
WRITE (I02, 90007)
WRITE (I02, 90008) ZVERS, ZVERSD
WRITE (I02, 90009) ZPROG, ZPROG
WRITE (I02, 90010) ZDATE, ZCOMPL
CBE** ********************** BBCHED0A **********************************
C*****
WRITE(NUVI,44100)
44100 FORMAT(1H , / 30H INQF4 - (441) INQUIRE BY FILE//
1 31H DIRECT ACCESS UNFORMATTED FILE//
2 19H ANS REF. - 12.10.3)
CBB** ********************** BBCHED0B **********************************
C**** WRITE DETAIL REPORT HEADERS
C****
WRITE (I02,90004)
WRITE (I02,90004)
WRITE (I02,90013)
WRITE (I02,90014)
WRITE (I02,90015) IVTOTL
CBE** ********************** BBCHED0B **********************************
C*****
C***** OPEN FILE
OPEN(FILE=CDIR, UNIT=IOVI, ACCESS='DIRECT', RECL=MVI,
1 FORM='UNFORMATTED')
C*****
CT001* TEST 1 - FIRST INQUIRE (AFTER OPEN)
IVTNUM = 1
INQUIRE(FILE=CDIR, EXIST=AVB, OPENED=BVB, NUMBER=JVI,
1 ACCESS=B10VK, DIRECT=D10VK, RECL=KVI, NEXTREC=LVI,
2 FORM=E11VK, UNFORMATTED=G10VK, ERR=20014, IOSTAT=IVI)
C*****
IF (IVI .NE. 0) GO TO 20010
IF (.NOT. AVB) GO TO 20010
IF (.NOT. BVB) GO TO 20010
IF (JVI .NE. IOVI) GO TO 20010
IF (B10VK .NE. 'DIRECT') GO TO 20010
IF (D10VK .NE. 'YES') GO TO 20010
IF (KVI .NE. MVI) GO TO 20010
IF (LVI .NE. 1) GO TO 20010
IF (E11VK .NE. 'UNFORMATTED') GO TO 20010
IF (G10VK .NE. 'YES' ) GO TO 20010
WRITE (NUVI, 80002) IVTNUM
IVPASS = IVPASS + 1
GO TO 0011
20014 CONTINUE
WRITE (NUVI, 20015) IVTNUM
20015 FORMAT (1H ,2X,I3,4X,5H FAIL,12X,
1 46HERROR IN EXECUTION OF INQUIRE STATEMENT (ERR=)/)
GO TO 20016
20010 CONTINUE
WRITE (NUVI, 20011) IVTNUM
20011 FORMAT(1H ,2X,I3,4X,5H FAIL,12X,
1 29HERROR IN AN INQUIRE SPECIFIER/)
20016 IVFAIL = IVFAIL + 1
WRITE (NUVI, 20012) IVI,AVB,BVB,JVI,B10VK,D10VK,KVI,
1 LVI,E11VK,G10VK
20012 FORMAT (1H ,16X,10HCOMPUTED: ,7HIOSTAT=,I1,8H, EXIST=,L1,
1 9H ,OPENED=,L1,9H, NUMBER=,I4,1H,/
2 1H ,26X,7HACCESS=,A6,9H, DIRECT=,A3,7H, RECL=,
3 I4,1H,/1H ,26X,8HNEXTREC=,I4,7H, FORM=,
4 A11,1H,/1H ,26X,12HUNFORMATTED=,A3)
WRITE (NUVI, 20013) IOVI,MVI
20013 FORMAT (1H ,16X,10HCORRECT: ,19HIOSTAT=0, EXIST=T, ,
1 17HOPENED=T, NUMBER=,I4,1H,/
2 1H ,26X,32HACCESS=DIRECT, DIRECT=YES, RECL=,
3 I4,1H,/1H ,26X,31HNEXTREC= 1, FORM=UNFORMATTED,/
4 1H ,26X,15HUNFORMATTED=YES)
0011 CONTINUE
C*****
C***** WRITE A RECORD TO FILE
44103 WRITE(IOVI, REC=1) JVI
C*****
CT002* TEST 2 - SECOND INQUIRE (AFTER WRITE)
IVTNUM = 2
C***** THIS INQUIRE ONLY TESTS THE DIRECT, RECL, AND NEXTREC
C***** AS THE OTHER SPECIFIERS HAVE BEEN PREVIOUSLY TESTED
INQUIRE(FILE=CDIR, DIRECT=D10VK, RECL=KVI, NEXTREC=LVI,
1 ERR=20024, IOSTAT=IVI)
C*****
IF (IVI .NE. 0) GO TO 20020
IF (D10VK .NE. 'YES') GO TO 20020
IF (KVI .NE. MVI) GO TO 20020
IF (LVI .NE. 2) GO TO 20020
WRITE (NUVI, 80002) IVTNUM
IVPASS = IVPASS + 1
GO TO 0021
20024 CONTINUE
WRITE (NUVI, 20025) IVTNUM
20025 FORMAT (1H ,2X,I3,4X,5H FAIL,12X,
1 46HERROR IN EXECUTION OF INQUIRE STATEMENT (ERR=)/)
GO TO 20026
20020 CONTINUE
WRITE (NUVI, 20021) IVTNUM
20021 FORMAT(1H ,2X,I3,4X,5H FAIL,12X,
1 29HERROR IN AN INQUIRE SPECIFIER/)
20026 IVFAIL = IVFAIL + 1
WRITE (NUVI, 20022) IVI,D10VK,KVI,LVI
20022 FORMAT (1H ,16X,10HCOMPUTED: ,7HIOSTAT=,I1,9H, DIRECT=,A3,
1 7H ,RECL=,I4,10H, NEXTREC=,I4)
WRITE (NUVI, 20023) MVI
20023 FORMAT (1H ,16X,10HCORRECT: ,20HIOSTAT=0, DIRECT=YES,
1 7H ,RECL=,I4,14H, NEXTREC= 2)
0021 CONTINUE
C*****
C***** READ A RECORD FROM FILE
44106 READ(IOVI, REC=1) JVI
C*****
CT003* TEST 3 - THIRD INQUIRE (AFTER READ)
IVTNUM = 3
C***** THIS INQUIRE ONLY TESTS THE DIRECT, RECL, AND NEXTREC
C***** AS THE OTHER SPECIFIERS HAVE BEEN PREVIOUSLY TESTED
INQUIRE(FILE=CDIR, DIRECT=D10VK, RECL=KVI, NEXTREC=LVI,
1 ERR=20034, IOSTAT=IVI)
C*****
IF (IVI .NE. 0) GO TO 20030
IF (D10VK .NE. 'YES') GO TO 20030
IF (KVI .NE. MVI) GO TO 20030
IF (LVI .NE. 2) GO TO 20030
WRITE (NUVI, 80002) IVTNUM
IVPASS = IVPASS + 1
GO TO 0031
20034 CONTINUE
WRITE (NUVI, 20035) IVTNUM
20035 FORMAT (1H ,2X,I3,4X,5H FAIL,12X,
1 46HERROR IN EXECUTION OF INQUIRE STATEMENT (ERR=)/)
GO TO 20036
20030 CONTINUE
WRITE (NUVI, 20031) IVTNUM
20031 FORMAT(1H ,2X,I3,4X,5H FAIL,12X,
1 29HERROR IN AN INQUIRE SPECIFIER/)
20036 IVFAIL = IVFAIL + 1
WRITE (NUVI, 20032) IVI,D10VK,KVI,LVI
20032 FORMAT (1H ,16X,10HCOMPUTED: ,7HIOSTAT=,I1,9H, DIRECT=,A3,
1 7H ,RECL=,I4,10H, NEXTREC=,I4)
WRITE (NUVI, 20033) MVI
20033 FORMAT (1H ,16X,10HCORRECT: ,20HIOSTAT=0, DIRECT=YES,
1 7H ,RECL=,I4,14H, NEXTREC= 2)
0031 CONTINUE
C*****
CLOSE(UNIT=IOVI, STATUS='DELETE')
C*****
CBB** ********************** BBCSUM0 **********************************
C**** WRITE OUT TEST SUMMARY
C****
IVTOTN = IVPASS + IVFAIL + IVDELE + IVINSP
WRITE (I02, 90004)
WRITE (I02, 90014)
WRITE (I02, 90004)
WRITE (I02, 90020) IVPASS
WRITE (I02, 90022) IVFAIL
WRITE (I02, 90024) IVDELE
WRITE (I02, 90026) IVINSP
WRITE (I02, 90028) IVTOTN, IVTOTL
CBE** ********************** BBCSUM0 **********************************
CBB** ********************** BBCFOOT0 **********************************
C**** WRITE OUT REPORT FOOTINGS
C****
WRITE (I02,90016) ZPROG, ZPROG
WRITE (I02,90018) ZPROJ, ZNAME, ZTAPE, ZTAPED
WRITE (I02,90019)
CBE** ********************** BBCFOOT0 **********************************
CBB** ********************** BBCFMT0A **********************************
C**** FORMATS FOR TEST DETAIL LINES
C****
80000 FORMAT (1H ,2X,I3,4X,7HDELETED,32X,A31)
80002 FORMAT (1H ,2X,I3,4X,7H PASS ,32X,A31)
80004 FORMAT (1H ,2X,I3,4X,7HINSPECT,32X,A31)
80008 FORMAT (1H ,2X,I3,4X,7H FAIL ,32X,A31)
80010 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,15X,10HCOMPUTED= ,
1I6,/,1H ,15X,10HCORRECT= ,I6)
80012 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
1E12.5,/,1H ,16X,10HCORRECT= ,E12.5)
80018 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
1A21,/,1H ,16X,10HCORRECT= ,A21)
80020 FORMAT (1H ,16X,10HCOMPUTED= ,A21,1X,A31)
80022 FORMAT (1H ,16X,10HCORRECT= ,A21,1X,A31)
80024 FORMAT (1H ,16X,10HCOMPUTED= ,I6,16X,A31)
80026 FORMAT (1H ,16X,10HCORRECT= ,I6,16X,A31)
80028 FORMAT (1H ,16X,10HCOMPUTED= ,E12.5,10X,A31)
80030 FORMAT (1H ,16X,10HCORRECT= ,E12.5,10X,A31)
80050 FORMAT (1H ,48X,A31)
CBE** ********************** BBCFMT0A **********************************
CBB** ********************** BBCFMT0B **********************************
C**** FORMAT STATEMENTS FOR PAGE HEADERS
C****
90002 FORMAT (1H1)
90004 FORMAT (1H )
90006 FORMAT (1H ,20X,31HFEDERAL SOFTWARE TESTING CENTER)
90007 FORMAT (1H ,19X,34HFORTRAN COMPILER VALIDATION SYSTEM)
90008 FORMAT (1H ,21X,A13,A17)
90009 FORMAT (1H ,/,2H *,A5,6HBEGIN*,12X,15HTEST RESULTS - ,A5,/)
90010 FORMAT (1H ,8X,16HTEST DATE*TIME= ,A17,15H - COMPILER= ,A20)
90013 FORMAT (1H ,8H TEST ,10HPASS/FAIL ,6X,17HDISPLAYED RESULTS,
1 7X,7HREMARKS,24X)
90014 FORMAT (1H ,46H----------------------------------------------,
1 33H---------------------------------)
90015 FORMAT (1H ,48X,17HTHIS PROGRAM HAS ,I3,6H TESTS,/)
C****
C**** FORMAT STATEMENTS FOR REPORT FOOTINGS
C****
90016 FORMAT (1H ,/,2H *,A5,4HEND*,14X,14HEND OF TEST - ,A5,/)
90018 FORMAT (1H ,A13,13X,A20,7H * ,A10,1H/,
1 A13)
90019 FORMAT (1H ,26HFOR OFFICIAL USE ONLY ,35X,15HCOPYRIGHT 1982)
C****
C**** FORMAT STATEMENTS FOR RUN SUMMARY
C****
90020 FORMAT (1H ,21X,I5,13H TESTS PASSED)
90022 FORMAT (1H ,21X,I5,13H TESTS FAILED)
90024 FORMAT (1H ,21X,I5,14H TESTS DELETED)
90026 FORMAT (1H ,21X,I5,25H TESTS REQUIRE INSPECTION)
90028 FORMAT (1H ,21X,I5,4H OF ,I3,15H TESTS EXECUTED)
CBE** ********************** BBCFMT0B **********************************
C*****
C***** END OF TEST SEGMENT 441
STOP
END
*END-OF,FM921
FM922.f 481036690 170 2 100666 10600 `
*HEADER,FORTR,FM922
*FILES1,FORTR,FM922,X
C***********************************************************************
C***** FORTRAN 77
C***** FM922
C***** INQF5 - (442)
C*****
C***********************************************************************
C***** GENERAL PURPOSE ANS REF
C***** TEST INQUIRE BY FILE ON A FILE THAT IS NOT 12.10.3
C***** CONNECTED TO A UNIT
C*****
C***** THE TESTS IN THIS UNIT ARE ONLY BE PERFORMED ON A
C***** FILE THAT IS NOT CONNECTED TO A UNIT.
C***** THIS TEST PERFORMS AN EXPLICIT OPEN, AND THEN
C***** PERFORMS A CLOSE WITH STATUS='KEEP' IN ORDER TO
C***** ENSURE THAT THE UNIT AND FILE ARE NOT CONNECTED.
C***** (ANS REF 12.10.2)
C***********************************************************************
CBB** ********************** BBCCOMNT **********************************
C****
C**** 1978 FORTRAN COMPILER VALIDATION SYSTEM
C**** VERSION 2.0
C****
C****
C**** SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO
C**** GENERAL SERVICES ADMINISTRATION
C**** FEDERAL SOFTWARE TESTING CENTER
C**** 5203 LEESBURG PIKE, SUITE 1100
C**** FALLS CHURCH, VA. 22041
C****
C**** (703) 756-6153
C****
CBE** ********************** BBCCOMNT **********************************
LOGICAL AVB, BVB
CHARACTER*10 C10VK, F10VK
C***** BELOW CHARACTER STATEMENT ESTABLISHES THE FILE NAME VARIABLES.
CX19 REPLACED BY FEXEC X-19 CONTROL CARD. X-19 IS FOR REPLACING
CHARACTER*15 CSEQ
C THE CHARACTER STATEMENT FOR FILE NAMES ASSOCIATED WITH X-150
C (PROGRAM VARIABLE CSEQ) IF NOT VALID FOR THE PROCESSOR.
CBB** ********************** BBCINITA **********************************
C**** SPECIFICATION STATEMENTS
C****
CHARACTER ZVERS*13, ZVERSD*17, ZDATE*17, ZPROG*5, ZCOMPL*20,
1 ZNAME*20, ZTAPE*10, ZPROJ*13, REMRKS*31, ZTAPED*13
CBE** ********************** BBCINITA **********************************
CBB** ********************** BBCINITB **********************************
C**** INITIALIZE SECTION
DATA ZVERS, ZVERSD, ZDATE
1 /'VERSION 2.0 ', '82/08/02*18.33.46', '*NO DATE*TIME'/
DATA ZCOMPL, ZNAME, ZTAPE
1 /'*NONE SPECIFIED*', '*NO COMPANY NAME*', '*NO TAPE*'/
DATA ZPROJ, ZTAPED, ZPROG
1 /'*NO PROJECT*', '*NO TAPE DATE', 'XXXXX'/
DATA REMRKS /' '/
C**** THE FOLLOWING 9 COMMENT LINES (CZ01, CZ02, ...) CAN BE REPLACED
C**** FOR IDENTIFYING THE TEST ENVIRONMENT
C****
CZ01 ZVERS = 'VERSION OF THE COMPILER VALIDATION SYSTEM'
CZ02 ZVERSD = 'CREATION DATE/TIME OF THE COMPILER VALIDATION SYSTEM'
CZ03 ZPROG = 'PROGRAM NAME'
CZ04 ZDATE = 'DATE OF TEST'
CZ05 ZCOMPL = 'COMPILER IDENTIFICATION'
CZ06 ZPROJ = 'PROJECT NUMBER/IDENTIFICATION'
CZ07 ZNAME = 'NAME OF USER'
CZ08 ZTAPE = 'TAPE OWNER/ID'
CZ09 ZTAPED = 'DATE TAPE COPIED'
C
IVPASS = 0
IVFAIL = 0
IVDELE = 0
IVINSP = 0
IVTOTL = 0
IVTOTN = 0
ICZERO = 0
C
C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER.
I01 = 05
C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER.
I02 = 06
C
CX010 REPLACED BY FEXEC X-010 CONTROL CARD (CARD-READER UNIT NUMBER).
C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5
CX011 REPLACED BY FEXEC X-011 CONTROL CARD. CX011 IS FOR SYSTEMS
C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX010.
C
CX020 REPLACED BY FEXEC X-020 CONTROL CARD (PRINTER UNIT NUMBER).
C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02= 6
CX021 REPLACED BY FEXEC X-021 CONTROL CARD. CX021 IS FOR SYSTEMS
C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX020.
C
CBE** ********************** BBCINITB **********************************
C*****
C***** THE FOLLOWING STATEMENT MUST BE CHANGED IF
C***** THE UNIT GIVEN IS NOT CAPABLE OF BEING OPENED AS A
C***** SEQUENTIAL, FORMATTED FILE.
C*****
C I15 CONTAINS THE UNIT NUMBER FOR A SEQUENTIAL FORMATTED FILE.
I15 = 14
CX150 REPLACED BY FEXEC X-150 CONTROL CARD (SEQ. FILE UNIT NUMBER).
C SPECIFYING I15 = NN OVERRIDES THE DEFAULT I15 = 14.
C*****
C***** THE FOLLOWING STATEMENT MUST BE CHANGED IF THE NAME
C***** GIVEN IS NOT A VALID FILE SPECIFIER FOR A SEQUENTIAL,
C***** FORMATTED FILE.
C*****
C CSEQ CONTAINS THE FILE NAME FOR UNIT I15.
CSEQ = ' SEQFILE'
C
CX191 REPLACED BY FEXEC X-191 CONTROL CARD. CX191 IS FOR SYSTEMS
C REQUIRING A DIFFERENT FILE SPECIFIER FOR FILES ASSOCIATED WITH
C X-150 THAN THE DEFAULT CSEQ = ' SEQFILE'.
C
C*****
NUVI = I02
IMVI = I15
ZPROG = 'FM922'
IVTOTL = 1
CBB** ********************** BBCHED0A **********************************
C****
C**** WRITE REPORT TITLE
C****
WRITE (I02, 90002)
WRITE (I02, 90006)
WRITE (I02, 90007)
WRITE (I02, 90008) ZVERS, ZVERSD
WRITE (I02, 90009) ZPROG, ZPROG
WRITE (I02, 90010) ZDATE, ZCOMPL
CBE** ********************** BBCHED0A **********************************
WRITE(NUVI,44200)
44200 FORMAT(1H ,/ 31H INQF5 - (442) INQUIRE BY FILE/
1 30H FILE NOT CONNECTED TO A UNIT/
2 20H ANS REF. - 12.10.3)
CBB** ********************** BBCHED0B **********************************
C**** WRITE DETAIL REPORT HEADERS
C****
WRITE (I02,90004)
WRITE (I02,90004)
WRITE (I02,90013)
WRITE (I02,90014)
WRITE (I02,90015) IVTOTL
CBE** ********************** BBCHED0B **********************************
C*****
C***** OPEN FILE, WRITE TO FILE, REWIND FILE
C*****
OPEN(FILE=CSEQ, UNIT=IMVI,ACCESS='SEQUENTIAL',FORM='FORMATTED')
WRITE(IMVI, 44200)
ENDFILE IMVI
REWIND IMVI
C*****
C***** DISCONNECT FILE
C*****
CLOSE(UNIT=IMVI, STATUS='KEEP')
C*****
CT001* TEST 1 - INQUIRE ON DISCONNECTED FILE
IVTNUM = 1
INQUIRE(FILE=CSEQ, IOSTAT=IVI, EXIST=AVB, OPENED=BVB,
1 SEQUENTIAL=C10VK, FORMATTED=F10VK, ERR=44206)
IF (IVI .NE. 0) GO TO 44202
IF (.NOT. AVB) GO TO 44202
IF (BVB) GO TO 44202
IF (C10VK .EQ. 'NO') GO TO 44202
IF (F10VK .EQ. 'NO') GO TO 44202
55040 WRITE(NUVI,80002)IVTNUM
IVPASS=IVPASS+1
GO TO 44204
44206 CONTINUE
WRITE (NUVI, 44207) IVTNUM
44207 FORMAT (1H ,2X,I3,4X,5H FAIL,12X,
1 46HERROR IN EXECUTION OF INQUIRE STATEMENT (ERR=)/)
GO TO 44208
44202 CONTINUE
WRITE(NUVI,55010)IVTNUM
55010 FORMAT(1H ,5X,I3,4X,5H FAIL,12X,
1 29HERROR IN AN INQUIRE SPECIFIER/)
44208 IVFAIL=IVFAIL+1
WRITE(NUVI,55020)IVI,AVB,BVB,C10VK,F10VK
55020 FORMAT(1H ,10X,11HCOMPUTED: ,
1 7HIOSTAT=,I1,
2 8H, EXIST=,L1,9H, OPENED=,L1,13H, SEQUENTIAL=,A3,
3 12H, FORMATTED=,A3)
WRITE(NUVI,55030)
55030 FORMAT(1H ,10X,11HCORRECT: ,
1 10HIOSTAT=0, ,
2 45HEXIST=T, OPENED=F, SEQUENTIAL=YES, FORMATTED=,
3 3HYES/55X,10HOR UNKNOWN,4X,10HOR UNKNOWN)
44204 CONTINUE
OPEN(FILE=CSEQ, UNIT=IMVI)
CLOSE(UNIT=IMVI, STATUS='DELETE')
CBB** ********************** BBCSUM0 **********************************
C**** WRITE OUT TEST SUMMARY
C****
IVTOTN = IVPASS + IVFAIL + IVDELE + IVINSP
WRITE (I02, 90004)
WRITE (I02, 90014)
WRITE (I02, 90004)
WRITE (I02, 90020) IVPASS
WRITE (I02, 90022) IVFAIL
WRITE (I02, 90024) IVDELE
WRITE (I02, 90026) IVINSP
WRITE (I02, 90028) IVTOTN, IVTOTL
CBE** ********************** BBCSUM0 **********************************
CBB** ********************** BBCFOOT0 **********************************
C**** WRITE OUT REPORT FOOTINGS
C****
WRITE (I02,90016) ZPROG, ZPROG
WRITE (I02,90018) ZPROJ, ZNAME, ZTAPE, ZTAPED
WRITE (I02,90019)
CBE** ********************** BBCFOOT0 **********************************
CBB** ********************** BBCFMT0A **********************************
C**** FORMATS FOR TEST DETAIL LINES
C****
80000 FORMAT (1H ,2X,I3,4X,7HDELETED,32X,A31)
80002 FORMAT (1H ,2X,I3,4X,7H PASS ,32X,A31)
80004 FORMAT (1H ,2X,I3,4X,7HINSPECT,32X,A31)
80008 FORMAT (1H ,2X,I3,4X,7H FAIL ,32X,A31)
80010 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,15X,10HCOMPUTED= ,
1I6,/,1H ,15X,10HCORRECT= ,I6)
80012 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
1E12.5,/,1H ,16X,10HCORRECT= ,E12.5)
80018 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
1A21,/,1H ,16X,10HCORRECT= ,A21)
80020 FORMAT (1H ,16X,10HCOMPUTED= ,A21,1X,A31)
80022 FORMAT (1H ,16X,10HCORRECT= ,A21,1X,A31)
80024 FORMAT (1H ,16X,10HCOMPUTED= ,I6,16X,A31)
80026 FORMAT (1H ,16X,10HCORRECT= ,I6,16X,A31)
80028 FORMAT (1H ,16X,10HCOMPUTED= ,E12.5,10X,A31)
80030 FORMAT (1H ,16X,10HCORRECT= ,E12.5,10X,A31)
80050 FORMAT (1H ,48X,A31)
CBE** ********************** BBCFMT0A **********************************
CBB** ********************** BBCFMT0B **********************************
C**** FORMAT STATEMENTS FOR PAGE HEADERS
C****
90002 FORMAT (1H1)
90004 FORMAT (1H )
90006 FORMAT (1H ,20X,31HFEDERAL SOFTWARE TESTING CENTER)
90007 FORMAT (1H ,19X,34HFORTRAN COMPILER VALIDATION SYSTEM)
90008 FORMAT (1H ,21X,A13,A17)
90009 FORMAT (1H ,/,2H *,A5,6HBEGIN*,12X,15HTEST RESULTS - ,A5,/)
90010 FORMAT (1H ,8X,16HTEST DATE*TIME= ,A17,15H - COMPILER= ,A20)
90013 FORMAT (1H ,8H TEST ,10HPASS/FAIL ,6X,17HDISPLAYED RESULTS,
1 7X,7HREMARKS,24X)
90014 FORMAT (1H ,46H----------------------------------------------,
1 33H---------------------------------)
90015 FORMAT (1H ,48X,17HTHIS PROGRAM HAS ,I3,6H TESTS,/)
C****
C**** FORMAT STATEMENTS FOR REPORT FOOTINGS
C****
90016 FORMAT (1H ,/,2H *,A5,4HEND*,14X,14HEND OF TEST - ,A5,/)
90018 FORMAT (1H ,A13,13X,A20,7H * ,A10,1H/,
1 A13)
90019 FORMAT (1H ,26HFOR OFFICIAL USE ONLY ,35X,15HCOPYRIGHT 1982)
C****
C**** FORMAT STATEMENTS FOR RUN SUMMARY
C****
90020 FORMAT (1H ,21X,I5,13H TESTS PASSED)
90022 FORMAT (1H ,21X,I5,13H TESTS FAILED)
90024 FORMAT (1H ,21X,I5,14H TESTS DELETED)
90026 FORMAT (1H ,21X,I5,25H TESTS REQUIRE INSPECTION)
90028 FORMAT (1H ,21X,I5,4H OF ,I3,15H TESTS EXECUTED)
CBE** ********************** BBCFMT0B **********************************
STOP
END
*END-OF,FM922
FM923.f 481036695 170 2 100666 30514 `
*HEADER,FORTR,FM923
*FILES1,FORTR,FM923,XX
C***********************************************************************
C***** FORTRAN 77
C***** FM923
C***** LSTDI1 - (370)
C*****
C***********************************************************************
C***** GENERAL PURPOSE ANS REF
C***** TEST LIST DIRECTED INPUT ON 13.6
C***** INTEGER REAL, LOGICAL, AND CHARACTER DATA TYPES. 12.4
C*****
CBB** ********************** BBCCOMNT **********************************
C****
C**** 1978 FORTRAN COMPILER VALIDATION SYSTEM
C**** VERSION 2.0
C****
C****
C**** SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO
C**** GENERAL SERVICES ADMINISTRATION
C**** FEDERAL SOFTWARE TESTING CENTER
C**** 5203 LEESBURG PIKE, SUITE 1100
C**** FALLS CHURCH, VA. 22041
C****
C**** (703) 756-6153
C****
CBE** ********************** BBCCOMNT **********************************
C INPUT DATA TO THIS SEGMENT CONSISTS OF 34 CARD IMAGES IN COL. 1-80
COL. 1----------------------------------------------------------61
CARD 1 25
CARD 2 10.75
CARD 3 12.875E01
CARD 4 T
CARD 5 'ABCDEF'
CARD 6 10 15 22 40
CARD 7 100.5 0.25E-1 -1.625E2
CARD 8 T F F T F
CARD 9 'AB' 'ABCD' 'ABCDEF'
CARD 10 '123456' T 17.5 -11 2.5E0
CARD 11 -5,'2468',T,15.0
CARD 12 F 'CHAR' -1 0.25
CARD 13 5 10 15
CARD 14 -1.25E1 F T -6 '-6'
CARD 15 F 'ZYXW' 'DCBA' 15.5
CARD 16 'ONE ',,3,F
CARD 17 'TWO ', 2, , 2.0
CARD 18 ,4, 1*, 8, ,, 14
CARD 19 5, -0.25E1, 4*, 'TEST', F
CARD 20 1 2 3 4 5
CARD 21 6 7 8/ 9 10
CARD 22 12045,12 45
CARD 23 12045
COL. 62---------------80
CARD 23 12
COL. 1----------------------------------------------------------61
CARD 24 45
CARD 25 'ABCDEF'
COL. 62---------------80
CARD 25 'UVW
COL. 1----------------------------------------------------------61
CARD 26 XYZ'
CARD 27 'CAN''T, AND/OR WON''T'
CARD 28 '1234567890' '12345678' '1234567890123'
CARD 29 TRUCK .FOUR .FALSE. .TWIN. F12. F7.2 .TRUE. .T=3+4
CARD 30 T T T T T
CARD 31 F F/F F F
CARD 32 / 10 20 30
CARD 33 1 2 3 4
CARD 34 5 6 7 8
C*****
C***** S P E C I F I C A T I O N S SEGMENT 370
INTEGER J1I(3)
LOGICAL AVB, BVB, CVB, DVB, EVB, FVB, GVB, HVB
CHARACTER A2VK*2, A4VK*4, B4VK*4, A6VK*6, B6VK*6
CHARACTER A8VK*8, A9VK*9, A15VK*15, A21VK*21
CHARACTER CVNX06*6, CVNY06*6, CVNX21*21
C*****
CBB** ********************** BBCINITA **********************************
C**** SPECIFICATION STATEMENTS
C****
CHARACTER ZVERS*13, ZVERSD*17, ZDATE*17, ZPROG*5, ZCOMPL*20,
1 ZNAME*20, ZTAPE*10, ZPROJ*13, REMRKS*31, ZTAPED*13
CBE** ********************** BBCINITA **********************************
CBB** ********************** BBCINITB **********************************
C**** INITIALIZE SECTION
DATA ZVERS, ZVERSD, ZDATE
1 /'VERSION 2.0 ', '82/08/02*18.33.46', '*NO DATE*TIME'/
DATA ZCOMPL, ZNAME, ZTAPE
1 /'*NONE SPECIFIED*', '*NO COMPANY NAME*', '*NO TAPE*'/
DATA ZPROJ, ZTAPED, ZPROG
1 /'*NO PROJECT*', '*NO TAPE DATE', 'XXXXX'/
DATA REMRKS /' '/
C**** THE FOLLOWING 9 COMMENT LINES (CZ01, CZ02, ...) CAN BE REPLACED
C**** FOR IDENTIFYING THE TEST ENVIRONMENT
C****
CZ01 ZVERS = 'VERSION OF THE COMPILER VALIDATION SYSTEM'
CZ02 ZVERSD = 'CREATION DATE/TIME OF THE COMPILER VALIDATION SYSTEM'
CZ03 ZPROG = 'PROGRAM NAME'
CZ04 ZDATE = 'DATE OF TEST'
CZ05 ZCOMPL = 'COMPILER IDENTIFICATION'
CZ06 ZPROJ = 'PROJECT NUMBER/IDENTIFICATION'
CZ07 ZNAME = 'NAME OF USER'
CZ08 ZTAPE = 'TAPE OWNER/ID'
CZ09 ZTAPED = 'DATE TAPE COPIED'
C
IVPASS = 0
IVFAIL = 0
IVDELE = 0
IVINSP = 0
IVTOTL = 0
IVTOTN = 0
ICZERO = 0
C
C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER.
I01 = 05
C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER.
I02 = 06
C
CX010 REPLACED BY FEXEC X-010 CONTROL CARD (CARD-READER UNIT NUMBER).
C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5
CX011 REPLACED BY FEXEC X-011 CONTROL CARD. CX011 IS FOR SYSTEMS
C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX010.
C
CX020 REPLACED BY FEXEC X-020 CONTROL CARD (PRINTER UNIT NUMBER).
C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02= 6
CX021 REPLACED BY FEXEC X-021 CONTROL CARD. CX021 IS FOR SYSTEMS
C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX020.
C
CBE** ********************** BBCINITB **********************************
IRVI = I01
NUVI = I02
ZPROG = 'FM923'
IVTOTL = 28
CBB** ********************** BBCHED0A **********************************
C****
C**** WRITE REPORT TITLE
C****
WRITE (I02, 90002)
WRITE (I02, 90006)
WRITE (I02, 90007)
WRITE (I02, 90008) ZVERS, ZVERSD
WRITE (I02, 90009) ZPROG, ZPROG
WRITE (I02, 90010) ZDATE, ZCOMPL
CBE** ********************** BBCHED0A **********************************
C*****
C***** REAL NUMBER APPROXIMATION CRITERIA
DVS = 0.0001
IVCORR=0
RVCORR=0
C*****
C***** HEADING FOR SEGMENT 370
WRITE(NUVI,37000)
37000 FORMAT(/2X, 16H LSTDI1 - (370) ,
1 42H LIST DIRECTED INPUT FOR SUBSET DATA TYPES//
2 3X,22H ANS REF. - 13.6 12.4)
CBB** ********************** BBCHED0B **********************************
C**** WRITE DETAIL REPORT HEADERS
C****
WRITE (I02,90004)
WRITE (I02,90004)
WRITE (I02,90013)
WRITE (I02,90014)
WRITE (I02,90015) IVTOTL
CBE** ********************** BBCHED0B **********************************
C*****
CT001* TEST 1 - CARD 1 INTEGER
IVTNUM = 1
READ(IRVI, *) IVI
C***** TO DELETE TEST THE READ STATEMENTS MUST BE PERFORMED
C***** FIRST. THEN INCLUDE THE FOLLOWING 2 STATEMENTS
C***** IVDELE=IVDELE+1
C***** WRITE (NUVI,80000) IVTNUM
C***** AND COMMENT OUT REMAINING LINES UNTIL NEXT TEST
IVCORR=25
IF (IVI - 25) 20010,10010,20010
10010 IVPASS=IVPASS+1
WRITE (NUVI,80002) IVTNUM
GO TO 0011
20010 IVFAIL=IVFAIL+1
WRITE (NUVI,80008) IVTNUM
WRITE (NUVI,80024) IVI
WRITE (NUVI,80026) IVCORR
0011 CONTINUE
CT002* TEST 2 - CARD 2 REAL
IVTNUM = 2
READ(IRVI, *) AVS
C***** TO DELETE TEST SEE NOTES FOR TEST 1
RVCORR=10.75
AAVS = AVS - 10.75
IF (AAVS + .00005) 20020,10020,40020
40020 IF (AAVS - .00005) 10020,10020,20020
10020 IVPASS=IVPASS+1
WRITE (NUVI,80002) IVTNUM
GO TO 0021
20020 IVFAIL=IVFAIL+1
WRITE (NUVI,80008) IVTNUM
WRITE (NUVI,80028) AVS
WRITE (NUVI,80030) RVCORR
0021 CONTINUE
CT003* TEST 3 - CARD 3 REAL, EXPONENT
IVTNUM = 3
READ(IRVI, *) AVS
C***** TO DELETE TEST SEE NOTES FOR TEST 1
RVCORR=128.75
AAVS = AVS - 128.75
IF (AAVS + .00005) 20030,10030,40030
40030 IF (AAVS - .00005) 10030,10030,20030
10030 IVPASS=IVPASS+1
WRITE (NUVI,80002) IVTNUM
GO TO 0031
20030 IVFAIL=IVFAIL+1
WRITE (NUVI,80008) IVTNUM
WRITE (NUVI,80028) AVS
WRITE (NUVI,80030) RVCORR
0031 CONTINUE
CT004* TEST 4 - CARD 4 LOGICAL
IVTNUM = 4
READ(IRVI, *) AVB
C***** TO DELETE TEST SEE NOTES TEST 1
IVCOMP=0
IF (AVB) IVCOMP = 1
IF (IVCOMP - 1) 20040,10040,20040
10040 IVPASS=IVPASS+1
WRITE (NUVI,80002) IVTNUM
GO TO 0041
20040 IVFAIL=IVFAIL+1
WRITE (NUVI,80008) IVTNUM
70040 FORMAT (1H ,16X,10HCOMPUTED: ,1X,L1)
WRITE (NUVI,70040) AVB
70041 FORMAT (1H ,16X,10HCORRECT: ,2H T)
WRITE (NUVI,70041)
0041 CONTINUE
CT005* TEST 5 - CARD 5 CHARACTER
IVTNUM = 5
READ(IRVI, *) A6VK
C***** TO DELETE TEST SEE NOTES FOR TEST 1
CVNX06='ABCDEF'
IVCOMP=0
IF (A6VK .EQ. 'ABCDEF') IVCOMP = 1
IF (IVCOMP - 1) 20050,10050,20050
10050 IVPASS=IVPASS+1
WRITE (NUVI,80002) IVTNUM
GO TO 0051
20050 IVFAIL=IVFAIL+1
WRITE (NUVI,80008) IVTNUM
WRITE (NUVI,80020) A6VK
WRITE (NUVI,80022) CVNX06
0051 CONTINUE
CT006* TEST 6 - CARD 6 SEVERAL INTEGER
IVTNUM = 6
READ(IRVI, *) IVI, JVI, KVI, LVI
C***** TO DELETE TEST SEE NOTES FOR TEST 1
IF (IVI - 10) 20060,40060,20060
40060 IF (JVI - 15) 20060,40061,20060
40061 IF (KVI - 22) 20060,40062,20060
40062 IF (LVI - 40) 20060,10060,20060
10060 IVPASS=IVPASS+1
WRITE (NUVI,80002) IVTNUM
GO TO 0061
20060 IVFAIL=IVFAIL+1
WRITE (NUVI,80008) IVTNUM
70060 FORMAT (1H ,16X,10HCOMPUTED: ,I5,3(2X,I5))
WRITE (NUVI,70060) IVI,JVI,KVI,LVI
70061 FORMAT (1H ,16X,10HCORRECT: ,
1 5H 10,2X,5H 15,2X,5H 22,2X,5H 40)
WRITE (NUVI,70061)
0061 CONTINUE
CT007* TEST 7 - CARD 7 SEVERAL REAL
IVTNUM = 7
READ(IRVI, *) AVS, BVS, CVS
C******* TO DELETE TEST SEE NOTES FOR TEST 1
AAVS = AVS - 100.5
BBVS = BVS - 0.025
CCVS = CVS - (-162.5)
IF (AAVS + .00005) 20070,40071,40070
40070 IF (AAVS - .00005) 40071,40071,20070
40071 IF (BBVS + .00005) 20070,40073,40072
40072 IF (BBVS - .00005) 40073,40073,20070
40073 IF (CCVS + .00005) 20070,10070,40074
40074 IF (CCVS - .00005) 10070,10070,20070
10070 IVPASS=IVPASS+1
WRITE (NUVI,80002) IVTNUM
GO TO 0071
20070 IVFAIL=IVFAIL+1
WRITE (NUVI,80008) IVTNUM
70071 FORMAT (1H ,16X,10HCOMPUTED: ,F6.2,2X,F6.4,2X,F7.2)
WRITE (NUVI,70071) AVS,BVS,CVS
70072 FORMAT (1H ,16X,10HCORRECT: ,6H100.50,2X,6H0.0250,
1 2X,7H-162.50)
WRITE(NUVI,70072)
0071 CONTINUE
CT008* TEST 8 - CARD 8 SEVERAL LOGICAL
IVTNUM = 8
READ(IRVI, *) AVB, BVB, CVB, DVB, EVB
C**** TO DELETE TEST SEE NOTES FOR TEST 1
IF (AVB .AND. .NOT. BVB .AND. .NOT. CVB .AND. DVB .AND.
1 .NOT. EVB) GO TO 37008
IVFAIL=IVFAIL+1
WRITE (NUVI,80008) IVTNUM
70081 FORMAT (1H ,16X,10HCOMPUTED: ,L1,4(2X,L1))
WRITE (NUVI,70081) AVB,BVB,CVB,DVB,EVB
70082 FORMAT (1H ,16X,10HCORRECT: ,1HT,2X,1HF,2X,1HF,2X,1HT,2X,
1 1HF)
WRITE (NUVI,70082)
GO TO 37010
37008 CONTINUE
IVPASS=IVPASS+1
WRITE (NUVI,80002) IVTNUM
37010 CONTINUE
CT009* TEST 9 - CARD 9 SEVERAL CHARACTER STRINGS
IVTNUM = 9
READ(IRVI, *) A2VK, A4VK, A6VK
C***** TO DELETE CODE SEE NOTES FOR TEST 1
IF (A2VK .EQ. 'AB' .AND. A4VK .EQ. 'ABCD' .AND.
1 A6VK .EQ. 'ABCDEF') GO TO 37011
IVFAIL=IVFAIL+1
WRITE (NUVI,80008) IVTNUM
70090 FORMAT (1H ,16X,10HCOMPUTED: ,A2,2X,A4,2X,A6)
WRITE (NUVI,70090) A2VK,A4VK,A6VK
70091 FORMAT (1H ,16X,10HCORRECT: ,2HAB,2X,4HABCD,2X,6HABCDEF)
WRITE (NUVI,70091)
GO TO 37013
37011 CONTINUE
IVPASS=IVPASS+1
WRITE (NUVI,80002) IVTNUM
37013 CONTINUE
CT010* TEST 10 - CARD 10 MIXED TYPES
IVTNUM = 10
READ(IRVI, *) A6VK, AVB, AVS, IVI, BVS
C**** TO DELETE TEST SEE NOTES FOR TEST 1
IF (A6VK .EQ. '123456' .AND. AVB .AND. AVS .GE. (17.5 - DVS)
1 .AND. AVS .LE. (17.5 + DVS) .AND. IVI .EQ. -11 .AND.
2 BVS .GE. (2.5 - DVS) .AND. BVS .LE. (2.5 + DVS))
3 GO TO 37014
IVFAIL=IVFAIL+1
70100 FORMAT (1H ,2X,I3,4X,7H FAIL ,32X,
1 28HCOMPLEX IF - SEE SOURCE CODE)
WRITE (NUVI,70100) IVTNUM
70101 FORMAT (1H ,16X,10HCOMPUTED: ,
2 A6,2X,L1,2X,F5.2,2X,I5,2X,E12.5)
WRITE (NUVI,70101) A6VK,AVB,AVS,IVI,BVS
70102 FORMAT (1H ,16X,10HCORRECT: ,
1 23H123456 T 17.50 -11,2X,26H 0.25000E+01 OR .25000+001)
WRITE (NUVI,70102)
GO TO 37016
37014 CONTINUE
IVPASS=IVPASS+1
WRITE (NUVI,80002) IVTNUM
37016 CONTINUE
CT011* TEST 11 - CARD 11 MIXED TYPES SEPARATED BY COMMAS
IVTNUM = 11
READ(IRVI, *) IVI, A4VK, AVB, AVS
C***** TO DELETE TEST SEE NOTES FOR TEST 1
IF (IVI .EQ. -5 .AND. A4VK .EQ. '2468' .AND. AVB .AND.
1 AVS .GE. (15.0 - DVS) .AND. AVS .LE. (15.0 + DVS))
2 GO TO 37017
IVFAIL=IVFAIL+1
70110 FORMAT (1H ,2X,I3,4X,7H FAIL ,16HMIXED DATA TYPES,16X,
1 28HCOMPLEX IF - SEE SOURCE CODE)
WRITE (NUVI,70110) IVTNUM
70111 FORMAT (1H ,16X,10HCOMPUTED: ,
1 I5,2X,A4,2X,L1,2X,F5.2)
WRITE (NUVI,70111) IVI,A4VK,AVB,AVS
70112 FORMAT (1H ,16X,10HCORRECT: ,
1 5H -5,2X,4H2468,2X,1HT,2X,5H15.00)
WRITE (NUVI,70112)
GO TO 37019
37017 CONTINUE
IVPASS=IVPASS+1
WRITE (NUVI,80002) IVTNUM
37019 CONTINUE
CT012* TEST 12 - CARD 12 MIXED TYPES, VARYING NUMBER OF
C***** BLANKS SEPARATING VALUES
IVTNUM = 12
READ(IRVI, *) AVB, A4VK, IVI, AVS
C***** TO DELETE TEST SEE NOTES FOR TEST 1
IF (.NOT. AVB .AND. A4VK .EQ. 'CHAR' .AND. IVI .EQ. -1 .AND.
1 AVS .GE. (0.25 - DVS) .AND. AVS .LE. (0.25 + DVS))
2 GO TO 37020
IVFAIL=IVFAIL+1
70120 FORMAT (1H ,2X,I3,4X,7H FAIL ,16HMIXED DATA TYPES,16X,
1 28HCOMPLEX IF - SEE SOURCE CODE)
WRITE (NUVI,70120) IVTNUM
70121 FORMAT (1H ,16X,10HCOMPUTED: ,
1 L1,2X,A4,2X,I5,2X,F4.2)
WRITE (NUVI,70121) AVB,A4VK,IVI,AVS
70122 FORMAT (1H ,16X,10HCORRECT: ,
2 3HF ,4HCHAR,2X,5H -5,2X,4H0.25)
WRITE (NUVI,70122)
GO TO 37022
37020 CONTINUE
IVPASS=IVPASS+1
WRITE (NUVI,80002) IVTNUM
37022 CONTINUE
CT013* TEST 13 - CARD 13 READ VALUES INTO ARRAY BY USING
C***** AN IMPLICIT DO-LOOP
IVTNUM = 13
READ(IRVI, *) (J1I(IIVI), IIVI=1,3)
C**** TO DELETE TEST SEE NOTES FOR TEST 1
IF (J1I(1) - 5) 20130,40130,20130
40130 IF (J1I(2) - 10) 20130,40131,20130
40131 IF (J1I(3) - 15) 20130,10130,20130
10130 IVPASS=IVPASS+1
WRITE (NUVI,80002) IVTNUM
GO TO 0131
20130 IVFAIL=IVFAIL+1
WRITE (NUVI,80008) IVTNUM
70130 FORMAT (1H ,16X,10HCOMPUTED: ,I5,2X,I5,2X,I5)
WRITE (NUVI,70130) J1I(1),J1I(2),J1I(3)
70131 FORMAT (1H ,16X,10HCORRECT: ,
1 5H 5,2X,5H 10,2X,5H 15)
WRITE (NUVI,70131)
0131 CONTINUE
CT014* TEST 14 - CARDS 14-15 LIST EXTENDING OVER 2 RECORDS
IVTNUM = 14
READ(IRVI, *) AVS, AVB, BVB, IVI, A2VK, CVB, A4VK, B4VK, BVS
C***** TO DELETE CODE SEE NOTES FOR TEST 1
IF (AVS .GE. (-1.25E1 - DVS) .AND. AVS .LE. (-1.25E1 + DVS)
1 .AND. .NOT. AVB .AND. BVB .AND.
2 IVI .EQ. -6 .AND. A2VK .EQ. '-6' .AND. .NOT. CVB .AND.
3 A4VK .EQ. 'ZYXW' .AND. B4VK .EQ. 'DCBA' .AND.
4 BVS .GE. (15.5 - DVS) .AND. BVS .LE. (15.5 + DVS))
5 GO TO 37024
IVFAIL=IVFAIL+1
70140 FORMAT (1H ,2X,I3,4X,7H FAIL ,16HMIXED DATA TYPES,16X,
1 28HCOMPLEX IF - SEE SOURCE CODE)
WRITE (NUVI,70140) IVTNUM
70141 FORMAT (1H ,16X,10HCOMPUTED: ,E12.5,2X,L1,2X,L1,2X,I5,
1 /27X,A2,2X,L1,2X,A4,2X,A4,2X,F5.2)
WRITE (NUVI,70141) AVS,AVB,BVB,IVI,A2VK,CVB,A4VK,B4VK,BVS
70142 FORMAT (1H ,16X,10HCORRECT: ,
1 12H -.12500E+01,2X,1HF,2X,1HT,2X,5H -6,
2 /27X,2H-6,2X,1HF,2X,4HZYXW,2X,4HDCBA,2X,5H15.50)
WRITE (NUVI,70142)
GO TO 37026
37024 CONTINUE
IVPASS=IVPASS+1
WRITE (NUVI,80002) IVTNUM
37026 CONTINUE
CT015* TEST 15 - CARD 16 NULL VALUE REPRESENTED AS ,,
IVTNUM = 15
AVS = 2.0
READ(IRVI, *) A4VK, AVS, IVI, AVB
C***** TO DELETE TEST SEE NOTES FOR TEST 1
IF (A4VK .EQ. 'ONE ' .AND. AVS .GE. (2.0 - DVS) .AND.
1 AVS .LE. (2.0 + DVS) .AND. IVI .EQ. 3 .AND. .NOT. AVB)
2 GO TO 37027
IVFAIL=IVFAIL+1
WRITE (NUVI,70150) IVTNUM
70150 FORMAT (1H ,2X,I3,4X,7H FAIL ,32X,
1 28HCOMPLEX IF - SEE SOURCE CODE)
70151 FORMAT (1H ,16X,10HCOMPUTED: ,A4,2X,F4.1,2X,I5,2X,L1)
WRITE (NUVI,70151) A4VK,AVS,IVI,AVB
70152 FORMAT (1H ,16X,10HCORRECT: ,
1 20HONE 2.0 3 F)
WRITE (NUVI,70152)
GO TO 37029
37027 CONTINUE
IVPASS=IVPASS+1
WRITE (NUVI,80002) IVTNUM
37029 CONTINUE
CT016* TEST 16 - CARD 17 NULL VALUE REPRESENTED AS ' '
IVTNUM = 16
AVB = .TRUE.
READ(IRVI, *) A4VK, IVI, AVB, AVS
C***** TO DELETE TEST SEE NOTES FOR TEST 1
IF (A4VK .EQ. 'TWO ' .AND. IVI .EQ. 2 .AND. AVB .AND.
1 AVS .GE. (2.0 - DVS) .AND. AVS .LE. (2.0 + DVS))
2 GO TO 37030
IVFAIL=IVFAIL+1
WRITE (NUVI,80008) IVTNUM
70160 FORMAT (1H ,16X,10HCOMPUTED: ,A4,2X,I5,2X,L1,2X,F4.1)
WRITE (NUVI,70160) A4VK,IVI,AVB,AVS
70161 FORMAT (1H ,16X,10HCORRECT: ,
1 20HTWO 2 T 2.0)
WRITE (NUVI,70161)
GO TO 37032
37030 CONTINUE
IVPASS=IVPASS+1
WRITE (NUVI,80002) IVTNUM
37032 CONTINUE
CT017* TEST 17 - CARD 18 VARIOUS NULL REPRESENTATIONS
IVTNUM = 17
IVI = 2
JVI = 6
KVI = 10
KKVI = 12
READ(IRVI, *) IVI, IIVI, JVI, JJVI, KVI, KKVI, LVI
C**** TO DELETE TEST SEE NOTES FOR TEST 1
IF (IVI .EQ. 2 .AND. IIVI .EQ. 4 .AND. JVI .EQ. 6 .AND.
1 JJVI .EQ. 8 .AND. KVI .EQ. 10 .AND. KKVI .EQ. 12 .AND.
2 LVI .EQ. 14) GO TO 37033
IVFAIL=IVFAIL+1
WRITE (NUVI,70170) IVTNUM
70170 FORMAT (1H ,2X,I3,4X,7H FAIL ,32X,
1 28HCOMPLEX IF - SEE SOURCE CODE)
70171 FORMAT (1H ,16X,10HCOMPUTED: ,
1 I5,6(2X,I5))
WRITE (NUVI,70171) IVI,IIVI,JVI,JJVI,KVI,KKVI,LVI
70172 FORMAT (1H ,16X,10HCORRECT: ,
1 47H 2 4 6 8 10 12 14)
WRITE (NUVI,70172)
GO TO 37035
37033 CONTINUE
IVPASS=IVPASS+1
WRITE (NUVI,80002) IVTNUM
37035 CONTINUE
CT018* TEST 18 - CARD 19 NULL VALUE USING REPETITION FACTOR
IVTNUM = 18
IVI = 1
AVB = .TRUE.
AVS = 1.0
A4VK = 'TRUE'
READ (IRVI, *) JVI, BVS, IVI, AVB, AVS, A4VK, B4VK, BVB
C***** TO DELETE TEST SEE NOTES FOR TEST 1
IF (JVI .EQ. 5 .AND. BVS .GE. (-2.5 - DVS) .AND.
1 BVS .LE. (-2.5 + DVS) .AND. IVI .EQ. 1 .AND. AVB .AND.
2 AVS .GE. (1.0 - DVS) .AND. AVS .LE. (1.0 + DVS) .AND.
3 A4VK .EQ. 'TRUE' .AND. B4VK .EQ. 'TEST' .AND. .NOT. BVB)
4 GO TO 37036
IVFAIL=IVFAIL+1
WRITE (NUVI,70180) IVTNUM
70180 FORMAT (1H ,2X,I3,4X,7H FAIL ,32X,
1 28HCOMPLEX IF - SEE SOURCE CODE)
70181 FORMAT (1H ,16X,10HCOMPUTED: ,
1 I5,2X,F4.1,2X,I5,2X,L1,2X,F4.1,2X,A4,2X,
2 A4,2X,L1)
WRITE (NUVI,70181) JVI,BVS,IVI,AVB,AVS,A4VK,B4VK,BVB
70182 FORMAT (1H ,16X,10HCORRECT: ,
1 5H 5,2X,4H-2.5,2X,5H 1,2X,1HT,2X,4H 1.0,2X,4HTRUE,2X,
2 4HTEST,2X,1HF)
WRITE (NUVI,70182)
GO TO 37038
37036 CONTINUE
IVPASS=IVPASS+1
WRITE (NUVI,80002) IVTNUM
37038 CONTINUE
CT019* TEST 19 - CARDS 20-21 TERMINATOR SLASH (/)
IVTNUM = 19
READ(IRVI, *) IVI, JVI, KVI, LVI, MVI
READ(IRVI, *) IVI, JVI, KVI, LVI, MVI
C**** TO DELETE TEST SEE NOTES FOR TEST 1
IF (IVI - 6) 20190,40190,20190
40190 IF (JVI - 7) 20190,40191,20190
40191 IF (KVI - 8) 20190,40192,20190
40192 IF (LVI - 4) 20190,40193,20190
40193 IF (MVI - 5) 20190,10190,20190
10190 IVPASS=IVPASS+1
WRITE (NUVI,80002) IVTNUM
GO TO 0191
20190 IVFAIL=IVFAIL+1
WRITE (NUVI,80008) IVTNUM
70190 FORMAT (1H ,16X,10HCOMPUTED: ,I5,4(2X,I5))
WRITE (NUVI,70190) IVI,JVI,KVI,LVI,MVI
70191 FORMAT (1H ,16X,10HCORRECT: ,
1 5H 6,2X,5H 7,2X,5H 8,2X,5H 4,2X,5H 5)
WRITE (NUVI,70191)
0191 CONTINUE
CT020* TEST 20 - CARD 22 VERIFY THAT BLANKS ARE NOT
C***** INTERPRETED AS ZEROS
IVTNUM = 20
READ(IRVI, *) IVI, JVI, KVI
C**** TO DELETE TEST SEE NOTES FOR TEST 1
IF (IVI - 12045) 20200,40200,20200
40200 IF (JVI - 12) 20200,40201,20200
40201 IF (KVI - 45) 20200,10200,20200
10200 IVPASS=IVPASS+1
WRITE (NUVI,80002) IVTNUM
GO TO 0201
20200 IVFAIL=IVFAIL+1
WRITE (NUVI,80008) IVTNUM
70200 FORMAT (1H ,16X,10HCOMPUTED: ,I5,2X,I5,2X,I5)
WRITE (NUVI,70200) IVI,JVI,KVI
70201 FORMAT (1H ,16X,10HCORRECT: ,
1 5H12045,2X,5H 12,2X,5H 45)
WRITE (NUVI,70201)
0201 CONTINUE
CT021* TEST 21 - CARDS 23-24 VERIFY THAT END-OF-RECORD IS
C***** TREATED AS A BLANK WHEN IT
C***** SEPARATES TWO INTEGERS
IVTNUM = 21
READ(IRVI, *) IVI, JVI, KVI
C**** TO DELETE TEST SEE NOTES FOR TEST 1
IF (IVI - 12045) 20210,40210,20210
40210 IF (JVI - 12) 20210,40211,20210
40211 IF (KVI - 45) 20210,10210,20210
10210 IVPASS=IVPASS+1
WRITE (NUVI,80002) IVTNUM
GO TO 0211
20210 IVFAIL=IVFAIL+1
WRITE (NUVI,80008) IVTNUM
70210 FORMAT (1H ,16X,10HCOMPUTED: ,I5,2X,I5,2X,I5)
WRITE (NUVI,70210) IVI,JVI,KVI
70211 FORMAT (1H ,16X,10HCORRECT: ,
1 5H12045,2X,5H 12,2X,5H 45)
WRITE (NUVI,70211)
0211 CONTINUE
CT022* TEST 22 - CARDS 25-26 VERIFY THAT END-OF-RECORD IS
C***** NOT TREATED AS A BLANK IN A
C***** CHARACTER STRING
IVTNUM = 22
READ(IRVI, *) A6VK, B6VK
CVNX06='ABCDEF'
CVNY06='UVWXYZ'
IF (A6VK .EQ. 'ABCDEF' .AND. B6VK .EQ. 'UVWXYZ') GO TO 37041
IVFAIL=IVFAIL+1
WRITE (NUVI,80008) IVTNUM
WRITE (NUVI,80020) A6VK,B6VK
WRITE (NUVI,80022) CVNX06,CVNY06
GO TO 37043
37041 CONTINUE
IVPASS=IVPASS+1
WRITE (NUVI,80002) IVTNUM
37043 CONTINUE
CT023* TEST 23 - CARD 27 QUOTES, BLANKS, COMMAS AND SLASHES
C***** EMBEDDED IN CHARACTER STRINGS
IVTNUM = 23
READ(IRVI, *) A21VK
C**** TO DELETE TEST SEE NOTES FOR TEST 1
CVNX21='CAN''T, AND/OR WON''T'
IF (A21VK .EQ. 'CAN''T, AND/OR WON''T') GO TO 37044
IVFAIL=IVFAIL+1
WRITE (NUVI,80008) IVTNUM
WRITE (NUVI,80020) A21VK
WRITE (NUVI,80022) CVNX21
GO TO 0231
37044 CONTINUE
IVPASS=IVPASS+1
WRITE (NUVI,80002) IVTNUM
0231 CONTINUE
CT024* TEST 24 - CARD 28 CHARACTER STRINGS THAT ARE READ IN
C***** VARIABLES OF DIFFERENT LENGTHS
IVTNUM = 24
READ(IRVI, *) A15VK, A8VK, A9VK
C**** TO DELETE TEST SEE NOTES FOR TEST 1
IF (A15VK .EQ. '1234567890 ' .AND.
1 A8VK .EQ. '12345678' .AND.
2 A9VK .EQ. '123456789') GO TO 37047
IVFAIL=IVFAIL+1
WRITE (NUVI,80008) IVTNUM
70240 FORMAT (1H ,16X,10HCOMPUTED: ,A15,2X,A8,2X,A9)
WRITE (NUVI,70240) A15VK,A8VK,A9VK
70241 FORMAT (1H ,16X,10HCORRECT: ,
1 15H1234567890 ,2X,8H12345678,2X,9H123456789)
WRITE (NUVI,70241)
GO TO 37049
37047 CONTINUE
IVPASS=IVPASS+1
WRITE (NUVI,80002) IVTNUM
37049 CONTINUE
CT025* TEST 25 - CARD 29 LOGICAL VALUES IN DIFFERENT
C***** REPRESENTATIONS
IVTNUM = 25
READ(IRVI, *) AVB, BVB, CVB, DVB, EVB, FVB, GVB, HVB
C***** TO DELETE CODE SEE NOTES FOR TEST 1
IF (AVB .AND. .NOT. BVB .AND. .NOT. CVB .AND. DVB .AND.
1 .NOT. EVB .AND. .NOT. EVB .AND. GVB .AND. HVB)
2 GO TO 37050
IVFAIL=IVFAIL+1
WRITE (NUVI,70250) IVTNUM
70250 FORMAT (1H ,2X,I3,4X,7H FAIL ,32X,
1 28HCOMPLEX IF - SEE SOURCE CODE)
70251 FORMAT (1H ,16X,10HCOMPUTED: ,L1,7(2X,L1))
WRITE (NUVI,70251) AVB,BVB,CVB,DVB,EVB,FVB,GVB,HVB
70252 FORMAT (1H ,16X,10HCORRECT: ,22HT F F T F F T T)
WRITE (NUVI,70252)
GO TO 37052
37050 CONTINUE
IVPASS=IVPASS+1
WRITE (NUVI,80002) IVTNUM
37052 CONTINUE
CT026* TEST 26 - CARDS 30-31 SLASH TERMINATOR
IVTNUM = 26
READ(IRVI, *) AVB, BVB, CVB, DVB, EVB
READ(IRVI, *) AVB, BVB, CVB, DVB, EVB
C***** TO DELETE CODE SEE NOTES FOR TEST 1
IF (.NOT. AVB .AND. .NOT. BVB .AND. CVB .AND.
1 DVB .AND. EVB) GO TO 37053
IVFAIL=IVFAIL+1
WRITE (NUVI,80008) IVTNUM
70260 FORMAT (1H ,16X,10HCOMPUTED: , L1,4(2X,L1))
WRITE (NUVI,70260) AVB,BVB,CVB,DVB,EVB
70261 FORMAT (1H ,16X,10HCORRECT: ,13HF F T T T)
WRITE (NUVI,70261)
GO TO 37055
37053 CONTINUE
IVPASS=IVPASS+1
WRITE (NUVI,80002) IVTNUM
37055 CONTINUE
CT027* TEST 27 - CARD 32 SLASH TERMINATING IMPLIED-DO LOOP
IVTNUM = 27
J1I(1) = 1
READ(IRVI,*) (J1I(IVI), IVI=1,3)
C**** TO DELETE CODE SEE NOTES FOR TEST 1
IVCORR=1
IF (J1I(1) - 1) 20270,10270,20270
10270 IVPASS=IVPASS+1
WRITE (NUVI,80002) IVTNUM
GO TO 0271
20270 IVFAIL=IVFAIL+1
WRITE (NUVI,80008) IVTNUM
WRITE(NUVI, 80024) J1I(1)
WRITE (NUVI,80026) IVCORR
0271 CONTINUE
CT028* TEST 28 - CARDS 33-34 SECOND READ SHOULD CAUSE VALUES
C***** TO BE READ FROM SECOND CARD
IVTNUM = 28
READ(IRVI,*) IVI, JVI
READ(IRVI,*) IVI, JVI
C**** TO DELETE TEST SEE NOTES FOR TEST 1
IF (IVI - 5) 20280,40280,20280
40280 IF (JVI - 6) 20280,10280,20280
10280 IVPASS=IVPASS+1
WRITE (NUVI,80002) IVTNUM
GO TO 0281
20280 IVFAIL=IVFAIL+1
WRITE (NUVI,80008) IVTNUM
70280 FORMAT (1H ,16X,10HCOMPUTED: ,I5,2X,I5)
WRITE (NUVI,70280) IVI,JVI
70281 FORMAT (1H ,16X,10HCORRECT: ,5H 5,2X,5H 6)
WRITE (NUVI,70281)
0281 CONTINUE
C*****
CBB** ********************** BBCSUM0 **********************************
C**** WRITE OUT TEST SUMMARY
C****
IVTOTN = IVPASS + IVFAIL + IVDELE + IVINSP
WRITE (I02, 90004)
WRITE (I02, 90014)
WRITE (I02, 90004)
WRITE (I02, 90020) IVPASS
WRITE (I02, 90022) IVFAIL
WRITE (I02, 90024) IVDELE
WRITE (I02, 90026) IVINSP
WRITE (I02, 90028) IVTOTN, IVTOTL
CBE** ********************** BBCSUM0 **********************************
CBB** ********************** BBCFOOT0 **********************************
C**** WRITE OUT REPORT FOOTINGS
C****
WRITE (I02,90016) ZPROG, ZPROG
WRITE (I02,90018) ZPROJ, ZNAME, ZTAPE, ZTAPED
WRITE (I02,90019)
CBE** ********************** BBCFOOT0 **********************************
CBB** ********************** BBCFMT0A **********************************
C**** FORMATS FOR TEST DETAIL LINES
C****
80000 FORMAT (1H ,2X,I3,4X,7HDELETED,32X,A31)
80002 FORMAT (1H ,2X,I3,4X,7H PASS ,32X,A31)
80004 FORMAT (1H ,2X,I3,4X,7HINSPECT,32X,A31)
80008 FORMAT (1H ,2X,I3,4X,7H FAIL ,32X,A31)
80010 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,15X,10HCOMPUTED= ,
1I6,/,1H ,15X,10HCORRECT= ,I6)
80012 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
1E12.5,/,1H ,16X,10HCORRECT= ,E12.5)
80018 FORMAT (1H ,2X,I3,4X,7H FAIL ,/,1H ,16X,10HCOMPUTED= ,
1A21,/,1H ,16X,10HCORRECT= ,A21)
80020 FORMAT (1H ,16X,10HCOMPUTED= ,A21,1X,A31)
80022 FORMAT (1H ,16X,10HCORRECT= ,A21,1X,A31)
80024 FORMAT (1H ,16X,10HCOMPUTED= ,I6,16X,A31)
80026 FORMAT (1H ,16X,10HCORRECT= ,I6,16X,A31)
80028 FORMAT (1H ,16X,10HCOMPUTED= ,E12.5,10X,A31)
80030 FORMAT (1H ,16X,10HCORRECT= ,E12.5,10X,A31)
80050 FORMAT (1H ,48X,A31)
CBE** ********************** BBCFMT0A **********************************
CBB** ********************** BBCFMT0B **********************************
C**** FORMAT STATEMENTS FOR PAGE HEADERS
C****
90002 FORMAT (1H1)
90004 FORMAT (1H )
90006 FORMAT (1H ,20X,31HFEDERAL SOFTWARE TESTING CENTER)
90007 FORMAT (1H ,19X,34HFORTRAN COMPILER VALIDATION SYSTEM)
90008 FORMAT (1H ,21X,A13,A17)
90009 FORMAT (1H ,/,2H *,A5,6HBEGIN*,12X,15HTEST RESULTS - ,A5,/)
90010 FORMAT (1H ,8X,16HTEST DATE*TIME= ,A17,15H - COMPILER= ,A20)
90013 FORMAT (1H ,8H TEST ,10HPASS/FAIL ,6X,17HDISPLAYED RESULTS,
1 7X,7HREMARKS,24X)
90014 FORMAT (1H ,46H----------------------------------------------,
1 33H---------------------------------)
90015 FORMAT (1H ,48X,17HTHIS PROGRAM HAS ,I3,6H TESTS,/)
C****
C**** FORMAT STATEMENTS FOR REPORT FOOTINGS
C****
90016 FORMAT (1H ,/,2H *,A5,4HEND*,14X,14HEND OF TEST - ,A5,/)
90018 FORMAT (1H ,A13,13X,A20,7H * ,A10,1H/,
1 A13)
90019 FORMAT (1H ,26HFOR OFFICIAL USE ONLY ,35X,15HCOPYRIGHT 1982)
C****
C**** FORMAT STATEMENTS FOR RUN SUMMARY
C****
90020 FORMAT (1H ,21X,I5,13H TESTS PASSED)
90022 FORMAT (1H ,21X,I5,13H TESTS FAILED)
90024 FORMAT (1H ,21X,I5,14H TESTS DELETED)
90026 FORMAT (1H ,21X,I5,25H TESTS REQUIRE INSPECTION)
90028 FORMAT (1H ,21X,I5,4H OF ,I3,15H TESTS EXECUTED)
CBE** ********************** BBCFMT0B **********************************
C***** END OF TEST SEGMENT 370
STOP
END
*END-OF,FM923