FM368.f Source File


Contents

Source Code


Source Code

      PROGRAM FM368

C***********************************************************************00010368
C*****  FORTRAN 77                                                      00020368
C*****   FM368                                                          00030368
C*****                       XSQRT - (175)                              00040368
C*****                                                                  00050368
C***********************************************************************00060368
C*****  GENERAL PURPOSE                                      SUBSET REF 00070368
C*****    TEST INTRINSIC FUNCTION SQRT                         15.3     00080368
C*****                                                        TABLE 5   00090368
C*****                                                                  00100368
CBB** ********************** BBCCOMNT **********************************00110368
C****                                                                   00120368
C****            1978 FORTRAN COMPILER VALIDATION SYSTEM                00130368
C****                          VERSION 2.1                              00140368
C****                                                                   00150368
C****                                                                   00160368
C****           SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO         00170368
C****          NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY           00180368
C****               SOFTWARE STANDARDS VALIDATION GROUP                 00190368
C****                      BUILDING 225  RM A266                        00200368
C****                     GAITHERSBURG, MD  20899                       00210368
C****                                                                   00220368
C****                                                                   00230368
C****                                                                   00240368
CBE** ********************** BBCCOMNT **********************************00250368
CBB** ********************** BBCINITA **********************************00260368
C**** SPECIFICATION STATEMENTS                                          00270368
C****                                                                   00280368
      CHARACTER ZVERS*13, ZVERSD*17, ZDATE*17, ZPROG*5, ZCOMPL*20,      00290368
     1          ZNAME*20, ZTAPE*10, ZPROJ*13, REMRKS*31, ZTAPED*13      00300368
CBE** ********************** BBCINITA **********************************00310368
CBB** ********************** BBCINITB **********************************00320368
C**** INITIALIZE SECTION                                                00330368
      DATA  ZVERS,                  ZVERSD,             ZDATE           00340368
     1      /'VERSION 2.1  ',  '93/10/21*21.02.00',  '*NO DATE*TIME'/   00350368
      DATA       ZCOMPL,             ZNAME,             ZTAPE           00360368
     1      /'*NONE SPECIFIED*', '*NO COMPANY NAME*', '*NO TAPE*'/      00370368
      DATA       ZPROJ,           ZTAPED,         ZPROG                 00380368
     1      /'*NO PROJECT*',   '*NO TAPE DATE',  'XXXXX'/               00390368
      DATA   REMRKS /'                               '/                 00400368
C**** THE FOLLOWING 9 COMMENT LINES (CZ01, CZ02, ...) CAN BE REPLACED   00410368
C**** FOR IDENTIFYING THE TEST ENVIRONMENT                              00420368
C****                                                                   00430368
CZ01  ZVERS  = 'VERSION OF THE COMPILER VALIDATION SYSTEM'              00440368
CZ02  ZVERSD = 'CREATION DATE/TIME OF THE COMPILER VALIDATION SYSTEM'   00450368
CZ03  ZPROG  = 'PROGRAM NAME'                                           00460368
CZ04  ZDATE  = 'DATE OF TEST'                                           00470368
CZ05  ZCOMPL = 'COMPILER IDENTIFICATION'                                00480368
CZ06  ZPROJ  = 'PROJECT NUMBER/IDENTIFICATION'                          00490368
CZ07  ZNAME  = 'NAME OF USER'                                           00500368
CZ08  ZTAPE  = 'TAPE OWNER/ID'                                          00510368
CZ09  ZTAPED = 'DATE TAPE COPIED'                                       00520368
C                                                                       00530368
      IVPASS = 0                                                        00540368
      IVFAIL = 0                                                        00550368
      IVDELE = 0                                                        00560368
      IVINSP = 0                                                        00570368
      IVTOTL = 0                                                        00580368
      IVTOTN = 0                                                        00590368
      ICZERO = 0                                                        00600368
C                                                                       00610368
C     I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER.         00620368
      I01 = 05                                                          00630368
C     I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER.             00640368
      I02 = 06                                                          00650368
