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

1.1     ! root        1: C***********************************************************************00010378
        !             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                                                      00020378
        !             6: C*****   FM378                                                          00030378
        !             7: C*****                       XTANH - (199)                              00040378
        !             8: C*****                                                                  00050378
        !             9: C***********************************************************************00060378
        !            10: C*****  GENERAL PURPOSE                                      SUBSET REF 00070378
        !            11: C*****    TEST INTRINSIC FUNCTION TANH                         15.3     00080378
        !            12: C*****                                                        TABLE 5   00090378
        !            13: C*****                                                                  00100378
        !            14: CBB** ********************** BBCCOMNT **********************************00110378
        !            15: C****                                                                   00120378
        !            16: C****            1978 FORTRAN COMPILER VALIDATION SYSTEM                00130378
        !            17: C****                          VERSION 2.0                              00140378
        !            18: C****                                                                   00150378
        !            19: C****                                                                   00160378
        !            20: C****           SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO         00170378
        !            21: C****                   GENERAL SERVICES ADMINISTRATION                 00180378
        !            22: C****                   FEDERAL SOFTWARE TESTING CENTER                 00190378
        !            23: C****                   5203 LEESBURG PIKE, SUITE 1100                  00200378
        !            24: C****                      FALLS CHURCH, VA. 22041                      00210378
        !            25: C****                                                                   00220378
        !            26: C****                          (703) 756-6153                           00230378
        !            27: C****                                                                   00240378
        !            28: CBE** ********************** BBCCOMNT **********************************00250378
        !            29: CBB** ********************** BBCINITA **********************************00260378
        !            30: C**** SPECIFICATION STATEMENTS                                          00270378
        !            31: C****                                                                   00280378
        !            32:       CHARACTER ZVERS*13, ZVERSD*17, ZDATE*17, ZPROG*5, ZCOMPL*20,      00290378
        !            33:      1          ZNAME*20, ZTAPE*10, ZPROJ*13, REMRKS*31, ZTAPED*13      00300378
        !            34: CBE** ********************** BBCINITA **********************************00310378
        !            35: CBB** ********************** BBCINITB **********************************00320378
        !            36: C**** INITIALIZE SECTION                                                00330378
        !            37:       DATA  ZVERS,                  ZVERSD,             ZDATE           00340378
        !            38:      1      /'VERSION 2.0  ',  '82/08/02*18.33.46',  '*NO DATE*TIME'/   00350378
        !            39:       DATA       ZCOMPL,             ZNAME,             ZTAPE           00360378
        !            40:      1      /'*NONE SPECIFIED*', '*NO COMPANY NAME*', '*NO TAPE*'/      00370378
        !            41:       DATA       ZPROJ,           ZTAPED,         ZPROG                 00380378
        !            42:      1      /'*NO PROJECT*',   '*NO TAPE DATE',  'XXXXX'/               00390378
        !            43:       DATA   REMRKS /'                               '/                 00400378
        !            44: C**** THE FOLLOWING 9 COMMENT LINES (CZ01, CZ02, ...) CAN BE REPLACED   00410378
        !            45: C**** FOR IDENTIFYING THE TEST ENVIRONMENT                              00420378
        !            46: C****                                                                   00430378
        !            47: CZ01  ZVERS  = 'VERSION OF THE COMPILER VALIDATION SYSTEM'              00440378
        !            48: CZ02  ZVERSD = 'CREATION DATE/TIME OF THE COMPILER VALIDATION SYSTEM'   00450378
        !            49: CZ03  ZPROG  = 'PROGRAM NAME'                                           00460378
        !            50:       ZDATE  = '07-Nov-85        '                                           *RP
        !            51:       ZCOMPL = 'CCI 5.2             '                                        *RP
        !            52:       ZPROJ  = 'TC-85-   -410'                                               *RP
        !            53:       ZNAME  = '                    '                                        *RP
        !            54:       ZTAPE  = '          '                                                  *RP
        !            55:       ZTAPED = '850703       '                                               *RP
        !            56: C                                                                       00530378
        !            57:       IVPASS = 0                                                        00540378
        !            58:       IVFAIL = 0                                                        00550378
        !            59:       IVDELE = 0                                                        00560378
        !            60:       IVINSP = 0                                                        00570378
        !            61:       IVTOTL = 0                                                        00580378
        !            62:       IVTOTN = 0                                                        00590378
        !            63:       ICZERO = 0                                                        00600378
        !            64: C                                                                       00610378
        !            65: C     I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER.         00620378
        !            66:       I01 = 05                                                          00630378
        !            67: C     I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER.             00640378
        !            68:       I02 = 06                                                          00650378
        !            69: C                                                                       00660378
        !            70:       I01 = 5                                                           00670378
        !            71: C     THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5      00680378
        !            72: CX011   REPLACED BY FEXEC X-011 CONTROL CARD.  CX011 IS FOR SYSTEMS     00690378
        !            73: C     REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX010.  00700378
        !            74: C                                                                       00710378
        !            75:       I02 = 6                                                           00720378
        !            76: C     THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02= 6       00730378
        !            77: CX021   REPLACED BY FEXEC X-021 CONTROL CARD.  CX021 IS FOR SYSTEMS     00740378
        !            78: C     REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX020.  00750378
        !            79: C                                                                       00760378
        !            80: CBE** ********************** BBCINITB **********************************00770378
        !            81:       NUVI = I02                                                        00780378
        !            82:       IVTOTL = 9                                                        00790378
        !            83:       ZPROG = 'FM378'                                                   00800378
        !            84: CBB** ********************** BBCHED0A **********************************00810378
        !            85: C****                                                                   00820378
        !            86: C**** WRITE REPORT TITLE                                                00830378
        !            87: C****                                                                   00840378
        !            88:       WRITE (I02, 90002)                                                00850378
        !            89:       WRITE (I02, 90006)                                                00860378
        !            90:       WRITE (I02, 90007)                                                00870378
        !            91:       WRITE (I02, 90008)  ZVERS, ZVERSD                                 00880378
        !            92:       WRITE (I02, 90009)  ZPROG, ZPROG                                  00890378
        !            93:       WRITE (I02, 90010)  ZDATE, ZCOMPL                                 00900378
        !            94: CBE** ********************** BBCHED0A **********************************00910378
        !            95: C*****                                                                  00920378
        !            96: C*****    HEADER FOR SEGMENT 199                                        00930378
        !            97:         WRITE(NUVI,19900)                                               00940378
        !            98: 19900   FORMAT(1H , / 35H  XTANH - (199) INTRINSIC FUNCTIONS//          00950378
        !            99:      1         28H  TANH  (HYPERBOLIC TANGENT)//                        00960378
        !           100:      2         20H  SUBSET REF. - 15.3)                                 00970378
        !           101: CBB** ********************** BBCHED0B **********************************00980378
        !           102: C**** WRITE DETAIL REPORT HEADERS                                       00990378
        !           103: C****                                                                   01000378
        !           104:       WRITE (I02,90004)                                                 01010378
        !           105:       WRITE (I02,90004)                                                 01020378
        !           106:       WRITE (I02,90013)                                                 01030378
        !           107:       WRITE (I02,90014)                                                 01040378
        !           108:       WRITE (I02,90015) IVTOTL                                          01050378
        !           109: CBE** ********************** BBCHED0B **********************************01060378
        !           110: C*****                                                                  01070378
        !           111: CT001*  TEST 1                                       TEST AT ZERO (0.0) 01080378
        !           112:            IVTNUM = 1                                                   01090378
        !           113:         BVS = 0.0                                                       01100378
        !           114:         AVS = TANH(BVS)                                                 01110378
        !           115:            IF (AVS + 0.50000E-04) 20010, 10010, 40010                   01120378
        !           116: 40010      IF (AVS - 0.50000E-04) 10010, 10010, 20010                   01130378
        !           117: 10010      IVPASS = IVPASS + 1                                          01140378
        !           118:            WRITE (NUVI, 80002) IVTNUM                                   01150378
        !           119:            GO TO 0011                                                   01160378
        !           120: 20010      IVFAIL = IVFAIL + 1                                          01170378
        !           121:            RVCORR = 0.00000000000000                                    01180378
        !           122:            WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR                      01190378
        !           123:  0011      CONTINUE                                                     01200378
        !           124: CT002*  TEST 2                                      A NEGATIVE ARGUMENT 01210378
        !           125:            IVTNUM = 2                                                   01220378
        !           126:         AVS = TANH(-2.5)                                                01230378
        !           127:            IF (AVS + 0.98667E+00) 20020, 10020, 40020                   01240378
        !           128: 40020      IF (AVS + 0.98656E+00) 10020, 10020, 20020                   01250378
        !           129: 10020      IVPASS = IVPASS + 1                                          01260378
        !           130:            WRITE (NUVI, 80002) IVTNUM                                   01270378
        !           131:            GO TO 0021                                                   01280378
        !           132: 20020      IVFAIL = IVFAIL + 1                                          01290378
        !           133:            RVCORR = -0.98661429815143                                   01300378
        !           134:            WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR                      01310378
        !           135:  0021      CONTINUE                                                     01320378
        !           136: CT003*  TEST 3                       A VARIABLE SUPPLIED AS AN ARGUMENT 01330378
        !           137:            IVTNUM = 3                                                   01340378
        !           138:         BVS = 4.75                                                      01350378
        !           139:         AVS = TANH(BVS)                                                 01360378
        !           140:            IF (AVS - 0.99980E+00) 20030, 10030, 40030                   01370378
        !           141: 40030      IF (AVS - 0.99990E+00) 10030, 10030, 20030                   01380378
        !           142: 10030      IVPASS = IVPASS + 1                                          01390378
        !           143:            WRITE (NUVI, 80002) IVTNUM                                   01400378
        !           144:            GO TO 0031                                                   01410378
        !           145: 20030      IVFAIL = IVFAIL + 1                                          01420378
        !           146:            RVCORR = 0.99985030754498                                    01430378
        !           147:            WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR                      01440378
        !           148:  0031      CONTINUE                                                     01450378
        !           149: CT004*  TEST 4           A POSITIVE REAL NUMBER SUPPLIED AS AN ARGUMENT 01460378
        !           150:            IVTNUM = 4                                                   01470378
        !           151:         AVS = TANH(15.125)                                              01480378
        !           152:            IF (AVS - 0.99995E+00) 20040, 10040, 40040                   01490378
        !           153: 40040      IF (AVS - 0.10001E+01) 10040, 10040, 20040                   01500378
        !           154: 10040      IVPASS = IVPASS + 1                                          01510378
        !           155:            WRITE (NUVI, 80002) IVTNUM                                   01520378
        !           156:            GO TO 0041                                                   01530378
        !           157: 20040      IVFAIL = IVFAIL + 1                                          01540378
        !           158:            RVCORR = 0.99999999999985                                    01550378
        !           159:            WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR                      01560378
        !           160:  0041      CONTINUE                                                     01570378
        !           161: CT005*  TEST 5                                   TEST WITH LARGE VALUES 01580378
        !           162:            IVTNUM = 5                                                   01590378
        !           163:         BVS = 10.0 ** 2                                                 01600378
        !           164:         AVS = TANH(BVS)                                                 01610378
        !           165:            IF (AVS - 0.99995E+00) 20050, 10050, 40050                   01620378
        !           166: 40050      IF (AVS - 0.10001E+01) 10050, 10050, 20050                   01630378
        !           167: 10050      IVPASS = IVPASS + 1                                          01640378
        !           168:            WRITE (NUVI, 80002) IVTNUM                                   01650378
        !           169:            GO TO 0051                                                   01660378
        !           170: 20050      IVFAIL = IVFAIL + 1                                          01670378
        !           171:            RVCORR = 1.00000000000000                                    01680378
        !           172:            WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR                      01690378
        !           173:  0051      CONTINUE                                                     01700378
        !           174: CT006*  TEST 6                                   TEST WITH LARGE VALUES 01710378
        !           175:            IVTNUM = 6                                                   01720378
        !           176:         BVS = -100.0 * 10.0                                             01730378
        !           177:         AVS = TANH(BVS)                                                 01740378
        !           178:            IF (AVS + 0.10001E+01) 20060, 10060, 40060                   01750378
        !           179: 40060      IF (AVS + 0.99995E+00) 10060, 10060, 20060                   01760378
        !           180: 10060      IVPASS = IVPASS + 1                                          01770378
        !           181:            WRITE (NUVI, 80002) IVTNUM                                   01780378
        !           182:            GO TO 0061                                                   01790378
        !           183: 20060      IVFAIL = IVFAIL + 1                                          01800378
        !           184:            RVCORR = -1.00000000000000                                   01810378
        !           185:            WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR                      01820378
        !           186:  0061      CONTINUE                                                     01830378
        !           187: CT007*  TEST 7                            AN ARGUMENT OF HIGH MAGNITUDE 01840378
        !           188:            IVTNUM = 7                                                   01850378
        !           189:         BVS = 3.0E+36                                                   01860378
        !           190:         AVS = TANH(BVS)                                                 01870378
        !           191:            IF (AVS - 0.99995E+00) 20070, 10070, 40070                   01880378
        !           192: 40070      IF (AVS - 0.10001E+01) 10070, 10070, 20070                   01890378
        !           193: 10070      IVPASS = IVPASS + 1                                          01900378
        !           194:            WRITE (NUVI, 80002) IVTNUM                                   01910378
        !           195:            GO TO 0071                                                   01920378
        !           196: 20070      IVFAIL = IVFAIL + 1                                          01930378
        !           197:            RVCORR = 1.00000000000000                                    01940378
        !           198:            WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR                      01950378
        !           199:  0071      CONTINUE                                                     01960378
        !           200: CT008*  TEST 8                             AN ARGUMENT OF LOW MAGNITUDE 01970378
        !           201:            IVTNUM = 8                                                   01980378
        !           202:         BVS = -1.0E-15                                                  01990378
        !           203:         AVS = TANH(BVS)                                                 02000378
        !           204:            IF (AVS + 0.10001E-14) 20080, 10080, 40080                   02010378
        !           205: 40080      IF (AVS + 0.99995E-15) 10080, 10080, 20080                   02020378
        !           206: 10080      IVPASS = IVPASS + 1                                          02030378
        !           207:            WRITE (NUVI, 80002) IVTNUM                                   02040378
        !           208:            GO TO 0081                                                   02050378
        !           209: 20080      IVFAIL = IVFAIL + 1                                          02060378
        !           210:            RVCORR = -1.00000000000000E-15                               02070378
        !           211:            WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR                      02080378
        !           212:  0081      CONTINUE                                                     02090378
        !           213: CT009*  TEST 9                               THE FUNCTION APPLIED TWICE 02100378
        !           214:            IVTNUM = 9                                                   02110378
        !           215:         AVS = TANH(0.5) * TANH(0.75)                                    02120378
        !           216:            IF (AVS - 0.29349E+00) 20090, 10090, 40090                   02130378
        !           217: 40090      IF (AVS - 0.29353E+00) 10090, 10090, 20090                   02140378
        !           218: 10090      IVPASS = IVPASS + 1                                          02150378
        !           219:            WRITE (NUVI, 80002) IVTNUM                                   02160378
        !           220:            GO TO 0091                                                   02170378
        !           221: 20090      IVFAIL = IVFAIL + 1                                          02180378
        !           222:            RVCORR = 0.293513228313886                                   02190378
        !           223:            WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR                      02200378
        !           224:  0091      CONTINUE                                                     02210378
        !           225: C*****                                                                  02220378
        !           226: CBB** ********************** BBCSUM0  **********************************02230378
        !           227: C**** WRITE OUT TEST SUMMARY                                            02240378
        !           228: C****                                                                   02250378
        !           229:       IVTOTN = IVPASS + IVFAIL + IVDELE + IVINSP                        02260378
        !           230:       WRITE (I02, 90004)                                                02270378
        !           231:       WRITE (I02, 90014)                                                02280378
        !           232:       WRITE (I02, 90004)                                                02290378
        !           233:       WRITE (I02, 90020) IVPASS                                         02300378
        !           234:       WRITE (I02, 90022) IVFAIL                                         02310378
        !           235:       WRITE (I02, 90024) IVDELE                                         02320378
        !           236:       WRITE (I02, 90026) IVINSP                                         02330378
        !           237:       WRITE (I02, 90028) IVTOTN, IVTOTL                                 02340378
        !           238: CBE** ********************** BBCSUM0  **********************************02350378
        !           239: CBB** ********************** BBCFOOT0 **********************************02360378
        !           240: C**** WRITE OUT REPORT FOOTINGS                                         02370378
        !           241: C****                                                                   02380378
        !           242:       WRITE (I02,90016) ZPROG, ZPROG                                    02390378
        !           243:       WRITE (I02,90018) ZPROJ, ZNAME, ZTAPE, ZTAPED                     02400378
        !           244:       WRITE (I02,90019)                                                 02410378
        !           245: CBE** ********************** BBCFOOT0 **********************************02420378
        !           246: CBB** ********************** BBCFMT0A **********************************02430378
        !           247: C**** FORMATS FOR TEST DETAIL LINES                                     02440378
        !           248: C****                                                                   02450378
        !           249: 80000 FORMAT (1H ,2X,I3,4X,7HDELETED,32X,A31)                           02460378
        !           250: 80002 FORMAT (1H ,2X,I3,4X,7H PASS  ,32X,A31)                           02470378
        !           251: 80004 FORMAT (1H ,2X,I3,4X,7HINSPECT,32X,A31)                           02480378
        !           252: 80008 FORMAT (1H ,2X,I3,4X,7H FAIL  ,32X,A31)                           02490378
        !           253: 80010 FORMAT (1H ,2X,I3,4X,7H FAIL  ,/,1H ,15X,10HCOMPUTED= ,           02500378
        !           254:      1I6,/,1H ,15X,10HCORRECT=  ,I6)                                    02510378
        !           255: 80012 FORMAT (1H ,2X,I3,4X,7H FAIL  ,/,1H ,16X,10HCOMPUTED= ,           02520378
        !           256:      1E12.5,/,1H ,16X,10HCORRECT=  ,E12.5)                              02530378
        !           257: 80018 FORMAT (1H ,2X,I3,4X,7H FAIL  ,/,1H ,16X,10HCOMPUTED= ,           02540378
        !           258:      1A21,/,1H ,16X,10HCORRECT=  ,A21)                                  02550378
        !           259: 80020 FORMAT (1H ,16X,10HCOMPUTED= ,A21,1X,A31)                         02560378
        !           260: 80022 FORMAT (1H ,16X,10HCORRECT=  ,A21,1X,A31)                         02570378
        !           261: 80024 FORMAT (1H ,16X,10HCOMPUTED= ,I6,16X,A31)                         02580378
        !           262: 80026 FORMAT (1H ,16X,10HCORRECT=  ,I6,16X,A31)                         02590378
        !           263: 80028 FORMAT (1H ,16X,10HCOMPUTED= ,E12.5,10X,A31)                      02600378
        !           264: 80030 FORMAT (1H ,16X,10HCORRECT=  ,E12.5,10X,A31)                      02610378
        !           265: 80050 FORMAT (1H ,48X,A31)                                              02620378
        !           266: CBE** ********************** BBCFMT0A **********************************02630378
        !           267: CBB** ********************** BBCFMT0B **********************************02640378
        !           268: C**** FORMAT STATEMENTS FOR PAGE HEADERS                                02650378
        !           269: C****                                                                   02660378
        !           270: 90002 FORMAT (1H1)                                                      02670378
        !           271: 90004 FORMAT (1H )                                                      02680378
        !           272: 90006 FORMAT (1H ,20X,31HFEDERAL SOFTWARE TESTING CENTER)               02690378
        !           273: 90007 FORMAT (1H ,19X,34HFORTRAN COMPILER VALIDATION SYSTEM)            02700378
        !           274: 90008 FORMAT (1H ,21X,A13,A17)                                          02710378
        !           275: 90009 FORMAT (1H ,/,2H *,A5,6HBEGIN*,12X,15HTEST RESULTS - ,A5,/)       02720378
        !           276: 90010 FORMAT (1H ,8X,16HTEST DATE*TIME= ,A17,15H  -  COMPILER= ,A20)    02730378
        !           277: 90013 FORMAT (1H ,8H TEST   ,10HPASS/FAIL ,6X,17HDISPLAYED RESULTS,     02740378
        !           278:      1       7X,7HREMARKS,24X)                                          02750378
        !           279: 90014 FORMAT (1H ,46H----------------------------------------------,    02760378
        !           280:      1        33H---------------------------------)                     02770378
        !           281: 90015 FORMAT (1H ,48X,17HTHIS PROGRAM HAS ,I3,6H TESTS,/)               02780378
        !           282: C****                                                                   02790378
        !           283: C**** FORMAT STATEMENTS FOR REPORT FOOTINGS                             02800378
        !           284: C****                                                                   02810378
        !           285: 90016 FORMAT (1H ,/,2H *,A5,4HEND*,14X,14HEND OF TEST - ,A5,/)          02820378
        !           286: 90018 FORMAT (1H ,A13,13X,A20,7H   *   ,A10,1H/,                        02830378
        !           287:      1        A13)                                                      02840378
        !           288: 90019 FORMAT (1H ,26HFOR OFFICIAL USE ONLY     ,35X,15HCOPYRIGHT  1982) 02850378
        !           289: C****                                                                   02860378
        !           290: C**** FORMAT STATEMENTS FOR RUN SUMMARY                                 02870378
        !           291: C****                                                                   02880378
        !           292: 90020 FORMAT (1H ,21X,I5,13H TESTS PASSED)                              02890378
        !           293: 90022 FORMAT (1H ,21X,I5,13H TESTS FAILED)                              02900378
        !           294: 90024 FORMAT (1H ,21X,I5,14H TESTS DELETED)                             02910378
        !           295: 90026 FORMAT (1H ,21X,I5,25H TESTS REQUIRE INSPECTION)                  02920378
        !           296: 90028 FORMAT (1H ,21X,I5,4H OF ,I3,15H TESTS EXECUTED)                  02930378
        !           297: CBE** ********************** BBCFMT0B **********************************02940378
        !           298: C*****                                                                  02950378
        !           299: C*****    END OF TEST SEGMENT 199                                       02960378
        !           300:       STOP                                                              02970378
        !           301:       END                                                               02980378
        !           302:                                                                         02990378

unix.superglobalmegacorp.com

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