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