      PROGRAM FM826

C***********************************************************************00010826
C*****  FORTRAN 77                                                      00020826
C*****   FM826                                                          00030826
C*****                       YDTANH - (200)                             00040826
C*****                                                                  00050826
C***********************************************************************00060826
C*****  GENERAL PURPOSE                                         ANS REF 00070826
C*****    TEST INTRINSIC FUNCTION DTANH                           15.3  00080826
C*****                                                          TABLE 5 00090826
C*****                                                                  00100826
CBB** ********************** BBCCOMNT **********************************00110826
C****                                                                   00120826
C****            1978 FORTRAN COMPILER VALIDATION SYSTEM                00130826
C****                          VERSION 2.1                              00140826
C****                                                                   00150826
C****                                                                   00160826
C****           SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO         00170826
C****          NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY           00180826
C****               SOFTWARE STANDARDS VALIDATION GROUP                 00190826
C****                      BUILDING 225  RM A266                        00200826
C****                     GAITHERSBURG, MD  20899                       00210826
C****                                                                   00220826
C****                                                                   00230826
C****                                                                   00240826
CBE** ********************** BBCCOMNT **********************************00250826
C*****                                                                  00260826
C*****    S P E C I F I C A T I O N S SEGMENT 200                       00270826
        DOUBLE PRECISION AVD, BVD, DVCORR                               00280826
C*****                                                                  00290826
CBB** ********************** BBCINITA **********************************00300826
C**** SPECIFICATION STATEMENTS                                          00310826
C****                                                                   00320826
      CHARACTER ZVERS*13, ZVERSD*17, ZDATE*17, ZPROG*5, ZCOMPL*20,      00330826
     1          ZNAME*20, ZTAPE*10, ZPROJ*13, REMRKS*31, ZTAPED*13      00340826
CBE** ********************** BBCINITA **********************************00350826
CBB** ********************** BBCINITB **********************************00360826
C**** INITIALIZE SECTION                                                00370826
      DATA  ZVERS,                  ZVERSD,             ZDATE           00380826
     1      /'VERSION 2.1  ',  '93/10/21*21.02.00',  '*NO DATE*TIME'/   00390826
      DATA       ZCOMPL,             ZNAME,             ZTAPE           00400826
     1      /'*NONE SPECIFIED*', '*NO COMPANY NAME*', '*NO TAPE*'/      00410826
      DATA       ZPROJ,           ZTAPED,         ZPROG                 00420826
     1      /'*NO PROJECT*',   '*NO TAPE DATE',  'XXXXX'/               00430826
      DATA   REMRKS /'                               '/                 00440826
C**** THE FOLLOWING 9 COMMENT LINES (CZ01, CZ02, ...) CAN BE REPLACED   00450826
C**** FOR IDENTIFYING THE TEST ENVIRONMENT                              00460826
C****                                                                   00470826
CZ01  ZVERS  = 'VERSION OF THE COMPILER VALIDATION SYSTEM'              00480826
CZ02  ZVERSD = 'CREATION DATE/TIME OF THE COMPILER VALIDATION SYSTEM'   00490826
CZ03  ZPROG  = 'PROGRAM NAME'                                           00500826
CZ04  ZDATE  = 'DATE OF TEST'                                           00510826
CZ05  ZCOMPL = 'COMPILER IDENTIFICATION'                                00520826
CZ06  ZPROJ  = 'PROJECT NUMBER/IDENTIFICATION'                          00530826
CZ07  ZNAME  = 'NAME OF USER'                                           00540826
CZ08  ZTAPE  = 'TAPE OWNER/ID'                                          00550826
CZ09  ZTAPED = 'DATE TAPE COPIED'                                       00560826
C                                                                       00570826
      IVPASS = 0                                                        00580826
      IVFAIL = 0                                                        00590826
      IVDELE = 0                                                        00600826
      IVINSP = 0                                                        00610826
      IVTOTL = 0                                                        00620826
      IVTOTN = 0                                                        00630826
      ICZERO = 0                                                        00640826
C                                                                       00650826
C     I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER.         00660826
      I01 = 05                                                          00670826
C     I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER.             00680826
      I02 = 06                                                          00690826