C                                                                       00660368
CX010   REPLACED BY FEXEC X-010 CONTROL CARD (CARD-READER UNIT NUMBER). 00670368
C     THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5      00680368
CX011   REPLACED BY FEXEC X-011 CONTROL CARD.  CX011 IS FOR SYSTEMS     00690368
C     REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX010.  00700368
C                                                                       00710368
CX020   REPLACED BY FEXEC X-020 CONTROL CARD (PRINTER UNIT NUMBER).     00720368
C     THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02= 6       00730368
CX021   REPLACED BY FEXEC X-021 CONTROL CARD.  CX021 IS FOR SYSTEMS     00740368
C     REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX020.  00750368
C                                                                       00760368
CBE** ********************** BBCINITB **********************************00770368
      NUVI = I02                                                        00780368
      IVTOTL = 13                                                       00790368
      ZPROG = 'FM368'                                                   00800368
CBB** ********************** BBCHED0A **********************************00810368
C****                                                                   00820368
C**** WRITE REPORT TITLE                                                00830368
C****                                                                   00840368
      WRITE (I02, 90002)                                                00850368
      WRITE (I02, 90006)                                                00860368
      WRITE (I02, 90007)                                                00870368
      WRITE (I02, 90008)  ZVERS, ZVERSD                                 00880368
      WRITE (I02, 90009)  ZPROG, ZPROG                                  00890368
      WRITE (I02, 90010)  ZDATE, ZCOMPL                                 00900368
CBE** ********************** BBCHED0A **********************************00910368
C*****                                                                  00920368
C*****    HEADER FOR SEGMENT 175                                        00930368
        WRITE(NUVI,17500)                                               00940368
17500   FORMAT(" ", / "  XSQRT - (175) INTRINSIC FUNCTIONS" //          00950368
     1         "  SQRT (SQUARE ROOT)" //                                00960368
     2         "  SUBSET REF. - 15.3" )                                 00970368
CBB** ********************** BBCHED0B **********************************00980368
C**** WRITE DETAIL REPORT HEADERS                                       00990368
C****                                                                   01000368
      WRITE (I02,90004)                                                 01010368
      WRITE (I02,90004)                                                 01020368
      WRITE (I02,90013)                                                 01030368
      WRITE (I02,90014)                                                 01040368
      WRITE (I02,90015) IVTOTL                                          01050368
CBE** ********************** BBCHED0B **********************************01060368
C*****                                                                  01070368
CT001*  TEST 1                                FIXED POINT OF FUNCTION   01080368
           IVTNUM = 1                                                   01090368
        BVS = 0.0                                                       01100368
        AVS = SQRT(BVS)                                                 01110368
           IF (AVS + 0.50000E-04) 20010, 10010, 40010                   01120368
40010      IF (AVS - 0.50000E-04) 10010, 10010, 20010                   01130368
10010      IVPASS = IVPASS + 1                                          01140368
           WRITE (NUVI, 80002) IVTNUM                                   01150368
           GO TO 0011                                                   01160368
20010      IVFAIL = IVFAIL + 1                                          01170368
           RVCORR = 0.00000000000000                                    01180368
           WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR                      01190368
 0011      CONTINUE                                                     01200368
CT002*  TEST 2                                FIXED POINT OF FUNCTION   01210368
           IVTNUM = 2                                                   01220368
        AVS = SQRT(1.0)                                                 01230368
           IF (AVS - 0.99995E+00) 20020, 10020, 40020                   01240368
40020      IF (AVS - 0.10001E+01) 10020, 10020, 20020                   01250368
10020      IVPASS = IVPASS + 1                                          01260368
           WRITE (NUVI, 80002) IVTNUM                                   01270368
           GO TO 0021                                                   01280368
20020      IVFAIL = IVFAIL + 1                                          01290368
           RVCORR = 1.00000000000000                                    01300368
           WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR                      01310368
 0021      CONTINUE                                                     01320368
CT003*  TEST 3                                                          01330368
           IVTNUM = 3                                                   01340368
        AVS = SQRT(2.0)                                                 01350368
           IF (AVS - 0.14141E+01) 20030, 10030, 40030                   01360368
40030      IF (AVS - 0.14143E+01) 10030, 10030, 20030                   01370368
10030      IVPASS = IVPASS + 1                                          01380368
           WRITE (NUVI, 80002) IVTNUM                                   01390368
           GO TO 0031                                                   01400368
20030      IVFAIL = IVFAIL + 1                                          01410368
           RVCORR = 1.41421356237310                                    01420368
           WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR                      01430368
 0031      CONTINUE                                                     01440368
