FM802.f Source File


Contents

Source Code


Source Code

      PROGRAM FM802

C***********************************************************************00010802
C*****  FORTRAN 77                                                      00020802
C*****   FM802               YDABS - (157)                              00030802
C*****                                                                  00040802
C***********************************************************************00050802
C*****  GENERAL PURPOSE                                         ANS REF 00060802
C*****    TEST INTRINSIC FUNCTION DABS (ABSOLUTE VALUE OF        15.3   00070802
C*****    A DOUBLE PRECISION ARGUMENT)                         (TABLE 5)00080802
CBB** ********************** BBCCOMNT **********************************00090802
C****                                                                   00100802
C****            1978 FORTRAN COMPILER VALIDATION SYSTEM                00110802
C****                          VERSION 2.1                              00120802
C****                                                                   00130802
C****                                                                   00140802
C****           SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO         00150802
C****          NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY           00160802
C****               SOFTWARE STANDARDS VALIDATION GROUP                 00170802
C****                      BUILDING 225  RM A266                        00180802
C****                     GAITHERSBURG, MD  20899                       00190802
C****                                                                   00200802
C****                                                                   00210802
C****                                                                   00220802
CBE** ********************** BBCCOMNT **********************************00230802
C*****                                                                  00240802
C*****    S P E C I F I C A T I O N S  SEGMENT 157                      00250802
        DOUBLE PRECISION DOAVD, DOBVD, DODVD, DOEVD, DVCORR             00260802
C*****                                                                  00270802
CBB** ********************** BBCINITA **********************************00280802
C**** SPECIFICATION STATEMENTS                                          00290802
C****                                                                   00300802
      CHARACTER ZVERS*13, ZVERSD*17, ZDATE*17, ZPROG*5, ZCOMPL*20,      00310802
     1          ZNAME*20, ZTAPE*10, ZPROJ*13, REMRKS*31, ZTAPED*13      00320802
CBE** ********************** BBCINITA **********************************00330802
CBB** ********************** BBCINITB **********************************00340802
C**** INITIALIZE SECTION                                                00350802
      DATA  ZVERS,                  ZVERSD,             ZDATE           00360802
     1      /'VERSION 2.1  ',  '93/10/21*21.02.00',  '*NO DATE*TIME'/   00370802
      DATA       ZCOMPL,             ZNAME,             ZTAPE           00380802
     1      /'*NONE SPECIFIED*', '*NO COMPANY NAME*', '*NO TAPE*'/      00390802
      DATA       ZPROJ,           ZTAPED,         ZPROG                 00400802
     1      /'*NO PROJECT*',   '*NO TAPE DATE',  'XXXXX'/               00410802
      DATA   REMRKS /'                               '/                 00420802
C**** THE FOLLOWING 9 COMMENT LINES (CZ01, CZ02, ...) CAN BE REPLACED   00430802
C**** FOR IDENTIFYING THE TEST ENVIRONMENT                              00440802
C****                                                                   00450802
CZ01  ZVERS  = 'VERSION OF THE COMPILER VALIDATION SYSTEM'              00460802
CZ02  ZVERSD = 'CREATION DATE/TIME OF THE COMPILER VALIDATION SYSTEM'   00470802
CZ03  ZPROG  = 'PROGRAM NAME'                                           00480802
CZ04  ZDATE  = 'DATE OF TEST'                                           00490802
CZ05  ZCOMPL = 'COMPILER IDENTIFICATION'                                00500802
CZ06  ZPROJ  = 'PROJECT NUMBER/IDENTIFICATION'                          00510802
CZ07  ZNAME  = 'NAME OF USER'                                           00520802
CZ08  ZTAPE  = 'TAPE OWNER/ID'                                          00530802
CZ09  ZTAPED = 'DATE TAPE COPIED'                                       00540802
C                                                                       00550802
      IVPASS = 0                                                        00560802
      IVFAIL = 0                                                        00570802
      IVDELE = 0                                                        00580802
      IVINSP = 0                                                        00590802
      IVTOTL = 0                                                        00600802
      IVTOTN = 0                                                        00610802
      ICZERO = 0                                                        00620802
