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