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

1.1       root        1:       PROGRAM FM509                                                     00010509
                      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                                                                       00020509
                      6: C     THIS ROUTINE TESTS SUBROUTINE SUBPROGRAMS AND        ANS REF.     00030509
                      7: C        FUNCTION SUBPROGRAMS WITH MULTIPLE ENTRIES.       15.6.1       00040509
                      8: C        THIS ROUTINE ALSO TESTS THE USE OF SYMBOLIC       15.7, 15.7.1 00050509
                      9: C        NAMES OF CONSTANTS, SUBSTRINGS NAMES, AND         15.9.2       00060509
                     10: C        ARRAY ELEMENT SUBSTRINGS AS ARGUMENTS.            15.9.3.2     00070509
                     11: C                                                          15.9.3.3     00080509
                     12: C     THIS ROUTINE USES THE SUBROUTINE SUBPROGRAMS SN510,               00090509
                     13: C     SN511, AND SN512, AND THE FUNCTION SUBPROGRAM RF513.              00100509
                     14: C                                                                       00110509
                     15: CBB** ********************** BBCCOMNT **********************************00120509
                     16: C****                                                                   00130509
                     17: C****            1978 FORTRAN COMPILER VALIDATION SYSTEM                00140509
                     18: C****                          VERSION 2.0                              00150509
                     19: C****                                                                   00160509
                     20: C****                                                                   00170509
                     21: C****           SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO         00180509
                     22: C****                   GENERAL SERVICES ADMINISTRATION                 00190509
                     23: C****                   FEDERAL SOFTWARE TESTING CENTER                 00200509
                     24: C****                   5203 LEESBURG PIKE, SUITE 1100                  00210509
                     25: C****                      FALLS CHURCH, VA. 22041                      00220509
                     26: C****                                                                   00230509
                     27: C****                          (703) 756-6153                           00240509
                     28: C****                                                                   00250509
                     29: CBE** ********************** BBCCOMNT **********************************00260509
                     30:            IMPLICIT DOUBLE PRECISION (D), COMPLEX (Z), LOGICAL (L)      00270509
                     31:            IMPLICIT CHARACTER*27 (C)                                    00280509
                     32: CBB** ********************** BBCINITA **********************************00290509
                     33: C**** SPECIFICATION STATEMENTS                                          00300509
                     34: C****                                                                   00310509
                     35:       CHARACTER ZVERS*13, ZVERSD*17, ZDATE*17, ZPROG*5, ZCOMPL*20,      00320509
                     36:      1          ZNAME*20, ZTAPE*10, ZPROJ*13, REMRKS*31, ZTAPED*13      00330509
                     37: CBE** ********************** BBCINITA **********************************00340509
                     38: C                                                                       00350509
                     39:       INTEGER I2N001(2,2)                                               00360509
                     40:       CHARACTER CVCOMP*12,CVCORR*12,CVN001*30                           00370509
                     41:       CHARACTER C1N001(6)*10                                            00380509
                     42:       PARAMETER (IPN001=31)                                             00390509
                     43:       COMMON IVC001, IVC002, IVC003                                     00400509
                     44:       EXTERNAL RF513                                                    00410509
                     45:       DATA I2N001 /1, 3, 5, 7/                                          00420509
                     46:       DATA CVN001 /'REDORANGEYELLOWGREENBLUEVIOLET'/                    00430509
                     47:       DATA C1N001 /'FIRST-AID:','SECONDRATE','THIRD-TERM',              00440509
                     48:      1             'FOURTH-DAY','FIFTHROUND','SIXTHMONTH'/              00450509
                     49: C                                                                       00460509
                     50: C                                                                       00470509
                     51: CBB** ********************** BBCINITB **********************************00480509
                     52: C**** INITIALIZE SECTION                                                00490509
                     53:       DATA  ZVERS,                  ZVERSD,             ZDATE           00500509
                     54:      1      /'VERSION 2.0  ',  '82/08/02*18.33.46',  '*NO DATE*TIME'/   00510509
                     55:       DATA       ZCOMPL,             ZNAME,             ZTAPE           00520509
                     56:      1      /'*NONE SPECIFIED*', '*NO COMPANY NAME*', '*NO TAPE*'/      00530509
                     57:       DATA       ZPROJ,           ZTAPED,         ZPROG                 00540509
                     58:      1      /'*NO PROJECT*',   '*NO TAPE DATE',  'XXXXX'/               00550509
                     59:       DATA   REMRKS /'                               '/                 00560509
                     60: C**** THE FOLLOWING 9 COMMENT LINES (CZ01, CZ02, ...) CAN BE REPLACED   00570509
                     61: C**** FOR IDENTIFYING THE TEST ENVIRONMENT                              00580509
                     62: C****                                                                   00590509
                     63: CZ01  ZVERS  = 'VERSION OF THE COMPILER VALIDATION SYSTEM'              00600509
                     64: CZ02  ZVERSD = 'CREATION DATE/TIME OF THE COMPILER VALIDATION SYSTEM'   00610509
                     65: CZ03  ZPROG  = 'PROGRAM NAME'                                           00620509
                     66:       ZDATE  = '07-Nov-85        '                                           *RP
                     67:       ZCOMPL = 'CCI 5.2             '                                        *RP
                     68:       ZPROJ  = 'TC-85-   -410'                                               *RP
                     69:       ZNAME  = '                    '                                        *RP
                     70:       ZTAPE  = '          '                                                  *RP
                     71:       ZTAPED = '850703       '                                               *RP
                     72: C                                                                       00690509
                     73:       IVPASS = 0                                                        00700509
                     74:       IVFAIL = 0                                                        00710509
                     75:       IVDELE = 0                                                        00720509
                     76:       IVINSP = 0                                                        00730509
                     77:       IVTOTL = 0                                                        00740509
                     78:       IVTOTN = 0                                                        00750509
                     79:       ICZERO = 0                                                        00760509
                     80: C                                                                       00770509
                     81: C     I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER.         00780509
                     82:       I01 = 05                                                          00790509
                     83: C     I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER.             00800509
                     84:       I02 = 06                                                          00810509
                     85: C                                                                       00820509
                     86:       I01 = 5                                                           00830509
                     87: C     THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5      00840509
                     88: CX011   REPLACED BY FEXEC X-011 CONTROL CARD.  CX011 IS FOR SYSTEMS     00850509
                     89: C     REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX010.  00860509
                     90: C                                                                       00870509
                     91:       I02 = 6                                                           00880509
                     92: C     THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02= 6       00890509
                     93: CX021   REPLACED BY FEXEC X-021 CONTROL CARD.  CX021 IS FOR SYSTEMS     00900509
                     94: C     REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX020.  00910509
                     95: C                                                                       00920509
                     96: CBE** ********************** BBCINITB **********************************00930509
                     97:            ZPROG = 'FM509'                                              00940509
                     98:            IVTOTL = 16                                                  00950509
                     99: CBB** ********************** BBCHED0A **********************************00960509
                    100: C****                                                                   00970509
                    101: C**** WRITE REPORT TITLE                                                00980509
                    102: C****                                                                   00990509
                    103:       WRITE (I02, 90002)                                                01000509
                    104:       WRITE (I02, 90006)                                                01010509
                    105:       WRITE (I02, 90007)                                                01020509
                    106:       WRITE (I02, 90008)  ZVERS, ZVERSD                                 01030509
                    107:       WRITE (I02, 90009)  ZPROG, ZPROG                                  01040509
                    108:       WRITE (I02, 90010)  ZDATE, ZCOMPL                                 01050509
                    109: CBE** ********************** BBCHED0A **********************************01060509
                    110: CBB** ********************** BBCHED0B **********************************01070509
                    111: C**** WRITE DETAIL REPORT HEADERS                                       01080509
                    112: C****                                                                   01090509
                    113:       WRITE (I02,90004)                                                 01100509
                    114:       WRITE (I02,90004)                                                 01110509
                    115:       WRITE (I02,90013)                                                 01120509
                    116:       WRITE (I02,90014)                                                 01130509
                    117:       WRITE (I02,90015) IVTOTL                                          01140509
                    118: CBE** ********************** BBCHED0B **********************************01150509
                    119: C                                                                       01160509
                    120: CT001*  TEST 001   ****  FCVS PROGRAM 509  ****                         01170509
                    121: C     SUBROUTINE WITH MULTIPLE ENTRIES                                  01180509
                    122: C                                                                       01190509
                    123:            IVTNUM = 1                                                   01200509
                    124:            IVCOMP = 0                                                   01210509
                    125:            IVCORR =    25                                               01220509
                    126:            IVD020=3                                                     01220*TI
                    127:       CALL SN510(IVD020,IVN001)                                         01230*TI
                    128:       CALL EN851(IVN001,IVCOMP)                                         01240509
                    129: 40010      IF (IVCOMP -    25) 20010, 10010, 20010                      01250509
                    130: 10010      IVPASS = IVPASS + 1                                          01260509
                    131:            WRITE (I02,80002) IVTNUM                                     01270509
                    132:            GO TO 0011                                                   01280509
                    133: 20010      IVFAIL = IVFAIL + 1                                          01290509
                    134:            WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR                     01300509
                    135:  0011      CONTINUE                                                     01310509
                    136: C                                                                       01320509
                    137: CT002*  TEST 002   ****  FCVS PROGRAM 509  ****                         01330509
                    138: C     ENTRY WITH ONE ARGUMENT                                           01340509
                    139: C                                                                       01350509
                    140:            IVTNUM = 2                                                   01360509
                    141:            IVCOMP = 0                                                   01370509
                    142:            IVCORR =   137                                               01380509
                    143:       IVN001 = 37                                                       01390509
                    144:       CALL EN852(IVN001)                                                01400509
                    145:       IVCOMP = IVN001                                                   01410509
                    146: 40020      IF (IVCOMP -   137) 20020, 10020, 20020                      01420509
                    147: 10020      IVPASS = IVPASS + 1                                          01430509
                    148:            WRITE (I02,80002) IVTNUM                                     01440509
                    149:            GO TO 0021                                                   01450509
                    150: 20020      IVFAIL = IVFAIL + 1                                          01460509
                    151:            WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR                     01470509
                    152:  0021      CONTINUE                                                     01480509
                    153: C                                                                       01490509
                    154: CT003*  TEST 003   ****  FCVS PROGRAM 509  ****                         01500509
                    155: C     ENTRY WITH TWO ARGUMENT                                           01510509
                    156: C                                                                       01520509
                    157:            IVTNUM = 3                                                   01530509
                    158:            IVCOMP = 0                                                   01540509
                    159:            IVCORR =   -51                                               01550509
                    160:       CALL EN853(-9,IVCOMP)                                             01560509
                    161: 40030      IF (IVCOMP +    51) 20030, 10030, 20030                      01570509
                    162: 10030      IVPASS = IVPASS + 1                                          01580509
                    163:            WRITE (I02,80002) IVTNUM                                     01590509
                    164:            GO TO 0031                                                   01600509
                    165: 20030      IVFAIL = IVFAIL + 1                                          01610509
                    166:            WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR                     01620509
                    167:  0031      CONTINUE                                                     01630509
                    168: C                                                                       01640509
                    169: CT004*  TEST 004   ****  FCVS PROGRAM 509  ****                         01650509
                    170: C     ENTRY WITH THREE ARGUMENTS                                        01660509
                    171: C                                                                       01670509
                    172:            IVTNUM = 4                                                   01680509
                    173:            IVCOMP = 0                                                   01690509
                    174:            IVCORR =   -71                                               01700509
                    175:       CALL EN854(275,147,IVCOMP)                                        01710509
                    176: 40040      IF (IVCOMP +    71) 20040, 10040, 20040                      01720509
                    177: 10040      IVPASS = IVPASS + 1                                          01730509
                    178:            WRITE (I02,80002) IVTNUM                                     01740509
                    179:            GO TO 0041                                                   01750509
                    180: 20040      IVFAIL = IVFAIL + 1                                          01760509
                    181:            WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR                     01770509
                    182:  0041      CONTINUE                                                     01780509
                    183: C                                                                       01790509
                    184: CT005*  TEST 005   ****  FCVS PROGRAM 509  ****                         01800509
                    185: C     ENTRY WITH FOUR ARGUMENTS                                         01810509
                    186: C                                                                       01820509
                    187:            IVTNUM = 5                                                   01830509
                    188:            IVCOMP = 0                                                   01840509
                    189:            IVCORR =   567                                               01850509
                    190:       CALL EN855(12,-15,63,IVCOMP)                                      01860509
                    191: 40050      IF (IVCOMP -   567) 20050, 10050, 20050                      01870509
                    192: 10050      IVPASS = IVPASS + 1                                          01880509
                    193:            WRITE (I02,80002) IVTNUM                                     01890509
                    194:            GO TO 0051                                                   01900509
                    195: 20050      IVFAIL = IVFAIL + 1                                          01910509
                    196:            WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR                     01920509
                    197:  0051      CONTINUE                                                     01930509
                    198: C                                                                       01940509
                    199: CT006*  TEST 006   ****  FCVS PROGRAM 509  ****                         01950509
                    200: C     ENTRY WITH ARRAY AS DUMMY ARGUMENT                                01960509
                    201: C                                                                       01970509
                    202:            IVTNUM = 6                                                   01980509
                    203:            IVCOMP = 0                                                   01990509
                    204:            IVCORR =    16                                               02000509
                    205:       IVN001 = 2                                                        02010509
                    206:       CALL EN856(IVN001,I2N001,IVCOMP)                                  02020509
                    207: 40060      IF (IVCOMP -    16) 20060, 10060, 20060                      02030509
                    208: 10060      IVPASS = IVPASS + 1                                          02040509
                    209:            WRITE (I02,80002) IVTNUM                                     02050509
                    210:            GO TO 0061                                                   02060509
                    211: 20060      IVFAIL = IVFAIL + 1                                          02070509
                    212:            WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR                     02080509
                    213:  0061      CONTINUE                                                     02090509
                    214: C                                                                       02100509
                    215: CT007*  TEST 007   ****  FCVS PROGRAM 509  ****                         02110509
                    216: C     ENTRY WITH PROCEDURE AS DUMMY ARGUMENT                            02120509
                    217: C                                                                       02130509
                    218:            IVTNUM = 7                                                   02140509
                    219:            RVCOMP = 0.0                                                 02150509
                    220:            RVCORR = 2.25                                                02160509
                    221:       CALL EN857(1.5,RVCOMP,RF513)                                      02170509
                    222:            IF (RVCOMP - 0.22498E+01) 20070, 10070, 40070                02180509
                    223: 40070      IF (RVCOMP - 0.22502E+01) 10070, 10070, 20070                02190509
                    224: 10070      IVPASS = IVPASS + 1                                          02200509
                    225:            WRITE (I02,80002) IVTNUM                                     02210509
                    226:            GO TO 0071                                                   02220509
                    227: 20070      IVFAIL = IVFAIL + 1                                          02230509
                    228:            WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR                     02240509
                    229:  0071      CONTINUE                                                     02250509
                    230: C                                                                       02260509
                    231: CT008*  TEST 008   ****  FCVS PROGRAM 509  ****                         02270509
                    232: C     ENTRY WITH ASTERISK AS DUMMY ARGUMENT                             02280509
                    233: C                                                                       02290509
                    234:            IVTNUM = 8                                                   02300509
                    235:            IVCOMP = 0                                                   02310509
                    236:            IVCORR =    19                                               02320509
                    237:       IVN001 = 2                                                        02330509
                    238:       CALL EN858(IVN001,*0082,*0083)                                    02340509
                    239: 0082  IVCOMP = 5                                                        02350509
                    240:       GO TO 0084                                                        02360509
                    241: 0083  IVCOMP = 19                                                       02370509
                    242: 0084  CONTINUE                                                          02380509
                    243: 40080      IF (IVCOMP -    19) 20080, 10080, 20080                      02390509
                    244: 10080      IVPASS = IVPASS + 1                                          02400509
                    245:            WRITE (I02,80002) IVTNUM                                     02410509
                    246:            GO TO 0081                                                   02420509
                    247: 20080      IVFAIL = IVFAIL + 1                                          02430509
                    248:            WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR                     02440509
                    249:  0081      CONTINUE                                                     02450509
                    250: C                                                                       02460509
                    251: C     TESTS 9 AND 10 TEST ENTRY WITHOUT ARGUMENTS                       02470509
                    252: C                                                                       02480509
                    253: CT009*  TEST 009   ****  FCVS PROGRAM 509  ****                         02490509
                    254: C                                                                       02500509
                    255:            IVTNUM = 9                                                   02510509
                    256:            IVCOMP = 0                                                   02520509
                    257:            IVCORR =    88                                               02530509
                    258:       IVC002 = 65                                                       02540509
                    259:       IVC003 = 23                                                       02550509
                    260:       CALL EN859( )                                                     02560509
                    261:       IVCOMP = IVC001                                                   02570509
                    262: 40090      IF (IVCOMP -    88) 20090, 10090, 20090                      02580509
                    263: 10090      IVPASS = IVPASS + 1                                          02590509
                    264:            WRITE (I02,80002) IVTNUM                                     02600509
                    265:            GO TO 0091                                                   02610509
                    266: 20090      IVFAIL = IVFAIL + 1                                          02620509
                    267:            WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR                     02630509
                    268:  0091      CONTINUE                                                     02640509
                    269: C                                                                       02650509
                    270: CT010*  TEST 010   ****  FCVS PROGRAM 509  ****                         02660509
                    271: C                                                                       02670509
                    272:            IVTNUM = 10                                                  02680509
                    273:            IVCOMP = 0                                                   02690509
                    274:            IVCORR =   -13                                               02700509
                    275:       IVC001 = 4                                                        02710509
                    276:       IVC002 = -17                                                      02720509
                    277:       CALL EN860                                                        02730509
                    278:       IVCOMP = IVC003                                                   02740509
                    279: 40100      IF (IVCOMP +    13) 20100, 10100, 20100                      02750509
                    280: 10100      IVPASS = IVPASS + 1                                          02760509
                    281:            WRITE (I02,80002) IVTNUM                                     02770509
                    282:            GO TO 0101                                                   02780509
                    283: 20100      IVFAIL = IVFAIL + 1                                          02790509
                    284:            WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR                     02800509
                    285:  0101      CONTINUE                                                     02810509
                    286: C                                                                       02820509
                    287: CT011*  TEST 011   ****  FCVS PROGRAM 509  ****                         02830509
                    288: C     FUNCTION SUBPROGRAM WITH MULTIPLE ENTRIES                         02840509
                    289: C                                                                       02850509
                    290:            IVTNUM = 11                                                  02860509
                    291:            RVCOMP = 0.0                                                 02870509
                    292:            RVCORR = 3.675E-3                                            02880509
                    293:       RVN001 = RF513(3.5E-2)                                            02890509
                    294:       RVCOMP = EF852(RVN001)                                            02900509
                    295:            IF (RVCOMP - 0.36748E-02) 20110, 10110, 40110                02910509
                    296: 40110      IF (RVCOMP - 0.36752E-02) 10110, 10110, 20110                02920509
                    297: 10110      IVPASS = IVPASS + 1                                          02930509
                    298:            WRITE (I02,80002) IVTNUM                                     02940509
                    299:            GO TO 0111                                                   02950509
                    300: 20110      IVFAIL = IVFAIL + 1                                          02960509
                    301:            WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR                     02970509
                    302:  0111      CONTINUE                                                     02980509
                    303: C                                                                       02990509
                    304: CT012*  TEST 012   ****  FCVS PROGRAM 509  ****                         03000509
                    305: C     SYMBOLIC NAME OF A CONSTANT AS AN ACTUAL ARGUMENT                 03010509
                    306: C                                                                       03020509
                    307:            IVTNUM = 12                                                  03030509
                    308:            IVCOMP = 0                                                   03040509
                    309:            IVCORR =    34                                               03050509
                    310:       CALL SN510(IPN001,IVCOMP)                                         03060509
                    311: 40120      IF (IVCOMP -    34) 20120, 10120, 20120                      03070509
                    312: 10120      IVPASS = IVPASS + 1                                          03080509
                    313:            WRITE (I02,80002) IVTNUM                                     03090509
                    314:            GO TO 0121                                                   03100509
                    315: 20120      IVFAIL = IVFAIL + 1                                          03110509
                    316:            WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR                     03120509
                    317:  0121      CONTINUE                                                     03130509
                    318: C                                                                       03140509
                    319: C     TESTS 13 AND 14 TEST THE USE OF A SUBSTRING AS AN ACTUAL ARGUMENT 03150509
                    320: C     WHICH IS ASSOCIATED WITH A DUMMY ARGUMENT THAT IS A VARIABLE      03160509
                    321: C                                                                       03170509
                    322: C                                                                       03180509
                    323: CT013*  TEST 013   ****  FCVS PROGRAM 509  ****                         03190509
                    324: C                                                                       03200509
                    325:            IVTNUM = 13                                                  03210509
                    326:            CVCOMP = ' '                                                 03220509
                    327:            CVCORR = 'COLOR=YELLOW                  '                    03230509
                    328:       CALL SN511(CVN001(10:15),CVCOMP)                                  03240509
                    329:            IVCOMP = 0                                                   03250509
                    330:            IF (CVCOMP.EQ.'COLOR=YELLOW                  ') IVCOMP = 1   03260509
                    331: 40130      IF (IVCOMP - 1) 20130, 10130, 20130                          03270509
                    332: 10130      IVPASS = IVPASS + 1                                          03280509
                    333:            WRITE (I02,80002) IVTNUM                                     03290509
                    334:            GO TO 0131                                                   03300509
                    335: 20130      IVFAIL = IVFAIL + 1                                          03310509
                    336:            WRITE (I02,80018) IVTNUM, CVCOMP, CVCORR                     03320509
                    337:  0131      CONTINUE                                                     03330509
                    338: C                                                                       03340509
                    339: CT014*  TEST 014   ****  FCVS PROGRAM 509  ****                         03350509
                    340: C                                                                       03360509
                    341:            IVTNUM = 14                                                  03370509
                    342:            CVCOMP = ' '                                                 03380509
                    343:            CVCORR = 'COLOR=VIOLET                  '                    03390509
                    344:       CALL SN511(CVN001(25:30),CVCOMP)                                  03400509
                    345:            IVCOMP = 0                                                   03410509
                    346:            IF (CVCOMP.EQ.'COLOR=VIOLET                  ') IVCOMP = 1   03420509
                    347: 40140      IF (IVCOMP - 1) 20140, 10140, 20140                          03430509
                    348: 10140      IVPASS = IVPASS + 1                                          03440509
                    349:            WRITE (I02,80002) IVTNUM                                     03450509
                    350:            GO TO 0141                                                   03460509
                    351: 20140      IVFAIL = IVFAIL + 1                                          03470509
                    352:            WRITE (I02,80018) IVTNUM, CVCOMP, CVCORR                     03480509
                    353:  0141      CONTINUE                                                     03490509
                    354: C                                                                       03500509
                    355: C     TESTS 15 AND 16 TEST THE USE OF AN ARRAY ELEMENT SUBSTRING AS AN  03510509
                    356: C     ACTUAL ARGUMENT WHICH IS ASSOCIATED WITH A DUMMY ARGUMENT THAT    03520509
                    357: C     IS AN ARRAY                                                       03530509
                    358: C                                                                       03540509
                    359: C                                                                       03550509
                    360: CT015*  TEST 015   ****  FCVS PROGRAM 509  ****                         03560509
                    361: C                                                                       03570509
                    362:            IVTNUM = 15                                                  03580509
                    363:            CVCOMP = ' '                                                 03590509
                    364:            CVCORR = 'RST-AID:                      '                    03600509
                    365:       CALL SN512(C1N001(1)(3:10),CVCOMP)                                03610509
                    366:            IVCOMP = 0                                                   03620509
                    367:            IF (CVCOMP.EQ.'RST-AID:                      ') IVCOMP = 1   03630509
                    368: 40150      IF (IVCOMP - 1) 20150, 10150, 20150                          03640509
                    369: 10150      IVPASS = IVPASS + 1                                          03650509
                    370:            WRITE (I02,80002) IVTNUM                                     03660509
                    371:            GO TO 0151                                                   03670509
                    372: 20150      IVFAIL = IVFAIL + 1                                          03680509
                    373:            WRITE (I02,80018) IVTNUM, CVCOMP, CVCORR                     03690509
                    374:  0151      CONTINUE                                                     03700509
                    375: C                                                                       03710509
                    376: CT016*  TEST 016   ****  FCVS PROGRAM 509  ****                         03720509
                    377: C                                                                       03730509
                    378:            IVTNUM = 16                                                  03740509
                    379:            CVCOMP = ' '                                                 03750509
                    380:            CVCORR = 'IFTHROUN                      '                    03760509
                    381:       CALL SN512(C1N001(5)(2:9),CVCOMP)                                 03770509
                    382:            IVCOMP = 0                                                   03780509
                    383:            IF (CVCOMP.EQ.'IFTHROUN                      ') IVCOMP = 1   03790509
                    384: 40160      IF (IVCOMP - 1) 20160, 10160, 20160                          03800509
                    385: 10160      IVPASS = IVPASS + 1                                          03810509
                    386:            WRITE (I02,80002) IVTNUM                                     03820509
                    387:            GO TO 0161                                                   03830509
                    388: 20160      IVFAIL = IVFAIL + 1                                          03840509
                    389:            WRITE (I02,80018) IVTNUM, CVCOMP, CVCORR                     03850509
                    390:  0161      CONTINUE                                                     03860509
                    391: C                                                                       03870509
                    392: CBB** ********************** BBCSUM0  **********************************03880509
                    393: C**** WRITE OUT TEST SUMMARY                                            03890509
                    394: C****                                                                   03900509
                    395:       IVTOTN = IVPASS + IVFAIL + IVDELE + IVINSP                        03910509
                    396:       WRITE (I02, 90004)                                                03920509
                    397:       WRITE (I02, 90014)                                                03930509
                    398:       WRITE (I02, 90004)                                                03940509
                    399:       WRITE (I02, 90020) IVPASS                                         03950509
                    400:       WRITE (I02, 90022) IVFAIL                                         03960509
                    401:       WRITE (I02, 90024) IVDELE                                         03970509
                    402:       WRITE (I02, 90026) IVINSP                                         03980509
                    403:       WRITE (I02, 90028) IVTOTN, IVTOTL                                 03990509
                    404: CBE** ********************** BBCSUM0  **********************************04000509
                    405: CBB** ********************** BBCFOOT0 **********************************04010509
                    406: C**** WRITE OUT REPORT FOOTINGS                                         04020509
                    407: C****                                                                   04030509
                    408:       WRITE (I02,90016) ZPROG, ZPROG                                    04040509
                    409:       WRITE (I02,90018) ZPROJ, ZNAME, ZTAPE, ZTAPED                     04050509
                    410:       WRITE (I02,90019)                                                 04060509
                    411: CBE** ********************** BBCFOOT0 **********************************04070509
                    412: 90001 FORMAT (1H ,56X,5HFM509)                                          04080509
                    413: 90000 FORMAT (1H ,50X,20HEND OF PROGRAM FM509)                          04090509
                    414: CBB** ********************** BBCFMT0A **********************************04100509
                    415: C**** FORMATS FOR TEST DETAIL LINES                                     04110509
                    416: C****                                                                   04120509
                    417: 80000 FORMAT (1H ,2X,I3,4X,7HDELETED,32X,A31)                           04130509
                    418: 80002 FORMAT (1H ,2X,I3,4X,7H PASS  ,32X,A31)                           04140509
                    419: 80004 FORMAT (1H ,2X,I3,4X,7HINSPECT,32X,A31)                           04150509
                    420: 80008 FORMAT (1H ,2X,I3,4X,7H FAIL  ,32X,A31)                           04160509
                    421: 80010 FORMAT (1H ,2X,I3,4X,7H FAIL  ,/,1H ,15X,10HCOMPUTED= ,           04170509
                    422:      1I6,/,1H ,15X,10HCORRECT=  ,I6)                                    04180509
                    423: 80012 FORMAT (1H ,2X,I3,4X,7H FAIL  ,/,1H ,16X,10HCOMPUTED= ,           04190509
                    424:      1E12.5,/,1H ,16X,10HCORRECT=  ,E12.5)                              04200509
                    425: 80018 FORMAT (1H ,2X,I3,4X,7H FAIL  ,/,1H ,16X,10HCOMPUTED= ,           04210509
                    426:      1A21,/,1H ,16X,10HCORRECT=  ,A21)                                  04220509
                    427: 80020 FORMAT (1H ,16X,10HCOMPUTED= ,A21,1X,A31)                         04230509
                    428: 80022 FORMAT (1H ,16X,10HCORRECT=  ,A21,1X,A31)                         04240509
                    429: 80024 FORMAT (1H ,16X,10HCOMPUTED= ,I6,16X,A31)                         04250509
                    430: 80026 FORMAT (1H ,16X,10HCORRECT=  ,I6,16X,A31)                         04260509
                    431: 80028 FORMAT (1H ,16X,10HCOMPUTED= ,E12.5,10X,A31)                      04270509
                    432: 80030 FORMAT (1H ,16X,10HCORRECT=  ,E12.5,10X,A31)                      04280509
                    433: 80050 FORMAT (1H ,48X,A31)                                              04290509
                    434: CBE** ********************** BBCFMT0A **********************************04300509
                    435: CBB** ********************** BBCFMAT1 **********************************04310509
                    436: C**** FORMATS FOR TEST DETAIL LINES - FULL LANGUAGE                     04320509
                    437: C****                                                                   04330509
                    438: 80031 FORMAT (1H ,2X,I3,4X,7H FAIL  ,/,1H ,16X,10HCOMPUTED= ,           04340509
                    439:      1D17.10,/,1H ,16X,10HCORRECT=  ,D17.10)                            04350509
                    440: 80033 FORMAT (1H ,16X,10HCOMPUTED= ,D17.10,10X,A31)                     04360509
                    441: 80035 FORMAT (1H ,16X,10HCORRECT=  ,D17.10,10X,A31)                     04370509
                    442: 80037 FORMAT (1H ,16X,10HCOMPUTED= ,1H(,E12.5,2H, ,E12.5,1H),6X,A31)    04380509
                    443: 80039 FORMAT (1H ,16X,10HCORRECT=  ,1H(,E12.5,2H, ,E12.5,1H),6X,A31)    04390509
                    444: 80041 FORMAT (1H ,16X,10HCOMPUTED= ,1H(,F12.5,2H, ,F12.5,1H),6X,A31)    04400509
                    445: 80043 FORMAT (1H ,16X,10HCORRECT=  ,1H(,F12.5,2H, ,F12.5,1H),6X,A31)    04410509
                    446: 80045 FORMAT (1H ,2X,I3,4X,7H FAIL  ,/,1H ,16X,10HCOMPUTED= ,           04420509
                    447:      11H(,F12.5,2H, ,F12.5,1H)/,1H ,16X,10HCORRECT=  ,                  04430509
                    448:      21H(,F12.5,2H, ,F12.5,1H))                                         04440509
                    449: CBE** ********************** BBCFMAT1 **********************************04450509
                    450: CBB** ********************** BBCFMT0B **********************************04460509
                    451: C**** FORMAT STATEMENTS FOR PAGE HEADERS                                04470509
                    452: C****                                                                   04480509
                    453: 90002 FORMAT (1H1)                                                      04490509
                    454: 90004 FORMAT (1H )                                                      04500509
                    455: 90006 FORMAT (1H ,20X,31HFEDERAL SOFTWARE TESTING CENTER)               04510509
                    456: 90007 FORMAT (1H ,19X,34HFORTRAN COMPILER VALIDATION SYSTEM)            04520509
                    457: 90008 FORMAT (1H ,21X,A13,A17)                                          04530509
                    458: 90009 FORMAT (1H ,/,2H *,A5,6HBEGIN*,12X,15HTEST RESULTS - ,A5,/)       04540509
                    459: 90010 FORMAT (1H ,8X,16HTEST DATE*TIME= ,A17,15H  -  COMPILER= ,A20)    04550509
                    460: 90013 FORMAT (1H ,8H TEST   ,10HPASS/FAIL ,6X,17HDISPLAYED RESULTS,     04560509
                    461:      1       7X,7HREMARKS,24X)                                          04570509
                    462: 90014 FORMAT (1H ,46H----------------------------------------------,    04580509
                    463:      1        33H---------------------------------)                     04590509
                    464: 90015 FORMAT (1H ,48X,17HTHIS PROGRAM HAS ,I3,6H TESTS,/)               04600509
                    465: C****                                                                   04610509
                    466: C**** FORMAT STATEMENTS FOR REPORT FOOTINGS                             04620509
                    467: C****                                                                   04630509
                    468: 90016 FORMAT (1H ,/,2H *,A5,4HEND*,14X,14HEND OF TEST - ,A5,/)          04640509
                    469: 90018 FORMAT (1H ,A13,13X,A20,7H   *   ,A10,1H/,                        04650509
                    470:      1        A13)                                                      04660509
                    471: 90019 FORMAT (1H ,26HFOR OFFICIAL USE ONLY     ,35X,15HCOPYRIGHT  1982) 04670509
                    472: C****                                                                   04680509
                    473: C**** FORMAT STATEMENTS FOR RUN SUMMARY                                 04690509
                    474: C****                                                                   04700509
                    475: 90020 FORMAT (1H ,21X,I5,13H TESTS PASSED)                              04710509
                    476: 90022 FORMAT (1H ,21X,I5,13H TESTS FAILED)                              04720509
                    477: 90024 FORMAT (1H ,21X,I5,14H TESTS DELETED)                             04730509
                    478: 90026 FORMAT (1H ,21X,I5,25H TESTS REQUIRE INSPECTION)                  04740509
                    479: 90028 FORMAT (1H ,21X,I5,4H OF ,I3,15H TESTS EXECUTED)                  04750509
                    480: CBE** ********************** BBCFMT0B **********************************04760509
                    481:       STOP                                                              04770509
                    482:       END                                                               04780509
                    483: C                                                                       00010510
                    484: C     DATE***82/08/02*18.33.46
                    485: C     OWNER  PRE/850703/TC-85-   -410/    /FSTC/278FCVS*F78UBP20/
                    486: C     AUDIT  FCVS78 V2.0
                    487: C     THIS ROUTINE IS TO BE RUN WITH ROUTINE 509.                       00020510
                    488: C                                                                       00030510
                    489: C     THIS SUBROUTINE IS CALLED IN THE MAIN PROGRAM TO TEST IF          00040510
                    490: C           MULTIPLE ENTRIES ARE PERMITTED IN A SUBROUTINE SUBPROGRAM.  00050510
                    491: C                                                                       00060510
                    492:       SUBROUTINE SN510(IVD021,IVD002)                                   00070*TI
                    493:       INTEGER I2D001(2,2)                                               00080510
                    494:       COMMON IVC001, IVC002, IVC003                                     00090510
                    495:       IVD001 = IVD021                                                   00090*TI
                    496:       DO 70010 IVN001 = 1, 3                                            00100510
                    497:       IVD001 = IVD001 + 1                                               00110510
                    498: 70010 CONTINUE                                                          00120510
                    499:       IVD002 = IVD001                                                   00130510
                    500:       RETURN                                                            00140510
                    501:       ENTRY EN851(IVD003,IVD004)                                        00150510
                    502:       IVD004 = 3*IVD003 + 7                                             00160510
                    503:       RETURN                                                            00170510
                    504:       ENTRY EN852(IVD005)                                               00180510
                    505:       IVD005 = IVD005 + 100                                             00190510
                    506:       RETURN                                                            00200510
                    507:       ENTRY EN853(IVD006,IVD007)                                        00210510
                    508:       IVD007 = 5*(IVD006 + 2) - 16                                      00220510
                    509:       RETURN                                                            00230510
                    510:       ENTRY EN854(IVD008,IVD009,IVD010)                                 00240510
                    511:       IVD010 = 4*(IVD008 - 2*IVD009) + 5                                00250510
                    512:       RETURN                                                            00260510
                    513:       ENTRY EN855(IVD011, IVD012, IVD013, IVD014)                       00270510
                    514:       IVD014 = IVD013*(2*IVD011 + IVD012)                               00280510
                    515:       RETURN                                                            00290510
                    516:       ENTRY EN856(IVD015,I2D001,IVD016)                                 00300510
                    517:       IVD016 = 0                                                        00310510
                    518:       DO 70020 IVN001 = 1, IVD015                                       00320510
                    519:       DO 70020 IVN002 = 1, IVD015                                       00330510
                    520: 70020 IVD016 = IVD016 + I2D001(IVN001,IVN002)                           00340510
                    521:       RETURN                                                            00350510
                    522:       ENTRY EN857(RVD017,RVD018,RFD001)                                 00360510
                    523:       RVD018 = RFD001(RVD017)                                           00370510
                    524:       RETURN                                                            00380510
                    525:       ENTRY EN858(IVD019,*,*)                                           00390510
                    526:       RETURN IVD019                                                     00400510
                    527:       ENTRY EN859( )                                                    00410510
                    528:       IVC001 = IVC002 + IVC003                                          00420510
                    529:       RETURN                                                            00430510
                    530:       ENTRY EN860                                                       00440510
                    531:       IVC003 = IVC001 + IVC002                                          00450510
                    532:       RETURN                                                            00460510
                    533:       END                                                               00470510
                    534: C                                                                       00480510
                    535: C                                                                       00010511
                    536: C     DATE***82/08/02*18.33.46
                    537: C     OWNER  PRE/850703/TC-85-   -410/    /FSTC/278FCVS*F78UBP20/
                    538: C     AUDIT  FCVS78 V2.0
                    539: C     THIS ROUTINE IS TO BE RUN WITH ROUTINE 509.                       00020511
                    540: C                                                                       00030511
                    541: C     THIS SUBROUTINE IS CALLED IN THE MAIN PROGRAM TO TEST THE USE     00040511
                    542: C              OF A SUBSTRING NAME AS AN ACTUAL ARGUMENT WHICH IS       00050511
                    543: C              ASSOCIATED WITH A DUMMY ARGUMENT THAT IS A VARIBLE       00060511
                    544: C                                                                       00070511
                    545:       SUBROUTINE SN511(CVD001,CVD002)                                   00080511
                    546:       CHARACTER CVD001*6, CVD002*12                                     00090511
                    547:       CVD002 = 'COLOR='//CVD001                                         00100511
                    548:       RETURN                                                            00110511
                    549:       END                                                               00120511
                    550: C                                                                       00010512
                    551: C     DATE***82/08/02*18.33.46
                    552: C     OWNER  PRE/850703/TC-85-   -410/    /FSTC/278FCVS*F78UBP20/
                    553: C     AUDIT  FCVS78 V2.0
                    554: C     THIS ROUTINE IS TO BE RUN WIHT ROUTINE 509.                       00020512
                    555: C                                                                       00030512
                    556: C     THIS SUBROUTINE IS CALLED IN THE MAIN PROGRAM TO TEST THE USE OF  00040512
                    557: C            AN ARRAY ELEMENT SUBSTRING AS AN ACTUAL ARGUMENT WHICH     00050512
                    558: C            IS ASSOCIATED WITH A DUMMY ARGUMENT THAT IS AN ARRAY.      00060512
                    559: C                                                                       00070512
                    560:       SUBROUTINE SN512(C1D001,CVD001)                                   00080512
                    561:       CHARACTER C1D001(6)*8,CVD001*8                                    00090512
                    562:       CVD001 = C1D001(1)                                                00100512
                    563:       RETURN                                                            00110512
                    564:       END                                                               00120512
                    565: C                                                                       00010513
                    566: C     DATE***82/08/02*18.33.46
                    567: C     OWNER  PRE/850703/TC-85-   -410/    /FSTC/278FCVS*F78UBP20/
                    568: C     AUDIT  FCVS78 V2.0
                    569: C     THIS FUNCTION IS TO BE RUN WITH ROUTINE 509.                      00020513
                    570: C                                                                       00030513
                    571: C     THIS FUNCTION IS REFERENCED IN THE MAIN PROGRAM TO TEST IF        00040513
                    572: C          MULTIPLE ENTRIES ARE PERMITTED IN A FUNCTION SUBPROGRAM.     00050513
                    573: C                                                                       00060513
                    574:       FUNCTION RF513(RVD001)                                            00070513
                    575:       RF513 = RVD001**2                                                 00080513
                    576:       RETURN                                                            00090513
                    577:       ENTRY EF852(RVD002)                                               00100513
                    578:       EF852 = 3*RVD002                                                  00110513
                    579:       RETURN                                                            00120513
                    580:       END                                                               00130513

unix.superglobalmegacorp.com

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