C                                                                       00700826
CX010   REPLACED BY FEXEC X-010 CONTROL CARD (CARD-READER UNIT NUMBER). 00710826
C     THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5      00720826
CX011   REPLACED BY FEXEC X-011 CONTROL CARD.  CX011 IS FOR SYSTEMS     00730826
C     REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX010.  00740826
C                                                                       00750826
CX020   REPLACED BY FEXEC X-020 CONTROL CARD (PRINTER UNIT NUMBER).     00760826
C     THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02= 6       00770826
CX021   REPLACED BY FEXEC X-021 CONTROL CARD.  CX021 IS FOR SYSTEMS     00780826
C     REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX020.  00790826
C                                                                       00800826
CBE** ********************** BBCINITB **********************************00810826
      NUVI = I02                                                        00820826
      IVTOTL = 9                                                        00830826
      ZPROG = 'FM826'                                                   00840826
CBB** ********************** BBCHED0A **********************************00850826
C****                                                                   00860826
C**** WRITE REPORT TITLE                                                00870826
C****                                                                   00880826
      WRITE (I02, 90002)                                                00890826
      WRITE (I02, 90006)                                                00900826
      WRITE (I02, 90007)                                                00910826
      WRITE (I02, 90008)  ZVERS, ZVERSD                                 00920826
      WRITE (I02, 90009)  ZPROG, ZPROG                                  00930826
      WRITE (I02, 90010)  ZDATE, ZCOMPL                                 00940826
CBE** ********************** BBCHED0A **********************************00950826
C*****                                                                  00960826
C*****    HEADER FOR SEGMENT 200                                        00970826
        WRITE(NUVI,20000)                                               00980826
20000   FORMAT(" ", / "  YDTANH - (200) INTRINSIC FUNCTIONS" //         00990826
     1         "  DTANH  (DOUBLE PRECISION HYPERBOLIC TANGENT)" //      01000826
     2         "  ANS REF. - 15.3" )                                    01010826
CBB** ********************** BBCHED0B **********************************01020826
C**** WRITE DETAIL REPORT HEADERS                                       01030826
C****                                                                   01040826
      WRITE (I02,90004)                                                 01050826
      WRITE (I02,90004)                                                 01060826
      WRITE (I02,90013)                                                 01070826
      WRITE (I02,90014)                                                 01080826
      WRITE (I02,90015) IVTOTL                                          01090826
CBE** ********************** BBCHED0B **********************************01100826
C*****                                                                  01110826
CT001*  TEST 1                                       TEST AT ZERO (0.0) 01120826
           IVTNUM = 1                                                   01130826
        BVD = 0.0D0                                                     01140826
        AVD = DTANH(BVD)                                                01150826
           IF (AVD + 0.5000000000D-09) 20010, 10010, 40010              01160826
40010      IF (AVD - 0.5000000000D-09) 10010, 10010, 20010              01170826
10010      IVPASS = IVPASS + 1                                          01180826
           WRITE (NUVI, 80002) IVTNUM                                   01190826
           GO TO 0011                                                   01200826
20010      IVFAIL = IVFAIL + 1                                          01210826
           DVCORR = 0.00000000000000000000D+00                          01220826
           WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR                      01230826
 0011      CONTINUE                                                     01240826
CT002*  TEST 2                                      A NEGATIVE ARGUMENT 01250826
           IVTNUM = 2                                                   01260826
        AVD = DTANH(-2.5D0)                                             01270826
           IF (AVD + 0.9866142987D+00) 20020, 10020, 40020              01280826
40020      IF (AVD + 0.9866142976D+00) 10020, 10020, 20020              01290826
10020      IVPASS = IVPASS + 1                                          01300826
           WRITE (NUVI, 80002) IVTNUM                                   01310826
           GO TO 0021                                                   01320826
20020      IVFAIL = IVFAIL + 1                                          01330826
           DVCORR = -0.98661429815143028888D+00                         01340826
           WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR                      01350826
 0021      CONTINUE                                                     01360826
CT003*  TEST 3                       A VARIABLE SUPPLIED AS AN ARGUMENT 01370826
           IVTNUM = 3                                                   01380826
        BVD = 4.75D0                                                    01390826
        AVD = DTANH(BVD)                                                01400826
           IF (AVD - 0.9998503070D+00) 20030, 10030, 40030              01410826
