      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