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

1.1       root        1: C***********************************************************************00010805
                      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*****  FORTRAN 77                                                      00020805
                      6: C*****   FM805               YDDIM - (164)                              00030805
                      7: C*****                                                                  00040805
                      8: C***********************************************************************00050805
                      9: C*****  GENERAL PURPOSE                                         ANS REF 00060805
                     10: C*****    TEST INTRINSIC FUNCTION DDIM AND PROD--POSITIVE        15.3   00070805
                     11: C*****    DIFFERENCE AND DOUBLE PRECISION PRODUCT, RESP.       (TABLE 5)00080805
                     12: C*****                                                                  00090805
                     13: CBB** ********************** BBCCOMNT **********************************00100805
                     14: C****                                                                   00110805
                     15: C****            1978 FORTRAN COMPILER VALIDATION SYSTEM                00120805
                     16: C****                          VERSION 2.0                              00130805
                     17: C****                                                                   00140805
                     18: C****                                                                   00150805
                     19: C****           SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO         00160805
                     20: C****                   GENERAL SERVICES ADMINISTRATION                 00170805
                     21: C****                   FEDERAL SOFTWARE TESTING CENTER                 00180805
                     22: C****                   5203 LEESBURG PIKE, SUITE 1100                  00190805
                     23: C****                      FALLS CHURCH, VA. 22041                      00200805
                     24: C****                                                                   00210805
                     25: C****                          (703) 756-6153                           00220805
                     26: C****                                                                   00230805
                     27: CBE** ********************** BBCCOMNT **********************************00240805
                     28: C*****                                                                  00250805
                     29: C*****     S P E C I F I C A T I O N S  SEGMENT 164                     00260805
                     30:         DOUBLE PRECISION DSAVD, DSBVD, DSDVD, DSEVD, DVCORR             00270805
                     31: C*****                                                                  00280805
                     32: CBB** ********************** BBCINITA **********************************00290805
                     33: C**** SPECIFICATION STATEMENTS                                          00300805
                     34: C****                                                                   00310805
                     35:       CHARACTER ZVERS*13, ZVERSD*17, ZDATE*17, ZPROG*5, ZCOMPL*20,      00320805
                     36:      1          ZNAME*20, ZTAPE*10, ZPROJ*13, REMRKS*31, ZTAPED*13      00330805
                     37: CBE** ********************** BBCINITA **********************************00340805
                     38: CBB** ********************** BBCINITB **********************************00350805
                     39: C**** INITIALIZE SECTION                                                00360805
                     40:       DATA  ZVERS,                  ZVERSD,             ZDATE           00370805
                     41:      1      /'VERSION 2.0  ',  '82/08/02*18.33.46',  '*NO DATE*TIME'/   00380805
                     42:       DATA       ZCOMPL,             ZNAME,             ZTAPE           00390805
                     43:      1      /'*NONE SPECIFIED*', '*NO COMPANY NAME*', '*NO TAPE*'/      00400805
                     44:       DATA       ZPROJ,           ZTAPED,         ZPROG                 00410805
                     45:      1      /'*NO PROJECT*',   '*NO TAPE DATE',  'XXXXX'/               00420805
                     46:       DATA   REMRKS /'                               '/                 00430805
                     47: C**** THE FOLLOWING 9 COMMENT LINES (CZ01, CZ02, ...) CAN BE REPLACED   00440805
                     48: C**** FOR IDENTIFYING THE TEST ENVIRONMENT                              00450805
                     49: C****                                                                   00460805
                     50: CZ01  ZVERS  = 'VERSION OF THE COMPILER VALIDATION SYSTEM'              00470805
                     51: CZ02  ZVERSD = 'CREATION DATE/TIME OF THE COMPILER VALIDATION SYSTEM'   00480805
                     52: CZ03  ZPROG  = 'PROGRAM NAME'                                           00490805
                     53:       ZDATE  = '07-Nov-85        '                                           *RP
                     54:       ZCOMPL = 'CCI 5.2             '                                        *RP
                     55:       ZPROJ  = 'TC-85-   -410'                                               *RP
                     56:       ZNAME  = '                    '                                        *RP
                     57:       ZTAPE  = '          '                                                  *RP
                     58:       ZTAPED = '850703       '                                               *RP
                     59: C                                                                       00560805
                     60:       IVPASS = 0                                                        00570805
                     61:       IVFAIL = 0                                                        00580805
                     62:       IVDELE = 0                                                        00590805
                     63:       IVINSP = 0                                                        00600805
                     64:       IVTOTL = 0                                                        00610805
                     65:       IVTOTN = 0                                                        00620805
                     66:       ICZERO = 0                                                        00630805
                     67: C                                                                       00640805
                     68: C     I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER.         00650805
                     69:       I01 = 05                                                          00660805
                     70: C     I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER.             00670805
                     71:       I02 = 06                                                          00680805
                     72: C                                                                       00690805
                     73:       I01 = 5                                                           00700805
                     74: C     THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5      00710805
                     75: CX011   REPLACED BY FEXEC X-011 CONTROL CARD.  CX011 IS FOR SYSTEMS     00720805
                     76: C     REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX010.  00730805
                     77: C                                                                       00740805
                     78:       I02 = 6                                                           00750805
                     79: C     THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02= 6       00760805
                     80: CX021   REPLACED BY FEXEC X-021 CONTROL CARD.  CX021 IS FOR SYSTEMS     00770805
                     81: C     REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX020.  00780805
                     82: C                                                                       00790805
                     83: CBE** ********************** BBCINITB **********************************00800805
                     84:       NUVI = I02                                                        00810805
                     85:       IVTOTL = 18                                                       00820805
                     86:       ZPROG = 'FM805'                                                   00830805
                     87: CBB** ********************** BBCHED0A **********************************00840805
                     88: C****                                                                   00850805
                     89: C**** WRITE REPORT TITLE                                                00860805
                     90: C****                                                                   00870805
                     91:       WRITE (I02, 90002)                                                00880805
                     92:       WRITE (I02, 90006)                                                00890805
                     93:       WRITE (I02, 90007)                                                00900805
                     94:       WRITE (I02, 90008)  ZVERS, ZVERSD                                 00910805
                     95:       WRITE (I02, 90009)  ZPROG, ZPROG                                  00920805
                     96:       WRITE (I02, 90010)  ZDATE, ZCOMPL                                 00930805
                     97: CBE** ********************** BBCHED0A **********************************00940805
                     98: C*****                                                                  00950805
                     99: C*****    HEADER FOR SEGMENT 164                                        00960805
                    100:         WRITE (NUVI,16401)                                              00970805
                    101: 16401   FORMAT (1H ,// 1X,36HYDDIM - (164) INTRINSIC FUNCTIONS-- //16X, 00980805
                    102:      1          26HDDIM (POSITIVE DIFFERENCE)/,16X,                     00990805
                    103:      2          20HDPROD (D.P. PRODUCT)//                               01000805
                    104:      3          2X,15HANS REF. - 15.3)                                  01010805
                    105: CBB** ********************** BBCHED0B **********************************01020805
                    106: C**** WRITE DETAIL REPORT HEADERS                                       01030805
                    107: C****                                                                   01040805
                    108:       WRITE (I02,90004)                                                 01050805
                    109:       WRITE (I02,90004)                                                 01060805
                    110:       WRITE (I02,90013)                                                 01070805
                    111:       WRITE (I02,90014)                                                 01080805
                    112:       WRITE (I02,90015) IVTOTL                                          01090805
                    113: CBE** ********************** BBCHED0B **********************************01100805
                    114: C*****                                                                  01110805
                    115: C*****    TEST OF DDIM                                                  01120805
                    116: C*****                                                                  01130805
                    117:         WRITE(NUVI, 16402)                                              01140805
                    118: 16402   FORMAT(/ 8X, 12HTEST OF DDIM)                                   01150805
                    119: CT001*  TEST 1                                        BOTH VALUES EQUAL 01160805
                    120:            IVTNUM = 1                                                   01170805
                    121:         DSBVD = 0.25D0                                                  01180805
                    122:         DSDVD = 0.25D0                                                  01190805
                    123:         DSAVD = DDIM(DSBVD, DSDVD)                                      01200805
                    124:            IF (DSAVD + 5.0D-10) 20010, 10010, 40010                     01210805
                    125: 40010      IF (DSAVD - 5.0D-10) 10010, 10010, 20010                     01220805
                    126: 10010      IVPASS = IVPASS + 1                                          01230805
                    127:            WRITE (NUVI, 80002) IVTNUM                                   01240805
                    128:            GO TO 0011                                                   01250805
                    129: 20010      IVFAIL = IVFAIL + 1                                          01260805
                    130:            DVCORR = 0.0D0                                               01270805
                    131:            WRITE (NUVI, 80031) IVTNUM, DSAVD, DVCORR                    01280805
                    132:  0011      CONTINUE                                                     01290805
                    133: CT002*  TEST 2                       BOTH VALUES EQUAL, INTEGRAL VALUES 01300805
                    134:            IVTNUM = 2                                                   01310805
                    135:         DSBVD = 2.0D0                                                   01320805
                    136:         DSDVD = 2.0D0                                                   01330805
                    137:         DSAVD = DDIM(DSBVD, DSDVD)                                      01340805
                    138:            IF (DSAVD + 5.0D-10) 20020, 10020, 40020                     01350805
                    139: 40020      IF (DSAVD - 5.0D-10) 10020, 10020, 20020                     01360805
                    140: 10020      IVPASS = IVPASS + 1                                          01370805
                    141:            WRITE (NUVI, 80002) IVTNUM                                   01380805
                    142:            GO TO 0021                                                   01390805
                    143: 20020      IVFAIL = IVFAIL + 1                                          01400805
                    144:            DVCORR = 0.0D0                                               01410805
                    145:            WRITE (NUVI, 80031) IVTNUM, DSAVD, DVCORR                    01420805
                    146:  0021      CONTINUE                                                     01430805
                    147: CT003*  TEST 3                             FIRST VALUE LESS THAN SECOND 01440805
                    148:            IVTNUM = 3                                                   01450805
                    149:         DSBVD = 0.25D1                                                  01460805
                    150:         DSDVD = 0.55D1                                                  01470805
                    151:         DSAVD = DDIM(DSBVD, DSDVD)                                      01480805
                    152:            IF (DSAVD + 5.0D-10) 20030, 10030, 40030                     01490805
                    153: 40030      IF (DSAVD - 5.0D-10) 10030, 10030, 20030                     01500805
                    154: 10030      IVPASS = IVPASS + 1                                          01510805
                    155:            WRITE (NUVI, 80002) IVTNUM                                   01520805
                    156:            GO TO 0031                                                   01530805
                    157: 20030      IVFAIL = IVFAIL + 1                                          01540805
                    158:            DVCORR = 0.0D0                                               01550805
                    159:            WRITE (NUVI, 80031) IVTNUM, DSAVD, DVCORR                    01560805
                    160:  0031      CONTINUE                                                     01570805
                    161: CT004*  TEST 4                          FIRST VALUE GREATER THAN SECOND 01580805
                    162:            IVTNUM = 4                                                   01590805
                    163:         DSBVD = 0.55D1                                                  01600805
                    164:         DSDVD = 0.25D1                                                  01610805
                    165:         DSAVD = DDIM(DSBVD, DSDVD)                                      01620805
                    166:            IF (DSAVD - 2.999999998D0) 20040, 10040, 40040               01630805
                    167: 40040      IF (DSAVD - 3.000000002D0) 10040, 10040, 20040               01640805
                    168: 10040      IVPASS = IVPASS + 1                                          01650805
                    169:            WRITE (NUVI, 80002) IVTNUM                                   01660805
                    170:            GO TO 0041                                                   01670805
                    171: 20040      IVFAIL = IVFAIL + 1                                          01680805
                    172:            DVCORR = 3.0D0                                               01690805
                    173:            WRITE (NUVI, 80031) IVTNUM, DSAVD, DVCORR                    01700805
                    174:  0041      CONTINUE                                                     01710805
                    175: CT005*  TEST 5                         BOTH VALUES EQUAL, BOTH NEGATIVE 01720805
                    176:            IVTNUM = 5                                                   01730805
                    177:         DSBVD = -0.25D1                                                 01740805
                    178:         DSDVD = -0.25D1                                                 01750805
                    179:         DSAVD = DDIM(DSBVD, DSDVD)                                      01760805
                    180:            IF (DSAVD + 5.0D-10) 20050, 10050, 40050                     01770805
                    181: 40050      IF (DSAVD - 5.0D-10) 10050, 10050, 20050                     01780805
                    182: 10050      IVPASS = IVPASS + 1                                          01790805
                    183:            WRITE (NUVI, 80002) IVTNUM                                   01800805
                    184:            GO TO 0051                                                   01810805
                    185: 20050      IVFAIL = IVFAIL + 1                                          01820805
                    186:            DVCORR = 0.0D0                                               01830805
                    187:            WRITE (NUVI, 80031) IVTNUM, DSAVD, DVCORR                    01840805
                    188:  0051      CONTINUE                                                     01850805
                    189: CT006*  TEST 6           FIRST VALUE GREATER THAN SECOND, BOTH NEGATIVE 01860805
                    190:            IVTNUM = 6                                                   01870805
                    191:         DSBVD = -0.25D1                                                 01880805
                    192:         DSDVD = -0.55D1                                                 01890805
                    193:         DSAVD = DDIM(DSBVD, DSDVD)                                      01900805
                    194:            IF (DSAVD - 2.999999998D0) 20060, 10060, 40060               01910805
                    195: 40060      IF (DSAVD - 3.000000002D0) 10060, 10060, 20060               01920805
                    196: 10060      IVPASS = IVPASS + 1                                          01930805
                    197:            WRITE (NUVI, 80002) IVTNUM                                   01940805
                    198:            GO TO 0061                                                   01950805
                    199: 20060      IVFAIL = IVFAIL + 1                                          01960805
                    200:            DVCORR = 3.0D0                                               01970805
                    201:            WRITE (NUVI, 80031) IVTNUM, DSAVD, DVCORR                    01980805
                    202:  0061      CONTINUE                                                     01990805
                    203: CT007*  TEST 7                    FIRST VALUE POSITIVE, SECOND NEGATIVE 02000805
                    204:            IVTNUM = 7                                                   02010805
                    205:         DSBVD = 0.55D1                                                  02020805
                    206:         DSDVD = -0.25D1                                                 02030805
                    207:         DSAVD = DDIM(DSBVD, DSDVD)                                      02040805
                    208:            IF (DSAVD - 7.999999996D0) 20070, 10070, 40070               02050805
                    209: 40070      IF (DSAVD - 8.000000004D0) 10070, 10070, 20070               02060805
                    210: 10070      IVPASS = IVPASS + 1                                          02070805
                    211:            WRITE (NUVI, 80002) IVTNUM                                   02080805
                    212:            GO TO 0071                                                   02090805
                    213: 20070      IVFAIL = IVFAIL + 1                                          02100805
                    214:            DVCORR = 8.0D0                                               02110805
                    215:            WRITE (NUVI, 80031) IVTNUM, DSAVD, DVCORR                    02120805
                    216:  0071      CONTINUE                                                     02130805
                    217: CT008*  TEST 8                  ARITHMETIC EXPRESSION PRESENTED TO DDIM 02140805
                    218:            IVTNUM = 8                                                   02150805
                    219:         DSDVD = 0.25D1                                                  02160805
                    220:         DSEVD = 0.125D1                                                 02170805
                    221:         DSAVD = DDIM(DSDVD / DSEVD, DSDVD * DSEVD)                      02180805
                    222:            IF (DSAVD + 5.0D-10) 20080, 10080, 40080                     02190805
                    223: 40080      IF (DSAVD - 5.0D-10) 10080, 10080, 20080                     02200805
                    224: 10080      IVPASS = IVPASS + 1                                          02210805
                    225:            WRITE (NUVI, 80002) IVTNUM                                   02220805
                    226:            GO TO 0081                                                   02230805
                    227: 20080      IVFAIL = IVFAIL + 1                                          02240805
                    228:            DVCORR = 0.0D0                                               02250805
                    229:            WRITE (NUVI, 80031) IVTNUM, DSAVD, DVCORR                    02260805
                    230:  0081      CONTINUE                                                     02270805
                    231: C*****                                                                  02280805
                    232: C*****    TEST OF DPROD                                                 02290805
                    233: C*****                                                                  02300805
                    234:         WRITE(NUVI, 16404)                                              02310805
                    235:         REMRKS = '+ OR - 0.00005'                                       02320805
                    236: 16404   FORMAT(// 8X, 13HTEST OF DPROD)                                 02330805
                    237: CT009*  TEST 9                     PAIR OF VALUES, ONE OF WHICH IS ZERO 02340805
                    238:            IVTNUM = 9                                                   02350805
                    239:         RSAVS = 0.0                                                     02360805
                    240:         RSBVS = 2.0                                                     02370805
                    241:         DSAVD = DPROD(RSAVS, RSBVS)                                     02380805
                    242:            IF (DSAVD + 5.0D-5) 20090, 10090, 40090                      02390805
                    243: 40090      IF (DSAVD - 5.0D-5) 10090, 10090, 20090                      02400805
                    244: 10090      IVPASS = IVPASS + 1                                          02410805
                    245:            WRITE (NUVI, 80002) IVTNUM                                   02420805
                    246:            GO TO 0091                                                   02430805
                    247: 20090      IVFAIL = IVFAIL + 1                                          02440805
                    248:            DVCORR = 0.0D0                                               02450805
                    249:            WRITE (NUVI, 80008) IVTNUM                                   02460805
                    250:            WRITE (NUVI, 80033) DSAVD                                    02470805
                    251:            WRITE (NUVI, 80035) DVCORR, REMRKS                           02480805
                    252:  0091      CONTINUE                                                     02490805
                    253: CT010*  TEST 10                     PAIR OF VALUES, ONE OF WHICH IS ONE 02500805
                    254:            IVTNUM = 10                                                  02510805
                    255:         RSAVS = 1.0                                                     02520805
                    256:         RSBVS = 2.0                                                     02530805
                    257:         DSAVD = DPROD(RSAVS, RSBVS)                                     02540805
                    258:            IF (DSAVD - 1.9999D0) 20100, 10100, 40100                    02550805
                    259: 40100      IF (DSAVD - 2.0001D0) 10100, 10100, 20100                    02560805
                    260: 10100      IVPASS = IVPASS + 1                                          02570805
                    261:            WRITE (NUVI, 80002) IVTNUM                                   02580805
                    262:            GO TO 0101                                                   02590805
                    263: 20100      IVFAIL = IVFAIL + 1                                          02600805
                    264:            DVCORR = 2.0D0                                               02610805
                    265:            WRITE (NUVI, 80008) IVTNUM                                   02620805
                    266:            WRITE (NUVI, 80033) DSAVD                                    02630805
                    267:            WRITE (NUVI, 80035) DVCORR, REMRKS                           02640805
                    268:  0101      CONTINUE                                                     02650805
                    269: CT011*  TEST 11                                 PAIR OF NON-ZERO VALUES 02660805
                    270:            IVTNUM = 11                                                  02670805
                    271:         RSAVS = 3.333333                                                02680805
                    272:         RSBVS = 2.3948094                                               02690805
                    273:         DSAVD = DPROD(RSAVS, RSBVS)                                     02700805
                    274:            IF (DSAVD - 7.9823D0) 20110, 10110, 40110                    02710805
                    275: 40110      IF (DSAVD - 7.9831D0) 10110, 10110, 20110                    02720805
                    276: 10110      IVPASS = IVPASS + 1                                          02730805
                    277:            WRITE (NUVI, 80002) IVTNUM                                   02740805
                    278:            GO TO 0111                                                   02750805
                    279: 20110      IVFAIL = IVFAIL + 1                                          02760805
                    280:            DVCORR = 7.982697202D0                                       02770805
                    281:            WRITE (NUVI, 80008) IVTNUM                                   02780805
                    282:            WRITE (NUVI, 80033) DSAVD                                    02790805
                    283:            WRITE (NUVI, 80035) DVCORR, REMRKS                           02800805
                    284:  0111      CONTINUE                                                     02810805
                    285: CT012*  TEST 12                            ONE POSITIVE, ONE NEGATIVE   02820805
                    286:            IVTNUM = 12                                                  02830805
                    287:         RSAVS = 0.123456                                                02840805
                    288:         RSBVS = -2.98765                                                02850805
                    289:         DSAVD = DPROD(RSAVS, RSBVS)                                     02860805
                    290:            IF (DSAVD + 3.6887D-1) 20120, 10120, 40120                   02870805
                    291: 40120      IF (DSAVD + 3.6882D-1) 10120, 10120, 20120                   02880805
                    292: 10120      IVPASS = IVPASS + 1                                          02890805
                    293:            WRITE (NUVI, 80002) IVTNUM                                   02900805
                    294:            GO TO 0121                                                   02910805
                    295: 20120      IVFAIL = IVFAIL + 1                                          02920805
                    296:            DVCORR = -3.688433184D-1                                     02930805
                    297:            WRITE (NUVI, 80008) IVTNUM                                   02940805
                    298:            WRITE (NUVI, 80033) DSAVD                                    02950805
                    299:            WRITE (NUVI, 80035) DVCORR, REMRKS                           02960805
                    300:  0121      CONTINUE                                                     02970805
                    301: CT013*  TEST 13                          ONE VALUE ONE(1), ONE NEGATIVE 02980805
                    302:            IVTNUM = 13                                                  02990805
                    303:         RSAVS = 1.0834001                                               03000805
                    304:         RSBVS = -2.034985                                               03010805
                    305:         DSAVD = DPROD(RSAVS, RSBVS)                                     03020805
                    306:            IF (DSAVD + 2.2049D0) 20130, 10130, 40130                    03030805
                    307: 40130      IF (DSAVD + 2.2045D0) 10130, 10130, 20130                    03040805
                    308: 10130      IVPASS = IVPASS + 1                                          03050805
                    309:            WRITE (NUVI, 80002) IVTNUM                                   03060805
                    310:            GO TO 0131                                                   03070805
                    311: 20130      IVFAIL = IVFAIL + 1                                          03080805
                    312:            DVCORR = -2.204702953D0                                      03090805
                    313:            WRITE (NUVI, 80008) IVTNUM                                   03100805
                    314:            WRITE (NUVI, 80033) DSAVD                                    03110805
                    315:            WRITE (NUVI, 80035) DVCORR, REMRKS                           03120805
                    316:  0131      CONTINUE                                                     03130805
                    317: CT014*  TEST 14                                 PAIR OF NEGATIVE VALUES 03140805
                    318:            IVTNUM = 14                                                  03150805
                    319:         RSAVS = -3.077734                                               03160805
                    320:         RSBVS = -2.348343                                               03170805
                    321:         DSAVD = DPROD(RSAVS, RSBVS)                                     03180805
                    322:            IF (DSAVD - 7.2272D0) 20140, 10140, 40140                    03190805
                    323: 40140      IF (DSAVD - 7.2280D0) 10140, 10140, 20140                    03200805
                    324: 10140      IVPASS = IVPASS + 1                                          03210805
                    325:            WRITE (NUVI, 80002) IVTNUM                                   03220805
                    326:            GO TO 0141                                                   03230805
                    327: 20140      IVFAIL = IVFAIL + 1                                          03240805
                    328:            DVCORR = 7.227575095D0                                       03250805
                    329:            WRITE (NUVI, 80008) IVTNUM                                   03260805
                    330:            WRITE (NUVI, 80033) DSAVD                                    03270805
                    331:            WRITE (NUVI, 80035) DVCORR, REMRKS                           03280805
                    332:  0141      CONTINUE                                                     03290805
                    333: CT015*  TEST 15                  ONE POSITIVE VALUE, ONE NEGATIVE VALUE 03300805
                    334:            IVTNUM = 15                                                  03310805
                    335:         RSAVS = 3.3333324                                               03320805
                    336:         RSBVS = -2.343953                                               03330805
                    337:         DSAVD = DPROD(RSAVS, RSBVS)                                     03340805
                    338:            IF (DSAVD + 7.8136D0) 20150, 10150, 40150                    03350805
                    339: 40150      IF (DSAVD + 7.8127D0) 10150, 10150, 20150                    03360805
                    340: 10150      IVPASS = IVPASS + 1                                          03370805
                    341:            WRITE (NUVI, 80002) IVTNUM                                   03380805
                    342:            GO TO 0151                                                   03390805
                    343: 20150      IVFAIL = IVFAIL + 1                                          03400805
                    344:            DVCORR = -7.813174479D0                                      03410805
                    345:            WRITE (NUVI, 80008) IVTNUM                                   03420805
                    346:            WRITE (NUVI, 80033) DSAVD                                    03430805
                    347:            WRITE (NUVI, 80035) DVCORR, REMRKS                           03440805
                    348:  0151      CONTINUE                                                     03450805
                    349: CT016*  TEST 16                ARITHMETIC EXPRESSION PRESENTED TO DPROD 03460805
                    350:            IVTNUM = 16                                                  03470805
                    351:         RSAVS = 1.555674                                                03480805
                    352:         RSBVS = 2.00012                                                 03490805
                    353:         DSAVD = DPROD(RSAVS - RSBVS, RSAVS + RSBVS)                     03500805
                    354:            IF (DSAVD + 1.5805D0) 20160, 10160, 40160                    03510805
                    355: 40160      IF (DSAVD + 1.5802D0) 10160, 10160, 20160                    03520805
                    356: 10160      IVPASS = IVPASS + 1                                          03530805
                    357:            WRITE (NUVI, 80002) IVTNUM                                   03540805
                    358:            GO TO 0161                                                   03550805
                    359: 20160      IVFAIL = IVFAIL + 1                                          03560805
                    360:            DVCORR = -1.580358420D0                                      03570805
                    361:            WRITE (NUVI, 80008) IVTNUM                                   03580805
                    362:            WRITE (NUVI, 80033) DSAVD                                    03590805
                    363:            WRITE (NUVI, 80035) DVCORR, REMRKS                           03600805
                    364:  0161      CONTINUE                                                     03610805
                    365: CT017*  TEST 17                       DPROD FORMS THE ARGUMENTS TO DDIM 03620805
                    366:            IVTNUM = 17                                                  03630805
                    367:         DSAVD = DDIM(DPROD(0.4, 2.0), DPROD(3.0, 0.1))                  03640805
                    368:            IF (DSAVD - 0.49997D0) 20170, 10170, 40170                   03650805
                    369: 40170      IF (DSAVD - 0.50003D0) 10170, 10170, 20170                   03660805
                    370: 10170      IVPASS = IVPASS + 1                                          03670805
                    371:            WRITE (NUVI, 80002) IVTNUM                                   03680805
                    372:            GO TO 0171                                                   03690805
                    373: 20170      IVFAIL = IVFAIL + 1                                          03700805
                    374:            DVCORR = 0.5D0                                               03710805
                    375:            WRITE (NUVI, 80008) IVTNUM                                   03720805
                    376:            WRITE (NUVI, 80033) DSAVD                                    03730805
                    377:            WRITE (NUVI, 80035) DVCORR, REMRKS                           03740805
                    378:  0171      CONTINUE                                                     03750805
                    379: CT018*  TEST 18                  ARGUMENTS WITH HIGH AND LOW MAGNITUDES 03760805
                    380:            IVTNUM = 18                                                  03770805
                    381:         RSAVS = 1.23456E-33                                             03780805
                    382:         RSBVS = 1.23456E+34                                             03790805
                    383:         DSAVD = DPROD(RSAVS, RSBVS)                                     03800805
                    384:            IF (DSAVD - 1.5240D1) 20180, 10180, 40180                    03810805
                    385: 40180      IF (DSAVD - 1.5242D1) 10180, 10180, 20180                    03820805
                    386: 10180      IVPASS = IVPASS + 1                                          03830805
                    387:            WRITE (NUVI, 80002) IVTNUM                                   03840805
                    388:            GO TO 0181                                                   03850805
                    389: 20180      IVFAIL = IVFAIL + 1                                          03860805
                    390:            DVCORR = 1.524138394D1                                       03870805
                    391:            WRITE (NUVI, 80008) IVTNUM                                   03880805
                    392:            WRITE (NUVI, 80033) DSAVD                                    03890805
                    393:            WRITE (NUVI, 80035) DVCORR, REMRKS                           03900805
                    394:  0181      CONTINUE                                                     03910805
                    395: C*****                                                                  03920805
                    396: CBB** ********************** BBCSUM0  **********************************03930805
                    397: C**** WRITE OUT TEST SUMMARY                                            03940805
                    398: C****                                                                   03950805
                    399:       IVTOTN = IVPASS + IVFAIL + IVDELE + IVINSP                        03960805
                    400:       WRITE (I02, 90004)                                                03970805
                    401:       WRITE (I02, 90014)                                                03980805
                    402:       WRITE (I02, 90004)                                                03990805
                    403:       WRITE (I02, 90020) IVPASS                                         04000805
                    404:       WRITE (I02, 90022) IVFAIL                                         04010805
                    405:       WRITE (I02, 90024) IVDELE                                         04020805
                    406:       WRITE (I02, 90026) IVINSP                                         04030805
                    407:       WRITE (I02, 90028) IVTOTN, IVTOTL                                 04040805
                    408: CBE** ********************** BBCSUM0  **********************************04050805
                    409: CBB** ********************** BBCFOOT0 **********************************04060805
                    410: C**** WRITE OUT REPORT FOOTINGS                                         04070805
                    411: C****                                                                   04080805
                    412:       WRITE (I02,90016) ZPROG, ZPROG                                    04090805
                    413:       WRITE (I02,90018) ZPROJ, ZNAME, ZTAPE, ZTAPED                     04100805
                    414:       WRITE (I02,90019)                                                 04110805
                    415: CBE** ********************** BBCFOOT0 **********************************04120805
                    416: CBB** ********************** BBCFMT0A **********************************04130805
                    417: C**** FORMATS FOR TEST DETAIL LINES                                     04140805
                    418: C****                                                                   04150805
                    419: 80000 FORMAT (1H ,2X,I3,4X,7HDELETED,32X,A31)                           04160805
                    420: 80002 FORMAT (1H ,2X,I3,4X,7H PASS  ,32X,A31)                           04170805
                    421: 80004 FORMAT (1H ,2X,I3,4X,7HINSPECT,32X,A31)                           04180805
                    422: 80008 FORMAT (1H ,2X,I3,4X,7H FAIL  ,32X,A31)                           04190805
                    423: 80010 FORMAT (1H ,2X,I3,4X,7H FAIL  ,/,1H ,15X,10HCOMPUTED= ,           04200805
                    424:      1I6,/,1H ,15X,10HCORRECT=  ,I6)                                    04210805
                    425: 80012 FORMAT (1H ,2X,I3,4X,7H FAIL  ,/,1H ,16X,10HCOMPUTED= ,           04220805
                    426:      1E12.5,/,1H ,16X,10HCORRECT=  ,E12.5)                              04230805
                    427: 80018 FORMAT (1H ,2X,I3,4X,7H FAIL  ,/,1H ,16X,10HCOMPUTED= ,           04240805
                    428:      1A21,/,1H ,16X,10HCORRECT=  ,A21)                                  04250805
                    429: 80020 FORMAT (1H ,16X,10HCOMPUTED= ,A21,1X,A31)                         04260805
                    430: 80022 FORMAT (1H ,16X,10HCORRECT=  ,A21,1X,A31)                         04270805
                    431: 80024 FORMAT (1H ,16X,10HCOMPUTED= ,I6,16X,A31)                         04280805
                    432: 80026 FORMAT (1H ,16X,10HCORRECT=  ,I6,16X,A31)                         04290805
                    433: 80028 FORMAT (1H ,16X,10HCOMPUTED= ,E12.5,10X,A31)                      04300805
                    434: 80030 FORMAT (1H ,16X,10HCORRECT=  ,E12.5,10X,A31)                      04310805
                    435: 80050 FORMAT (1H ,48X,A31)                                              04320805
                    436: CBE** ********************** BBCFMT0A **********************************04330805
                    437: CBB** ********************** BBCFMAT1 **********************************04340805
                    438: C**** FORMATS FOR TEST DETAIL LINES - FULL LANGUAGE                     04350805
                    439: C****                                                                   04360805
                    440: 80031 FORMAT (1H ,2X,I3,4X,7H FAIL  ,/,1H ,16X,10HCOMPUTED= ,           04370805
                    441:      1D17.10,/,1H ,16X,10HCORRECT=  ,D17.10)                            04380805
                    442: 80033 FORMAT (1H ,16X,10HCOMPUTED= ,D17.10,10X,A31)                     04390805
                    443: 80035 FORMAT (1H ,16X,10HCORRECT=  ,D17.10,10X,A31)                     04400805
                    444: 80037 FORMAT (1H ,16X,10HCOMPUTED= ,1H(,E12.5,2H, ,E12.5,1H),6X,A31)    04410805
                    445: 80039 FORMAT (1H ,16X,10HCORRECT=  ,1H(,E12.5,2H, ,E12.5,1H),6X,A31)    04420805
                    446: 80041 FORMAT (1H ,16X,10HCOMPUTED= ,1H(,F12.5,2H, ,F12.5,1H),6X,A31)    04430805
                    447: 80043 FORMAT (1H ,16X,10HCORRECT=  ,1H(,F12.5,2H, ,F12.5,1H),6X,A31)    04440805
                    448: 80045 FORMAT (1H ,2X,I3,4X,7H FAIL  ,/,1H ,16X,10HCOMPUTED= ,           04450805
                    449:      11H(,F12.5,2H, ,F12.5,1H)/,1H ,16X,10HCORRECT=  ,                  04460805
                    450:      21H(,F12.5,2H, ,F12.5,1H))                                         04470805
                    451: CBE** ********************** BBCFMAT1 **********************************04480805
                    452: CBB** ********************** BBCFMT0B **********************************04490805
                    453: C**** FORMAT STATEMENTS FOR PAGE HEADERS                                04500805
                    454: C****                                                                   04510805
                    455: 90002 FORMAT (1H1)                                                      04520805
                    456: 90004 FORMAT (1H )                                                      04530805
                    457: 90006 FORMAT (1H ,20X,31HFEDERAL SOFTWARE TESTING CENTER)               04540805
                    458: 90007 FORMAT (1H ,19X,34HFORTRAN COMPILER VALIDATION SYSTEM)            04550805
                    459: 90008 FORMAT (1H ,21X,A13,A17)                                          04560805
                    460: 90009 FORMAT (1H ,/,2H *,A5,6HBEGIN*,12X,15HTEST RESULTS - ,A5,/)       04570805
                    461: 90010 FORMAT (1H ,8X,16HTEST DATE*TIME= ,A17,15H  -  COMPILER= ,A20)    04580805
                    462: 90013 FORMAT (1H ,8H TEST   ,10HPASS/FAIL ,6X,17HDISPLAYED RESULTS,     04590805
                    463:      1       7X,7HREMARKS,24X)                                          04600805
                    464: 90014 FORMAT (1H ,46H----------------------------------------------,    04610805
                    465:      1        33H---------------------------------)                     04620805
                    466: 90015 FORMAT (1H ,48X,17HTHIS PROGRAM HAS ,I3,6H TESTS,/)               04630805
                    467: C****                                                                   04640805
                    468: C**** FORMAT STATEMENTS FOR REPORT FOOTINGS                             04650805
                    469: C****                                                                   04660805
                    470: 90016 FORMAT (1H ,/,2H *,A5,4HEND*,14X,14HEND OF TEST - ,A5,/)          04670805
                    471: 90018 FORMAT (1H ,A13,13X,A20,7H   *   ,A10,1H/,                        04680805
                    472:      1        A13)                                                      04690805
                    473: 90019 FORMAT (1H ,26HFOR OFFICIAL USE ONLY     ,35X,15HCOPYRIGHT  1982) 04700805
                    474: C****                                                                   04710805
                    475: C**** FORMAT STATEMENTS FOR RUN SUMMARY                                 04720805
                    476: C****                                                                   04730805
                    477: 90020 FORMAT (1H ,21X,I5,13H TESTS PASSED)                              04740805
                    478: 90022 FORMAT (1H ,21X,I5,13H TESTS FAILED)                              04750805
                    479: 90024 FORMAT (1H ,21X,I5,14H TESTS DELETED)                             04760805
                    480: 90026 FORMAT (1H ,21X,I5,25H TESTS REQUIRE INSPECTION)                  04770805
                    481: 90028 FORMAT (1H ,21X,I5,4H OF ,I3,15H TESTS EXECUTED)                  04780805
                    482: CBE** ********************** BBCFMT0B **********************************04790805
                    483: C*****                                                                  04800805
                    484: C*****    END OF TEST SEGMENT 164                                       04810805
                    485:         STOP                                                            04820805
                    486:         END                                                             04830805
                    487:                                                                         04840805

unix.superglobalmegacorp.com

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