40030      IF (AVD - 0.9998503081D+00) 10030, 10030, 20030              01420826
10030      IVPASS = IVPASS + 1                                          01430826
           WRITE (NUVI, 80002) IVTNUM                                   01440826
           GO TO 0031                                                   01450826
20030      IVFAIL = IVFAIL + 1                                          01460826
           DVCORR = 0.99985030754497877538D+00                          01470826
           WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR                      01480826
 0031      CONTINUE                                                     01490826
CT004*  TEST 4           A POSITIVE REAL NUMBER SUPPLIED AS AN ARGUMENT 01500826
           IVTNUM = 4                                                   01510826
        AVD = DTANH(15.125D0)                                           01520826
           IF (AVD - 0.9999999995D+00) 20040, 10040, 40040              01530826
40040      IF (AVD - 0.1000000001D+01) 10040, 10040, 20040              01540826
10040      IVPASS = IVPASS + 1                                          01550826
           WRITE (NUVI, 80002) IVTNUM                                   01560826
           GO TO 0041                                                   01570826
20040      IVFAIL = IVFAIL + 1                                          01580826
           DVCORR = 0.99999999999985424552D+00                          01590826
           WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR                      01600826
 0041      CONTINUE                                                     01610826
CT005*  TEST 5                                   TEST WITH LARGE VALUES 01620826
           IVTNUM = 5                                                   01630826
        BVD = 10.0D0 ** 2                                               01640826
        AVD = DTANH(BVD)                                                01650826
           IF (AVD - 0.9999999995D+00) 20050, 10050, 40050              01660826
40050      IF (AVD - 0.1000000001D+01) 10050, 10050, 20050              01670826
10050      IVPASS = IVPASS + 1                                          01680826
           WRITE (NUVI, 80002) IVTNUM                                   01690826
           GO TO 0051                                                   01700826
20050      IVFAIL = IVFAIL + 1                                          01710826
           DVCORR = 1.0000000000000000000D+00                           01720826
           WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR                      01730826
 0051      CONTINUE                                                     01740826
CT006*  TEST 6                                   TEST WITH LARGE VALUES 01750826
           IVTNUM = 6                                                   01760826
        BVD = -100.0D0 * 10.0D0                                         01770826
        AVD = DTANH(BVD)                                                01780826
           IF (AVD + 0.1000000001D+01) 20060, 10060, 40060              01790826
40060      IF (AVD + 0.9999999995D+00) 10060, 10060, 20060              01800826
10060      IVPASS = IVPASS + 1                                          01810826
           WRITE (NUVI, 80002) IVTNUM                                   01820826
           GO TO 0061                                                   01830826
20060      IVFAIL = IVFAIL + 1                                          01840826
           DVCORR = -1.0000000000000000000D+00                          01850826
           WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR                      01860826
 0061      CONTINUE                                                     01870826
CT007*  TEST 7                            AN ARGUMENT OF HIGH MAGNITUDE 01880826
           IVTNUM = 7                                                   01890826
        BVD = 3.0D+36                                                   01900826
        AVD = DTANH(BVD)                                                01910826
           IF (AVD - 0.9999999995D+00) 20070, 10070, 40070              01920826
40070      IF (AVD - 0.1000000001D+01) 10070, 10070, 20070              01930826
10070      IVPASS = IVPASS + 1                                          01940826
           WRITE (NUVI, 80002) IVTNUM                                   01950826
           GO TO 0071                                                   01960826
20070      IVFAIL = IVFAIL + 1                                          01970826
           DVCORR = 1.0000000000000000000D+00                           01980826
           WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR                      01990826
 0071      CONTINUE                                                     02000826
CT008*  TEST 8                             AN ARGUMENT OF LOW MAGNITUDE 02010826
           IVTNUM = 8                                                   02020826
        BVD = -1.0D-15                                                  02030826
        AVD = DTANH(BVD)                                                02040826
           IF (AVD + 0.1000000001D-14) 20080, 10080, 40080              02050826
40080      IF (AVD + 0.9999999995D-15) 10080, 10080, 20080              02060826
10080      IVPASS = IVPASS + 1                                          02070826
           WRITE (NUVI, 80002) IVTNUM                                   02080826
           GO TO 0081                                                   02090826