CT004*  TEST 4                                                          01450368
           IVTNUM = 4                                                   01460368
        AVS = SQRT(4.0)                                                 01470368
           IF (AVS - 0.19999E+01) 20040, 10040, 40040                   01480368
40040      IF (AVS - 0.20001E+01) 10040, 10040, 20040                   01490368
10040      IVPASS = IVPASS + 1                                          01500368
           WRITE (NUVI, 80002) IVTNUM                                   01510368
           GO TO 0041                                                   01520368
20040      IVFAIL = IVFAIL + 1                                          01530368
           RVCORR = 2.00000000000000                                    01540368
           WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR                      01550368
 0041      CONTINUE                                                     01560368
CT005*  TEST 5                                                          01570368
           IVTNUM = 5                                                   01580368
        AVS = SQRT(15.0)                                                01590368
           IF (AVS - 0.38727E+01) 20050, 10050, 40050                   01600368
40050      IF (AVS - 0.38732E+01) 10050, 10050, 20050                   01610368
10050      IVPASS = IVPASS + 1                                          01620368
           WRITE (NUVI, 80002) IVTNUM                                   01630368
           GO TO 0051                                                   01640368
20050      IVFAIL = IVFAIL + 1                                          01650368
           RVCORR = 3.87298334620742                                    01660368
           WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR                      01670368
 0051      CONTINUE                                                     01680368
CT006*  TEST 6                                                          01690368
           IVTNUM = 6                                                   01700368
        AVS = SQRT(31.0)                                                01710368
           IF (AVS - 0.55674E+01) 20060, 10060, 40060                   01720368
40060      IF (AVS - 0.55681E+01) 10060, 10060, 20060                   01730368
10060      IVPASS = IVPASS + 1                                          01740368
           WRITE (NUVI, 80002) IVTNUM                                   01750368
           GO TO 0061                                                   01760368
20060      IVFAIL = IVFAIL + 1                                          01770368
           RVCORR = 5.56776436283002                                    01780368
           WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR                      01790368
 0061      CONTINUE                                                     01800368
CT007*  TEST 7                                                          01810368
           IVTNUM = 7                                                   01820368
        BVS = 2.0/4.0                                                   01830368
        AVS = SQRT(BVS)                                                 01840368
           IF (AVS - 0.70707E+00) 20070, 10070, 40070                   01850368
40070      IF (AVS - 0.70715E+00) 10070, 10070, 20070                   01860368
10070      IVPASS = IVPASS + 1                                          01870368
           WRITE (NUVI, 80002) IVTNUM                                   01880368
           GO TO 0071                                                   01890368
20070      IVFAIL = IVFAIL + 1                                          01900368
           RVCORR = 0.70710678118655                                    01910368
           WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR                      01920368
 0071      CONTINUE                                                     01930368
CT008*  TEST 8                                                          01940368
           IVTNUM = 8                                                   01950368
        BVS = 25.0                                                      01960368
        AVS = SQRT(BVS/100.0)                                           01970368
           IF (AVS - 0.49997E+00) 20080, 10080, 40080                   01980368
40080      IF (AVS - 0.50003E+00) 10080, 10080, 20080                   01990368
10080      IVPASS = IVPASS + 1                                          02000368
           WRITE (NUVI, 80002) IVTNUM                                   02010368
           GO TO 0081                                                   02020368
20080      IVFAIL = IVFAIL + 1                                          02030368
           RVCORR = 0.50000000000000                                    02040368
           WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR                      02050368
 0081      CONTINUE                                                     02060368
CT009*  TEST 9                                                          02070368
           IVTNUM = 9                                                   02080368
        BVS = 0.0875                                                    02090368
        AVS = SQRT(BVS * 10.0)                                          02100368
           IF (AVS - 0.93536E+00) 20090, 10090, 40090                   02110368
40090      IF (AVS - 0.93546E+00) 10090, 10090, 20090                   02120368
10090      IVPASS = IVPASS + 1                                          02130368
           WRITE (NUVI, 80002) IVTNUM                                   02140368
           GO TO 0091                                                   02150368
20090      IVFAIL = IVFAIL + 1                                          02160368
           RVCORR = 0.93541434669349                                    02170368
           WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR                      02180368
 0091      CONTINUE                                                     02190368
