PROGRAM FM024 C COMMENT SECTION. 00010024 C 00020024 C FM024 00030024 C 00040024 C THREE DIMENSIONED ARRAYS ARE USED IN THIS ROUTINE. 00050024 C THIS ROUTINE TESTS ARRAYS WITH FIXED DIMENSION AND SIZE LIMITS00060024 C SET EITHER IN A BLANK COMMON OR DIMENSION STATEMENT. THE VALUES 00070024 C OF THE ARRAY ELEMENTS ARE SET IN VARIOUS WAYS SUCH AS SIMPLE 00080024 C ASSIGNMENT STATEMENTS, SET TO THE VALUES OF OTHER ARRAY ELEMENTS 00090024 C (EITHER POSITIVE OR NEGATIVE), SET BY INTEGER TO REAL OR REAL TO 00100024 C INTEGER CONVERSION, SET BY ARITHMETIC EXPRESSIONS, OR SET BY 00110024 C USE OF THE EQUIVALENCE STATEMENT. 00120024 C 00130024 C 00140024 C REFERENCES 00150024 C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN, 00160024 C X3.9-1978 00170024 C 00180024 C SECTION 8, SPECIFICATION STATEMENTS 00190024 C SECTION 8.1, DIMENSION STATEMENT 00200024 C SECTION 8.2, EQUIVALENCE STATEMENT 00210024 C SECTION 8.3, COMMON STATEMENT 00220024 C SECTION 8.4, TYPE-STATEMENTS 00230024 C SECTION 9, DATA STATEMENT 00240024 C 00250024 COMMON ICOE01, RCOE01, LCOE01 00260024 COMMON IADE31(3,3,3), RADE31(3,3,3), LADE31(3,3,3) 00270024 COMMON IADN31(2,2,2), RADN31(2,2,2), LADN31(2,2,2) 00280024 C 00290024 DIMENSION IADE32(3,3,3), RADE32(3,3,3), LADE32(3,3,3) 00300024 DIMENSION IADN32(2,2,2), IADN21(2,2), IADN11(2) 00310024 DIMENSION IADE21(2,2), IADE11(4) 00320024 C 00330024 EQUIVALENCE (IADE31(1,1,1), IADE32(1,1,1) ) 00340024 EQUIVALENCE ( RADE31(1,1,1), RADE32(1,1,1) ) 00350024 EQUIVALENCE ( LADE31(1,1,1), LADE32(1,1,1) ) 00360024 EQUIVALENCE ( IADE31(1,1,1), IADE21(1,1), IADE11(1) ) 00370024 EQUIVALENCE ( ICOE01, ICOE02, ICOE03 ) 00380024 C 00390024 LOGICAL LADE31, LADN31, LADE32, LCOE01 00400024 INTEGER RADN33(2,2,2), RADN21(2,4), RADN11(8) 00410024 REAL IADN33(2,2,2), IADN22(2,4), IADN12(8) 00420024 C 00430024 C 00440024 C ********************************************************** 00450024 C 00460024 C A COMPILER VALIDATION SYSTEM FOR THE FORTRAN LANGUAGE 00470024 C BASED ON SPECIFICATIONS AS DEFINED IN AMERICAN NATIONAL STANDARD 00480024 C PROGRAMMING LANGUAGE FORTRAN X3.9-1978, HAS BEEN DEVELOPED BY THE 00490024 C FEDERAL COBOL COMPILER TESTING SERVICE. THE FORTRAN COMPILER 00500024 C VALIDATION SYSTEM (FCVS) CONSISTS OF AUDIT ROUTINES, THEIR RELATED00510024 C DATA, AND AN EXECUTIVE SYSTEM. EACH AUDIT ROUTINE IS A FORTRAN 00520024 C PROGRAM, SUBPROGRAM OR FUNCTION WHICH INCLUDES TESTS OF SPECIFIC 00530024 C LANGUAGE ELEMENTS AND SUPPORTING PROCEDURES INDICATING THE RESULT 00540024 C OF EXECUTING THESE TESTS. 00550024 C 00560024 C THIS PARTICULAR PROGRAM/SUBPROGRAM/FUNCTION CONTAINS FEATURES 00570024 C FOUND ONLY IN THE SUBSET AS DEFINED IN X3.9-1978. 00580024 C 00590024 C SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO - 00600024 C 00610024 C NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY 00620024 C SOFTWARE STANDARDS VALIDATION GROUP 00630024 C BUILDING 225 RM A266 00640024 C GAITHERSBURG, MD 20899 00650024 C ********************************************************** 00660024 C 00670024 C 00680024 C 00690024 C INITIALIZATION SECTION 00700024 C 00710024 C INITIALIZE CONSTANTS 00720024 C ************** 00730024 C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER. 00740024 I01 = 5 00750024 C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER. 00760024 I02 = 6 00770024 C SYSTEM ENVIRONMENT SECTION 00780024 C 00790024 CX010 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-010 CONTROL CARD. 00800024 C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 00810024 C (UNIT NUMBER FOR CARD READER). 00820024 CX011 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-011 CONTROL CARD. 00830024 C THE CX011 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 00840024 C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX010 ABOVE. 00850024 C 00860024 CX020 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-020 CONTROL CARD. 00870024 C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02 = 6 00880024 C (UNIT NUMBER FOR PRINTER). 00890024 CX021 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-021 CONTROL CARD. 00900024 C THE CX021 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 00910024 C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX020 ABOVE. 00920024 C 00930024 IVPASS=0 00940024 IVFAIL=0 00950024 IVDELE=0 00960024 ICZERO=0 00970024 C 00980024 C WRITE PAGE HEADERS 00990024 WRITE (I02,90000) 01000024 WRITE (I02,90001) 01010024 WRITE (I02,90002) 01020024 WRITE (I02, 90002) 01030024 WRITE (I02,90003) 01040024 WRITE (I02,90002) 01050024 WRITE (I02,90004) 01060024 WRITE (I02,90002) 01070024 WRITE (I02,90011) 01080024 WRITE (I02,90002) 01090024 WRITE (I02,90002) 01100024 WRITE (I02,90005) 01110024 WRITE (I02,90006) 01120024 WRITE (I02,90002) 01130024 IVTNUM = 645 01140024 C 01150024 C **** TEST 645 **** 01160024 C TEST 645 - TESTS SETTING A THREE DIMENSION INTEGER ARRAY ELEMENT01170024 C BY A SIMPLE INTEGER ASSIGNMENT STATEMENT. 01180024 C 01190024 IF (ICZERO) 36450, 6450, 36450 01200024 6450 CONTINUE 01210024 IADN31(2,2,2) = -9999 01220024 IVCOMP = IADN31(2,2,2) 01230024 GO TO 46450 01240024 36450 IVDELE = IVDELE + 1 01250024 WRITE (I02,80003) IVTNUM 01260024 IF (ICZERO) 46450, 6461, 46450 01270024 46450 IF ( IVCOMP + 9999 ) 26450, 16450, 26450 01280024 16450 IVPASS = IVPASS + 1 01290024 WRITE (I02,80001) IVTNUM 01300024 GO TO 6461 01310024 26450 IVFAIL = IVFAIL + 1 01320024 IVCORR = -9999 01330024 WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 01340024 6461 CONTINUE 01350024 IVTNUM = 646 01360024 C 01370024 C **** TEST 646 **** 01380024 C TEST 646 - TESTS SETTING A THREE DIMENSION REAL ARRAY ELEMENT 01390024 C BY A SIMPLE REAL ASSIGNMENT STATEMENT. 01400024 C 01410024 IF (ICZERO) 36460, 6460, 36460 01420024 6460 CONTINUE 01430024 RADN31(1,2,1) = 512. 01440024 IVCOMP = RADN31(1,2,1) 01450024 GO TO 46460 01460024 36460 IVDELE = IVDELE + 1 01470024 WRITE (I02,80003) IVTNUM 01480024 IF (ICZERO) 46460, 6471, 46460 01490024 46460 IF ( IVCOMP - 512 ) 26460, 16460, 26460 01500024 16460 IVPASS = IVPASS + 1 01510024 WRITE (I02,80001) IVTNUM 01520024 GO TO 6471 01530024 26460 IVFAIL = IVFAIL + 1 01540024 IVCORR = 512 01550024 WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 01560024 6471 CONTINUE 01570024 IVTNUM = 647 01580024 C 01590024 C **** TEST 647 **** 01600024 C TEST 647 - TESTS SETTING A THREE DIMENSION LOGICAL ARRAY ELEMENT01610024 C BY A SIMPLE LOGICAL ASSIGNMENT STATEMENT. 01620024 C 01630024 IF (ICZERO) 36470, 6470, 36470 01640024 6470 CONTINUE 01650024 LADN31(1,2,2) = .TRUE. 01660024 ICON01 = 0 01670024 IF ( LADN31(1,2,2) ) ICON01 = 1 01680024 GO TO 46470 01690024 36470 IVDELE = IVDELE + 1 01700024 WRITE (I02,80003) IVTNUM 01710024 IF (ICZERO) 46470, 6481, 46470 01720024 46470 IF ( ICON01 - 1 ) 26470, 16470, 26470 01730024 16470 IVPASS = IVPASS + 1 01740024 WRITE (I02,80001) IVTNUM 01750024 GO TO 6481 01760024 26470 IVFAIL = IVFAIL + 1 01770024 IVCOMP = ICON01 01780024 IVCORR = 1 01790024 WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 01800024 6481 CONTINUE 01810024 IVTNUM = 648 01820024 C 01830024 C **** TEST 648 **** 01840024 C TEST 648 - TESTS SETTING A ONE, TWO, AND THREE DIMENSION ARRAY 01850024 C ELEMENT TO A VALUE IN ARITHMETIC ASSIGNMENT STATEMENTS. ALL THREE01860024 C ELEMENTS ARE INTEGERS. THE INTEGER ARRAY ELEMENTS ARE THEN USED 01870024 C IN AN ARITHMETIC STATEMENT AND THE RESULT IS STORED BY INTEGER 01880024 C TO REAL CONVERSION INTO A THREE DIMENSION REAL ARRAY ELEMENT. 01890024 C 01900024 IF (ICZERO) 36480, 6480, 36480 01910024 6480 CONTINUE 01920024 IADN11(2) = 1 01930024 IADN21(2,2) = 2 01940024 IADN32(2,2,2) = 3 01950024 RADN31(2,2,1) = IADN11(2) + IADN21(2,2) + IADN32(2,2,2) 01960024 IVCOMP = RADN31(2,2,1) 01970024 GO TO 46480 01980024 36480 IVDELE = IVDELE + 1 01990024 WRITE (I02,80003) IVTNUM 02000024 IF (ICZERO) 46480, 6491, 46480 02010024 46480 IF ( IVCOMP - 6) 26480, 16480, 26480 02020024 16480 IVPASS = IVPASS + 1 02030024 WRITE (I02,80001) IVTNUM 02040024 GO TO 6491 02050024 26480 IVFAIL = IVFAIL + 1 02060024 IVCORR = 6 02070024 WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 02080024 6491 CONTINUE 02090024 IVTNUM = 649 02100024 C 02110024 C **** TEST 649 **** 02120024 C TEST 649 - TESTS OF ONE, TWO, AND THREE DIMENSION ARRAY ELEMENTS02130024 C SET EXPLICITLY INTEGER BY THE INTEGER TYPE STATEMENT. ALL ELEMENT02140024 C VALUES SHOULD BE ZERO FROM REAL TO INTEGER TRUNCATION FROM A VALUE02150024 C OF 0.5. ALL THREE ELEMENTS ARE USED IN AN ARITHMETIC EXPRESSION. 02160024 C THE VALUE OF THE SUM OF THE ELEMENTS SHOULD BE ZERO. 02170024 C 02180024 IF (ICZERO) 36490, 6490, 36490 02190024 6490 CONTINUE 02200024 RADN11(8) = 0000.50000 02210024 RADN21(2,4) = .50000 02220024 RADN33(2,2,2) = 00000.5 02230024 RADN11(1) = RADN11(8) + RADN21(2,4) + RADN33(2,2,2) 02240024 IVCOMP = RADN11(1) 02250024 GO TO 46490 02260024 36490 IVDELE = IVDELE + 1 02270024 WRITE (I02,80003) IVTNUM 02280024 IF (ICZERO) 46490, 6501, 46490 02290024 46490 IF ( IVCOMP - 0 ) 26490, 16490, 26490 02300024 16490 IVPASS = IVPASS + 1 02310024 WRITE (I02,80001) IVTNUM 02320024 GO TO 6501 02330024 26490 IVFAIL = IVFAIL + 1 02340024 IVCORR = 0 02350024 WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 02360024 6501 CONTINUE 02370024 IVTNUM = 650 02380024 C 02390024 C **** TEST 650 **** 02400024 C TEST 650 - TEST OF THE EQUIVALENCE STATEMENT. A REAL ARRAY 02410024 C ELEMENT IS SET BY AN ASSIGNMENT STATEMENT. ITS EQUIVALENT ELEMENT02420024 C IN COMMON IS USED TO SET THE VALUE OF AN INTEGER ARRAY ELEMENT 02430024 C ALSO IN COMMON. FINALLY THE DIMENSIONED EQUIVALENT INTEGER 02440024 C ARRAY ELEMENT IS TESTED FOR THE VALUE USED THROUGHOUT 32767. 02450024 C 02460024 IF (ICZERO) 36500, 6500, 36500 02470024 6500 CONTINUE 02480024 RADE32(2,2,2) = 32767. 02490024 IADE31(2,2,2) = RADE31(2,2,2) 02500024 IVCOMP = IADE32(2,2,2) 02510024 GO TO 46500 02520024 36500 IVDELE = IVDELE + 1 02530024 WRITE (I02,80003) IVTNUM 02540024 IF (ICZERO) 46500, 6511, 46500 02550024 46500 IF ( IVCOMP - 32767 ) 26500, 16500, 26500 02560024 16500 IVPASS = IVPASS + 1 02570024 WRITE (I02,80001) IVTNUM 02580024 GO TO 6511 02590024 26500 IVFAIL = IVFAIL + 1 02600024 IVCORR = 32767 02610024 WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 02620024 6511 CONTINUE 02630024 IVTNUM = 651 02640024 C 02650024 C **** TEST 651 **** 02660024 C TEST 651 - THIS IS A TEST OF COMMON AND DIMENSION AS WELL AS A 02670024 C TEST OF THE EQUIVALENCE STATEMENT USING LOGICAL ARRAY ELEMENTS 02680024 C BOTH IN COMMON AND DIMENSIONED. A LOGICAL VARIABLE IN COMMON IS 02690024 C SET TO A VALUE OF .NOT. THE VALUE USED IN THE EQUIVALENCED ARRAY 02700024 C ELEMENTS WHICH WERE SET IN A LOGICAL ASSIGNMENT STATEMENT. 02710024 C 02720024 IF (ICZERO) 36510, 6510, 36510 02730024 6510 CONTINUE 02740024 LADE31(1,2,3) = .FALSE. 02750024 LCOE01 = .NOT. LADE32(1,2,3) 02760024 ICON01 = 0 02770024 IF ( LCOE01 ) ICON01 = 1 02780024 GO TO 46510 02790024 36510 IVDELE = IVDELE + 1 02800024 WRITE (I02,80003) IVTNUM 02810024 IF (ICZERO) 46510, 6521, 46510 02820024 46510 IF ( ICON01 - 1 ) 26510, 16510, 26510 02830024 16510 IVPASS = IVPASS + 1 02840024 WRITE (I02,80001) IVTNUM 02850024 GO TO 6521 02860024 26510 IVFAIL = IVFAIL + 1 02870024 IVCOMP = ICON01 02880024 IVCORR = 1 02890024 WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 02900024 6521 CONTINUE 02910024 IVTNUM = 652 02920024 C 02930024 C **** TEST 652 **** 02940024 C TEST 652 - TESTS OF ONE, TWO, AND THREE DIMENSION ARRAY ELEMENTS02950024 C SET EXPLICITLY REAL BY THE REAL TYPE STATEMENT. ALL ELEMENT 02960024 C VALUES SHOULD BE 0.5 FROM THE REAL ASSIGNMENT STATEMENT. THE 02970024 C ARRAY ELEMENTS ARE SUMMED AND THEN THE SUM MULTIPLIED BY 2. 02980024 C FINALLY 0.2 IS ADDED TO THE RESULT AND THE FINAL RESULT CONVERTED 02990024 C TO AN INTEGER ( ( .5 + .5 + .5 ) * 2. ) + 0.2 03000024 C 03010024 IF (ICZERO) 36520, 6520, 36520 03020024 6520 CONTINUE 03030024 IADN12(5) = 0.5 03040024 IADN22(1,3) = 0.5 03050024 IADN33(1,2,2) = 0.5 03060024 IVCOMP = ( ( IADN12(5) + IADN22(1,3) + IADN33(1,2,2) ) * 2. ) + .203070024 GO TO 46520 03080024 36520 IVDELE = IVDELE + 1 03090024 WRITE (I02,80003) IVTNUM 03100024 IF (ICZERO) 46520, 6531, 46520 03110024 46520 IF ( IVCOMP - 3 ) 26520, 16520, 26520 03120024 16520 IVPASS = IVPASS + 1 03130024 WRITE (I02,80001) IVTNUM 03140024 GO TO 6531 03150024 26520 IVFAIL = IVFAIL + 1 03160024 IVCORR = 3 03170024 WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 03180024 6531 CONTINUE 03190024 C 03200024 C WRITE PAGE FOOTINGS AND RUN SUMMARIES 03210024 99999 CONTINUE 03220024 WRITE (I02,90002) 03230024 WRITE (I02,90006) 03240024 WRITE (I02,90002) 03250024 WRITE (I02,90002) 03260024 WRITE (I02,90007) 03270024 WRITE (I02,90002) 03280024 WRITE (I02,90008) IVFAIL 03290024 WRITE (I02,90009) IVPASS 03300024 WRITE (I02,90010) IVDELE 03310024 C 03320024 C 03330024 C TERMINATE ROUTINE EXECUTION 03340024 STOP 03350024 C 03360024 C FORMAT STATEMENTS FOR PAGE HEADERS 03370024 90000 FORMAT ("1") 03380024 90002 FORMAT (" ") 03390024 90001 FORMAT (" ",10X,"FORTRAN COMPILER VALIDATION SYSTEM" ) 03400024 90003 FORMAT (" ",21X,"VERSION 2.1" ) 03410024 90004 FORMAT (" ",10X,"FOR OFFICIAL USE ONLY - COPYRIGHT 1978" ) 03420024 90005 FORMAT (" ",5X,"TEST",5X,"PASS/FAIL", 5X,"COMPUTED",8X,"CORRECT") 03430024 90006 FORMAT (" ",5X,"----------------------------------------------" ) 03440024 90011 FORMAT (" ",18X,"SUBSET LEVEL TEST" ) 03450024 C 03460024 C FORMAT STATEMENTS FOR RUN SUMMARIES 03470024 90008 FORMAT (" ",15X,I5," ERRORS ENCOUNTERED" ) 03480024 90009 FORMAT (" ",15X,I5," TESTS PASSED" ) 03490024 90010 FORMAT (" ",15X,I5," TESTS DELETED" ) 03500024 C 03510024 C FORMAT STATEMENTS FOR TEST RESULTS 03520024 80001 FORMAT (" ",4X,I5,7X,"PASS") 03530024 80002 FORMAT (" ",4X,I5,7X,"FAIL") 03540024 80003 FORMAT (" ",4X,I5,7X,"DELETED") 03550024 80004 FORMAT (" ",4X,I5,7X,"FAIL",10X,I6,9X,I6) 03560024 80005 FORMAT (" ",4X,I5,7X,"FAIL",4X,E12.5,3X,E12.5) 03570024 C 03580024 90007 FORMAT (" ",20X,"END OF PROGRAM FM024" ) 03590024 END 03600024