Annotation of cci/usr/src/usr.bin/f77/testf77/tests/FM028.f, revision 1.1.1.1

1.1       root        1: C     COMMENT SECTION                                                   00010028
                      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                                                                       00020028
                      6: C     FM028                                                             00030028
                      7: C                                                                       00040028
                      8: C         THIS ROUTINE CONTAINS THE EXTERNAL FUNCTION REFERENCE TESTS.  00050028
                      9: C     THE FUNCTION SUBPROGRAM FF029 IS CALLED BY THIS PROGRAM. THE      00060028
                     10: C     FUNCTION SUBPROGRAM FF029 INCREMENTS THE CALLING ARGUMENT BY 1    00070028
                     11: C     AND RETURNS TO THE CALLING PROGRAM.                               00080028
                     12: C                                                                       00090028
                     13: C         EXECUTION OF AN EXTERNAL FUNCTION REFERENCE RESULTS IN AN     00100028
                     14: C     ASSOCIATION OF ACTUAL ARGUMENTS WITH ALL APPEARANCES OF DUMMY     00110028
                     15: C     ARGUMENTS IN THE DEFINING SUBPROGRAM.  FOLLOWING THESE            00120028
                     16: C     ASSOCIATIONS, EXECUTION OF THE FIRST EXECUTABLE STATEMENT OF THE  00130028
                     17: C     DEFINING SUBPROGRAM IS UNDERTAKEN.                                00140028
                     18: C                                                                       00150028
                     19: C      REFERENCES                                                       00160028
                     20: C        AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN,       00170028
                     21: C              X3.9-1978                                                00180028
                     22: C                                                                       00190028
                     23: C        SECTION 15.5.2, REFERENCING AN EXTERNAL FUNCTION               00200028
                     24: C                                                                       00210028
                     25:       INTEGER FF029                                                     00220028
                     26: C                                                                       00230028
                     27: C                                                                       00240028
                     28: C      **********************************************************       00250028
                     29: C                                                                       00260028
                     30: C         A COMPILER VALIDATION SYSTEM FOR THE FORTRAN LANGUAGE         00270028
                     31: C     BASED ON SPECIFICATIONS AS DEFINED IN AMERICAN NATIONAL STANDARD  00280028
                     32: C     PROGRAMMING LANGUAGE FORTRAN X3.9-1978, HAS BEEN DEVELOPED BY THE 00290028
                     33: C     FEDERAL COBOL COMPILER TESTING SERVICE.  THE FORTRAN COMPILER     00300028
                     34: C     VALIDATION SYSTEM (FCVS) CONSISTS OF AUDIT ROUTINES, THEIR RELATED00310028
                     35: C     DATA, AND AN EXECUTIVE SYSTEM.  EACH AUDIT ROUTINE IS A FORTRAN   00320028
                     36: C     PROGRAM, SUBPROGRAM OR FUNCTION WHICH INCLUDES TESTS OF SPECIFIC  00330028
                     37: C     LANGUAGE ELEMENTS AND SUPPORTING PROCEDURES INDICATING THE RESULT 00340028
                     38: C     OF EXECUTING THESE TESTS.                                         00350028
                     39: C                                                                       00360028
                     40: C         THIS PARTICULAR PROGRAM/SUBPROGRAM/FUNCTION CONTAINS FEATURES 00370028
                     41: C     FOUND ONLY IN THE SUBSET AS DEFINED IN X3.9-1978.                 00380028
                     42: C                                                                       00390028
                     43: C         SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO -             00400028
                     44: C                                                                       00410028
                     45: C                  DEPARTMENT OF THE NAVY                               00420028
                     46: C                  FEDERAL COBOL COMPILER TESTING SERVICE               00430028
                     47: C                  WASHINGTON, D.C.  20376                              00440028
                     48: C                                                                       00450028
                     49: C      **********************************************************       00460028
                     50: C                                                                       00470028
                     51: C                                                                       00480028
                     52: C                                                                       00490028
                     53: C     INITIALIZATION SECTION                                            00500028
                     54: C                                                                       00510028
                     55: C     INITIALIZE CONSTANTS                                              00520028
                     56: C      **************                                                   00530028
                     57: C     I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER.         00540028
                     58:       I01 = 5                                                           00550028
                     59: C     I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER.             00560028
                     60:       I02 = 6                                                           00570028
                     61: C     SYSTEM ENVIRONMENT SECTION                                        00580028
                     62: C                                                                       00590028
                     63:       I01 = 5                                                           00600028
                     64: C     THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5      00610028
                     65: C     (UNIT NUMBER FOR CARD READER).                                    00620028
                     66: CX011    THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-011 CONTROL CARD. 00630028
                     67: C     THE CX011 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL            00640028
                     68: C     FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX010 ABOVE.         00650028
                     69: C                                                                       00660028
                     70:       I02 = 6                                                           00670028
                     71: C     THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02 = 6      00680028
                     72: C     (UNIT NUMBER FOR PRINTER).                                        00690028
                     73: CX021    THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-021 CONTROL CARD. 00700028
                     74: C     THE CX021 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL            00710028
                     75: C     FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX020 ABOVE.         00720028
                     76: C                                                                       00730028
                     77:       IVPASS=0                                                          00740028
                     78:       IVFAIL=0                                                          00750028
                     79:       IVDELE=0                                                          00760028
                     80:       ICZERO=0                                                          00770028
                     81: C                                                                       00780028
                     82: C     WRITE PAGE HEADERS                                                00790028
                     83:       WRITE (I02,90000)                                                 00800028
                     84:       WRITE (I02,90001)                                                 00810028
                     85:       WRITE (I02,90002)                                                 00820028
                     86:       WRITE (I02, 90002)                                                00830028
                     87:       WRITE (I02,90003)                                                 00840028
                     88:       WRITE (I02,90002)                                                 00850028
                     89:       WRITE (I02,90004)                                                 00860028
                     90:       WRITE (I02,90002)                                                 00870028
                     91:       WRITE (I02,90011)                                                 00880028
                     92:       WRITE (I02,90002)                                                 00890028
                     93:       WRITE (I02,90002)                                                 00900028
                     94:       WRITE (I02,90005)                                                 00910028
                     95:       WRITE (I02,90006)                                                 00920028
                     96:       WRITE (I02,90002)                                                 00930028
                     97: C                                                                       00940028
                     98: C     TEST SECTION                                                      00950028
                     99: C                                                                       00960028
                    100: C     EXTERNAL FUNCTION REFERENCE                                       00970028
                    101: C                                                                       00980028
                    102: C     EXTERNAL FUNCTION REFERENCE - ARGUMENT NAME SAME AS SUBPROGRAM    00990028
                    103: C              ARGUMENT NAME.                                           01000028
                    104:  6701 CONTINUE                                                          01010028
                    105:       IVTNUM = 670                                                      01020028
                    106: C                                                                       01030028
                    107: C     **** TEST 670 ****                                                01040028
                    108: C                                                                       01050028
                    109:       IF (ICZERO) 36700,6700,36700                                      01060028
                    110:  6700 CONTINUE                                                          01070028
                    111:       IVON01 = 0                                                        01080028
                    112:       IVCOMP = FF029(IVON01)                                            01090028
                    113:       GO TO 46700                                                       01100028
                    114: 36700 IVDELE = IVDELE + 1                                               01110028
                    115:       WRITE (I02,80003) IVTNUM                                          01120028
                    116:       IF (ICZERO) 46700,6711,46700                                      01130028
                    117: 46700 IF (IVCOMP - 1) 26700,16700,26700                                 01140028
                    118: 16700 IVPASS = IVPASS + 1                                               01150028
                    119:       WRITE (I02,80001) IVTNUM                                          01160028
                    120:       GO TO 6711                                                        01170028
                    121: 26700 IVFAIL = IVFAIL + 1                                               01180028
                    122:       IVCORR = 1                                                        01190028
                    123:       WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR                          01200028
                    124:  6711 CONTINUE                                                          01210028
                    125:       IVTNUM = 671                                                      01220028
                    126: C                                                                       01230028
                    127: C      ****  TEST 671  ****                                             01240028
                    128: C                                                                       01250028
                    129: C     EXTERNAL FUNCTION REFERENCE - ARGUMENT NAME SAME AS INTERNAL      01260028
                    130: C           VARIABLE IN FUNCTION SUBPROGRAM.                            01270028
                    131: C                                                                       01280028
                    132:       IF (ICZERO) 36710,6710,36710                                      01290028
                    133:  6710 CONTINUE                                                          01300028
                    134:       IVON02 = 2                                                        01310028
                    135:       IVON01 = 5                                                        01320028
                    136:       IVCOMP = FF029(IVON02)                                            01330028
                    137:       GO TO 46710                                                       01340028
                    138: 36710 IVDELE = IVDELE + 1                                               01350028
                    139:       WRITE (I02,80003) IVTNUM                                          01360028
                    140:       IF (ICZERO) 46710,6721,46710                                      01370028
                    141: 46710 IF (IVCOMP - 3) 26710,16710,26710                                 01380028
                    142: 16710 IVPASS = IVPASS + 1                                               01390028
                    143:       WRITE (I02,80001) IVTNUM                                          01400028
                    144:       GO TO 6721                                                        01410028
                    145: 26710 IVFAIL = IVFAIL + 1                                               01420028
                    146:       IVCORR = 3                                                        01430028
                    147:       WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR                          01440028
                    148:  6721 CONTINUE                                                          01450028
                    149:       IVTNUM = 672                                                      01460028
                    150: C                                                                       01470028
                    151: C     ****  TEST 672  ****                                              01480028
                    152: C                                                                       01490028
                    153: C     EXTERNAL FUNCTION REFERENCE - ARGUMENT NAME DIFFERENT FROM        01500028
                    154: C           FUNCTION SUBPROGRAM ARGUMENT AND INTERNAL VARIABLE.         01510028
                    155: C                                                                       01520028
                    156:       IF  (ICZERO) 36720,6720,36720                                     01530028
                    157:  6720 CONTINUE                                                          01540028
                    158:       IVON01 = 7                                                        01550028
                    159:       IVON03 = -12                                                      01560028
                    160:       IVCOMP = FF029(IVON03)                                            01570028
                    161:       GO TO 46720                                                       01580028
                    162: 36720 IVDELE = IVDELE + 1                                               01590028
                    163:       WRITE (I02,80003) IVTNUM                                          01600028
                    164:       IF (ICZERO) 46720,6731,46720                                      01610028
                    165: 46720 IF (IVCOMP + 11) 26720,16720,26720                                01620028
                    166: 16720 IVPASS = IVPASS + 1                                               01630028
                    167:       WRITE (I02,80001) IVTNUM                                          01640028
                    168:       GO TO 6731                                                        01650028
                    169: 26720 IVFAIL = IVFAIL + 1                                               01660028
                    170:       IVCORR = -11                                                      01670028
                    171:       WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR                          01680028
                    172:  6731 CONTINUE                                                          01690028
                    173:       IVTNUM = 673                                                      01700028
                    174: C                                                                       01710028
                    175: C      **** TEST 673  ****                                              01720028
                    176: C                                                                       01730028
                    177: C     REPEATED EXTERNAL FUNCTION REFERENCE IN A DO LOOP.                01740028
                    178: C                                                                       01750028
                    179:       IF (ICZERO) 36730,6730,36730                                      01760028
                    180:  6730 CONTINUE                                                          01770028
                    181:       IVON01 = -7                                                       01780028
                    182:       IVCOMP = 0                                                        01790028
                    183:       DO 6732 IVON04 = 1,5                                              01800028
                    184:       IVCOMP = FF029(IVCOMP)                                            01810028
                    185:  6732 CONTINUE                                                          01820028
                    186:       GO TO 46730                                                       01830028
                    187: 36730 IVDELE = IVDELE + 1                                               01840028
                    188:       WRITE (I02,80003) IVTNUM                                          01850028
                    189:       IF (ICZERO) 46730,6741,46730                                      01860028
                    190: 46730 IF (IVCOMP - 5) 26730,16730,26730                                 01870028
                    191: 16730 IVPASS = IVPASS + 1                                               01880028
                    192:       WRITE (I02,80001) IVTNUM                                          01890028
                    193:       GO TO 6741                                                        01900028
                    194: 26730 IVFAIL = IVFAIL + 1                                               01910028
                    195:       IVCORR = 5                                                        01920028
                    196:       WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR                          01930028
                    197:  6741 CONTINUE                                                          01940028
                    198: C                                                                       01950028
                    199: C     WRITE PAGE FOOTINGS AND RUN SUMMARIES                             01960028
                    200: 99999 CONTINUE                                                          01970028
                    201:       WRITE (I02,90002)                                                 01980028
                    202:       WRITE (I02,90006)                                                 01990028
                    203:       WRITE (I02,90002)                                                 02000028
                    204:       WRITE (I02,90002)                                                 02010028
                    205:       WRITE (I02,90007)                                                 02020028
                    206:       WRITE (I02,90002)                                                 02030028
                    207:       WRITE (I02,90008)  IVFAIL                                         02040028
                    208:       WRITE (I02,90009) IVPASS                                          02050028
                    209:       WRITE (I02,90010) IVDELE                                          02060028
                    210: C                                                                       02070028
                    211: C                                                                       02080028
                    212: C     TERMINATE ROUTINE EXECUTION                                       02090028
                    213:       STOP                                                              02100028
                    214: C                                                                       02110028
                    215: C     FORMAT STATEMENTS FOR PAGE HEADERS                                02120028
                    216: 90000 FORMAT (1H1)                                                      02130028
                    217: 90002 FORMAT (1H )                                                      02140028
                    218: 90001 FORMAT (1H ,10X,34HFORTRAN COMPILER VALIDATION SYSTEM)            02150028
                    219: 90003 FORMAT (1H ,21X,11HVERSION 1.0)                                   02160028
                    220: 90004 FORMAT (1H ,10X,38HFOR OFFICIAL USE ONLY - COPYRIGHT 1978)        02170028
                    221: 90005 FORMAT (1H ,5X,4HTEST,5X,9HPASS/FAIL, 5X,8HCOMPUTED,8X,7HCORRECT) 02180028
                    222: 90006 FORMAT (1H ,5X,46H----------------------------------------------) 02190028
                    223: 90011 FORMAT (1H ,18X,17HSUBSET LEVEL TEST)                             02200028
                    224: C                                                                       02210028
                    225: C     FORMAT STATEMENTS FOR RUN SUMMARIES                               02220028
                    226: 90008 FORMAT (1H ,15X,I5,19H ERRORS ENCOUNTERED)                        02230028
                    227: 90009 FORMAT (1H ,15X,I5,13H TESTS PASSED)                              02240028
                    228: 90010 FORMAT (1H ,15X,I5,14H TESTS DELETED)                             02250028
                    229: C                                                                       02260028
                    230: C     FORMAT STATEMENTS FOR TEST RESULTS                                02270028
                    231: 80001 FORMAT (1H ,4X,I5,7X,4HPASS)                                      02280028
                    232: 80002 FORMAT (1H ,4X,I5,7X,4HFAIL)                                      02290028
                    233: 80003 FORMAT (1H ,4X,I5,7X,7HDELETED)                                   02300028
                    234: 80004 FORMAT (1H ,4X,I5,7X,4HFAIL,10X,I6,9X,I6)                         02310028
                    235: 80005 FORMAT (1H ,4X,I5,7X,4HFAIL,4X,E12.5,3X,E12.5)                    02320028
                    236: C                                                                       02330028
                    237: 90007 FORMAT (1H ,20X,20HEND OF PROGRAM FM028)                          02340028
                    238:       END                                                               02350028
                    239:       INTEGER FUNCTION FF029(IVON01)                                    00010029
                    240: C     DATE***82/08/02*18.33.46
                    241: C     OWNER  PRE/850703/TC-85-   -410/    /FSTC/278FCVS*F78UBP20/
                    242: C     AUDIT  FCVS78 V2.0
                    243: C                                                                       00020029
                    244: C     COMMENT SECTION                                                   00030029
                    245: C     FF029                                                             00040029
                    246: C                                                                       00050029
                    247: C         THIS FUNCTION SUBPROGRAM IS CALLED BY THE MAIN PROGRAM FM028. 00060029
                    248: C     THE FUNCTION ARGUMENT IS INCREMENTED BY 1 AND CONTROL RETURNED    00070029
                    249: C     TO THE CALLING PROGRAM.                                           00080029
                    250: C                                                                       00090029
                    251: C      REFERENCES                                                       00100029
                    252: C        AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN,       00110029
                    253: C              X3.9-1978                                                00120029
                    254: C                                                                       00130029
                    255: C        SECTION 15.5.1, DEFINING FUNCTION SUBPROGRAMS AND FUNCTION     00140029
                    256: C                        STATEMENTS                                     00150029
                    257: C        SECTION 15.8, RETURN STATEMENT                                 00160029
                    258: C                                                                       00170029
                    259: C     TEST SECTION                                                      00180029
                    260: C                                                                       00190029
                    261: C          FUNCTION SUBPROGRAM                                          00200029
                    262: C                                                                       00210029
                    263: C     INCREMENT ARGUMENT BY 1 AND RETURN TO CALLING PROGRAM.            00220029
                    264: C                                                                       00230029
                    265:       IVON02 = IVON01                                                   00240029
                    266:       FF029  = IVON02 + 1                                               00250029
                    267:       IVON02 = 500                                                      00260029
                    268:       RETURN                                                            00270029
                    269:       END                                                               00280029

unix.superglobalmegacorp.com

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