PROGRAM FM301 00010301 C 00020301 C 00030301 C FM301 TESTS THE USE OF THE TYPE-STATEMENT TO EXPLICITLY 00040301 C DEFINE THE DATA TYPE FOR VARIABLES, ARRAYS, AND STATEMENT 00050301 C FUNCTIONS. ONLY INTEGER, REAL, LOGICAL AND CHARACTER DATA 00060301 C TYPES ARE TESTED IN THIS ROUTINE. INTEGER AND REAL VARIABLES 00070301 C AND ARRAYS ARE TESTED IN A MANNER WHICH BOTH CONFIRMS AND 00080301 C OVERRIDES THE IMPLICIT TYPING OF THE DATA ENTITIES. 00090301 C 00100301 C FM301 DOES NOT ATTEMPT TO TEST ALL OF THE ELEMENTARY SYNTAX 00110301 C FORMS OF THE TYPE-STATEMENT. THESE FORMS ARE TESTED ADEQUATELY 00120301 C WITHIN THE BOILER PLATE AND OTHER AUDIT PROGRAMS. 00130301 C 00140301 C REFERENCES. 00150301 C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN, 00160301 C X3.9-1978 00170301 C 00180301 C SECTION 4.1, DATA TYPES 00190301 C SECTION 8.4, TYPE-STATEMENT 00200301 C SECTION 8.5, IMPLICIT STATEMENT 00210301 C SECTION 15.4, STATEMENT FUNCTION 00220301 C 00230301 C 00240301 C ******************************************************************00250301 C A COMPILER VALIDATION SYSTEM FOR THE FORTRAN LANGUAGE 00260301 C BASED ON SPECIFICATIONS AS DEFINED IN AMERICAN STANDARD FORTRAN 00270301 C X3.9-1978, HAS BEEN DEVELOPED BY THE DEPARTMENT OF THE NAVY. THE 00280301 C FORTRAN COMPILER VALIDATION SYSTEM (FCVS) CONSISTS OF AUDIT 00290301 C ROUTINES, THEIR RELATED DATA, AND AN EXECUTIVE SYSTEM. EACH AUDIT00300301 C ROUTINE IS A FORTRAN PROGRAM OR SUBPROGRAM WHICH INCLUDES TESTS 00310301 C OF SPECIFIC LANGUAGE ELEMENTS AND SUPPORTING PROCEDURES INDICATING00320301 C THE RESULT OF EXECUTING THESE TESTS. 00330301 C 00340301 C THIS PARTICULAR PROGRAM OR SUBPROGRAM CONTAINS ONLY FEATURES 00350301 C FOUND IN THE SUBSET LEVEL OF THE STANDARD. 00360301 C 00370301 C SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO 00380301 C NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY 00390301 C SOFTWARE STANDARDS VALIDATION GROUP 00400301 C BUILDING 225 RM A266 00410301 C GAITHERSBURG, MD 20899 00420301 C ******************************************************************00430301 C 00440301 C 00450301 IMPLICIT LOGICAL (L) 00460301 IMPLICIT CHARACTER*14 (C) 00470301 C 00480301 00490301 C 00500301 C *** IMPLICIT STATEMENT FOR TEST 006 *** 00510301 C 00520301 IMPLICIT LOGICAL (M) 00530301 C 00540301 C *** IMPLICIT STATEMENT FOR TEST 017 *** 00550301 C 00560301 IMPLICIT INTEGER (G) 00570301 C 00580301 C *** IMPLICIT STATEMENT FOR TEST 018 *** 00590301 C 00600301 IMPLICIT CHARACTER*2 (F) 00610301 C 00620301 C *** SPECIFICATION STATEMENTS FOR TEST 001 *** 00630301 C 00640301 INTEGER AVTN01 00650301 C 00660301 C *** SPECIFICATION STATEMENTS FOR TEST 002 *** 00670301 C 00680301 REAL KVTN01 00690301 C 00700301 C *** SPECIFICATION STATEMENTS FOR TEST 003 *** 00710301 C 00720301 INTEGER KVTN02, AVTN02, KVTN03 00730301 C 00740301 C *** SPECIFICATION STATEMENTS FOR TEST 004 *** 00750301 C 00760301 REAL AVTN03, AVTN04, KVTN04 00770301 C 00780301 C *** SPECIFICATION STATEMENTS FOR TEST 005 *** 00790301 C 00800301 LOGICAL HVTN01 00810301 C 00820301 C *** SPECIFICATION STATEMENTS FOR TEST 006 *** 00830301 C (ALSO SEE THE IMPLICIT STATEMENTS FOR TEST 006) 00840301 C 00850301 REAL MVTN01 00860301 C 00870301 C *** SPECIFICATION STATEMENTS FOR TEST 007 *** 00880301 C 00890301 INTEGER NVTN11(4) 00900301 C 00910301 C *** SPECIFICATION STATEMENTS FOR TEST 008 *** 00920301 C 00930301 REAL NVTN22(2,2) 00940301 C 00950301 C *** SPECIFICATION STATEMENTS FOR TESTS 009 AND 010 *** 00960301 C 00970301 INTEGER NVTN33(3,3,3), AVTN15(5) 00980301 C 00990301 C *** SPECIFICATION STATEMENTS FOR TEST 011 *** 01000301 C 01010301 DIMENSION NVTN14(5) 01020301 INTEGER NVTN14 01030301 C 01040301 C *** SPECIFICATION STATEMENTS FOR TEST 012 *** 01050301 C 01060301 DIMENSION AVTN16(4) 01070301 INTEGER AVTN16 01080301 C 01090301 C *** SPECIFICATION STATEMENTS FOR TESTS 013 AND 014 *** 01100301 C 01110301 CHARACTER CVTN01*14, CATN12(4)*14 01120301 C 01130301 C *** SPECIFICATION STATEMENTS FOR TEST 015 *** 01140301 C 01150301 DIMENSION CADN13(6) 01160301 CHARACTER CADN13*14 01170301 C 01180301 C *** SPECIFICATION STATEMENTS FOR TEST 016 *** 01190301 C 01200301 CHARACTER KVTN05 01210301 C 01220301 C *** SPECIFICATION STATEMENTS FOR TEST 017 *** 01230301 C (ALSO SEE THE IMPLICIT STATEMENT FOR TEST 017) 01240301 C 01250301 CHARACTER GVTN01*3 01260301 C 01270301 C *** SPECIFICATION STATEMENTS FOR TEST 018 *** 01280301 C (ALSO SEE THE IMPLICIT STATEMENT FOR TEST 018) 01290301 C 01300301 CHARACTER FVTN01*3 01310301 C 01320301 C *** SPECIFICATION STATEMENTS FOR TEST 019 *** 01330301 C 01340301 INTEGER IFTN01 01350301 IFTN01(IDON01) = IDON01 + 1 01360301 C 01370301 C 01380301 C 01390301 C INITIALIZATION SECTION. 01400301 C 01410301 C INITIALIZE CONSTANTS 01420301 C ******************** 01430301 C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER 01440301 I01 = 5 01450301 C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER 01460301 I02 = 6 01470301 C SYSTEM ENVIRONMENT SECTION 01480301 C 01490301 CX010 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-010 CONTROL CARD.01500301 C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 01510301 C (UNIT NUMBER FOR CARD READER). 01520301 CX011 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-011 CONTROL CARD01530301 C THE CX011 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 01540301 C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX010 ABOVE. 01550301 C 01560301 CX020 THIS CARD IS PEPLACED BY CONTENTS OF FEXEC X-020 CONTROL CARD.01570301 C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02 = 6 01580301 C (UNIT NUMBER FOR PRINTER). 01590301 CX021 THIS CARD IS PEPLACED BY CONTENTS OF FEXEC X-021 CONTROL CARD.01600301 C THE CX021 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 01610301 C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX020 ABOVE. 01620301 C 01630301 IVPASS = 0 01640301 IVFAIL = 0 01650301 IVDELE = 0 01660301 ICZERO = 0 01670301 C 01680301 C WRITE OUT PAGE HEADERS 01690301 C 01700301 WRITE (I02,90002) 01710301 WRITE (I02,90006) 01720301 WRITE (I02,90008) 01730301 WRITE (I02,90004) 01740301 WRITE (I02,90010) 01750301 WRITE (I02,90004) 01760301 WRITE (I02,90016) 01770301 WRITE (I02,90001) 01780301 WRITE (I02,90004) 01790301 WRITE (I02,90012) 01800301 WRITE (I02,90014) 01810301 WRITE (I02,90004) 01820301 C 01830301 C 01840301 C **** FCVS PROGRAM 301 - TEST 001 **** 01850301 C 01860301 C TEST 001 DEFINES AN INTEGER VARIABLE OVERRIDING THE IMPLICIT 01870301 C COMPILER DEFAULT TYPE SPECIFYING REAL. 01880301 C 01890301 C 01900301 IVTNUM = 1 01910301 IF (ICZERO) 30010, 0010, 30010 01920301 0010 CONTINUE 01930301 IVCOMP = 0 01940301 AVTN01 = 100 01950301 IVCORR = 100 01960301 IVCOMP = AVTN01 01970301 40010 IF (IVCOMP - 100) 20010, 10010, 20010 01980301 30010 IVDELE = IVDELE + 1 01990301 WRITE (I02,80000) IVTNUM 02000301 IF (ICZERO) 10010, 0021, 20010 02010301 10010 IVPASS = IVPASS + 1 02020301 WRITE (I02,80002) IVTNUM 02030301 GO TO 0021 02040301 20010 IVFAIL = IVFAIL + 1 02050301 WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 02060301 0021 CONTINUE 02070301 C 02080301 C **** FCVS PROGRAM 301 - TEST 002 **** 02090301 C 02100301 C TEST 002 DEFINES A REAL VARIABLE OVERRIDING THE IMPLICIT 02110301 C COMPILER DEFAULT TYPE SPECIFYING INTEGER. 02120301 C 02130301 C 02140301 IVTNUM = 2 02150301 IF (ICZERO) 30020, 0020, 30020 02160301 0020 CONTINUE 02170301 RVCOMP = 0.0 02180301 KVTN01 = 1.004 02190301 RVCORR = 1.004 02200301 RVCOMP = KVTN01 02210301 40020 IF (RVCOMP - 1.0035) 20020, 10020, 40021 02220301 40021 IF (RVCOMP - 1.0045) 10020, 10020, 20020 02230301 30020 IVDELE = IVDELE + 1 02240301 WRITE (I02,80000) IVTNUM 02250301 IF (ICZERO) 10020, 0031, 20020 02260301 10020 IVPASS = IVPASS + 1 02270301 WRITE (I02,80002) IVTNUM 02280301 GO TO 0031 02290301 20020 IVFAIL = IVFAIL + 1 02300301 WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 02310301 0031 CONTINUE 02320301 C 02330301 C **** FCVS PROGRAM 301 - TEST 003 **** 02340301 C 02350301 C TEST 003 DEFINES A SERIES OF INTEGER VARIABLES IN ONE TYPE- 02360301 C STATEMENT. TWO VARIABLES CONFIRM THE IMPLICIT INTEGER TYPING. 02370301 C THE OTHER VARIABLE OVERRIDES THE IMPLICIT TYPING. 02380301 C 02390301 C 02400301 IVTNUM = 3 02410301 IF (ICZERO) 30030, 0030, 30030 02420301 0030 CONTINUE 02430301 IVCOMP = 0 02440301 KVTN02 = 20 02450301 KVTN03 = 30 02460301 AVTN02 = 200 02470301 IVCORR = 20 02480301 IVCOMP = KVTN02 02490301 40030 IF (IVCOMP - 20) 20030, 40031, 20030 02500301 40031 IVCORR = 30 02510301 IVCOMP = KVTN03 02520301 40033 IF (IVCOMP - 30) 20030, 40034, 20030 02530301 40034 IVCORR = 200 02540301 IVCOMP = AVTN02 02550301 40035 IF (IVCOMP - 200) 20030, 10030, 20030 02560301 30030 IVDELE = IVDELE + 1 02570301 WRITE (I02,80000) IVTNUM 02580301 IF (ICZERO) 10030, 0041, 20030 02590301 10030 IVPASS = IVPASS + 1 02600301 WRITE (I02,80002) IVTNUM 02610301 GO TO 0041 02620301 20030 IVFAIL = IVFAIL + 1 02630301 WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 02640301 0041 CONTINUE 02650301 C 02660301 C **** FCVS PROGRAM 301 - TEST 004 **** 02670301 C 02680301 C TEST 004 DEFINES A SERIES OF REAL VARIABLES IN ONE TYPE- 02690301 C STATEMENT. TWO VARIABLES CONFIRM THE IMPLICIT REAL TYPING. THE 02700301 C THIRD VARIABLE OVERRIDES THE IMPLICIT TYPING. 02710301 C 02720301 C 02730301 IVTNUM = 4 02740301 IF (ICZERO) 30040, 0040, 30040 02750301 0040 CONTINUE 02760301 RVCOMP = 0.0 02770301 AVTN03 = 3.0 02780301 AVTN04 = 4. 02790301 KVTN04 = .4 02800301 RVCORR = 3.0 02810301 RVCOMP = AVTN03 02820301 40040 IF (RVCOMP - 2.9995) 20040, 40042, 40041 02830301 40041 IF (RVCOMP - 3.0005) 40042, 40042, 20040 02840301 40042 RVCORR = 4. 02850301 RVCOMP = AVTN04 02860301 40043 IF (RVCOMP - 3.9995) 20040, 40045, 40044 02870301 40044 IF (RVCOMP - 4.0005) 40045, 40045, 20040 02880301 40045 RVCORR = .4 02890301 RVCOMP = KVTN04 02900301 40046 IF (RVCOMP - .39995) 20040, 10040, 40047 02910301 40047 IF (RVCOMP - .40005) 10040, 10040, 20040 02920301 30040 IVDELE = IVDELE + 1 02930301 WRITE (I02,80000) IVTNUM 02940301 IF (ICZERO) 10040, 0051, 20040 02950301 10040 IVPASS = IVPASS + 1 02960301 WRITE (I02,80002) IVTNUM 02970301 GO TO 0051 02980301 20040 IVFAIL = IVFAIL + 1 02990301 WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 03000301 0051 CONTINUE 03010301 C 03020301 C **** FCVS PROGRAM 301 - TEST 005 **** 03030301 C 03040301 C TEST 005 DEFINES A LOGICAL VARIABLE. 03050301 C 03060301 C 03070301 IVTNUM = 5 03080301 IF (ICZERO) 30050, 0050, 30050 03090301 0050 CONTINUE 03100301 HVTN01 = .TRUE. 03110301 IVCORR = 1 03120301 IVCOMP = 0 03130301 IF (HVTN01) IVCOMP = 1 03140301 40050 IF (IVCOMP - 1) 20050, 10050, 20050 03150301 30050 IVDELE = IVDELE + 1 03160301 WRITE (I02,80000) IVTNUM 03170301 IF (ICZERO) 10050, 0061, 20050 03180301 10050 IVPASS = IVPASS + 1 03190301 WRITE (I02,80002) IVTNUM 03200301 GO TO 0061 03210301 20050 IVFAIL = IVFAIL + 1 03220301 WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 03230301 0061 CONTINUE 03240301 C 03250301 C **** FCVS PROGRAM 301 - TEST 006 **** 03260301 C 03270301 C TEST 006 DEFINES A REAL VARIABLE WITH A TYPE-STATEMENT THAT 03280301 C OVERRIDES THE IMPLICIT STATEMENT TYPING OF THE INTEGER LETTER 'M' 03290301 C AS LOGICAL. 03300301 C 03310301 C 03320301 IVTNUM = 6 03330301 IF (ICZERO) 30060, 0060, 30060 03340301 0060 CONTINUE 03350301 RVCOMP = 0.0 03360301 MVTN01 = 12.345 03370301 RVCORR = 12.345 03380301 RVCOMP = MVTN01 03390301 40060 IF (RVCOMP - 12.340) 20060, 10060, 40061 03400301 40061 IF (RVCOMP - 12.350) 10060, 10060, 20060 03410301 30060 IVDELE = IVDELE + 1 03420301 WRITE (I02,80000) IVTNUM 03430301 IF (ICZERO) 10060, 0071, 20060 03440301 10060 IVPASS = IVPASS + 1 03450301 WRITE (I02,80002) IVTNUM 03460301 GO TO 0071 03470301 20060 IVFAIL = IVFAIL + 1 03480301 WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 03490301 0071 CONTINUE 03500301 C 03510301 C **** FCVS PROGRAM 301 - TEST 007 **** 03520301 C 03530301 C TEST 007 DEFINES A ONE DIMENSIONAL INTEGER ARRAY. 03540301 C 03550301 C 03560301 IVTNUM = 7 03570301 IF (ICZERO) 30070, 0070, 30070 03580301 0070 CONTINUE 03590301 IVCOMP = 0 03600301 NVTN11(3) = 3 03610301 IVCORR = 3 03620301 IVCOMP = NVTN11(3) 03630301 40070 IF (IVCOMP - 3) 20070, 10070, 20070 03640301 30070 IVDELE = IVDELE + 1 03650301 WRITE (I02,80000) IVTNUM 03660301 IF (ICZERO) 10070, 0081, 20070 03670301 10070 IVPASS = IVPASS + 1 03680301 WRITE (I02,80002) IVTNUM 03690301 GO TO 0081 03700301 20070 IVFAIL = IVFAIL + 1 03710301 WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 03720301 0081 CONTINUE 03730301 C 03740301 C **** FCVS PROGRAM 301 - TEST 008 **** 03750301 C 03760301 C TEST 008 DEFINES A TWO DIMENSIONAL REAL ARRAY THAT OVERRIDES 03770301 C THE IMPLICIT TYPING OF INTEGER. 03780301 C 03790301 C 03800301 IVTNUM = 8 03810301 IF (ICZERO) 30080, 0080, 30080 03820301 0080 CONTINUE 03830301 RVCOMP = 0.0 03840301 NVTN22(1,2) = 2.12 03850301 RVCORR = 2.12 03860301 RVCOMP = NVTN22(1,2) 03870301 40080 IF (RVCOMP - 2.1195) 20080, 10080, 40081 03880301 40081 IF (RVCOMP - 2.1205) 10080, 10080, 20080 03890301 30080 IVDELE = IVDELE + 1 03900301 WRITE (I02,80000) IVTNUM 03910301 IF (ICZERO) 10080, 0091, 20080 03920301 10080 IVPASS = IVPASS + 1 03930301 WRITE (I02,80002) IVTNUM 03940301 GO TO 0091 03950301 20080 IVFAIL = IVFAIL + 1 03960301 WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 03970301 0091 CONTINUE 03980301 C 03990301 C **** FCVS PROGRAM 301 - TEST 009 **** 04000301 C 04010301 C TEST 009 DEFINES TWO INTEGER ARRAYS WITH ONE TYPE-STATEMENT. 04020301 C ONE ARRAY IS THREE DIMENSIONAL WHILE THE OTHER ARRAY OVERRIDES 04030301 C THE IMPLICIT TYPING OF REAL. ONLY THE THREE DIMENSIONAL ARRAY 04040301 C IS CHECKED IN THIS TEST. 04050301 C 04060301 C 04070301 IVTNUM = 9 04080301 IF (ICZERO) 30090, 0090, 30090 04090301 0090 CONTINUE 04100301 IVCOMP = 0 04110301 NVTN33(1,2,3) = 123 04120301 IVCORR = 123 04130301 IVCOMP = NVTN33(1,2,3) 04140301 40090 IF (IVCOMP - 123) 20090, 10090, 20090 04150301 30090 IVDELE = IVDELE + 1 04160301 WRITE (I02,80000) IVTNUM 04170301 IF (ICZERO) 10090, 0101, 20090 04180301 10090 IVPASS = IVPASS + 1 04190301 WRITE (I02,80002) IVTNUM 04200301 GO TO 0101 04210301 20090 IVFAIL = IVFAIL + 1 04220301 WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 04230301 0101 CONTINUE 04240301 C 04250301 C **** FCVS PROGRAM 301 - TEST 010 **** 04260301 C 04270301 C TEST 010 CHECKS THE SECOND ARRAY DESCRIBED IN THE PREVIOUS 04280301 C TEST. 04290301 C 04300301 C 04310301 IVTNUM = 10 04320301 IF (ICZERO) 30100, 0100, 30100 04330301 0100 CONTINUE 04340301 IVCOMP = 0 04350301 AVTN15(2) = 5 04360301 IVCORR = 5 04370301 IVCOMP = AVTN15(2) 04380301 40100 IF (IVCOMP - 5) 20100, 10100, 20100 04390301 30100 IVDELE = IVDELE + 1 04400301 WRITE (I02,80000) IVTNUM 04410301 IF (ICZERO) 10100, 0111, 20100 04420301 10100 IVPASS = IVPASS + 1 04430301 WRITE (I02,80002) IVTNUM 04440301 GO TO 0111 04450301 20100 IVFAIL = IVFAIL + 1 04460301 WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 04470301 0111 CONTINUE 04480301 C 04490301 C **** FCVS PROGRAM 301 - TEST 011 **** 04500301 C 04510301 C TEST 011 USES THE TYPE-STATEMENT TO EXPLICITLY TYPE AN ARRAY 04520301 C THAT WAS DEFINED WITH A DIMENSION STATEMENT. 04530301 C 04540301 C 04550301 IVTNUM = 11 04560301 IF (ICZERO) 30110, 0110, 30110 04570301 0110 CONTINUE 04580301 IVCOMP = 0 04590301 NVTN14(5) = 5 04600301 IVCORR = 5 04610301 IVCOMP = NVTN14(5) 04620301 40110 IF (IVCOMP - 5) 20110, 10110, 20110 04630301 30110 IVDELE = IVDELE + 1 04640301 WRITE (I02,80000) IVTNUM 04650301 IF (ICZERO) 10110, 0121, 20110 04660301 10110 IVPASS = IVPASS + 1 04670301 WRITE (I02,80002) IVTNUM 04680301 GO TO 0121 04690301 20110 IVFAIL = IVFAIL + 1 04700301 WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 04710301 0121 CONTINUE 04720301 C 04730301 C **** FCVS PROGRAM 301 - TEST 012 **** 04740301 C 04750301 C TEST 012 USES THE TYPE-STATEMENT TO OVERRIDE THE TYPING OF 04760301 C AN ARRAY THAT WAS DEFINED WITH A DIMENSION STATEMENT. 04770301 C 04780301 IVTNUM = 12 04790301 IF (ICZERO) 30120, 0120, 30120 04800301 0120 CONTINUE 04810301 IVCOMP = 0 04820301 AVTN16(3) = 163 04830301 IVCORR = 163 04840301 IVCOMP = AVTN16(3) 04850301 40120 IF (IVCOMP - 163) 20120, 10120, 20120 04860301 30120 IVDELE = IVDELE + 1 04870301 WRITE (I02,80000) IVTNUM 04880301 IF (ICZERO) 10120, 0131, 20120 04890301 10120 IVPASS = IVPASS + 1 04900301 WRITE (I02,80002) IVTNUM 04910301 GO TO 0131 04920301 20120 IVFAIL = IVFAIL + 1 04930301 WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 04940301 0131 CONTINUE 04950301 C 04960301 C **** FCVS PROGRAM 301 - TEST 013 **** 04970301 C 04980301 C TEST 013 USES ONE CHARACTER TYPE-STATEMENT TO SPECIFY BOTH A 04990301 C VARIABLE AND AN ARRAY DECLARATOR. ONLY THE VARIABLE IS CHECKED 05000301 C IN THIS TEST. 05010301 C 05020301 IVTNUM = 13 05030301 IF (ICZERO) 30130, 0130, 30130 05040301 0130 CONTINUE 05050301 CVTN01 = '12345678901234' 05060301 CVCOMP = ' ' 05070301 CVCORR = '12345678901234' 05080301 CVCOMP = CVTN01 05090301 40130 IF (CVCOMP .EQ. '12345678901234') GO TO 10130 05100301 40131 GO TO 20130 05110301 30130 IVDELE = IVDELE + 1 05120301 WRITE (I02,80000) IVTNUM 05130301 IF (ICZERO) 10130, 0141, 20130 05140301 10130 IVPASS = IVPASS + 1 05150301 WRITE (I02,80002) IVTNUM 05160301 GO TO 0141 05170301 20130 IVFAIL = IVFAIL + 1 05180301 WRITE (I02,80018) IVTNUM, CVCOMP, CVCORR 05190301 0141 CONTINUE 05200301 C 05210301 C **** FCVS PROGRAM 301 - TEST 014 **** 05220301 C 05230301 C TEST 014 CHECKS THE ARRAY DECLARATOR FROM THE PREVIOUS TEST. 05240301 C 05250301 IVTNUM = 14 05260301 IF (ICZERO) 30140, 0140, 30140 05270301 0140 CONTINUE 05280301 CVCOMP = ' ' 05290301 CATN12(2) = 'ABCDEFGHIJKLMN' 05300301 CVCORR = 'ABCDEFGHIJKLMN' 05310301 CVCOMP = CATN12(2) 05320301 40140 IF (CVCOMP .EQ. 'ABCDEFGHIJKLMN') GO TO 10140 05330301 40141 GO TO 20140 05340301 30140 IVDELE = IVDELE + 1 05350301 WRITE (I02,80000) IVTNUM 05360301 IF (ICZERO) 10140, 0151, 20140 05370301 10140 IVPASS = IVPASS + 1 05380301 WRITE (I02,80002) IVTNUM 05390301 GO TO 0151 05400301 20140 IVFAIL = IVFAIL + 1 05410301 WRITE (I02,80018) IVTNUM, CVCOMP, CVCORR 05420301 0151 CONTINUE 05430301 C 05440301 C **** FCVS PROGRAM 301 - TEST 015 **** 05450301 C 05460301 C TEST 015 USES THE CHARACTER TYPE-STATEMENT TO SPECIFY AN 05470301 C ARRAY-NAME. THE ARRAY IS DECLARED IN A DIMENSION STATEMENT. 05480301 C 05490301 IVTNUM = 15 05500301 IF (ICZERO) 30150, 0150, 30150 05510301 0150 CONTINUE 05520301 CVCOMP = ' ' 05530301 CADN13(3) = '12345678901234' 05540301 CVCORR = '12345678901234' 05550301 CVCOMP = CADN13(3) 05560301 40150 IF (CVCOMP .EQ. '12345678901234') GO TO 10150 05570301 40151 GO TO 20150 05580301 30150 IVDELE = IVDELE + 1 05590301 WRITE (I02,80000) IVTNUM 05600301 IF (ICZERO) 10150, 0161, 20150 05610301 10150 IVPASS = IVPASS + 1 05620301 WRITE (I02,80002) IVTNUM 05630301 GO TO 0161 05640301 20150 IVFAIL = IVFAIL + 1 05650301 WRITE (I02,80018) IVTNUM, CVCOMP, CVCORR 05660301 0161 CONTINUE 05670301 C 05680301 C **** FCVS PROGRAM 301 - TEST 016 **** 05690301 C 05700301 C TEST 016 USES THE CHARACTER TYPE-STATEMENT TO OVERRIDE THE 05710301 C IMPLICIT (DEFAULT) TYPING OF INTEGER. 05720301 C 05730301 IVTNUM = 16 05740301 IF (ICZERO) 30160, 0160, 30160 05750301 0160 CONTINUE 05760301 CVCOMP = ' ' 05770301 KVTN05 = 'A' 05780301 CVCORR = 'A' 05790301 CVCOMP = KVTN05 05800301 40160 IF (CVCOMP .EQ. 'A') GO TO 10160 05810301 40161 GO TO 20160 05820301 30160 IVDELE = IVDELE + 1 05830301 WRITE (I02,80000) IVTNUM 05840301 IF (ICZERO) 10160, 0171, 20160 05850301 10160 IVPASS = IVPASS + 1 05860301 WRITE (I02,80002) IVTNUM 05870301 GO TO 0171 05880301 20160 IVFAIL = IVFAIL + 1 05890301 WRITE (I02,80018) IVTNUM, CVCOMP, CVCORR 05900301 0171 CONTINUE 05910301 C 05920301 C **** FCVS PROGRAM 301 - TEST 017 **** 05930301 C 05940301 C TEST 017 USES THE CHARACTER TYPE-STATEMENT TO OVERRIDE THE 05950301 C IMPLICIT TYPING OF THE LETTER 'G' AS INTEGER. 05960301 C 05970301 IVTNUM = 17 05980301 IF (ICZERO) 30170, 0170, 30170 05990301 0170 CONTINUE 06000301 CVCOMP = ' ' 06010301 GVTN01 = 'ABC' 06020301 CVCORR = 'ABC' 06030301 CVCOMP = GVTN01 06040301 40170 IF (CVCOMP .EQ. 'ABC') GO TO 10170 06050301 40171 GO TO 20170 06060301 30170 IVDELE = IVDELE + 1 06070301 WRITE (I02,80000) IVTNUM 06080301 IF (ICZERO) 10170, 0181, 20170 06090301 10170 IVPASS = IVPASS + 1 06100301 WRITE (I02,80002) IVTNUM 06110301 GO TO 0181 06120301 20170 IVFAIL = IVFAIL + 1 06130301 WRITE (I02,80018) IVTNUM, CVCOMP, CVCORR 06140301 0181 CONTINUE 06150301 C 06160301 C **** FCVS PROGRAM 301 - TEST 018 **** 06170301 C 06180301 C TEST 018 USES THE CHARAACTER TYPE-STATEMENT TO OVERRIDE THE 06190301 C LENGTH OF A CHARACTER FIELD DEFINED BY AN IMPLICIT STATEMENT. 06200301 C 06210301 IVTNUM = 18 06220301 IF (ICZERO) 30180, 0180, 30180 06230301 0180 CONTINUE 06240301 CVCOMP = ' ' 06250301 FVTN01 = 'ABC' 06260301 CVCORR = 'ABC' 06270301 CVCOMP = FVTN01 06280301 40180 IF (CVCOMP .EQ. 'ABC') GO TO 10180 06290301 40181 GO TO 20180 06300301 30180 IVDELE = IVDELE + 1 06310301 WRITE (I02,80000) IVTNUM 06320301 IF (ICZERO) 10180, 0191, 20180 06330301 10180 IVPASS = IVPASS + 1 06340301 WRITE (I02,80002) IVTNUM 06350301 GO TO 0191 06360301 20180 IVFAIL = IVFAIL + 1 06370301 WRITE (I02,80018) IVTNUM, CVCOMP, CVCORR 06380301 0191 CONTINUE 06390301 C 06400301 C **** FCVS PROGRAM 301 - TEST 019 **** 06410301 C 06420301 C TEST 019 USES THE TYPE-STATEMENT TO SPECIFY AN INTEGER 06430301 C STATEMENT FUNCTION. 06440301 C 06450301 IVTNUM = 19 06460301 IF (ICZERO) 30190, 0190, 30190 06470301 0190 CONTINUE 06480301 IVCOMP = 0 06490301 IVON01 = 5 06500301 IVON02 = IFTN01(IVON01) 06510301 IVCORR = 6 06520301 IVCOMP = IVON02 06530301 40190 IF (IVCOMP - 6) 20190, 10190, 20190 06540301 30190 IVDELE = IVDELE + 1 06550301 WRITE (I02,80000) IVTNUM 06560301 IF (ICZERO) 10190, 0201, 20190 06570301 10190 IVPASS = IVPASS + 1 06580301 WRITE (I02,80002) IVTNUM 06590301 GO TO 0201 06600301 20190 IVFAIL = IVFAIL + 1 06610301 WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 06620301 0201 CONTINUE 06630301 C 06640301 C 06650301 C WRITE OUT TEST SUMMARY 06660301 C 06670301 WRITE (I02,90004) 06680301 WRITE (I02,90014) 06690301 WRITE (I02,90004) 06700301 WRITE (I02,90000) 06710301 WRITE (I02,90004) 06720301 WRITE (I02,90020) IVFAIL 06730301 WRITE (I02,90022) IVPASS 06740301 WRITE (I02,90024) IVDELE 06750301 STOP 06760301 90001 FORMAT (" ",24X,"FM301") 06770301 90000 FORMAT (" ",20X,"END OF PROGRAM FM301" ) 06780301 C 06790301 C FORMATS FOR TEST DETAIL LINES 06800301 C 06810301 80000 FORMAT (" ",4X,I5,6X,"DELETED") 06820301 80002 FORMAT (" ",4X,I5,7X,"PASS") 06830301 80010 FORMAT (" ",4X,I5,7X,"FAIL",10X,I6,9X,I6) 06840301 80012 FORMAT (" ",4X,I5,7X,"FAIL",4X,E12.5,3X,E12.5) 06850301 80018 FORMAT (" ",4X,I5,7X,"FAIL",2X,A14,1X,A14) 06860301 C 06870301 C FORMAT STATEMENTS FOR PAGE HEADERS 06880301 C 06890301 90002 FORMAT ("1") 06900301 90004 FORMAT (" ") 06910301 90006 FORMAT (" ",10X,"FORTRAN COMPILER VALIDATION SYSTEM" ) 06920301 90008 FORMAT (" ",21X,"VERSION 2.1" ) 06930301 90010 FORMAT (" ",8X,"FOR OFFICIAL USE ONLY - COPYRIGHT 1978" ) 06940301 90012 FORMAT (" ",5X,"TEST",5X,"PASS/FAIL",5X,"COMPUTED",8X,"CORRECT") 06950301 90014 FORMAT (" ",5X,"----------------------------------------------" ) 06960301 90016 FORMAT (" ",18X,"SUBSET LEVEL TEST" ) 06970301 C 06980301 C FORMAT STATEMENTS FOR RUN SUMMARY 06990301 C 07000301 90020 FORMAT (" ",19X,I5," TESTS FAILED" ) 07010301 90022 FORMAT (" ",19X,I5," TESTS PASSED" ) 07020301 90024 FORMAT (" ",19X,I5," TESTS DELETED" ) 07030301 END 07040301