PROGRAM FM378 C***********************************************************************00010378 C***** FORTRAN 77 00020378 C***** FM378 00030378 C***** XTANH - (199) 00040378 C***** 00050378 C***********************************************************************00060378 C***** GENERAL PURPOSE SUBSET REF 00070378 C***** TEST INTRINSIC FUNCTION TANH 15.3 00080378 C***** TABLE 5 00090378 C***** 00100378 CBB** ********************** BBCCOMNT **********************************00110378 C**** 00120378 C**** 1978 FORTRAN COMPILER VALIDATION SYSTEM 00130378 C**** VERSION 2.1 00140378 C**** 00150378 C**** 00160378 C**** SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO 00170378 C**** NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY 00180378 C**** SOFTWARE STANDARDS VALIDATION GROUP 00190378 C**** BUILDING 225 RM A266 00200378 C**** GAITHERSBURG, MD 20899 00210378 C**** 00220378 C**** 00230378 C**** 00240378 CBE** ********************** BBCCOMNT **********************************00250378 CBB** ********************** BBCINITA **********************************00260378 C**** SPECIFICATION STATEMENTS 00270378 C**** 00280378 CHARACTER ZVERS*13, ZVERSD*17, ZDATE*17, ZPROG*5, ZCOMPL*20, 00290378 1 ZNAME*20, ZTAPE*10, ZPROJ*13, REMRKS*31, ZTAPED*13 00300378 CBE** ********************** BBCINITA **********************************00310378 CBB** ********************** BBCINITB **********************************00320378 C**** INITIALIZE SECTION 00330378 DATA ZVERS, ZVERSD, ZDATE 00340378 1 /'VERSION 2.1 ', '93/10/21*21.02.00', '*NO DATE*TIME'/ 00350378 DATA ZCOMPL, ZNAME, ZTAPE 00360378 1 /'*NONE SPECIFIED*', '*NO COMPANY NAME*', '*NO TAPE*'/ 00370378 DATA ZPROJ, ZTAPED, ZPROG 00380378 1 /'*NO PROJECT*', '*NO TAPE DATE', 'XXXXX'/ 00390378 DATA REMRKS /' '/ 00400378 C**** THE FOLLOWING 9 COMMENT LINES (CZ01, CZ02, ...) CAN BE REPLACED 00410378 C**** FOR IDENTIFYING THE TEST ENVIRONMENT 00420378 C**** 00430378 CZ01 ZVERS = 'VERSION OF THE COMPILER VALIDATION SYSTEM' 00440378 CZ02 ZVERSD = 'CREATION DATE/TIME OF THE COMPILER VALIDATION SYSTEM' 00450378 CZ03 ZPROG = 'PROGRAM NAME' 00460378 CZ04 ZDATE = 'DATE OF TEST' 00470378 CZ05 ZCOMPL = 'COMPILER IDENTIFICATION' 00480378 CZ06 ZPROJ = 'PROJECT NUMBER/IDENTIFICATION' 00490378 CZ07 ZNAME = 'NAME OF USER' 00500378 CZ08 ZTAPE = 'TAPE OWNER/ID' 00510378 CZ09 ZTAPED = 'DATE TAPE COPIED' 00520378 C 00530378 IVPASS = 0 00540378 IVFAIL = 0 00550378 IVDELE = 0 00560378 IVINSP = 0 00570378 IVTOTL = 0 00580378 IVTOTN = 0 00590378 ICZERO = 0 00600378 C 00610378 C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER. 00620378 I01 = 05 00630378 C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER. 00640378 I02 = 06 00650378 C 00660378 CX010 REPLACED BY FEXEC X-010 CONTROL CARD (CARD-READER UNIT NUMBER). 00670378 C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 00680378 CX011 REPLACED BY FEXEC X-011 CONTROL CARD. CX011 IS FOR SYSTEMS 00690378 C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX010. 00700378 C 00710378 CX020 REPLACED BY FEXEC X-020 CONTROL CARD (PRINTER UNIT NUMBER). 00720378 C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02= 6 00730378 CX021 REPLACED BY FEXEC X-021 CONTROL CARD. CX021 IS FOR SYSTEMS 00740378 C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX020. 00750378 C 00760378 CBE** ********************** BBCINITB **********************************00770378 NUVI = I02 00780378 IVTOTL = 9 00790378 ZPROG = 'FM378' 00800378 CBB** ********************** BBCHED0A **********************************00810378 C**** 00820378 C**** WRITE REPORT TITLE 00830378 C**** 00840378 WRITE (I02, 90002) 00850378 WRITE (I02, 90006) 00860378 WRITE (I02, 90007) 00870378 WRITE (I02, 90008) ZVERS, ZVERSD 00880378 WRITE (I02, 90009) ZPROG, ZPROG 00890378 WRITE (I02, 90010) ZDATE, ZCOMPL 00900378 CBE** ********************** BBCHED0A **********************************00910378 C***** 00920378 C***** HEADER FOR SEGMENT 199 00930378 WRITE(NUVI,19900) 00940378 19900 FORMAT(" ", / " XTANH - (199) INTRINSIC FUNCTIONS" // 00950378 1 " TANH (HYPERBOLIC TANGENT)" // 00960378 2 " SUBSET REF. - 15.3" ) 00970378 CBB** ********************** BBCHED0B **********************************00980378 C**** WRITE DETAIL REPORT HEADERS 00990378 C**** 01000378 WRITE (I02,90004) 01010378 WRITE (I02,90004) 01020378 WRITE (I02,90013) 01030378 WRITE (I02,90014) 01040378 WRITE (I02,90015) IVTOTL 01050378 CBE** ********************** BBCHED0B **********************************01060378 C***** 01070378 CT001* TEST 1 TEST AT ZERO (0.0) 01080378 IVTNUM = 1 01090378 BVS = 0.0 01100378 AVS = TANH(BVS) 01110378 IF (AVS + 0.50000E-04) 20010, 10010, 40010 01120378 40010 IF (AVS - 0.50000E-04) 10010, 10010, 20010 01130378 10010 IVPASS = IVPASS + 1 01140378 WRITE (NUVI, 80002) IVTNUM 01150378 GO TO 0011 01160378 20010 IVFAIL = IVFAIL + 1 01170378 RVCORR = 0.00000000000000 01180378 WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR 01190378 0011 CONTINUE 01200378 CT002* TEST 2 A NEGATIVE ARGUMENT 01210378 IVTNUM = 2 01220378 AVS = TANH(-2.5) 01230378 IF (AVS + 0.98667E+00) 20020, 10020, 40020 01240378 40020 IF (AVS + 0.98656E+00) 10020, 10020, 20020 01250378 10020 IVPASS = IVPASS + 1 01260378 WRITE (NUVI, 80002) IVTNUM 01270378 GO TO 0021 01280378 20020 IVFAIL = IVFAIL + 1 01290378 RVCORR = -0.98661429815143 01300378 WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR 01310378 0021 CONTINUE 01320378 CT003* TEST 3 A VARIABLE SUPPLIED AS AN ARGUMENT 01330378 IVTNUM = 3 01340378 BVS = 4.75 01350378 AVS = TANH(BVS) 01360378 IF (AVS - 0.99980E+00) 20030, 10030, 40030 01370378 40030 IF (AVS - 0.99990E+00) 10030, 10030, 20030 01380378 10030 IVPASS = IVPASS + 1 01390378 WRITE (NUVI, 80002) IVTNUM 01400378 GO TO 0031 01410378 20030 IVFAIL = IVFAIL + 1 01420378 RVCORR = 0.99985030754498 01430378 WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR 01440378 0031 CONTINUE 01450378 CT004* TEST 4 A POSITIVE REAL NUMBER SUPPLIED AS AN ARGUMENT 01460378 IVTNUM = 4 01470378 AVS = TANH(15.125) 01480378 IF (AVS - 0.99995E+00) 20040, 10040, 40040 01490378 40040 IF (AVS - 0.10001E+01) 10040, 10040, 20040 01500378 10040 IVPASS = IVPASS + 1 01510378 WRITE (NUVI, 80002) IVTNUM 01520378 GO TO 0041 01530378 20040 IVFAIL = IVFAIL + 1 01540378 RVCORR = 0.99999999999985 01550378 WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR 01560378 0041 CONTINUE 01570378 CT005* TEST 5 TEST WITH LARGE VALUES 01580378 IVTNUM = 5 01590378 BVS = 10.0 ** 2 01600378 AVS = TANH(BVS) 01610378 IF (AVS - 0.99995E+00) 20050, 10050, 40050 01620378 40050 IF (AVS - 0.10001E+01) 10050, 10050, 20050 01630378 10050 IVPASS = IVPASS + 1 01640378 WRITE (NUVI, 80002) IVTNUM 01650378 GO TO 0051 01660378 20050 IVFAIL = IVFAIL + 1 01670378 RVCORR = 1.00000000000000 01680378 WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR 01690378 0051 CONTINUE 01700378 CT006* TEST 6 TEST WITH LARGE VALUES 01710378 IVTNUM = 6 01720378 BVS = -100.0 * 10.0 01730378 AVS = TANH(BVS) 01740378 IF (AVS + 0.10001E+01) 20060, 10060, 40060 01750378 40060 IF (AVS + 0.99995E+00) 10060, 10060, 20060 01760378 10060 IVPASS = IVPASS + 1 01770378 WRITE (NUVI, 80002) IVTNUM 01780378 GO TO 0061 01790378 20060 IVFAIL = IVFAIL + 1 01800378 RVCORR = -1.00000000000000 01810378 WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR 01820378 0061 CONTINUE 01830378 CT007* TEST 7 AN ARGUMENT OF HIGH MAGNITUDE 01840378 IVTNUM = 7 01850378 BVS = 3.0E+36 01860378 AVS = TANH(BVS) 01870378 IF (AVS - 0.99995E+00) 20070, 10070, 40070 01880378 40070 IF (AVS - 0.10001E+01) 10070, 10070, 20070 01890378 10070 IVPASS = IVPASS + 1 01900378 WRITE (NUVI, 80002) IVTNUM 01910378 GO TO 0071 01920378 20070 IVFAIL = IVFAIL + 1 01930378 RVCORR = 1.00000000000000 01940378 WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR 01950378 0071 CONTINUE 01960378 CT008* TEST 8 AN ARGUMENT OF LOW MAGNITUDE 01970378 IVTNUM = 8 01980378 BVS = -1.0E-15 01990378 AVS = TANH(BVS) 02000378 IF (AVS + 0.10001E-14) 20080, 10080, 40080 02010378 40080 IF (AVS + 0.99995E-15) 10080, 10080, 20080 02020378 10080 IVPASS = IVPASS + 1 02030378 WRITE (NUVI, 80002) IVTNUM 02040378 GO TO 0081 02050378 20080 IVFAIL = IVFAIL + 1 02060378 RVCORR = -1.00000000000000E-15 02070378 WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR 02080378 0081 CONTINUE 02090378 CT009* TEST 9 THE FUNCTION APPLIED TWICE 02100378 IVTNUM = 9 02110378 AVS = TANH(0.5) * TANH(0.75) 02120378 IF (AVS - 0.29349E+00) 20090, 10090, 40090 02130378 40090 IF (AVS - 0.29353E+00) 10090, 10090, 20090 02140378 10090 IVPASS = IVPASS + 1 02150378 WRITE (NUVI, 80002) IVTNUM 02160378 GO TO 0091 02170378 20090 IVFAIL = IVFAIL + 1 02180378 RVCORR = 0.293513228313886 02190378 WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR 02200378 0091 CONTINUE 02210378 C***** 02220378 CBB** ********************** BBCSUM0 **********************************02230378 C**** WRITE OUT TEST SUMMARY 02240378 C**** 02250378 IVTOTN = IVPASS + IVFAIL + IVDELE + IVINSP 02260378 WRITE (I02, 90004) 02270378 WRITE (I02, 90014) 02280378 WRITE (I02, 90004) 02290378 WRITE (I02, 90020) IVPASS 02300378 WRITE (I02, 90022) IVFAIL 02310378 WRITE (I02, 90024) IVDELE 02320378 WRITE (I02, 90026) IVINSP 02330378 WRITE (I02, 90028) IVTOTN, IVTOTL 02340378 CBE** ********************** BBCSUM0 **********************************02350378 CBB** ********************** BBCFOOT0 **********************************02360378 C**** WRITE OUT REPORT FOOTINGS 02370378 C**** 02380378 WRITE (I02,90016) ZPROG, ZPROG 02390378 WRITE (I02,90018) ZPROJ, ZNAME, ZTAPE, ZTAPED 02400378 WRITE (I02,90019) 02410378 CBE** ********************** BBCFOOT0 **********************************02420378 CBB** ********************** BBCFMT0A **********************************02430378 C**** FORMATS FOR TEST DETAIL LINES 02440378 C**** 02450378 80000 FORMAT (" ",2X,I3,4X,"DELETED",32X,A31) 02460378 80002 FORMAT (" ",2X,I3,4X," PASS ",32X,A31) 02470378 80004 FORMAT (" ",2X,I3,4X,"INSPECT",32X,A31) 02480378 80008 FORMAT (" ",2X,I3,4X," FAIL ",32X,A31) 02490378 80010 FORMAT (" ",2X,I3,4X," FAIL ",/," ",15X,"COMPUTED= " , 02500378 1I6,/," ",15X,"CORRECT= " ,I6) 02510378 80012 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 02520378 1E12.5,/," ",16X,"CORRECT= " ,E12.5) 02530378 80018 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 02540378 1A21,/," ",16X,"CORRECT= " ,A21) 02550378 80020 FORMAT (" ",16X,"COMPUTED= " ,A21,1X,A31) 02560378 80022 FORMAT (" ",16X,"CORRECT= " ,A21,1X,A31) 02570378 80024 FORMAT (" ",16X,"COMPUTED= " ,I6,16X,A31) 02580378 80026 FORMAT (" ",16X,"CORRECT= " ,I6,16X,A31) 02590378 80028 FORMAT (" ",16X,"COMPUTED= " ,E12.5,10X,A31) 02600378 80030 FORMAT (" ",16X,"CORRECT= " ,E12.5,10X,A31) 02610378 80050 FORMAT (" ",48X,A31) 02620378 CBE** ********************** BBCFMT0A **********************************02630378 CBB** ********************** BBCFMT0B **********************************02640378 C**** FORMAT STATEMENTS FOR PAGE HEADERS 02650378 C**** 02660378 90002 FORMAT ("1") 02670378 90004 FORMAT (" ") 02680378 90006 FORMAT (" ",20X,"NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY" )02690378 90007 FORMAT (" ",19X,"FORTRAN COMPILER VALIDATION SYSTEM" ) 02700378 90008 FORMAT (" ",21X,A13,A17) 02710378 90009 FORMAT (" ",/," *",A5,"BEGIN*",12X,"TEST RESULTS - " ,A5,/) 02720378 90010 FORMAT (" ",8X,"TEST DATE*TIME= " ,A17," - COMPILER= " ,A20) 02730378 90013 FORMAT (" "," TEST ","PASS/FAIL " ,6X,"DISPLAYED RESULTS" , 02740378 1 7X,"REMARKS",24X) 02750378 90014 FORMAT (" ","----------------------------------------------" , 02760378 1 "---------------------------------" ) 02770378 90015 FORMAT (" ",48X,"THIS PROGRAM HAS " ,I3," TESTS",/) 02780378 C**** 02790378 C**** FORMAT STATEMENTS FOR REPORT FOOTINGS 02800378 C**** 02810378 90016 FORMAT (" ",/," *",A5,"END*",14X,"END OF TEST - " ,A5,/) 02820378 90018 FORMAT (" ",A13,13X,A20," * ",A10,"/", 02830378 1 A13) 02840378 90019 FORMAT (" ","FOR OFFICIAL USE ONLY " ,35X,"COPYRIGHT 1982" ) 02850378 C**** 02860378 C**** FORMAT STATEMENTS FOR RUN SUMMARY 02870378 C**** 02880378 90020 FORMAT (" ",21X,I5," TESTS PASSED" ) 02890378 90022 FORMAT (" ",21X,I5," TESTS FAILED" ) 02900378 90024 FORMAT (" ",21X,I5," TESTS DELETED" ) 02910378 90026 FORMAT (" ",21X,I5," TESTS REQUIRE INSPECTION" ) 02920378 90028 FORMAT (" ",21X,I5," OF ",I3," TESTS EXECUTED" ) 02930378 CBE** ********************** BBCFMT0B **********************************02940378 C***** 02950378 C***** END OF TEST SEGMENT 199 02960378 STOP 02970378 END 02980378 02990378