CT010*  TEST 10                                                         02200368
           IVTNUM = 10                                                  02210368
        AVS = SQRT(31.0/32.0)                                           02220368
           IF (AVS - 0.98420E+00) 20100, 10100, 40100                   02230368
40100      IF (AVS - 0.98430E+00) 10100, 10100, 20100                   02240368
10100      IVPASS = IVPASS + 1                                          02250368
           WRITE (NUVI, 80002) IVTNUM                                   02260368
           GO TO 0101                                                   02270368
20100      IVFAIL = IVFAIL + 1                                          02280368
           RVCORR = 0.98425098425148                                    02290368
           WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR                      02300368
 0101      CONTINUE                                                     02310368
CT011*  TEST 11                          AN ARGUMENT OF LOW MAGNITUDE   02320368
           IVTNUM = 11                                                  02330368
        AVS = SQRT(1.6E-35)                                             02340368
           IF (AVS - 0.39998E-17) 20110, 10110, 40110                   02350368
40110      IF (AVS - 0.40002E-17) 10110, 10110, 20110                   02360368
10110      IVPASS = IVPASS + 1                                          02370368
           WRITE (NUVI, 80002) IVTNUM                                   02380368
           GO TO 0111                                                   02390368
20110      IVFAIL = IVFAIL + 1                                          02400368
           RVCORR = 0.40000000000000E-17                                02410368
           WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR                      02420368
 0111      CONTINUE                                                     02430368
CT012*  TEST 12                         AN ARGUMENT OF HIGH MAGNITUDE   02440368
           IVTNUM = 12                                                  02450368
        AVS = SQRT(1.0E+35)                                             02460368
           IF (AVS - 0.31621E+18) 20120, 10120, 40120                   02470368
40120      IF (AVS - 0.31625E+18) 10120, 10120, 20120                   02480368
10120      IVPASS = IVPASS + 1                                          02490368
           WRITE (NUVI, 80002) IVTNUM                                   02500368
           GO TO 0121                                                   02510368
20120      IVFAIL = IVFAIL + 1                                          02520368
           RVCORR = 0.31622776601684E+18                                02530368
           WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR                      02540368
 0121      CONTINUE                                                     02550368
CT013*  TEST 13                                                         02560368
           IVTNUM = 13                                                  02570368
        BVS = SQRT(1.6)                                                 02580368
        AVS = SQRT(0.625) * BVS                                         02590368
           IF (AVS - 0.99995E+00) 20130, 10130, 40130                   02600368
40130      IF (AVS - 0.10001E+01) 10130, 10130, 20130                   02610368
10130      IVPASS = IVPASS + 1                                          02620368
           WRITE (NUVI, 80002) IVTNUM                                   02630368
           GO TO 0131                                                   02640368
20130      IVFAIL = IVFAIL + 1                                          02650368
           RVCORR = 1.0000000                                           02660368
           WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR                      02670368
 0131      CONTINUE                                                     02680368
C*****                                                                  02690368
CBB** ********************** BBCSUM0  **********************************02700368
C**** WRITE OUT TEST SUMMARY                                            02710368
C****                                                                   02720368
      IVTOTN = IVPASS + IVFAIL + IVDELE + IVINSP                        02730368
      WRITE (I02, 90004)                                                02740368
      WRITE (I02, 90014)                                                02750368
      WRITE (I02, 90004)                                                02760368
      WRITE (I02, 90020) IVPASS                                         02770368
      WRITE (I02, 90022) IVFAIL                                         02780368
      WRITE (I02, 90024) IVDELE                                         02790368
      WRITE (I02, 90026) IVINSP                                         02800368
      WRITE (I02, 90028) IVTOTN, IVTOTL                                 02810368
CBE** ********************** BBCSUM0  **********************************02820368
CBB** ********************** BBCFOOT0 **********************************02830368
C**** WRITE OUT REPORT FOOTINGS                                         02840368
C****                                                                   02850368
      WRITE (I02,90016) ZPROG, ZPROG                                    02860368
      WRITE (I02,90018) ZPROJ, ZNAME, ZTAPE, ZTAPED                     02870368
      WRITE (I02,90019)                                                 02880368
