PROGRAM FM818 C***********************************************************************00010818 C***** FORTRAN 77 00020818 C***** FM818 00030818 C***** YDLG10 - (185) 00040818 C***** 00050818 C***********************************************************************00060818 C***** GENERAL PURPOSE ANS REF 00070818 C***** TEST INTRINSIC FUNCTION DLOG10 15.3 00080818 C***** TABLE 5 00090818 C***** 00100818 CBB** ********************** BBCCOMNT **********************************00110818 C**** 00120818 C**** 1978 FORTRAN COMPILER VALIDATION SYSTEM 00130818 C**** VERSION 2.1 00140818 C**** 00150818 C**** 00160818 C**** SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO 00170818 C**** NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY 00180818 C**** SOFTWARE STANDARDS VALIDATION GROUP 00190818 C**** BUILDING 225 RM A266 00200818 C**** GAITHERSBURG, MD 20899 00210818 C**** 00220818 C**** 00230818 C**** 00240818 CBE** ********************** BBCCOMNT **********************************00250818 C***** S P E C I F I C A T I O N S SEGMENT 185 00260818 DOUBLE PRECISION AVD, BVD, CVD, DVCORR 00270818 C***** 00280818 CBB** ********************** BBCINITA **********************************00290818 C**** SPECIFICATION STATEMENTS 00300818 C**** 00310818 CHARACTER ZVERS*13, ZVERSD*17, ZDATE*17, ZPROG*5, ZCOMPL*20, 00320818 1 ZNAME*20, ZTAPE*10, ZPROJ*13, REMRKS*31, ZTAPED*13 00330818 CBE** ********************** BBCINITA **********************************00340818 CBB** ********************** BBCINITB **********************************00350818 C**** INITIALIZE SECTION 00360818 DATA ZVERS, ZVERSD, ZDATE 00370818 1 /'VERSION 2.1 ', '93/10/21*21.02.00', '*NO DATE*TIME'/ 00380818 DATA ZCOMPL, ZNAME, ZTAPE 00390818 1 /'*NONE SPECIFIED*', '*NO COMPANY NAME*', '*NO TAPE*'/ 00400818 DATA ZPROJ, ZTAPED, ZPROG 00410818 1 /'*NO PROJECT*', '*NO TAPE DATE', 'XXXXX'/ 00420818 DATA REMRKS /' '/ 00430818 C**** THE FOLLOWING 9 COMMENT LINES (CZ01, CZ02, ...) CAN BE REPLACED 00440818 C**** FOR IDENTIFYING THE TEST ENVIRONMENT 00450818 C**** 00460818 CZ01 ZVERS = 'VERSION OF THE COMPILER VALIDATION SYSTEM' 00470818 CZ02 ZVERSD = 'CREATION DATE/TIME OF THE COMPILER VALIDATION SYSTEM' 00480818 CZ03 ZPROG = 'PROGRAM NAME' 00490818 CZ04 ZDATE = 'DATE OF TEST' 00500818 CZ05 ZCOMPL = 'COMPILER IDENTIFICATION' 00510818 CZ06 ZPROJ = 'PROJECT NUMBER/IDENTIFICATION' 00520818 CZ07 ZNAME = 'NAME OF USER' 00530818 CZ08 ZTAPE = 'TAPE OWNER/ID' 00540818 CZ09 ZTAPED = 'DATE TAPE COPIED' 00550818 C 00560818 IVPASS = 0 00570818 IVFAIL = 0 00580818 IVDELE = 0 00590818 IVINSP = 0 00600818 IVTOTL = 0 00610818 IVTOTN = 0 00620818 ICZERO = 0 00630818 C 00640818 C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER. 00650818 I01 = 05 00660818 C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER. 00670818 I02 = 06 00680818 C 00690818 CX010 REPLACED BY FEXEC X-010 CONTROL CARD (CARD-READER UNIT NUMBER). 00700818 C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 00710818 CX011 REPLACED BY FEXEC X-011 CONTROL CARD. CX011 IS FOR SYSTEMS 00720818 C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX010. 00730818 C 00740818 CX020 REPLACED BY FEXEC X-020 CONTROL CARD (PRINTER UNIT NUMBER). 00750818 C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02= 6 00760818 CX021 REPLACED BY FEXEC X-021 CONTROL CARD. CX021 IS FOR SYSTEMS 00770818 C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX020. 00780818 C 00790818 CBE** ********************** BBCINITB **********************************00800818 NUVI = I02 00810818 IVTOTL = 15 00820818 ZPROG = 'FM818' 00830818 CBB** ********************** BBCHED0A **********************************00840818 C**** 00850818 C**** WRITE REPORT TITLE 00860818 C**** 00870818 WRITE (I02, 90002) 00880818 WRITE (I02, 90006) 00890818 WRITE (I02, 90007) 00900818 WRITE (I02, 90008) ZVERS, ZVERSD 00910818 WRITE (I02, 90009) ZPROG, ZPROG 00920818 WRITE (I02, 90010) ZDATE, ZCOMPL 00930818 CBE** ********************** BBCHED0A **********************************00940818 C***** 00950818 C***** HEADER FOR SEGMENT 185 00960818 WRITE(NUVI,18500) 00970818 18500 FORMAT(" ", / " YDLG10 - (185) INTRINSIC FUNCTIONS" // 00980818 1 " DLOG10 (DOUBLE PRECISION COMMON LOGARITHM)" // 00990818 2 " ANS REF. - 15.3" ) 01000818 CBB** ********************** BBCHED0B **********************************01010818 C**** WRITE DETAIL REPORT HEADERS 01020818 C**** 01030818 WRITE (I02,90004) 01040818 WRITE (I02,90004) 01050818 WRITE (I02,90013) 01060818 WRITE (I02,90014) 01070818 WRITE (I02,90015) IVTOTL 01080818 CBE** ********************** BBCHED0B **********************************01090818 C***** 01100818 CT001* TEST 1 ONE, SINCE LN(1.0) = 0.0 01110818 IVTNUM = 1 01120818 BVD = 1.0D0 01130818 AVD = DLOG10(BVD) 01140818 IF (AVD + 0.5000000000D-09) 20010, 10010, 40010 01150818 40010 IF (AVD - 0.5000000000D-09) 10010, 10010, 20010 01160818 10010 IVPASS = IVPASS + 1 01170818 WRITE (NUVI, 80002) IVTNUM 01180818 GO TO 0011 01190818 20010 IVFAIL = IVFAIL + 1 01200818 DVCORR = 0.00000000000000000000D+00 01210818 WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR 01220818 0011 CONTINUE 01230818 CT002* TEST 2 A VALUE CLOSE TO 10 01240818 IVTNUM = 2 01250818 AVD = DLOG10(9.875D0) 01260818 IF (AVD - 0.9945371038D+00) 20020, 10020, 40020 01270818 40020 IF (AVD - 0.9945371048D+00) 10020, 10020, 20020 01280818 10020 IVPASS = IVPASS + 1 01290818 WRITE (NUVI, 80002) IVTNUM 01300818 GO TO 0021 01310818 20020 IVFAIL = IVFAIL + 1 01320818 DVCORR = 0.99453710429849784235D+00 01330818 WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR 01340818 0021 CONTINUE 01350818 CT003* TEST 3 THE VALUE 10.D0 01360818 IVTNUM = 3 01370818 AVD = DLOG10(10.0D0) 01380818 IF (AVD - 0.9999999995D+00) 20030, 10030, 40030 01390818 40030 IF (AVD - 0.1000000001D+01) 10030, 10030, 20030 01400818 10030 IVPASS = IVPASS + 1 01410818 WRITE (NUVI, 80002) IVTNUM 01420818 GO TO 0031 01430818 20030 IVFAIL = IVFAIL + 1 01440818 DVCORR = 1.0000000000000000000D+00 01450818 WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR 01460818 0031 CONTINUE 01470818 CT004* TEST 4 THE VALUE 20.5D0 01480818 IVTNUM = 4 01490818 AVD = DLOG10(20.5D0) 01500818 IF (AVD - 0.1311753860D+01) 20040, 10040, 40040 01510818 40040 IF (AVD - 0.1311753862D+01) 10040, 10040, 20040 01520818 10040 IVPASS = IVPASS + 1 01530818 WRITE (NUVI, 80002) IVTNUM 01540818 GO TO 0041 01550818 20040 IVFAIL = IVFAIL + 1 01560818 DVCORR = 1.3117538610557542993D+00 01570818 WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR 01580818 0041 CONTINUE 01590818 CT005* TEST 5 THE VALUE 99.0D0 01600818 IVTNUM = 5 01610818 AVD = DLOG10(99.0D0) 01620818 IF (AVD - 0.1995635193D+01) 20050, 10050, 40050 01630818 40050 IF (AVD - 0.1995635196D+01) 10050, 10050, 20050 01640818 10050 IVPASS = IVPASS + 1 01650818 WRITE (NUVI, 80002) IVTNUM 01660818 GO TO 0051 01670818 20050 IVFAIL = IVFAIL + 1 01680818 DVCORR = 1.9956351945975499153D+00 01690818 WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR 01700818 0051 CONTINUE 01710818 CT006* TEST 6 VARIABLE WITHIN AN EXPRESSION 01720818 IVTNUM = 6 01730818 BVD = 1.0D0 01740818 CVD = 8.0D0 01750818 AVD = DLOG10(3.0D0 * BVD / CVD) 01760818 IF (AVD + 0.4259687325D+00) 20060, 10060, 40060 01770818 40060 IF (AVD + 0.4259687320D+00) 10060, 10060, 20060 01780818 10060 IVPASS = IVPASS + 1 01790818 WRITE (NUVI, 80002) IVTNUM 01800818 GO TO 0061 01810818 20060 IVFAIL = IVFAIL + 1 01820818 DVCORR = -0.42596873227228114835D+00 01830818 WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR 01840818 0061 CONTINUE 01850818 CT007* TEST 7 VARIABLE WITHIN AN EXPRESSION 01860818 IVTNUM = 7 01870818 BVD = 1.0D0 01880818 CVD = 8.0D0 01890818 AVD = DLOG10(5.0D0 * BVD / CVD) 01900818 IF (AVD + 0.2041199828D+00) 20070, 10070, 40070 01910818 40070 IF (AVD + 0.2041199825D+00) 10070, 10070, 20070 01920818 10070 IVPASS = IVPASS + 1 01930818 WRITE (NUVI, 80002) IVTNUM 01940818 GO TO 0071 01950818 20070 IVFAIL = IVFAIL + 1 01960818 DVCORR = -0.20411998265592478085D+00 01970818 WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR 01980818 0071 CONTINUE 01990818 CT008* TEST 8 AN EXPRESSION SUPPLIED TO DLOG10 02000818 IVTNUM = 8 02010818 AVD = DLOG10(75.D0 / 100.0D0) 02020818 IF (AVD + 0.1249387367D+00) 20080, 10080, 40080 02030818 40080 IF (AVD + 0.1249387365D+00) 10080, 10080, 20080 02040818 10080 IVPASS = IVPASS + 1 02050818 WRITE (NUVI, 80002) IVTNUM 02060818 GO TO 0081 02070818 20080 IVFAIL = IVFAIL + 1 02080818 DVCORR = -0.12493873660829995313D+00 02090818 WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR 02100818 0081 CONTINUE 02110818 CT009* TEST 9 VARIABLE WITHIN AN EXPRESSION 02120818 IVTNUM = 9 02130818 BVD = 1.0D0 02140818 CVD = 8.0D0 02150818 AVD = DLOG10(7.0D0 * BVD / CVD) 02160818 IF (AVD + 0.5799194701D-01) 20090, 10090, 40090 02170818 40090 IF (AVD + 0.5799194694D-01) 10090, 10090, 20090 02180818 10090 IVPASS = IVPASS + 1 02190818 WRITE (NUVI, 80002) IVTNUM 02200818 GO TO 0091 02210818 20090 IVFAIL = IVFAIL + 1 02220818 DVCORR = -0.057991946977686754929D+00 02230818 WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR 02240818 0091 CONTINUE 02250818 CT010* TEST 10 A VALUE CLOSE TO ONE 02260818 IVTNUM = 10 02270818 AVD = DLOG10(0.9921875D0) 02280818 IF (AVD + 0.3406248694D-02) 20100, 10100, 40100 02290818 40100 IF (AVD + 0.3406248690D-02) 10100, 10100, 20100 02300818 10100 IVPASS = IVPASS + 1 02310818 WRITE (NUVI, 80002) IVTNUM 02320818 GO TO 0101 02330818 20100 IVFAIL = IVFAIL + 1 02340818 DVCORR = -0.0034062486919115022492D+00 02350818 WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR 02360818 0101 CONTINUE 02370818 CT012* TEST 11 A VALUE CLOSE TO ZERO 02510818 IVTNUM = 11 02520818 BVD = 256.0D0 02530818 AVD = DLOG10(1.0D0 / BVD) 02540818 IF (AVD + 0.2408239967D+01) 20120, 10120, 40120 02550818 40120 IF (AVD + 0.2408239964D+01) 10120, 10120, 20120 02560818 10120 IVPASS = IVPASS + 1 02570818 WRITE (NUVI, 80002) IVTNUM 02580818 GO TO 0121 02590818 20120 IVFAIL = IVFAIL + 1 02600818 DVCORR = -2.4082399653118495617D+00 02610818 WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR 02620818 0121 CONTINUE 02630818 CT013* TEST 12 A VALUE CLOSE TO ZERO 02640818 IVTNUM = 12 02650818 BVD = 128.0D0 02660818 AVD = DLOG10(1.0D0 / (BVD * 8D0)) 02670818 IF (AVD + 0.3010299959D+01) 20130, 10130, 40130 02680818 40130 IF (AVD + 0.3010299955D+01) 10130, 10130, 20130 02690818 10130 IVPASS = IVPASS + 1 02700818 WRITE (NUVI, 80002) IVTNUM 02710818 GO TO 0131 02720818 20130 IVFAIL = IVFAIL + 1 02730818 DVCORR = -3.0102999566398119521D+00 02740818 WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR 02750818 0131 CONTINUE 02760818 CT014* TEST 13 AN ARGUMENT OF HIGH MAGNITUDE 02770818 IVTNUM = 13 02780818 BVD = 2.0D+35 02790818 AVD = DLOG10(BVD) 02800818 IF (AVD - 0.3530102997D+01) 20140, 10140, 40140 02810818 40140 IF (AVD - 0.3530103002D+02) 10140, 10140, 20140 02820818 10140 IVPASS = IVPASS + 1 02830818 WRITE (NUVI, 80002) IVTNUM 02840818 GO TO 0141 02850818 20140 IVFAIL = IVFAIL + 1 02860818 DVCORR = 35.301029995663981195D+00 02870818 WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR 02880818 0141 CONTINUE 02890818 CT015* TEST 14 AN ARGUMENT OF LOW MAGNITUDE 02900818 IVTNUM = 14 02910818 BVD = 2.0D-35 02920818 AVD = DLOG10(BVD) 02930818 IF (AVD + 0.3469897003D+02) 20150, 10150, 40150 02940818 40150 IF (AVD + 0.3469896998D+02) 10150, 10150, 20150 02950818 10150 IVPASS = IVPASS + 1 02960818 WRITE (NUVI, 80002) IVTNUM 02970818 GO TO 0151 02980818 20150 IVFAIL = IVFAIL + 1 02990818 DVCORR = -34.698970004336018805D+00 03000818 WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR 03010818 0151 CONTINUE 03020818 CT016* TEST 15 THE FUNCTION APPIED TWICE 03030818 IVTNUM = 15 03040818 AVD = DLOG10(20.0D0) - DLOG10(2.0D0) 03050818 IF (AVD - 0.9999999995D+00) 20160, 10160, 40160 03060818 40160 IF (AVD - 0.1000000001D+01) 10160, 10160, 20160 03070818 10160 IVPASS = IVPASS + 1 03080818 WRITE (NUVI, 80002) IVTNUM 03090818 GO TO 0161 03100818 20160 IVFAIL = IVFAIL + 1 03110818 DVCORR = 1.00000000000000D+00 03120818 WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR 03130818 0161 CONTINUE 03140818 C***** 03150818 CBB** ********************** BBCSUM0 **********************************03160818 C**** WRITE OUT TEST SUMMARY 03170818 C**** 03180818 IVTOTN = IVPASS + IVFAIL + IVDELE + IVINSP 03190818 WRITE (I02, 90004) 03200818 WRITE (I02, 90014) 03210818 WRITE (I02, 90004) 03220818 WRITE (I02, 90020) IVPASS 03230818 WRITE (I02, 90022) IVFAIL 03240818 WRITE (I02, 90024) IVDELE 03250818 WRITE (I02, 90026) IVINSP 03260818 WRITE (I02, 90028) IVTOTN, IVTOTL 03270818 CBE** ********************** BBCSUM0 **********************************03280818 CBB** ********************** BBCFOOT0 **********************************03290818 C**** WRITE OUT REPORT FOOTINGS 03300818 C**** 03310818 WRITE (I02,90016) ZPROG, ZPROG 03320818 WRITE (I02,90018) ZPROJ, ZNAME, ZTAPE, ZTAPED 03330818 WRITE (I02,90019) 03340818 CBE** ********************** BBCFOOT0 **********************************03350818 CBB** ********************** BBCFMT0A **********************************03360818 C**** FORMATS FOR TEST DETAIL LINES 03370818 C**** 03380818 80000 FORMAT (" ",2X,I3,4X,"DELETED",32X,A31) 03390818 80002 FORMAT (" ",2X,I3,4X," PASS ",32X,A31) 03400818 80004 FORMAT (" ",2X,I3,4X,"INSPECT",32X,A31) 03410818 80008 FORMAT (" ",2X,I3,4X," FAIL ",32X,A31) 03420818 80010 FORMAT (" ",2X,I3,4X," FAIL ",/," ",15X,"COMPUTED= " , 03430818 1I6,/," ",15X,"CORRECT= " ,I6) 03440818 80012 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 03450818 1E12.5,/," ",16X,"CORRECT= " ,E12.5) 03460818 80018 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 03470818 1A21,/," ",16X,"CORRECT= " ,A21) 03480818 80020 FORMAT (" ",16X,"COMPUTED= " ,A21,1X,A31) 03490818 80022 FORMAT (" ",16X,"CORRECT= " ,A21,1X,A31) 03500818 80024 FORMAT (" ",16X,"COMPUTED= " ,I6,16X,A31) 03510818 80026 FORMAT (" ",16X,"CORRECT= " ,I6,16X,A31) 03520818 80028 FORMAT (" ",16X,"COMPUTED= " ,E12.5,10X,A31) 03530818 80030 FORMAT (" ",16X,"CORRECT= " ,E12.5,10X,A31) 03540818 80050 FORMAT (" ",48X,A31) 03550818 CBE** ********************** BBCFMT0A **********************************03560818 CBB** ********************** BBCFMAT1 **********************************03570818 C**** FORMATS FOR TEST DETAIL LINES - FULL LANGUAGE 03580818 C**** 03590818 80031 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 03600818 1D17.10,/," ",16X,"CORRECT= " ,D17.10) 03610818 80033 FORMAT (" ",16X,"COMPUTED= " ,D17.10,10X,A31) 03620818 80035 FORMAT (" ",16X,"CORRECT= " ,D17.10,10X,A31) 03630818 80037 FORMAT (" ",16X,"COMPUTED= " ,"(",E12.5,", ",E12.5,")",6X,A31) 03640818 80039 FORMAT (" ",16X,"CORRECT= " ,"(",E12.5,", ",E12.5,")",6X,A31) 03650818 80041 FORMAT (" ",16X,"COMPUTED= " ,"(",F12.5,", ",F12.5,")",6X,A31) 03660818 80043 FORMAT (" ",16X,"CORRECT= " ,"(",F12.5,", ",F12.5,")",6X,A31) 03670818 80045 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 03680818 1"(",F12.5,", ",F12.5,")"/," ",16X,"CORRECT= " , 03690818 2"(",F12.5,", ",F12.5,")") 03700818 CBE** ********************** BBCFMAT1 **********************************03710818 CBB** ********************** BBCFMT0B **********************************03720818 C**** FORMAT STATEMENTS FOR PAGE HEADERS 03730818 C**** 03740818 90002 FORMAT ("1") 03750818 90004 FORMAT (" ") 03760818 90006 FORMAT (" ",20X,"NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY" )03770818 90007 FORMAT (" ",19X,"FORTRAN COMPILER VALIDATION SYSTEM" ) 03780818 90008 FORMAT (" ",21X,A13,A17) 03790818 90009 FORMAT (" ",/," *",A5,"BEGIN*",12X,"TEST RESULTS - " ,A5,/) 03800818 90010 FORMAT (" ",8X,"TEST DATE*TIME= " ,A17," - COMPILER= " ,A20) 03810818 90013 FORMAT (" "," TEST ","PASS/FAIL " ,6X,"DISPLAYED RESULTS" , 03820818 1 7X,"REMARKS",24X) 03830818 90014 FORMAT (" ","----------------------------------------------" , 03840818 1 "---------------------------------" ) 03850818 90015 FORMAT (" ",48X,"THIS PROGRAM HAS " ,I3," TESTS",/) 03860818 C**** 03870818 C**** FORMAT STATEMENTS FOR REPORT FOOTINGS 03880818 C**** 03890818 90016 FORMAT (" ",/," *",A5,"END*",14X,"END OF TEST - " ,A5,/) 03900818 90018 FORMAT (" ",A13,13X,A20," * ",A10,"/", 03910818 1 A13) 03920818 90019 FORMAT (" ","FOR OFFICIAL USE ONLY " ,35X,"COPYRIGHT 1982" ) 03930818 C**** 03940818 C**** FORMAT STATEMENTS FOR RUN SUMMARY 03950818 C**** 03960818 90020 FORMAT (" ",21X,I5," TESTS PASSED" ) 03970818 90022 FORMAT (" ",21X,I5," TESTS FAILED" ) 03980818 90024 FORMAT (" ",21X,I5," TESTS DELETED" ) 03990818 90026 FORMAT (" ",21X,I5," TESTS REQUIRE INSPECTION" ) 04000818 90028 FORMAT (" ",21X,I5," OF ",I3," TESTS EXECUTED" ) 04010818 CBE** ********************** BBCFMT0B **********************************04020818 C***** END OF TEST SEGMENT 185 04030818 STOP 04040818 END 04050818 04060818