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