C                                                                       00630802
C     I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER.         00640802
      I01 = 05                                                          00650802
C     I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER.             00660802
      I02 = 06                                                          00670802
C                                                                       00680802
CX010   REPLACED BY FEXEC X-010 CONTROL CARD (CARD-READER UNIT NUMBER). 00690802
C     THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5      00700802
CX011   REPLACED BY FEXEC X-011 CONTROL CARD.  CX011 IS FOR SYSTEMS     00710802
C     REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX010.  00720802
C                                                                       00730802
CX020   REPLACED BY FEXEC X-020 CONTROL CARD (PRINTER UNIT NUMBER).     00740802
C     THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02= 6       00750802
CX021   REPLACED BY FEXEC X-021 CONTROL CARD.  CX021 IS FOR SYSTEMS     00760802
C     REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX020.  00770802
C                                                                       00780802
CBE** ********************** BBCINITB **********************************00790802
      NUVI = I02                                                        00800802
      IVTOTL = 6                                                        00810802
      ZPROG = 'FM802'                                                   00820802
CBB** ********************** BBCHED0A **********************************00830802
C****                                                                   00840802
C**** WRITE REPORT TITLE                                                00850802
C****                                                                   00860802
      WRITE (I02, 90002)                                                00870802
      WRITE (I02, 90006)                                                00880802
      WRITE (I02, 90007)                                                00890802
      WRITE (I02, 90008)  ZVERS, ZVERSD                                 00900802
      WRITE (I02, 90009)  ZPROG, ZPROG                                  00910802
      WRITE (I02, 90010)  ZDATE, ZCOMPL                                 00920802
CBE** ********************** BBCHED0A **********************************00930802
C*****                                                                  00940802
C*****    HEADER FOR SEGMENT 157 WRITTEN                                00950802
        WRITE (NUVI,15701)                                              00960802
15701   FORMAT (" "//1X,"YDABS - (157) INTRINSIC FUNCTION--" //16X,     00970802
     1         "DABS (ABSOLUTE VALUE ) " //  2X,                        00980802
     2         "ANS REF. - 15.3" )                                      00990802
CBB** ********************** BBCHED0B **********************************01000802
C**** WRITE DETAIL REPORT HEADERS                                       01010802
C****                                                                   01020802
      WRITE (I02,90004)                                                 01030802
      WRITE (I02,90004)                                                 01040802
      WRITE (I02,90013)                                                 01050802
      WRITE (I02,90014)                                                 01060802
      WRITE (I02,90015) IVTOTL                                          01070802
CBE** ********************** BBCHED0B **********************************01080802
C*****                                                                  01090802
CT001*  TEST 1                                         THE VALUE ZERO   01100802
           IVTNUM = 1                                                   01110802
        DOBVD = 0.0D0                                                   01120802
        DOAVD = DABS(DOBVD)                                             01130802
           IF (DOAVD + 5.0D-10) 20010, 10010, 40010                     01140802
40010      IF (DOAVD - 5.0D-10) 10010, 10010, 20010                     01150802
10010      IVPASS = IVPASS + 1                                          01160802
           WRITE (NUVI, 80002) IVTNUM                                   01170802
           GO TO 0011                                                   01180802
20010      IVFAIL = IVFAIL + 1                                          01190802
           DVCORR = 0.0D0                                               01200802
           WRITE(NUVI, 80031) IVTNUM, DOAVD, DVCORR                     01210802
 0011      CONTINUE                                                     01220802