CBE** ********************** BBCFOOT0 **********************************02890368
CBB** ********************** BBCFMT0A **********************************02900368
C**** FORMATS FOR TEST DETAIL LINES                                     02910368
C****                                                                   02920368
80000 FORMAT (" ",2X,I3,4X,"DELETED",32X,A31)                           02930368
80002 FORMAT (" ",2X,I3,4X," PASS  ",32X,A31)                           02940368
80004 FORMAT (" ",2X,I3,4X,"INSPECT",32X,A31)                           02950368
80008 FORMAT (" ",2X,I3,4X," FAIL  ",32X,A31)                           02960368
80010 FORMAT (" ",2X,I3,4X," FAIL  ",/," ",15X,"COMPUTED= " ,           02970368
     1I6,/," ",15X,"CORRECT=  " ,I6)                                    02980368
80012 FORMAT (" ",2X,I3,4X," FAIL  ",/," ",16X,"COMPUTED= " ,           02990368
     1E12.5,/," ",16X,"CORRECT=  " ,E12.5)                              03000368
80018 FORMAT (" ",2X,I3,4X," FAIL  ",/," ",16X,"COMPUTED= " ,           03010368
     1A21,/," ",16X,"CORRECT=  " ,A21)                                  03020368
80020 FORMAT (" ",16X,"COMPUTED= " ,A21,1X,A31)                         03030368
80022 FORMAT (" ",16X,"CORRECT=  " ,A21,1X,A31)                         03040368
80024 FORMAT (" ",16X,"COMPUTED= " ,I6,16X,A31)                         03050368
80026 FORMAT (" ",16X,"CORRECT=  " ,I6,16X,A31)                         03060368
80028 FORMAT (" ",16X,"COMPUTED= " ,E12.5,10X,A31)                      03070368
80030 FORMAT (" ",16X,"CORRECT=  " ,E12.5,10X,A31)                      03080368
80050 FORMAT (" ",48X,A31)                                              03090368
CBE** ********************** BBCFMT0A **********************************03100368
CBB** ********************** BBCFMT0B **********************************03110368
C**** FORMAT STATEMENTS FOR PAGE HEADERS                                03120368
C****                                                                   03130368
90002 FORMAT ("1")                                                      03140368
90004 FORMAT (" ")                                                      03150368
90006 FORMAT (" ",20X,"NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY" )03160368
90007 FORMAT (" ",19X,"FORTRAN COMPILER VALIDATION SYSTEM" )            03170368
90008 FORMAT (" ",21X,A13,A17)                                          03180368
90009 FORMAT (" ",/," *",A5,"BEGIN*",12X,"TEST RESULTS - " ,A5,/)       03190368
90010 FORMAT (" ",8X,"TEST DATE*TIME= " ,A17,"  -  COMPILER= " ,A20)    03200368
90013 FORMAT (" "," TEST   ","PASS/FAIL " ,6X,"DISPLAYED RESULTS" ,     03210368
     1       7X,"REMARKS",24X)                                          03220368
90014 FORMAT (" ","----------------------------------------------" ,    03230368
     1        "---------------------------------" )                     03240368
90015 FORMAT (" ",48X,"THIS PROGRAM HAS " ,I3," TESTS",/)               03250368
C****                                                                   03260368
C**** FORMAT STATEMENTS FOR REPORT FOOTINGS                             03270368
C****                                                                   03280368
90016 FORMAT (" ",/," *",A5,"END*",14X,"END OF TEST - " ,A5,/)          03290368
90018 FORMAT (" ",A13,13X,A20,"   *   ",A10,"/",                        03300368
     1        A13)                                                      03310368
90019 FORMAT (" ","FOR OFFICIAL USE ONLY     " ,35X,"COPYRIGHT  1982" ) 03320368
C****                                                                   03330368
C**** FORMAT STATEMENTS FOR RUN SUMMARY                                 03340368
C****                                                                   03350368
90020 FORMAT (" ",21X,I5," TESTS PASSED" )                              03360368
90022 FORMAT (" ",21X,I5," TESTS FAILED" )                              03370368
90024 FORMAT (" ",21X,I5," TESTS DELETED" )                             03380368
90026 FORMAT (" ",21X,I5," TESTS REQUIRE INSPECTION" )                  03390368
90028 FORMAT (" ",21X,I5," OF ",I3," TESTS EXECUTED" )                  03400368
CBE** ********************** BBCFMT0B **********************************03410368
C*****                                                                  03420368
C*****    END OF TEST SEGMENT 175                                       03430368
      STOP                                                              03440368
      END                                                               03450368
                                                                        03460368