PROGRAM FM812 C***********************************************************************00010812 C***** FORTRAN 77 00020812 C***** FM812 00030812 C***** YDSQRT - (176) 00040812 C***** 00050812 C***********************************************************************00060812 C***** GENERAL PURPOSE ANS REF 00070812 C***** TEST INTRINSIC FUNCTION DSQRT 15.3 00080812 C***** TABLE 5 00090812 C***** 00100812 CBB** ********************** BBCCOMNT **********************************00110812 C**** 00120812 C**** 1978 FORTRAN COMPILER VALIDATION SYSTEM 00130812 C**** VERSION 2.1 00140812 C**** 00150812 C**** 00160812 C**** SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO 00170812 C**** NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY 00180812 C**** SOFTWARE STANDARDS VALIDATION GROUP 00190812 C**** BUILDING 225 RM A266 00200812 C**** GAITHERSBURG, MD 20899 00210812 C**** 00220812 C**** 00230812 C**** 00240812 CBE** ********************** BBCCOMNT **********************************00250812 C***** S P E C I F I C A T I O N S SEGMENT 176 00260812 DOUBLE PRECISION AVD, BVD, DVCORR 00270812 C***** 00280812 CBB** ********************** BBCINITA **********************************00290812 C**** SPECIFICATION STATEMENTS 00300812 C**** 00310812 CHARACTER ZVERS*13, ZVERSD*17, ZDATE*17, ZPROG*5, ZCOMPL*20, 00320812 1 ZNAME*20, ZTAPE*10, ZPROJ*13, REMRKS*31, ZTAPED*13 00330812 CBE** ********************** BBCINITA **********************************00340812 CBB** ********************** BBCINITB **********************************00350812 C**** INITIALIZE SECTION 00360812 DATA ZVERS, ZVERSD, ZDATE 00370812 1 /'VERSION 2.1 ', '93/10/21*21.02.00', '*NO DATE*TIME'/ 00380812 DATA ZCOMPL, ZNAME, ZTAPE 00390812 1 /'*NONE SPECIFIED*', '*NO COMPANY NAME*', '*NO TAPE*'/ 00400812 DATA ZPROJ, ZTAPED, ZPROG 00410812 1 /'*NO PROJECT*', '*NO TAPE DATE', 'XXXXX'/ 00420812 DATA REMRKS /' '/ 00430812 C**** THE FOLLOWING 9 COMMENT LINES (CZ01, CZ02, ...) CAN BE REPLACED 00440812 C**** FOR IDENTIFYING THE TEST ENVIRONMENT 00450812 C**** 00460812 CZ01 ZVERS = 'VERSION OF THE COMPILER VALIDATION SYSTEM' 00470812 CZ02 ZVERSD = 'CREATION DATE/TIME OF THE COMPILER VALIDATION SYSTEM' 00480812 CZ03 ZPROG = 'PROGRAM NAME' 00490812 CZ04 ZDATE = 'DATE OF TEST' 00500812 CZ05 ZCOMPL = 'COMPILER IDENTIFICATION' 00510812 CZ06 ZPROJ = 'PROJECT NUMBER/IDENTIFICATION' 00520812 CZ07 ZNAME = 'NAME OF USER' 00530812 CZ08 ZTAPE = 'TAPE OWNER/ID' 00540812 CZ09 ZTAPED = 'DATE TAPE COPIED' 00550812 C 00560812 IVPASS = 0 00570812 IVFAIL = 0 00580812 IVDELE = 0 00590812 IVINSP = 0 00600812 IVTOTL = 0 00610812 IVTOTN = 0 00620812 ICZERO = 0 00630812 C 00640812 C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER. 00650812 I01 = 05 00660812 C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER. 00670812 I02 = 06 00680812 C 00690812 CX010 REPLACED BY FEXEC X-010 CONTROL CARD (CARD-READER UNIT NUMBER). 00700812 C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 00710812 CX011 REPLACED BY FEXEC X-011 CONTROL CARD. CX011 IS FOR SYSTEMS 00720812 C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX010. 00730812 C 00740812 CX020 REPLACED BY FEXEC X-020 CONTROL CARD (PRINTER UNIT NUMBER). 00750812 C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02= 6 00760812 CX021 REPLACED BY FEXEC X-021 CONTROL CARD. CX021 IS FOR SYSTEMS 00770812 C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX020. 00780812 C 00790812 CBE** ********************** BBCINITB **********************************00800812 NUVI = I02 00810812 IVTOTL = 13 00820812 ZPROG = 'FM812' 00830812 CBB** ********************** BBCHED0A **********************************00840812 C**** 00850812 C**** WRITE REPORT TITLE 00860812 C**** 00870812 WRITE (I02, 90002) 00880812 WRITE (I02, 90006) 00890812 WRITE (I02, 90007) 00900812 WRITE (I02, 90008) ZVERS, ZVERSD 00910812 WRITE (I02, 90009) ZPROG, ZPROG 00920812 WRITE (I02, 90010) ZDATE, ZCOMPL 00930812 CBE** ********************** BBCHED0A **********************************00940812 C***** 00950812 C***** HEADER FOR SEGMENT 176 00960812 WRITE(NUVI,17600) 00970812 17600 FORMAT(" ", / " YDSQRT - (176) INTRINSIC FUNCTIONS" // 00980812 1 " DSQRT (DOUBLE PRECISION SQUARE ROOT)" // 00990812 2 " ANS REF. - 15.3" ) 01000812 CBB** ********************** BBCHED0B **********************************01010812 C**** WRITE DETAIL REPORT HEADERS 01020812 C**** 01030812 WRITE (I02,90004) 01040812 WRITE (I02,90004) 01050812 WRITE (I02,90013) 01060812 WRITE (I02,90014) 01070812 WRITE (I02,90015) IVTOTL 01080812 CBE** ********************** BBCHED0B **********************************01090812 C***** 01100812 CT001* TEST 1 FIXED POINT OF FUNCTION 01110812 IVTNUM = 1 01120812 BVD = 0.0D0 01130812 AVD = DSQRT(BVD) 01140812 IF (AVD + 0.5000000000D-09) 20010, 10010, 40010 01150812 40010 IF (AVD - 0.5000000000D-09) 10010, 10010, 20010 01160812 10010 IVPASS = IVPASS + 1 01170812 WRITE (NUVI, 80002) IVTNUM 01180812 GO TO 0011 01190812 20010 IVFAIL = IVFAIL + 1 01200812 DVCORR = 0.00000000000000000000D0 01210812 WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR 01220812 0011 CONTINUE 01230812 CT002* TEST 2 FIXED POINT OF FUNCTION 01240812 IVTNUM = 2 01250812 AVD = DSQRT(1.0D0) 01260812 IF (AVD - 0.9999999995D+00) 20020, 10020, 40020 01270812 40020 IF (AVD - 0.1000000001D+01) 10020, 10020, 20020 01280812 10020 IVPASS = IVPASS + 1 01290812 WRITE (NUVI, 80002) IVTNUM 01300812 GO TO 0021 01310812 20020 IVFAIL = IVFAIL + 1 01320812 DVCORR = 1.0000000000000000000D0 01330812 WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR 01340812 0021 CONTINUE 01350812 CT003* TEST 3 CONSTANT OF VALUE 2.0D0 01360812 IVTNUM = 3 01370812 AVD = DSQRT(2.0D0) 01380812 IF (AVD - 0.1414213561D+01) 20030, 10030, 40030 01390812 40030 IF (AVD - 0.1414213563D+01) 10030, 10030, 20030 01400812 10030 IVPASS = IVPASS + 1 01410812 WRITE (NUVI, 80002) IVTNUM 01420812 GO TO 0031 01430812 20030 IVFAIL = IVFAIL + 1 01440812 DVCORR = 1.4142135623730950488D0 01450812 WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR 01460812 0031 CONTINUE 01470812 CT004* TEST 4 CONSTANT OF VALUE 4.0D0 01480812 IVTNUM = 4 01490812 AVD = DSQRT(4.0D0) 01500812 IF (AVD - 0.1999999999D+01) 20040, 10040, 40040 01510812 40040 IF (AVD - 0.2000000001D+01) 10040, 10040, 20040 01520812 10040 IVPASS = IVPASS + 1 01530812 WRITE (NUVI, 80002) IVTNUM 01540812 GO TO 0041 01550812 20040 IVFAIL = IVFAIL + 1 01560812 DVCORR = 2.0000000000000000000D0 01570812 WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR 01580812 0041 CONTINUE 01590812 CT005* TEST 5 CONSTANT OF VALUE 15.0D0 01600812 IVTNUM = 5 01610812 AVD = DSQRT(15.0D0) 01620812 IF (AVD - 0.3872983344D+01) 20050, 10050, 40050 01630812 40050 IF (AVD - 0.3872983348D+01) 10050, 10050, 20050 01640812 10050 IVPASS = IVPASS + 1 01650812 WRITE (NUVI, 80002) IVTNUM 01660812 GO TO 0051 01670812 20050 IVFAIL = IVFAIL + 1 01680812 DVCORR = 3.8729833462074168852D0 01690812 WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR 01700812 0051 CONTINUE 01710812 CT006* TEST 6 CONSTANT OF VALUE 31.0D0 01720812 IVTNUM = 6 01730812 AVD = DSQRT(31.0D0) 01740812 IF (AVD - 0.5567764360D+01) 20060, 10060, 40060 01750812 40060 IF (AVD - 0.5567764366D+01) 10060, 10060, 20060 01760812 10060 IVPASS = IVPASS + 1 01770812 WRITE (NUVI, 80002) IVTNUM 01780812 GO TO 0061 01790812 20060 IVFAIL = IVFAIL + 1 01800812 DVCORR = 5.5677643628300219221D0 01810812 WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR 01820812 0061 CONTINUE 01830812 CT007* TEST 7 VARIABLE PRESENTED TO DSQRT 01840812 IVTNUM = 7 01850812 BVD = 2.0D0 / 4.0D0 01860812 AVD = DSQRT(BVD) 01870812 IF (AVD - 0.7071067808D+00) 20070, 10070, 40070 01880812 40070 IF (AVD - 0.7071067816D+00) 10070, 10070, 20070 01890812 10070 IVPASS = IVPASS + 1 01900812 WRITE (NUVI, 80002) IVTNUM 01910812 GO TO 0071 01920812 20070 IVFAIL = IVFAIL + 1 01930812 DVCORR = 0.70710678118654752440D0 01940812 WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR 01950812 0071 CONTINUE 01960812 CT008* TEST 8 EXPRESSION PRESENTED TO DSQRT 01970812 IVTNUM = 8 01980812 BVD = 25.0D0 01990812 AVD = DSQRT(BVD / 100.0D0) 02000812 IF (AVD - 0.4999999997D+00) 20080, 10080, 40080 02010812 40080 IF (AVD - 0.5000000003D+00) 10080, 10080, 20080 02020812 10080 IVPASS = IVPASS + 1 02030812 WRITE (NUVI, 80002) IVTNUM 02040812 GO TO 0081 02050812 20080 IVFAIL = IVFAIL + 1 02060812 DVCORR = 0.50000000000000000000D0 02070812 WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR 02080812 0081 CONTINUE 02090812 CT009* TEST 9 EXPRESSION PRESENTED TO DSQRT 02100812 IVTNUM = 9 02110812 BVD = 0.0875D0 02120812 AVD = DSQRT(BVD * 10.0D0) 02130812 IF (AVD - 0.9354143462D+00) 20090, 10090, 40090 02140812 40090 IF (AVD - 0.9354143472D+00) 10090, 10090, 20090 02150812 10090 IVPASS = IVPASS + 1 02160812 WRITE (NUVI, 80002) IVTNUM 02170812 GO TO 0091 02180812 20090 IVFAIL = IVFAIL + 1 02190812 DVCORR = 0.93541434669348534640D0 02200812 WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR 02210812 0091 CONTINUE 02220812 CT010* TEST 10 AN EXPRESSION WITH VALUE CLOSE TO ONE 02230812 IVTNUM = 10 02240812 AVD = DSQRT(31.0D0 / 32.0D0) 02250812 IF (AVD - 0.9842509837D+00) 20100, 10100, 40100 02260812 40100 IF (AVD - 0.9842509848D+00) 10100, 10100, 20100 02270812 10100 IVPASS = IVPASS + 1 02280812 WRITE (NUVI, 80002) IVTNUM 02290812 GO TO 0101 02300812 20100 IVFAIL = IVFAIL + 1 02310812 DVCORR = 0.98425098425147637746D0 02320812 WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR 02330812 0101 CONTINUE 02340812 CT011* TEST 11 AN ARGUMENT OF LOW MAGNITUDE 02350812 IVTNUM = 11 02360812 AVD = DSQRT(1.6D-35) 02370812 IF (AVD - 0.3999999998D-17) 20110, 10110, 40110 02380812 40110 IF (AVD - 0.4000000002D-17) 10110, 10110, 20110 02390812 10110 IVPASS = IVPASS + 1 02400812 WRITE (NUVI, 80002) IVTNUM 02410812 GO TO 0111 02420812 20110 IVFAIL = IVFAIL + 1 02430812 DVCORR = 0.40000000000000000000D-17 02440812 WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR 02450812 0111 CONTINUE 02460812 CT012* TEST 12 AN ARGUMENT OF HIGH MAGNITUDE 02470812 IVTNUM = 12 02480812 AVD = DSQRT(1.0D+35) 02490812 IF (AVD - 0.3162277658D+18) 20120, 10120, 40120 02500812 40120 IF (AVD - 0.3162277662D+18) 10120, 10120, 20120 02510812 10120 IVPASS = IVPASS + 1 02520812 WRITE (NUVI, 80002) IVTNUM 02530812 GO TO 0121 02540812 20120 IVFAIL = IVFAIL + 1 02550812 DVCORR = 0.31622776601683793320D+18 02560812 WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR 02570812 0121 CONTINUE 02580812 CT013* TEST 13 THE FUNCTION APPLIED TWICE 02590812 IVTNUM = 13 02600812 BVD = DSQRT(1.6D0) 02610812 AVD = DSQRT(0.625D0) * BVD 02620812 IF (AVD - 0.9999999995D+00) 20130, 10130, 40130 02630812 40130 IF (AVD - 0.1000000001D+01) 10130, 10130, 20130 02640812 10130 IVPASS = IVPASS + 1 02650812 WRITE (NUVI, 80002) IVTNUM 02660812 GO TO 0131 02670812 20130 IVFAIL = IVFAIL + 1 02680812 DVCORR = 1.00000000000000D0 02690812 WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR 02700812 0131 CONTINUE 02710812 C***** 02720812 CBB** ********************** BBCSUM0 **********************************02730812 C**** WRITE OUT TEST SUMMARY 02740812 C**** 02750812 IVTOTN = IVPASS + IVFAIL + IVDELE + IVINSP 02760812 WRITE (I02, 90004) 02770812 WRITE (I02, 90014) 02780812 WRITE (I02, 90004) 02790812 WRITE (I02, 90020) IVPASS 02800812 WRITE (I02, 90022) IVFAIL 02810812 WRITE (I02, 90024) IVDELE 02820812 WRITE (I02, 90026) IVINSP 02830812 WRITE (I02, 90028) IVTOTN, IVTOTL 02840812 CBE** ********************** BBCSUM0 **********************************02850812 CBB** ********************** BBCFOOT0 **********************************02860812 C**** WRITE OUT REPORT FOOTINGS 02870812 C**** 02880812 WRITE (I02,90016) ZPROG, ZPROG 02890812 WRITE (I02,90018) ZPROJ, ZNAME, ZTAPE, ZTAPED 02900812 WRITE (I02,90019) 02910812 CBE** ********************** BBCFOOT0 **********************************02920812 CBB** ********************** BBCFMT0A **********************************02930812 C**** FORMATS FOR TEST DETAIL LINES 02940812 C**** 02950812 80000 FORMAT (" ",2X,I3,4X,"DELETED",32X,A31) 02960812 80002 FORMAT (" ",2X,I3,4X," PASS ",32X,A31) 02970812 80004 FORMAT (" ",2X,I3,4X,"INSPECT",32X,A31) 02980812 80008 FORMAT (" ",2X,I3,4X," FAIL ",32X,A31) 02990812 80010 FORMAT (" ",2X,I3,4X," FAIL ",/," ",15X,"COMPUTED= " , 03000812 1I6,/," ",15X,"CORRECT= " ,I6) 03010812 80012 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 03020812 1E12.5,/," ",16X,"CORRECT= " ,E12.5) 03030812 80018 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 03040812 1A21,/," ",16X,"CORRECT= " ,A21) 03050812 80020 FORMAT (" ",16X,"COMPUTED= " ,A21,1X,A31) 03060812 80022 FORMAT (" ",16X,"CORRECT= " ,A21,1X,A31) 03070812 80024 FORMAT (" ",16X,"COMPUTED= " ,I6,16X,A31) 03080812 80026 FORMAT (" ",16X,"CORRECT= " ,I6,16X,A31) 03090812 80028 FORMAT (" ",16X,"COMPUTED= " ,E12.5,10X,A31) 03100812 80030 FORMAT (" ",16X,"CORRECT= " ,E12.5,10X,A31) 03110812 80050 FORMAT (" ",48X,A31) 03120812 CBE** ********************** BBCFMT0A **********************************03130812 CBB** ********************** BBCFMAT1 **********************************03140812 C**** FORMATS FOR TEST DETAIL LINES - FULL LANGUAGE 03150812 C**** 03160812 80031 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 03170812 1D17.10,/," ",16X,"CORRECT= " ,D17.10) 03180812 80033 FORMAT (" ",16X,"COMPUTED= " ,D17.10,10X,A31) 03190812 80035 FORMAT (" ",16X,"CORRECT= " ,D17.10,10X,A31) 03200812 80037 FORMAT (" ",16X,"COMPUTED= " ,"(",E12.5,", ",E12.5,")",6X,A31) 03210812 80039 FORMAT (" ",16X,"CORRECT= " ,"(",E12.5,", ",E12.5,")",6X,A31) 03220812 80041 FORMAT (" ",16X,"COMPUTED= " ,"(",F12.5,", ",F12.5,")",6X,A31) 03230812 80043 FORMAT (" ",16X,"CORRECT= " ,"(",F12.5,", ",F12.5,")",6X,A31) 03240812 80045 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 03250812 1"(",F12.5,", ",F12.5,")"/," ",16X,"CORRECT= " , 03260812 2"(",F12.5,", ",F12.5,")") 03270812 CBE** ********************** BBCFMAT1 **********************************03280812 CBB** ********************** BBCFMT0B **********************************03290812 C**** FORMAT STATEMENTS FOR PAGE HEADERS 03300812 C**** 03310812 90002 FORMAT ("1") 03320812 90004 FORMAT (" ") 03330812 90006 FORMAT (" ",20X,"NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY" )03340812 90007 FORMAT (" ",19X,"FORTRAN COMPILER VALIDATION SYSTEM" ) 03350812 90008 FORMAT (" ",21X,A13,A17) 03360812 90009 FORMAT (" ",/," *",A5,"BEGIN*",12X,"TEST RESULTS - " ,A5,/) 03370812 90010 FORMAT (" ",8X,"TEST DATE*TIME= " ,A17," - COMPILER= " ,A20) 03380812 90013 FORMAT (" "," TEST ","PASS/FAIL " ,6X,"DISPLAYED RESULTS" , 03390812 1 7X,"REMARKS",24X) 03400812 90014 FORMAT (" ","----------------------------------------------" , 03410812 1 "---------------------------------" ) 03420812 90015 FORMAT (" ",48X,"THIS PROGRAM HAS " ,I3," TESTS",/) 03430812 C**** 03440812 C**** FORMAT STATEMENTS FOR REPORT FOOTINGS 03450812 C**** 03460812 90016 FORMAT (" ",/," *",A5,"END*",14X,"END OF TEST - " ,A5,/) 03470812 90018 FORMAT (" ",A13,13X,A20," * ",A10,"/", 03480812 1 A13) 03490812 90019 FORMAT (" ","FOR OFFICIAL USE ONLY " ,35X,"COPYRIGHT 1982" ) 03500812 C**** 03510812 C**** FORMAT STATEMENTS FOR RUN SUMMARY 03520812 C**** 03530812 90020 FORMAT (" ",21X,I5," TESTS PASSED" ) 03540812 90022 FORMAT (" ",21X,I5," TESTS FAILED" ) 03550812 90024 FORMAT (" ",21X,I5," TESTS DELETED" ) 03560812 90026 FORMAT (" ",21X,I5," TESTS REQUIRE INSPECTION" ) 03570812 90028 FORMAT (" ",21X,I5," OF ",I3," TESTS EXECUTED" ) 03580812 CBE** ********************** BBCFMT0B **********************************03590812 C***** END OF TEST SEGMENT 176 03600812 STOP 03610812 END 03620812 03630812