CT002*  TEST 2                          ZERO PREFIXED WITH A MINUS SIGN 01230802
           IVTNUM = 2                                                   01240802
        DOBVD = 0.0D0                                                   01250802
        DOAVD = DABS(-DOBVD)                                            01260802
           IF (DOAVD + 5.0D-10) 20020, 10020, 40020                     01270802
40020      IF (DOAVD - 5.0D-10) 10020, 10020, 20020                     01280802
10020      IVPASS = IVPASS + 1                                          01290802
           WRITE (NUVI, 80002) IVTNUM                                   01300802
           GO TO 0021                                                   01310802
20020      IVFAIL = IVFAIL + 1                                          01320802
           DVCORR = 0.0D1                                               01330802
           WRITE(NUVI, 80031) IVTNUM, DOAVD, DVCORR                     01340802
 0021      CONTINUE                                                     01350802
CT003*  TEST 3                            A POSITIVE NON-INTEGRAL VALUE 01360802
           IVTNUM = 3                                                   01370802
        DOBVD = 0.35875D2                                               01380802
        DOAVD = DABS(DOBVD)                                             01390802
           IF (DOAVD - 0.3587499998D2) 20030, 10030, 40030              01400802
40030      IF (DOAVD - 0.3587500002D2) 10030, 10030, 20030              01410802
10030      IVPASS = IVPASS + 1                                          01420802
           WRITE (NUVI, 80002) IVTNUM                                   01430802
           GO TO 0031                                                   01440802
20030      IVFAIL = IVFAIL + 1                                          01450802
           DVCORR = 0.35875D2                                           01460802
           WRITE(NUVI, 80031) IVTNUM, DOAVD, DVCORR                     01470802
 0031      CONTINUE                                                     01480802
CT004*  TEST 4                            A NEGATIVE NON-INTEGRAL VALUE 01490802
           IVTNUM = 4                                                   01500802
        DOBVD = -0.35875D2                                              01510802
        DOAVD = DABS(DOBVD)                                             01520802
           IF (DOAVD - 0.3587499998D2) 20040, 10040, 40040              01530802
40040      IF (DOAVD - 0.3587500002D2) 10040, 10040, 20040              01540802
10040      IVPASS = IVPASS + 1                                          01550802
           WRITE (NUVI, 80002) IVTNUM                                   01560802
           GO TO 0041                                                   01570802
20040      IVFAIL = IVFAIL + 1                                          01580802
           DVCORR = 0.35875D2                                           01590802
           WRITE(NUVI, 80031) IVTNUM, DOAVD, DVCORR                     01600802
 0041      CONTINUE                                                     01610802
CT005*  TEST 5                                A POSITIVE INTEGRAL VALUE 01620802
           IVTNUM = 5                                                   01630802
        DOBVD = 7.0D1                                                   01640802
        DOAVD = DABS(DOBVD)                                             01650802
           IF (DOAVD - 6.999999996D1) 20050, 10050, 40050               01660802
40050      IF (DOAVD - 7.000000004D1) 10050, 10050, 20050               01670802
10050      IVPASS = IVPASS + 1                                          01680802
           WRITE (NUVI, 80002) IVTNUM                                   01690802
           GO TO 0051                                                   01700802
20050      IVFAIL = IVFAIL + 1                                          01710802
           DVCORR = 7.0D1                                               01720802
           WRITE(NUVI, 80031) IVTNUM, DOAVD, DVCORR                     01730802
 0051      CONTINUE                                                     01740802
CT006*  TEST 6              ARITHMETIC EXPRESSION PRESENTED TO FUNCTION 01750802
           IVTNUM = 6                                                   01760802
        DODVD = 2.625D0                                                 01770802
        DOEVD = 3.0D0                                                   01780802
        DOAVD = DABS((-DODVD) - DOEVD ** 3)                             01790802
           IF (DOAVD - 29.62499998D0) 20060, 10060, 40060               01800802
40060      IF (DOAVD - 29.62500002D0) 10060, 10060, 20060               01810802
10060      IVPASS = IVPASS + 1                                          01820802
           WRITE (NUVI, 80002) IVTNUM                                   01830802
           GO TO 0061                                                   01840802
