| PROGRAM FM808 |
| |
| C***********************************************************************00010808 |
| C***** FORTRAN 77 00020808 |
| C***** FM808 YDBLE - (169) 00030808 |
| C***** 00040808 |
| C***********************************************************************00050808 |
| C***** GENERAL PURPOSE ANS REF 00060808 |
| C***** TEST INTRINSIC FUNCTION DBLE (EXPRESS S.P. ARGUMENT 15.3 00070808 |
| C***** IN DOUBLE PRECISION FORM ) (TABLE 5)00080808 |
| C***** 00090808 |
| CBB** ********************** BBCCOMNT **********************************00100808 |
| C**** 00110808 |
| C**** 1978 FORTRAN COMPILER VALIDATION SYSTEM 00120808 |
| C**** VERSION 2.1 00130808 |
| C**** 00140808 |
| C**** 00150808 |
| C**** SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO 00160808 |
| C**** NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY 00170808 |
| C**** SOFTWARE STANDARDS VALIDATION GROUP 00180808 |
| C**** BUILDING 225 RM A266 00190808 |
| C**** GAITHERSBURG, MD 20899 00200808 |
| C**** 00210808 |
| C**** 00220808 |
| C**** 00230808 |
| CBE** ********************** BBCCOMNT **********************************00240808 |
| C***** 00250808 |
| C***** S P E C I F I C A T I O N S SEGMENT 169 00260808 |
| DOUBLE PRECISION DVAVD, DVBVD, DVCORR, DVAVD1 00270808 |
| C***** 00280808 |
| CBB** ********************** BBCINITA **********************************00290808 |
| C**** SPECIFICATION STATEMENTS 00300808 |
| C**** 00310808 |
| CHARACTER ZVERS*13, ZVERSD*17, ZDATE*17, ZPROG*5, ZCOMPL*20, 00320808 |
| 1 ZNAME*20, ZTAPE*10, ZPROJ*13, REMRKS*31, ZTAPED*13 00330808 |
| CBE** ********************** BBCINITA **********************************00340808 |
| CBB** ********************** BBCINITB **********************************00350808 |
| C**** INITIALIZE SECTION 00360808 |
| DATA ZVERS, ZVERSD, ZDATE 00370808 |
| 1 /'VERSION 2.1 ', '93/10/21*21.02.00', '*NO DATE*TIME'/ 00380808 |
| DATA ZCOMPL, ZNAME, ZTAPE 00390808 |
| 1 /'*NONE SPECIFIED*', '*NO COMPANY NAME*', '*NO TAPE*'/ 00400808 |
| DATA ZPROJ, ZTAPED, ZPROG 00410808 |
| 1 /'*NO PROJECT*', '*NO TAPE DATE', 'XXXXX'/ 00420808 |
| DATA REMRKS /' '/ 00430808 |
| C**** THE FOLLOWING 9 COMMENT LINES (CZ01, CZ02, ...) CAN BE REPLACED 00440808 |
| C**** FOR IDENTIFYING THE TEST ENVIRONMENT 00450808 |
| C**** 00460808 |
| CZ01 ZVERS = 'VERSION OF THE COMPILER VALIDATION SYSTEM' 00470808 |
| CZ02 ZVERSD = 'CREATION DATE/TIME OF THE COMPILER VALIDATION SYSTEM' 00480808 |
| CZ03 ZPROG = 'PROGRAM NAME' 00490808 |
| CZ04 ZDATE = 'DATE OF TEST' 00500808 |
| CZ05 ZCOMPL = 'COMPILER IDENTIFICATION' 00510808 |
| CZ06 ZPROJ = 'PROJECT NUMBER/IDENTIFICATION' 00520808 |
| CZ07 ZNAME = 'NAME OF USER' 00530808 |
| CZ08 ZTAPE = 'TAPE OWNER/ID' 00540808 |
| CZ09 ZTAPED = 'DATE TAPE COPIED' 00550808 |
| C 00560808 |
| IVPASS = 0 00570808 |
| IVFAIL = 0 00580808 |
| IVDELE = 0 00590808 |
| IVINSP = 0 00600808 |
| IVTOTL = 0 00610808 |
| IVTOTN = 0 00620808 |
| ICZERO = 0 00630808 |
| C 00640808 |
| C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER. 00650808 |
| I01 = 05 00660808 |
| C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER. 00670808 |
| I02 = 06 00680808 |
| C 00690808 |
| CX010 REPLACED BY FEXEC X-010 CONTROL CARD (CARD-READER UNIT NUMBER). 00700808 |
| C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 00710808 |
| CX011 REPLACED BY FEXEC X-011 CONTROL CARD. CX011 IS FOR SYSTEMS 00720808 |
| C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX010. 00730808 |
| C 00740808 |
| CX020 REPLACED BY FEXEC X-020 CONTROL CARD (PRINTER UNIT NUMBER). 00750808 |
| C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02= 6 00760808 |
| CX021 REPLACED BY FEXEC X-021 CONTROL CARD. CX021 IS FOR SYSTEMS 00770808 |
| C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX020. 00780808 |
| C 00790808 |
| CBE** ********************** BBCINITB **********************************00800808 |
| NUVI = I02 00810808 |
| IVTOTL = 8 00820808 |
| ZPROG = 'FM808' 00830808 |
| CBB** ********************** BBCHED0A **********************************00840808 |
| C**** 00850808 |
| C**** WRITE REPORT TITLE 00860808 |
| C**** 00870808 |
| WRITE (I02, 90002) 00880808 |
| WRITE (I02, 90006) 00890808 |
| WRITE (I02, 90007) 00900808 |
| WRITE (I02, 90008) ZVERS, ZVERSD 00910808 |
| WRITE (I02, 90009) ZPROG, ZPROG 00920808 |
| WRITE (I02, 90010) ZDATE, ZCOMPL 00930808 |
| CBE** ********************** BBCHED0A **********************************00940808 |
| C***** 00950808 |
| WRITE (NUVI,16901) 00960808 |
| 16901 FORMAT(" ",//1X,"YDBLE - (169) INTRINSIC FUNCTION--" // 00970808 |
| 1 16X,"DBLE (TYPE CONVERSION)" // 2X, 00980808 |
| 2 "ANS REF. - 15.3" ) 00990808 |
| CBB** ********************** BBCHED0B **********************************01000808 |
| C**** WRITE DETAIL REPORT HEADERS 01010808 |
| C**** 01020808 |
| WRITE (I02,90004) 01030808 |
| WRITE (I02,90004) 01040808 |
| WRITE (I02,90013) 01050808 |
| WRITE (I02,90014) 01060808 |
| WRITE (I02,90015) IVTOTL 01070808 |
| CBE** ********************** BBCHED0B **********************************01080808 |
| C***** 01090808 |
| CT001* TEST 1 THE VALUE ZERO 01100808 |
| IVTNUM = 1 01110808 |
| RVAVS = 0.0 01120808 |
| DVAVD = DBLE(RVAVS) 01130808 |
| IF (DVAVD + 5.0D-5) 20010, 10010, 40010 01140808 |
| 40010 IF (DVAVD - 5.0D-5) 10010, 10010, 20010 01150808 |
| 10010 IVPASS = IVPASS + 1 01160808 |
| WRITE (NUVI, 80002) IVTNUM 01170808 |
| GO TO 0011 01180808 |
| 20010 IVFAIL = IVFAIL + 1 01190808 |
| DVCORR = 0.0D0 01200808 |
| WRITE (NUVI, 80031) IVTNUM, DVAVD, DVCORR 01210808 |
| 0011 CONTINUE 01220808 |
| CT002* TEST 2 A D.P. CONSTANT WITH 6 SIGNIFICANT DIGITS 01230808 |
| IVTNUM = 2 01240808 |
| RVAVS = 0.015625 01250808 |
| DVAVD = DBLE(RVAVS) 01260808 |
| IF (DVAVD - 1.5624D-2) 20020, 10020, 40020 01270808 |
| 40020 IF (DVAVD - 1.5626D-2) 10020, 10020, 20020 01280808 |
| 10020 IVPASS = IVPASS + 1 01290808 |
| WRITE (NUVI, 80002) IVTNUM 01300808 |
| GO TO 0021 01310808 |
| 20020 IVFAIL = IVFAIL + 1 01320808 |
| DVCORR = 1.5625D-2 01330808 |
| WRITE (NUVI, 80031) IVTNUM, DVAVD, DVCORR 01340808 |
| 0021 CONTINUE 01350808 |
| CT003* TEST 3 A NEGATIVE INTEGRAL VALUE 01360808 |
| IVTNUM = 3 01370808 |
| RVAVS = -321.0 01380808 |
| DVAVD = DBLE(RVAVS) 01390808 |
| IF (DVAVD + 3.2102D2) 20030, 10030, 40030 01400808 |
| 40030 IF (DVAVD + 3.2098D2) 10030, 10030, 20030 01410808 |
| 10030 IVPASS = IVPASS + 1 01420808 |
| WRITE (NUVI, 80002) IVTNUM 01430808 |
| GO TO 0031 01440808 |
| 20030 IVFAIL = IVFAIL + 1 01450808 |
| DVCORR = -3.210D2 01460808 |
| WRITE (NUVI, 80031) IVTNUM, DVAVD, DVCORR 01470808 |
| 0031 CONTINUE 01480808 |
| CT004* TEST 4 A NEGATIVE D.P. CONSTANT WITH 6 SIGNIFICANT DIGITS 01490808 |
| IVTNUM = 4 01500808 |
| RVAVS = -0.015625 01510808 |
| DVAVD = DBLE(RVAVS) 01520808 |
| IF (DVAVD + 1.5626D-2) 20040, 10040, 40040 01530808 |
| 40040 IF (DVAVD + 1.5624D-2) 10040, 10040, 20040 01540808 |
| 10040 IVPASS = IVPASS + 1 01550808 |
| WRITE (NUVI, 80002) IVTNUM 01560808 |
| GO TO 0041 01570808 |
| 20040 IVFAIL = IVFAIL + 1 01580808 |
| DVCORR = -0.015625D0 01590808 |
| WRITE (NUVI, 80031) IVTNUM, DVAVD, DVCORR 01600808 |
| 0041 CONTINUE 01610808 |
| CT005* TEST 5 THE VALUE ZERO PRECEDED BY A MINUS SIGN 01620808 |
| IVTNUM = 5 01630808 |
| RVAVS = 0.0 01640808 |
| DVAVD = DBLE(-RVAVS) 01650808 |
| IF (DVAVD + 5.0D-5) 20050, 10050, 40050 01660808 |
| 40050 IF (DVAVD - 5.0D-5) 10050, 10050, 20050 01670808 |
| 10050 IVPASS = IVPASS + 1 01680808 |
| WRITE (NUVI, 80002) IVTNUM 01690808 |
| GO TO 0051 01700808 |
| 20050 IVFAIL = IVFAIL + 1 01710808 |
| DVCORR = -0.0D0 01720808 |
| WRITE (NUVI, 80031) IVTNUM, DVAVD, DVCORR 01730808 |
| 0051 CONTINUE 01740808 |
| CT006* TEST 6 A POSITIVE INTEGRAL VALUE 01750808 |
| IVTNUM = 6 01760808 |
| RVAVS = 321.0 01770808 |
| DVAVD = DBLE(RVAVS) 01780808 |
| IF (DVAVD - 3.2098D2) 20060, 10060, 40060 01790808 |
| 40060 IF (DVAVD - 3.2102D2) 10060, 10060, 20060 01800808 |
| 10060 IVPASS = IVPASS + 1 01810808 |
| WRITE (NUVI, 80002) IVTNUM 01820808 |
| GO TO 0061 01830808 |
| 20060 IVFAIL = IVFAIL + 1 01840808 |
| DVCORR = 3.21D2 01850808 |
| WRITE (NUVI, 80031) IVTNUM, DVAVD, DVCORR 01860808 |
| 0061 CONTINUE 01870808 |
| CT007* TEST 7 AN ARITHMETIC EXPRESSION IS USED AS ARGUMENT 01880808 |
| IVTNUM = 7 01890808 |
| RVAVS = 6.25 01900808 |
| RVBVS = 2.5 01910808 |
| DVAVD = DBLE(RVBVS ** 2) 01920808 |
| IF (DVAVD - 6.2496D0) 20070, 10070, 40070 01930808 |
| 40070 IF (DVAVD - 6.2504D0) 10070, 10070, 20070 01940808 |
| 10070 IVPASS = IVPASS + 1 01950808 |
| WRITE (NUVI, 80002) IVTNUM 01960808 |
| GO TO 0071 01970808 |
| 20070 IVFAIL = IVFAIL + 1 01980808 |
| DVCORR = 6.25D0 01990808 |
| WRITE (NUVI, 80031) IVTNUM, DVAVD, DVCORR 02000808 |
| 0071 CONTINUE 02010808 |
| CT008* TEST 8 COMPARE AUTOMATIC TYPE CONVERSION TO EXPLICIT 02020808 |
| IVTNUM = 8 02030808 |
| RVBVS = 2.5 02040808 |
| DVBVD = RVBVS ** 3 02050808 |
| DVAVD = DBLE(RVBVS ** 3) 02060808 |
| IF (DVAVD - 1.5624D1) 20080, 10080, 40080 02070808 |
| 40080 IF (DVAVD - 1.5626D1) 10080, 10080, 20080 02080808 |
| 10080 IVPASS = IVPASS + 1 02090808 |
| WRITE (NUVI, 80002) IVTNUM 02100808 |
| GO TO 0081 02110808 |
| 20080 IVFAIL = IVFAIL + 1 02120808 |
| DVCORR = 1.5625D1 02130808 |
| WRITE (NUVI, 80031) IVTNUM, DVAVD, DVCORR 02140808 |
| 0081 CONTINUE 02150808 |
| CBB** ********************** BBCSUM0 **********************************02160808 |
| C**** WRITE OUT TEST SUMMARY 02170808 |
| C**** 02180808 |
| IVTOTN = IVPASS + IVFAIL + IVDELE + IVINSP 02190808 |
| WRITE (I02, 90004) 02200808 |
| WRITE (I02, 90014) 02210808 |
| WRITE (I02, 90004) 02220808 |
| WRITE (I02, 90020) IVPASS 02230808 |
| WRITE (I02, 90022) IVFAIL 02240808 |
| WRITE (I02, 90024) IVDELE 02250808 |
| WRITE (I02, 90026) IVINSP 02260808 |
| WRITE (I02, 90028) IVTOTN, IVTOTL 02270808 |
| CBE** ********************** BBCSUM0 **********************************02280808 |
| CBB** ********************** BBCFOOT0 **********************************02290808 |
| C**** WRITE OUT REPORT FOOTINGS 02300808 |
| C**** 02310808 |
| WRITE (I02,90016) ZPROG, ZPROG 02320808 |
| WRITE (I02,90018) ZPROJ, ZNAME, ZTAPE, ZTAPED 02330808 |
| WRITE (I02,90019) 02340808 |
| CBE** ********************** BBCFOOT0 **********************************02350808 |
| CBB** ********************** BBCFMT0A **********************************02360808 |
| C**** FORMATS FOR TEST DETAIL LINES 02370808 |
| C**** 02380808 |
| 80000 FORMAT (" ",2X,I3,4X,"DELETED",32X,A31) 02390808 |
| 80002 FORMAT (" ",2X,I3,4X," PASS ",32X,A31) 02400808 |
| 80004 FORMAT (" ",2X,I3,4X,"INSPECT",32X,A31) 02410808 |
| 80008 FORMAT (" ",2X,I3,4X," FAIL ",32X,A31) 02420808 |
| 80010 FORMAT (" ",2X,I3,4X," FAIL ",/," ",15X,"COMPUTED= " , 02430808 |
| 1I6,/," ",15X,"CORRECT= " ,I6) 02440808 |
| 80012 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 02450808 |
| 1E12.5,/," ",16X,"CORRECT= " ,E12.5) 02460808 |
| 80018 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 02470808 |
| 1A21,/," ",16X,"CORRECT= " ,A21) 02480808 |
| 80020 FORMAT (" ",16X,"COMPUTED= " ,A21,1X,A31) 02490808 |
| 80022 FORMAT (" ",16X,"CORRECT= " ,A21,1X,A31) 02500808 |
| 80024 FORMAT (" ",16X,"COMPUTED= " ,I6,16X,A31) 02510808 |
| 80026 FORMAT (" ",16X,"CORRECT= " ,I6,16X,A31) 02520808 |
| 80028 FORMAT (" ",16X,"COMPUTED= " ,E12.5,10X,A31) 02530808 |
| 80030 FORMAT (" ",16X,"CORRECT= " ,E12.5,10X,A31) 02540808 |
| 80050 FORMAT (" ",48X,A31) 02550808 |
| CBE** ********************** BBCFMT0A **********************************02560808 |
| CBB** ********************** BBCFMAT1 **********************************02570808 |
| C**** FORMATS FOR TEST DETAIL LINES - FULL LANGUAGE 02580808 |
| C**** 02590808 |
| 80031 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 02600808 |
| 1D17.10,/," ",16X,"CORRECT= " ,D17.10) 02610808 |
| 80033 FORMAT (" ",16X,"COMPUTED= " ,D17.10,10X,A31) 02620808 |
| 80035 FORMAT (" ",16X,"CORRECT= " ,D17.10,10X,A31) 02630808 |
| 80037 FORMAT (" ",16X,"COMPUTED= " ,"(",E12.5,", ",E12.5,")",6X,A31) 02640808 |
| 80039 FORMAT (" ",16X,"CORRECT= " ,"(",E12.5,", ",E12.5,")",6X,A31) 02650808 |
| 80041 FORMAT (" ",16X,"COMPUTED= " ,"(",F12.5,", ",F12.5,")",6X,A31) 02660808 |
| 80043 FORMAT (" ",16X,"CORRECT= " ,"(",F12.5,", ",F12.5,")",6X,A31) 02670808 |
| 80045 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 02680808 |
| 1"(",F12.5,", ",F12.5,")"/," ",16X,"CORRECT= " , 02690808 |
| 2"(",F12.5,", ",F12.5,")") 02700808 |
| CBE** ********************** BBCFMAT1 **********************************02710808 |
| CBB** ********************** BBCFMT0B **********************************02720808 |
| C**** FORMAT STATEMENTS FOR PAGE HEADERS 02730808 |
| C**** 02740808 |
| 90002 FORMAT ("1") 02750808 |
| 90004 FORMAT (" ") 02760808 |
| 90006 FORMAT (" ",20X,"NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY" )02770808 |
| 90007 FORMAT (" ",19X,"FORTRAN COMPILER VALIDATION SYSTEM" ) 02780808 |
| 90008 FORMAT (" ",21X,A13,A17) 02790808 |
| 90009 FORMAT (" ",/," *",A5,"BEGIN*",12X,"TEST RESULTS - " ,A5,/) 02800808 |
| 90010 FORMAT (" ",8X,"TEST DATE*TIME= " ,A17," - COMPILER= " ,A20) 02810808 |
| 90013 FORMAT (" "," TEST ","PASS/FAIL " ,6X,"DISPLAYED RESULTS" , 02820808 |
| 1 7X,"REMARKS",24X) 02830808 |
| 90014 FORMAT (" ","----------------------------------------------" , 02840808 |
| 1 "---------------------------------" ) 02850808 |
| 90015 FORMAT (" ",48X,"THIS PROGRAM HAS " ,I3," TESTS",/) 02860808 |
| C**** 02870808 |
| C**** FORMAT STATEMENTS FOR REPORT FOOTINGS 02880808 |
| C**** 02890808 |
| 90016 FORMAT (" ",/," *",A5,"END*",14X,"END OF TEST - " ,A5,/) 02900808 |
| 90018 FORMAT (" ",A13,13X,A20," * ",A10,"/", 02910808 |
| 1 A13) 02920808 |
| 90019 FORMAT (" ","FOR OFFICIAL USE ONLY " ,35X,"COPYRIGHT 1982" ) 02930808 |
| C**** 02940808 |
| C**** FORMAT STATEMENTS FOR RUN SUMMARY 02950808 |
| C**** 02960808 |
| 90020 FORMAT (" ",21X,I5," TESTS PASSED" ) 02970808 |
| 90022 FORMAT (" ",21X,I5," TESTS FAILED" ) 02980808 |
| 90024 FORMAT (" ",21X,I5," TESTS DELETED" ) 02990808 |
| 90026 FORMAT (" ",21X,I5," TESTS REQUIRE INSPECTION" ) 03000808 |
| 90028 FORMAT (" ",21X,I5," OF ",I3," TESTS EXECUTED" ) 03010808 |
| CBE** ********************** BBCFMT0B **********************************03020808 |
| C***** 03030808 |
| C***** END OF TEST SEGMENT 169 03040808 |
| STOP 03050808 |
| END 03060808 |
| 03070808 |