20080      IVFAIL = IVFAIL + 1                                          02100826
           DVCORR = -1.0000000000000000000D-15                          02110826
           WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR                      02120826
 0081      CONTINUE                                                     02130826
CT009*  TEST 9                               THE FUNCTION APPLIED TWICE 02140826
           IVTNUM = 9                                                   02150826
        AVD = DTANH(0.5D0) * DTANH(0.75D0)                              02160826
           IF (AVD - 0.2935132281D+00) 20090, 10090, 40090              02170826
40090      IF (AVD - 0.2935132285D+00) 10090, 10090, 20090              02180826
10090      IVPASS = IVPASS + 1                                          02190826
           WRITE (NUVI, 80002) IVTNUM                                   02200826
           GO TO 0091                                                   02210826
20090      IVFAIL = IVFAIL + 1                                          02220826
           DVCORR = 0.293513228313886504621D+00                         02230826
           WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR                      02240826
 0091      CONTINUE                                                     02250826
C*****                                                                  02260826
CBB** ********************** BBCSUM0  **********************************02270826
C**** WRITE OUT TEST SUMMARY                                            02280826
C****                                                                   02290826
      IVTOTN = IVPASS + IVFAIL + IVDELE + IVINSP                        02300826
      WRITE (I02, 90004)                                                02310826
      WRITE (I02, 90014)                                                02320826
      WRITE (I02, 90004)                                                02330826
      WRITE (I02, 90020) IVPASS                                         02340826
      WRITE (I02, 90022) IVFAIL                                         02350826
      WRITE (I02, 90024) IVDELE                                         02360826
      WRITE (I02, 90026) IVINSP                                         02370826
      WRITE (I02, 90028) IVTOTN, IVTOTL                                 02380826
CBE** ********************** BBCSUM0  **********************************02390826
CBB** ********************** BBCFOOT0 **********************************02400826
C**** WRITE OUT REPORT FOOTINGS                                         02410826
C****                                                                   02420826
      WRITE (I02,90016) ZPROG, ZPROG                                    02430826
      WRITE (I02,90018) ZPROJ, ZNAME, ZTAPE, ZTAPED                     02440826
      WRITE (I02,90019)                                                 02450826
CBE** ********************** BBCFOOT0 **********************************02460826
CBB** ********************** BBCFMT0A **********************************02470826
C**** FORMATS FOR TEST DETAIL LINES                                     02480826
C****                                                                   02490826
80000 FORMAT (" ",2X,I3,4X,"DELETED",32X,A31)                           02500826
80002 FORMAT (" ",2X,I3,4X," PASS  ",32X,A31)                           02510826
80004 FORMAT (" ",2X,I3,4X,"INSPECT",32X,A31)                           02520826
80008 FORMAT (" ",2X,I3,4X," FAIL  ",32X,A31)                           02530826
80010 FORMAT (" ",2X,I3,4X," FAIL  ",/," ",15X,"COMPUTED= " ,           02540826
     1I6,/," ",15X,"CORRECT=  " ,I6)                                    02550826
80012 FORMAT (" ",2X,I3,4X," FAIL  ",/," ",16X,"COMPUTED= " ,           02560826
     1E12.5,/," ",16X,"CORRECT=  " ,E12.5)                              02570826
80018 FORMAT (" ",2X,I3,4X," FAIL  ",/," ",16X,"COMPUTED= " ,           02580826
     1A21,/," ",16X,"CORRECT=  " ,A21)                                  02590826
80020 FORMAT (" ",16X,"COMPUTED= " ,A21,1X,A31)                         02600826
80022 FORMAT (" ",16X,"CORRECT=  " ,A21,1X,A31)                         02610826
80024 FORMAT (" ",16X,"COMPUTED= " ,I6,16X,A31)                         02620826
80026 FORMAT (" ",16X,"CORRECT=  " ,I6,16X,A31)                         02630826
80028 FORMAT (" ",16X,"COMPUTED= " ,E12.5,10X,A31)                      02640826
80030 FORMAT (" ",16X,"CORRECT=  " ,E12.5,10X,A31)                      02650826
80050 FORMAT (" ",48X,A31)                                              02660826
CBE** ********************** BBCFMT0A **********************************02670826
CBB** ********************** BBCFMAT1 **********************************02680826
C**** FORMATS FOR TEST DETAIL LINES - FULL LANGUAGE                     02690826
C****                                                                   02700826
80031 FORMAT (" ",2X,I3,4X," FAIL  ",/," ",16X,"COMPUTED= " ,           02710826
     1D17.10,/," ",16X,"CORRECT=  " ,D17.10)                            02720826