20060      IVFAIL = IVFAIL + 1                                          01850802
           DVCORR = 29.625D0                                            01860802
           WRITE(NUVI, 80031) IVTNUM, DOAVD, DVCORR                     01870802
 0061      CONTINUE                                                     01880802
C*****                                                                  01890802
CBB** ********************** BBCSUM0  **********************************01900802
C**** WRITE OUT TEST SUMMARY                                            01910802
C****                                                                   01920802
      IVTOTN = IVPASS + IVFAIL + IVDELE + IVINSP                        01930802
      WRITE (I02, 90004)                                                01940802
      WRITE (I02, 90014)                                                01950802
      WRITE (I02, 90004)                                                01960802
      WRITE (I02, 90020) IVPASS                                         01970802
      WRITE (I02, 90022) IVFAIL                                         01980802
      WRITE (I02, 90024) IVDELE                                         01990802
      WRITE (I02, 90026) IVINSP                                         02000802
      WRITE (I02, 90028) IVTOTN, IVTOTL                                 02010802
CBE** ********************** BBCSUM0  **********************************02020802
CBB** ********************** BBCFOOT0 **********************************02030802
C**** WRITE OUT REPORT FOOTINGS                                         02040802
C****                                                                   02050802
      WRITE (I02,90016) ZPROG, ZPROG                                    02060802
      WRITE (I02,90018) ZPROJ, ZNAME, ZTAPE, ZTAPED                     02070802
      WRITE (I02,90019)                                                 02080802
CBE** ********************** BBCFOOT0 **********************************02090802
CBB** ********************** BBCFMT0A **********************************02100802
C**** FORMATS FOR TEST DETAIL LINES                                     02110802
C****                                                                   02120802
80000 FORMAT (" ",2X,I3,4X,"DELETED",32X,A31)                           02130802
80002 FORMAT (" ",2X,I3,4X," PASS  ",32X,A31)                           02140802
80004 FORMAT (" ",2X,I3,4X,"INSPECT",32X,A31)                           02150802
80008 FORMAT (" ",2X,I3,4X," FAIL  ",32X,A31)                           02160802
80010 FORMAT (" ",2X,I3,4X," FAIL  ",/," ",15X,"COMPUTED= " ,           02170802
     1I6,/," ",15X,"CORRECT=  " ,I6)                                    02180802
80012 FORMAT (" ",2X,I3,4X," FAIL  ",/," ",16X,"COMPUTED= " ,           02190802
     1E12.5,/," ",16X,"CORRECT=  " ,E12.5)                              02200802
80018 FORMAT (" ",2X,I3,4X," FAIL  ",/," ",16X,"COMPUTED= " ,           02210802
     1A21,/," ",16X,"CORRECT=  " ,A21)                                  02220802
80020 FORMAT (" ",16X,"COMPUTED= " ,A21,1X,A31)                         02230802
80022 FORMAT (" ",16X,"CORRECT=  " ,A21,1X,A31)                         02240802
80024 FORMAT (" ",16X,"COMPUTED= " ,I6,16X,A31)                         02250802
80026 FORMAT (" ",16X,"CORRECT=  " ,I6,16X,A31)                         02260802
80028 FORMAT (" ",16X,"COMPUTED= " ,E12.5,10X,A31)                      02270802
80030 FORMAT (" ",16X,"CORRECT=  " ,E12.5,10X,A31)                      02280802
80050 FORMAT (" ",48X,A31)                                              02290802
CBE** ********************** BBCFMT0A **********************************02300802
CBB** ********************** BBCFMAT1 **********************************02310802
C**** FORMATS FOR TEST DETAIL LINES - FULL LANGUAGE                     02320802
C****                                                                   02330802
80031 FORMAT (" ",2X,I3,4X," FAIL  ",/," ",16X,"COMPUTED= " ,           02340802
     1D17.10,/," ",16X,"CORRECT=  " ,D17.10)                            02350802
