Annotation of cci/usr/src/usr.bin/f77/testf77/tests/FM026.f, revision 1.1

1.1     ! root        1: C     COMMENT SECTION                                                   00010026
        !             2: C     DATE***82/08/02*18.33.46
        !             3: C     OWNER  PRE/850703/TC-85-   -410/    /FSTC/278FCVS*F78UBP20/
        !             4: C     AUDIT  FCVS78 V2.0
        !             5: C                                                                       00020026
        !             6: C     FM026                                                             00030026
        !             7: C                                                                       00040026
        !             8: C         THIS ROUTINE CONTAINS THE BASIC SUBROUTINE REFERENCE TESTS.   00050026
        !             9: C     THE SUBROUTINE FS027 IS CALLED BY THIS PROGRAM.  THE SUBROUTINE   00060026
        !            10: C     FS027 INCREMENTS THE CALLING ARGUMENT BY 1 AND RETURNS TO THE     00070026
        !            11: C     CALLING PROGRAM.                                                  00080026
        !            12: C                                                                       00090026
        !            13: C         EXECUTION OF A SUBROUTINE REFERENCE RESULTS IN AN ASSOCIATION 00100026
        !            14: C     OF ACTUAL ARGUMENTS WITH ALL APPEARANCES OF DUMMY ARGUMENTS IN    00110026
        !            15: C     THE DEFINING SUBPROGRAM.  FOLLOWING THESE ASSOCIATIONS, EXECUTION 00120026
        !            16: C     OF THE FIRST EXECUTABLE STATEMENT OF THE DEFINING SUBPROGRAM      00130026
        !            17: C     IS UNDERTAKEN.                                                    00140026
        !            18: C                                                                       00150026
        !            19: C      REFERENCES                                                       00160026
        !            20: C        AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN,       00170026
        !            21: C              X3.9-1978                                                00180026
        !            22: C                                                                       00190026
        !            23: C        SECTION 15.6.2, SUBROUTINE REFERENCE                           00200026
        !            24: C                                                                       00210026
        !            25: C      **********************************************************       00220026
        !            26: C                                                                       00230026
        !            27: C         A COMPILER VALIDATION SYSTEM FOR THE FORTRAN LANGUAGE         00240026
        !            28: C     BASED ON SPECIFICATIONS AS DEFINED IN AMERICAN NATIONAL STANDARD  00250026
        !            29: C     PROGRAMMING LANGUAGE FORTRAN X3.9-1978, HAS BEEN DEVELOPED BY THE 00260026
        !            30: C     FEDERAL COBOL COMPILER TESTING SERVICE.  THE FORTRAN COMPILER     00270026
        !            31: C     VALIDATION SYSTEM (FCVS) CONSISTS OF AUDIT ROUTINES, THEIR RELATED00280026
        !            32: C     DATA, AND AN EXECUTIVE SYSTEM.  EACH AUDIT ROUTINE IS A FORTRAN   00290026
        !            33: C     PROGRAM, SUBPROGRAM OR FUNCTION WHICH INCLUDES TESTS OF SPECIFIC  00300026
        !            34: C     LANGUAGE ELEMENTS AND SUPPORTING PROCEDURES INDICATING THE RESULT 00310026
        !            35: C     OF EXECUTING THESE TESTS.                                         00320026
        !            36: C                                                                       00330026
        !            37: C         THIS PARTICULAR PROGRAM/SUBPROGRAM/FUNCTION CONTAINS FEATURES 00340026
        !            38: C     FOUND ONLY IN THE SUBSET AS DEFINED IN X3.9-1978.                 00350026
        !            39: C                                                                       00360026
        !            40: C         SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO -             00370026
        !            41: C                                                                       00380026
        !            42: C                  DEPARTMENT OF THE NAVY                               00390026
        !            43: C                  FEDERAL COBOL COMPILER TESTING SERVICE               00400026
        !            44: C                  WASHINGTON, D.C.  20376                              00410026
        !            45: C                                                                       00420026
        !            46: C      **********************************************************       00430026
        !            47: C                                                                       00440026
        !            48: C                                                                       00450026
        !            49: C                                                                       00460026
        !            50: C     INITIALIZATION SECTION                                            00470026
        !            51: C                                                                       00480026
        !            52: C     INITIALIZE CONSTANTS                                              00490026
        !            53: C      **************                                                   00500026
        !            54: C     I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER.         00510026
        !            55:       I01 = 5                                                           00520026
        !            56: C     I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER.             00530026
        !            57:       I02 = 6                                                           00540026
        !            58: C     SYSTEM ENVIRONMENT SECTION                                        00550026
        !            59: C                                                                       00560026
        !            60:       I01 = 5                                                           00570026
        !            61: C     THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5      00580026
        !            62: C     (UNIT NUMBER FOR CARD READER).                                    00590026
        !            63: CX011    THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-011 CONTROL CARD. 00600026
        !            64: C     THE CX011 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL            00610026
        !            65: C     FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX010 ABOVE.         00620026
        !            66: C                                                                       00630026
        !            67:       I02 = 6                                                           00640026
        !            68: C     THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02 = 6      00650026
        !            69: C     (UNIT NUMBER FOR PRINTER).                                        00660026
        !            70: CX021    THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-021 CONTROL CARD. 00670026
        !            71: C     THE CX021 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL            00680026
        !            72: C     FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX020 ABOVE.         00690026
        !            73: C                                                                       00700026
        !            74:       IVPASS=0                                                          00710026
        !            75:       IVFAIL=0                                                          00720026
        !            76:       IVDELE=0                                                          00730026
        !            77:       ICZERO=0                                                          00740026
        !            78: C                                                                       00750026
        !            79: C     WRITE PAGE HEADERS                                                00760026
        !            80:       WRITE (I02,90000)                                                 00770026
        !            81:       WRITE (I02,90001)                                                 00780026
        !            82:       WRITE (I02,90002)                                                 00790026
        !            83:       WRITE (I02, 90002)                                                00800026
        !            84:       WRITE (I02,90003)                                                 00810026
        !            85:       WRITE (I02,90002)                                                 00820026
        !            86:       WRITE (I02,90004)                                                 00830026
        !            87:       WRITE (I02,90002)                                                 00840026
        !            88:       WRITE (I02,90011)                                                 00850026
        !            89:       WRITE (I02,90002)                                                 00860026
        !            90:       WRITE (I02,90002)                                                 00870026
        !            91:       WRITE (I02,90005)                                                 00880026
        !            92:       WRITE (I02,90006)                                                 00890026
        !            93:       WRITE (I02,90002)                                                 00900026
        !            94: C                                                                       00910026
        !            95: C     TEST SECTION                                                      00920026
        !            96: C                                                                       00930026
        !            97: C         SUBROUTINE REFERENCE - CALL                                   00940026
        !            98: C                                                                       00950026
        !            99:       IVTNUM = 666                                                      00960026
        !           100: C                                                                       00970026
        !           101: C      ****  TEST 666  ****                                             00980026
        !           102: C     SUBROUTINE CALL - ARGUMENT NAME SAME AS SUBROUTINE ARGUMENT NAME. 00990026
        !           103: C                                                                       01000026
        !           104:       IF (ICZERO) 36660, 6660, 36660                                    01010026
        !           105:  6660 CONTINUE                                                          01020026
        !           106:       IVON01 = 0                                                        01030026
        !           107:       CALL FS027(IVON01)                                                01040026
        !           108:       IVCOMP = IVON01                                                   01050026
        !           109:       GO TO 46660                                                       01060026
        !           110: 36660 IVDELE = IVDELE + 1                                               01070026
        !           111:       WRITE (I02,80003) IVTNUM                                          01080026
        !           112:       IF (ICZERO) 46660, 6671, 46660                                    01090026
        !           113: 46660 IF (IVCOMP - 1) 26660,16660,26660                                 01100026
        !           114: 16660 IVPASS = IVPASS + 1                                               01110026
        !           115:       WRITE (I02,80001) IVTNUM                                          01120026
        !           116:       GO TO 6671                                                        01130026
        !           117: 26660 IVFAIL = IVFAIL + 1                                               01140026
        !           118:       IVCORR = 1                                                        01150026
        !           119:       WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR                          01160026
        !           120:  6671 CONTINUE                                                          01170026
        !           121:       IVTNUM = 667                                                      01180026
        !           122: C                                                                       01190026
        !           123: C      ****  TEST 667  ****                                             01200026
        !           124: C     SUBROUTINE CALL - ARGUMENT NAME SAME AS INTERNAL VARIABLE IN      01210026
        !           125: C         SUBROUTINE.                                                   01220026
        !           126: C                                                                       01230026
        !           127:       IF (ICZERO) 36670, 6670, 36670                                    01240026
        !           128:  6670 CONTINUE                                                          01250026
        !           129:       IVON02 = 2                                                        01260026
        !           130:       CALL FS027(IVON02)                                                01270026
        !           131:       IVCOMP = IVON02                                                   01280026
        !           132:       GO TO 46670                                                       01290026
        !           133: 36670 IVDELE = IVDELE + 1                                               01300026
        !           134:       WRITE (I02,80003) IVTNUM                                          01310026
        !           135:       IF (ICZERO) 46670, 6681, 46670                                    01320026
        !           136: 46670 IF (IVCOMP - 3) 26670,16670,26670                                 01330026
        !           137: 16670 IVPASS = IVPASS + 1                                               01340026
        !           138:       WRITE (I02,80001) IVTNUM                                          01350026
        !           139:       GO TO 6681                                                        01360026
        !           140: 26670 IVFAIL = IVFAIL + 1                                               01370026
        !           141:       IVCORR = 3                                                        01380026
        !           142:       WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR                          01390026
        !           143:  6681 CONTINUE                                                          01400026
        !           144:       IVTNUM = 668                                                      01410026
        !           145: C                                                                       01420026
        !           146: C      ****  TEST 668  ****                                             01430026
        !           147: C     SUBROUTINE CALL - ARGUMENT NAME DIFFERENT FROM SUBROUTINE ARGUMENT01440026
        !           148: C         AND INTERNAL VARIABLE.                                        01450026
        !           149: C                                                                       01460026
        !           150:       IF (ICZERO) 36680, 6680, 36680                                    01470026
        !           151:  6680 CONTINUE                                                          01480026
        !           152:       IVON01 = 7                                                        01490026
        !           153:       IVON03 = -12                                                      01500026
        !           154:       CALL FS027(IVON03)                                                01510026
        !           155:       IVCOMP = IVON03                                                   01520026
        !           156:       GO TO 46680                                                       01530026
        !           157: 36680 IVDELE = IVDELE + 1                                               01540026
        !           158:       WRITE (I02,80003) IVTNUM                                          01550026
        !           159:       IF (ICZERO) 46680, 6691, 46680                                    01560026
        !           160: 46680 IF (IVCOMP + 11 ) 26680,16680,26680                               01570026
        !           161: 16680 IVPASS = IVPASS + 1                                               01580026
        !           162:       WRITE (I02,80001) IVTNUM                                          01590026
        !           163:       GO TO 6691                                                        01600026
        !           164: 26680 IVFAIL = IVFAIL + 1                                               01610026
        !           165:       IVCORR = -11                                                      01620026
        !           166:       WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR                          01630026
        !           167:  6691 CONTINUE                                                          01640026
        !           168:       IVTNUM = 669                                                      01650026
        !           169: C                                                                       01660026
        !           170: C      ****  TEST 669  ****                                             01670026
        !           171: C     REPEATED SUBROUTINE CALLS IN A DO LOOP.                           01680026
        !           172: C                                                                       01690026
        !           173:       IF (ICZERO) 36690, 6690, 36690                                    01700026
        !           174:  6690 CONTINUE                                                          01710026
        !           175:       IVCOMP = 0                                                        01720026
        !           176:       DO 6692 IVON04 = 1,5                                              01730026
        !           177:       CALL FS027 (IVCOMP)                                               01740026
        !           178:  6692 CONTINUE                                                          01750026
        !           179:       GO TO 46690                                                       01760026
        !           180: 36690 IVDELE = IVDELE + 1                                               01770026
        !           181:       WRITE (I02,80003) IVTNUM                                          01780026
        !           182:       IF (ICZERO) 46690, 6701, 46690                                    01790026
        !           183: 46690 IF (IVCOMP - 5) 26690,16690,26690                                 01800026
        !           184: 16690 IVPASS = IVPASS + 1                                               01810026
        !           185:       WRITE (I02,80001) IVTNUM                                          01820026
        !           186:       GO TO 6701                                                        01830026
        !           187: 26690 IVFAIL = IVFAIL + 1                                               01840026
        !           188:       IVCORR = 5                                                        01850026
        !           189:       WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR                          01860026
        !           190: C      ****     END OF TESTS   ****                                     01870026
        !           191:  6701 CONTINUE                                                          01880026
        !           192: C                                                                       01890026
        !           193: C     WRITE PAGE FOOTINGS AND RUN SUMMARIES                             01900026
        !           194: 99999 CONTINUE                                                          01910026
        !           195:       WRITE (I02,90002)                                                 01920026
        !           196:       WRITE (I02,90006)                                                 01930026
        !           197:       WRITE (I02,90002)                                                 01940026
        !           198:       WRITE (I02,90002)                                                 01950026
        !           199:       WRITE (I02,90007)                                                 01960026
        !           200:       WRITE (I02,90002)                                                 01970026
        !           201:       WRITE (I02,90008)  IVFAIL                                         01980026
        !           202:       WRITE (I02,90009) IVPASS                                          01990026
        !           203:       WRITE (I02,90010) IVDELE                                          02000026
        !           204: C                                                                       02010026
        !           205: C                                                                       02020026
        !           206: C     TERMINATE ROUTINE EXECUTION                                       02030026
        !           207:       STOP                                                              02040026
        !           208: C                                                                       02050026
        !           209: C     FORMAT STATEMENTS FOR PAGE HEADERS                                02060026
        !           210: 90000 FORMAT (1H1)                                                      02070026
        !           211: 90002 FORMAT (1H )                                                      02080026
        !           212: 90001 FORMAT (1H ,10X,34HFORTRAN COMPILER VALIDATION SYSTEM)            02090026
        !           213: 90003 FORMAT (1H ,21X,11HVERSION 1.0)                                   02100026
        !           214: 90004 FORMAT (1H ,10X,38HFOR OFFICIAL USE ONLY - COPYRIGHT 1978)        02110026
        !           215: 90005 FORMAT (1H ,5X,4HTEST,5X,9HPASS/FAIL, 5X,8HCOMPUTED,8X,7HCORRECT) 02120026
        !           216: 90006 FORMAT (1H ,5X,46H----------------------------------------------) 02130026
        !           217: 90011 FORMAT (1H ,18X,17HSUBSET LEVEL TEST)                             02140026
        !           218: C                                                                       02150026
        !           219: C     FORMAT STATEMENTS FOR RUN SUMMARIES                               02160026
        !           220: 90008 FORMAT (1H ,15X,I5,19H ERRORS ENCOUNTERED)                        02170026
        !           221: 90009 FORMAT (1H ,15X,I5,13H TESTS PASSED)                              02180026
        !           222: 90010 FORMAT (1H ,15X,I5,14H TESTS DELETED)                             02190026
        !           223: C                                                                       02200026
        !           224: C     FORMAT STATEMENTS FOR TEST RESULTS                                02210026
        !           225: 80001 FORMAT (1H ,4X,I5,7X,4HPASS)                                      02220026
        !           226: 80002 FORMAT (1H ,4X,I5,7X,4HFAIL)                                      02230026
        !           227: 80003 FORMAT (1H ,4X,I5,7X,7HDELETED)                                   02240026
        !           228: 80004 FORMAT (1H ,4X,I5,7X,4HFAIL,10X,I6,9X,I6)                         02250026
        !           229: 80005 FORMAT (1H ,4X,I5,7X,4HFAIL,4X,E12.5,3X,E12.5)                    02260026
        !           230: C                                                                       02270026
        !           231: 90007 FORMAT (1H ,20X,20HEND OF PROGRAM FM026)                          02280026
        !           232:       END                                                               02290026
        !           233:       SUBROUTINE FS027(IVON01)                                          00010027
        !           234: C     DATE***82/08/02*18.33.46
        !           235: C     OWNER  PRE/850703/TC-85-   -410/    /FSTC/278FCVS*F78UBP20/
        !           236: C     AUDIT  FCVS78 V2.0
        !           237: C     COMMENT SECTION                                                   00020027
        !           238: C                                                                       00030027
        !           239: C     FS027                                                             00040027
        !           240: C                                                                       00050027
        !           241: C         THIS SUBROUTINE IS CALLED BY THE MAIN PROGRAM FM026.  THE     00060027
        !           242: C     SUBROUTINE ARGUMENT IS INCREMENTED BY 1 AND CONTROL RETURNED      00070027
        !           243: C     TO THE CALLING PROGRAM.                                           00080027
        !           244: C                                                                       00090027
        !           245: C      REFERENCES                                                       00100027
        !           246: C        AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN,       00110027
        !           247: C              X3.9-1978                                                00120027
        !           248: C                                                                       00130027
        !           249: C        SECTION 15.6, SUBROUTINES                                      00140027
        !           250: C        SECTION 15.8, RETURN STATEMENT                                 00150027
        !           251: C                                                                       00160027
        !           252: C     TEST SECTION                                                      00170027
        !           253: C                                                                       00180027
        !           254: C         SUBROUTINE SUBPROGRAM                                         00190027
        !           255: C                                                                       00200027
        !           256: C     INCREMENT ARGUMENT BY 1 AND RETURN TO CALLING PROGRAM.            00210027
        !           257: C                                                                       00220027
        !           258:       IVON02 = IVON01                                                   00230027
        !           259:       IVON02 = IVON02 + 1                                               00240027
        !           260:       IVON01 = IVON02                                                   00250027
        !           261:       IVON02 = 300                                                      00260027
        !           262:       RETURN                                                            00270027
        !           263:       END                                                               00280027

unix.superglobalmegacorp.com

This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.