blob: a0a3667893214fea5ab6e29f752b9abca8b4b922 [file] [log] [blame]
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