80033 FORMAT (" ",16X,"COMPUTED= " ,D17.10,10X,A31)                     02360802
80035 FORMAT (" ",16X,"CORRECT=  " ,D17.10,10X,A31)                     02370802
80037 FORMAT (" ",16X,"COMPUTED= " ,"(",E12.5,", ",E12.5,")",6X,A31)    02380802
80039 FORMAT (" ",16X,"CORRECT=  " ,"(",E12.5,", ",E12.5,")",6X,A31)    02390802
80041 FORMAT (" ",16X,"COMPUTED= " ,"(",F12.5,", ",F12.5,")",6X,A31)    02400802
80043 FORMAT (" ",16X,"CORRECT=  " ,"(",F12.5,", ",F12.5,")",6X,A31)    02410802
80045 FORMAT (" ",2X,I3,4X," FAIL  ",/," ",16X,"COMPUTED= " ,           02420802
     1"(",F12.5,", ",F12.5,")"/," ",16X,"CORRECT=  " ,                  02430802
     2"(",F12.5,", ",F12.5,")")                                         02440802
CBE** ********************** BBCFMAT1 **********************************02450802
CBB** ********************** BBCFMT0B **********************************02460802
C**** FORMAT STATEMENTS FOR PAGE HEADERS                                02470802
C****                                                                   02480802
90002 FORMAT ("1")                                                      02490802
90004 FORMAT (" ")                                                      02500802
90006 FORMAT (" ",20X,"NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY" )02510802
90007 FORMAT (" ",19X,"FORTRAN COMPILER VALIDATION SYSTEM" )            02520802
90008 FORMAT (" ",21X,A13,A17)                                          02530802
90009 FORMAT (" ",/," *",A5,"BEGIN*",12X,"TEST RESULTS - " ,A5,/)       02540802
90010 FORMAT (" ",8X,"TEST DATE*TIME= " ,A17,"  -  COMPILER= " ,A20)    02550802
90013 FORMAT (" "," TEST   ","PASS/FAIL " ,6X,"DISPLAYED RESULTS" ,     02560802
     1       7X,"REMARKS",24X)                                          02570802
90014 FORMAT (" ","----------------------------------------------" ,    02580802
     1        "---------------------------------" )                     02590802
90015 FORMAT (" ",48X,"THIS PROGRAM HAS " ,I3," TESTS",/)               02600802
C****                                                                   02610802
C**** FORMAT STATEMENTS FOR REPORT FOOTINGS                             02620802
C****                                                                   02630802
90016 FORMAT (" ",/," *",A5,"END*",14X,"END OF TEST - " ,A5,/)          02640802
90018 FORMAT (" ",A13,13X,A20,"   *   ",A10,"/",                        02650802
     1        A13)                                                      02660802
90019 FORMAT (" ","FOR OFFICIAL USE ONLY     " ,35X,"COPYRIGHT  1982" ) 02670802
C****                                                                   02680802
C**** FORMAT STATEMENTS FOR RUN SUMMARY                                 02690802
C****                                                                   02700802
90020 FORMAT (" ",21X,I5," TESTS PASSED" )                              02710802
90022 FORMAT (" ",21X,I5," TESTS FAILED" )                              02720802
90024 FORMAT (" ",21X,I5," TESTS DELETED" )                             02730802
90026 FORMAT (" ",21X,I5," TESTS REQUIRE INSPECTION" )                  02740802
90028 FORMAT (" ",21X,I5," OF ",I3," TESTS EXECUTED" )                  02750802
CBE** ********************** BBCFMT0B **********************************02760802
C*****                                                                  02770802
C*****    END OF TEST SEGMENT 157                                       02780802
        STOP                                                            02790802
        END                                                             02800802
                                                                        02810802