80033 FORMAT (" ",16X,"COMPUTED= " ,D17.10,10X,A31)                     02730826
80035 FORMAT (" ",16X,"CORRECT=  " ,D17.10,10X,A31)                     02740826
80037 FORMAT (" ",16X,"COMPUTED= " ,"(",E12.5,", ",E12.5,")",6X,A31)    02750826
80039 FORMAT (" ",16X,"CORRECT=  " ,"(",E12.5,", ",E12.5,")",6X,A31)    02760826
80041 FORMAT (" ",16X,"COMPUTED= " ,"(",F12.5,", ",F12.5,")",6X,A31)    02770826
80043 FORMAT (" ",16X,"CORRECT=  " ,"(",F12.5,", ",F12.5,")",6X,A31)    02780826
80045 FORMAT (" ",2X,I3,4X," FAIL  ",/," ",16X,"COMPUTED= " ,           02790826
     1"(",F12.5,", ",F12.5,")"/," ",16X,"CORRECT=  " ,                  02800826
     2"(",F12.5,", ",F12.5,")")                                         02810826
CBE** ********************** BBCFMAT1 **********************************02820826
CBB** ********************** BBCFMT0B **********************************02830826
C**** FORMAT STATEMENTS FOR PAGE HEADERS                                02840826
C****                                                                   02850826
90002 FORMAT ("1")                                                      02860826
90004 FORMAT (" ")                                                      02870826
90006 FORMAT (" ",20X,"NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY" )02880826
90007 FORMAT (" ",19X,"FORTRAN COMPILER VALIDATION SYSTEM" )            02890826
90008 FORMAT (" ",21X,A13,A17)                                          02900826
90009 FORMAT (" ",/," *",A5,"BEGIN*",12X,"TEST RESULTS - " ,A5,/)       02910826
90010 FORMAT (" ",8X,"TEST DATE*TIME= " ,A17,"  -  COMPILER= " ,A20)    02920826
90013 FORMAT (" "," TEST   ","PASS/FAIL " ,6X,"DISPLAYED RESULTS" ,     02930826
     1       7X,"REMARKS",24X)                                          02940826
90014 FORMAT (" ","----------------------------------------------" ,    02950826
     1        "---------------------------------" )                     02960826
90015 FORMAT (" ",48X,"THIS PROGRAM HAS " ,I3," TESTS",/)               02970826
C****                                                                   02980826
C**** FORMAT STATEMENTS FOR REPORT FOOTINGS                             02990826
C****                                                                   03000826
90016 FORMAT (" ",/," *",A5,"END*",14X,"END OF TEST - " ,A5,/)          03010826
90018 FORMAT (" ",A13,13X,A20,"   *   ",A10,"/",                        03020826
     1        A13)                                                      03030826
90019 FORMAT (" ","FOR OFFICIAL USE ONLY     " ,35X,"COPYRIGHT  1982" ) 03040826
C****                                                                   03050826
C**** FORMAT STATEMENTS FOR RUN SUMMARY                                 03060826
C****                                                                   03070826
90020 FORMAT (" ",21X,I5," TESTS PASSED" )                              03080826
90022 FORMAT (" ",21X,I5," TESTS FAILED" )                              03090826
90024 FORMAT (" ",21X,I5," TESTS DELETED" )                             03100826
90026 FORMAT (" ",21X,I5," TESTS REQUIRE INSPECTION" )                  03110826
90028 FORMAT (" ",21X,I5," OF ",I3," TESTS EXECUTED" )                  03120826
CBE** ********************** BBCFMT0B **********************************03130826
C*****                                                                  03140826
C*****    END OF TEST SEGMENT 200                                       03150826
      STOP                                                              03160826
      END                                                               03170826
                                                                        03180826