FM830.f Source File


Contents

Source Code


Source Code

      PROGRAM FM830

C***********************************************************************00010830
C*****  FORTRAN 77                                                      00020830
C*****   FM830                                                          00030830
C*****                       YGEN2 - (207)                              00040830
C*****                                                                  00050830
C***********************************************************************00060830
C*****  GENERAL PURPOSE                                         ANS REF 00070830
C*****      TEST GENERIC FUNCTIONS                               15.3   00080830
C*****         AINT, ANINT, NINT, SQRT, EXP, LOG, LOG10         TABLE 5 00090830
C*****                                                                  00100830
CBB** ********************** BBCCOMNT **********************************00110830
C****                                                                   00120830
C****            1978 FORTRAN COMPILER VALIDATION SYSTEM                00130830
C****                          VERSION 2.1                              00140830
C****                                                                   00150830
C****                                                                   00160830
C****           SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO         00170830
C****          NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY           00180830
C****               SOFTWARE STANDARDS VALIDATION GROUP                 00190830
C****                      BUILDING 225  RM A266                        00200830
C****                     GAITHERSBURG, MD  20899                       00210830
C****                                                                   00220830
C****                                                                   00230830
C****                                                                   00240830
CBE** ********************** BBCCOMNT **********************************00250830
C*****                                                                  00260830
C*****  S P E C I F I C A T I O N S  SEGMENT 207                        00270830
        DOUBLE PRECISION AVD, DVCORR                                    00280830
        COMPLEX AVC, ZVCORR                                             00290830
        REAL R2E(2)                                                     00300830
        EQUIVALENCE (AVC, R2E)                                          00310830
C*****                                                                  00320830
CBB** ********************** BBCINITA **********************************00330830
C**** SPECIFICATION STATEMENTS                                          00340830
C****                                                                   00350830
      CHARACTER ZVERS*13, ZVERSD*17, ZDATE*17, ZPROG*5, ZCOMPL*20,      00360830
     1          ZNAME*20, ZTAPE*10, ZPROJ*13, REMRKS*31, ZTAPED*13      00370830
CBE** ********************** BBCINITA **********************************00380830
CBB** ********************** BBCINITB **********************************00390830
C**** INITIALIZE SECTION                                                00400830
      DATA  ZVERS,                  ZVERSD,             ZDATE           00410830
     1      /'VERSION 2.1  ',  '93/10/21*21.02.00',  '*NO DATE*TIME'/   00420830
      DATA       ZCOMPL,             ZNAME,             ZTAPE           00430830
     1      /'*NONE SPECIFIED*', '*NO COMPANY NAME*', '*NO TAPE*'/      00440830
      DATA       ZPROJ,           ZTAPED,         ZPROG                 00450830
     1      /'*NO PROJECT*',   '*NO TAPE DATE',  'XXXXX'/               00460830
      DATA   REMRKS /'                               '/                 00470830
C**** THE FOLLOWING 9 COMMENT LINES (CZ01, CZ02, ...) CAN BE REPLACED   00480830
C**** FOR IDENTIFYING THE TEST ENVIRONMENT                              00490830
C****                                                                   00500830
CZ01  ZVERS  = 'VERSION OF THE COMPILER VALIDATION SYSTEM'              00510830
CZ02  ZVERSD = 'CREATION DATE/TIME OF THE COMPILER VALIDATION SYSTEM'   00520830
CZ03  ZPROG  = 'PROGRAM NAME'                                           00530830
CZ04  ZDATE  = 'DATE OF TEST'                                           00540830
CZ05  ZCOMPL = 'COMPILER IDENTIFICATION'                                00550830
CZ06  ZPROJ  = 'PROJECT NUMBER/IDENTIFICATION'                          00560830
CZ07  ZNAME  = 'NAME OF USER'                                           00570830
CZ08  ZTAPE  = 'TAPE OWNER/ID'                                          00580830
CZ09  ZTAPED = 'DATE TAPE COPIED'                                       00590830
C                                                                       00600830
      IVPASS = 0                                                        00610830
      IVFAIL = 0                                                        00620830
      IVDELE = 0                                                        00630830
      IVINSP = 0                                                        00640830
      IVTOTL = 0                                                        00650830
      IVTOTN = 0                                                        00660830
      ICZERO = 0                                                        00670830
C                                                                       00680830
C     I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER.         00690830
      I01 = 05                                                          00700830
C     I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER.             00710830
      I02 = 06                                                          00720830
C                                                                       00730830
CX010   REPLACED BY FEXEC X-010 CONTROL CARD (CARD-READER UNIT NUMBER). 00740830
C     THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5      00750830
CX011   REPLACED BY FEXEC X-011 CONTROL CARD.  CX011 IS FOR SYSTEMS     00760830
C     REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX010.  00770830
C                                                                       00780830
CX020   REPLACED BY FEXEC X-020 CONTROL CARD (PRINTER UNIT NUMBER).     00790830
C     THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02= 6       00800830
CX021   REPLACED BY FEXEC X-021 CONTROL CARD.  CX021 IS FOR SYSTEMS     00810830
C     REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX020.  00820830
C                                                                       00830830
CBE** ********************** BBCINITB **********************************00840830
      NUVI = I02                                                        00850830
      IVTOTL = 9                                                        00860830
      ZPROG = 'FM830'                                                   00870830
CBB** ********************** BBCHED0A **********************************00880830
C****                                                                   00890830
C**** WRITE REPORT TITLE                                                00900830
C****                                                                   00910830
      WRITE (I02, 90002)                                                00920830
      WRITE (I02, 90006)                                                00930830
      WRITE (I02, 90007)                                                00940830
      WRITE (I02, 90008)  ZVERS, ZVERSD                                 00950830
      WRITE (I02, 90009)  ZPROG, ZPROG                                  00960830
      WRITE (I02, 90010)  ZDATE, ZCOMPL                                 00970830
CBE** ********************** BBCHED0A **********************************00980830
C*****                                                                  00990830
C*****    HEADER FOR SEGMENT 207                                        01000830
        WRITE(NUVI,20700)                                               01010830
20700   FORMAT( " ", /  " YGEN2 - (207) GENERIC FUNCTIONS --" //        01020830
     1          "  AINT, ANINT, NINT, SQRT, EXP, LOG, LOG10" //         01030830
     2          "  ANS REF. - 15.3" )                                   01040830
CBB** ********************** BBCHED0B **********************************01050830
C**** WRITE DETAIL REPORT HEADERS                                       01060830
C****                                                                   01070830
      WRITE (I02,90004)                                                 01080830
      WRITE (I02,90004)                                                 01090830
      WRITE (I02,90013)                                                 01100830
      WRITE (I02,90014)                                                 01110830
      WRITE (I02,90015) IVTOTL                                          01120830
CBE** ********************** BBCHED0B **********************************01130830
C*****                                                                  01140830
CT001*  TEST 1                            TEST OF NINT WITH DOUBLE PREC 01150830
           IVTNUM = 1                                                   01160830
        LVI = NINT(27.96875D0)                                          01170830
           IF (LVI -    28) 20010, 10010, 20010                         01180830
10010      IVPASS = IVPASS + 1                                          01190830
           WRITE (NUVI, 80002) IVTNUM                                   01200830
           GO TO 0011                                                   01210830
20010      IVFAIL = IVFAIL + 1                                          01220830
           IVCORR =    28                                               01230830
           WRITE (NUVI, 80010) IVTNUM, LVI, IVCORR                      01240830
 0011      CONTINUE                                                     01250830
CT002*  TEST 2                  TEST OF AINT AND ANINT WITH DOUBLE PREC 01260830
           IVTNUM = 2                                                   01270830
        AVD = AINT(-1.375D0) + ANINT(-27.96875D0)                       01280830
           IF (AVD +  0.2900000002D+02) 20020, 10020, 40020             01290830
40020      IF (AVD +  0.2899999998D+02) 10020, 10020, 20020             01300830
10020      IVPASS = IVPASS + 1                                          01310830
           WRITE (NUVI, 80002) IVTNUM                                   01320830
           GO TO 0021                                                   01330830
20020      IVFAIL = IVFAIL + 1                                          01340830
           DVCORR = -29.0D0                                             01350830
           WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR                      01360830
 0021      CONTINUE                                                     01370830
CT003*  TEST 3                    TEST OF SQRT AND EXP WITH DOUBLE PREC 01380830
           IVTNUM = 3                                                   01390830
        AVD = SQRT(16.0D0) - EXP(5.125D0)                               01400830
           IF (AVD +  0.1641741418D+03) 20030, 10030, 40030             01410830
40030      IF (AVD +  0.1641741415D+03) 10030, 10030, 20030             01420830
10030      IVPASS = IVPASS + 1                                          01430830
           WRITE (NUVI, 80002) IVTNUM                                   01440830
           GO TO 0031                                                   01450830
20030      IVFAIL = IVFAIL + 1                                          01460830
           DVCORR = -0.16417414165D+03                                  01470830
           WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR                      01480830
 0031      CONTINUE                                                     01490830
CT004*  TEST 4                   TEST OF LOG AND LOG10 WITH DOUBLE PREC 01500830
           IVTNUM = 4                                                   01510830
        AVD = LOG(9.5D0) * LOG10(25.25D0)                               01520830
           IF (AVD -  0.3156899548D+01) 20040, 10040, 40040             01530830
40040      IF (AVD -  0.3156899552D+01) 10040, 10040, 20040             01540830
10040      IVPASS = IVPASS + 1                                          01550830
           WRITE (NUVI, 80002) IVTNUM                                   01560830
           GO TO 0041                                                   01570830
20040      IVFAIL = IVFAIL + 1                                          01580830
           DVCORR = 0.31568995498D+01                                   01590830
           WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR                      01600830
 0041      CONTINUE                                                     01610830
CT005*  TEST 5                            TEST OF AINT, SQRT AND  LOG10 01620830
           IVTNUM = 5                                                   01630830
        AVD = (AINT(2.75D0) + SQRT(17.125D0)) * LOG10(10.0D0)           01640830
           IF (AVD -  0.6138236337D+01) 20050, 10050, 40050             01650830
40050      IF (AVD -  0.6138236343D+01) 10050, 10050, 20050             01660830
10050      IVPASS = IVPASS + 1                                          01670830
           WRITE (NUVI, 80002) IVTNUM                                   01680830
           GO TO 0051                                                   01690830
20050      IVFAIL = IVFAIL + 1                                          01700830
           DVCORR = 0.613823634D+01                                     01710830
           WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR                      01720830
 0051      CONTINUE                                                     01730830
CT006*  TEST 6                   TEST OF AINT AND NINT WITH DOUBLE PREC 01740830
           IVTNUM = 6                                                   01750830
        AVD = AINT(72.375D0) * NINT(-4.25D0)                            01760830
           IF (AVD +  0.2880000002D+03) 20060, 10060, 40060             01770830
40060      IF (AVD +  0.2879999998D+03) 10060, 10060, 20060             01780830
10060      IVPASS = IVPASS + 1                                          01790830
           WRITE (NUVI, 80002) IVTNUM                                   01800830
           GO TO 0061                                                   01810830
20060      IVFAIL = IVFAIL + 1                                          01820830
           DVCORR = -288.0D0                                            01830830
           WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR                      01840830
 0061      CONTINUE                                                     01850830
CT007*  TEST 7                   TEST OF SQRT, EXP AND LOG WITH COMPLEX 01860830
           IVTNUM = 7                                                   01870830
        AVC = SQRT((-4.0,2.0)) + EXP((2.125,6.75)) * LOG((17.375,2.5))  01880830
           IF (R2E(1) -  0.21370E+02) 20070, 40072, 40071               01890830
40071      IF (R2E(1) -  0.21373E+02) 40072, 40072, 20070               01900830
40072      IF (R2E(2) -  0.13922E+02) 20070, 10070, 40070               01910830
40070      IF (R2E(2) -  0.13925E+02) 10070, 10070, 20070               01920830
10070      IVPASS = IVPASS + 1                                          01930830
           WRITE (NUVI, 80002) IVTNUM                                   01940830
           GO TO 0071                                                   01950830
20070      IVFAIL = IVFAIL + 1                                          01960830
           ZVCORR = (21.3712104, 13.9235362)                            01970830
           WRITE (NUVI, 80045) IVTNUM, AVC, ZVCORR                      01980830
 0071      CONTINUE                                                     01990830
CT008*  TEST 8                       TEST OF SQRT WITH REAL AND COMPLEX 02000830
           IVTNUM = 8                                                   02010830
        AVC = SQRT(77.76953) - SQRT((-22.125, 7.0))                     02020830
           IF (R2E(1) -  0.80831E+01) 20080, 40082, 40081               02030830
40081      IF (R2E(1) -  0.80840E+01) 40082, 40082, 20080               02040830
40082      IF (R2E(2) +  0.47611E+01) 20080, 10080, 40080               02050830
40080      IF (R2E(2) +  0.47605E+01) 10080, 10080, 20080               02060830
10080      IVPASS = IVPASS + 1                                          02070830
           WRITE (NUVI, 80002) IVTNUM                                   02080830
           GO TO 0081                                                   02090830
20080      IVFAIL = IVFAIL + 1                                          02100830
           ZVCORR = (8.0835370, -4.7608266)                             02110830
           WRITE (NUVI, 80045) IVTNUM, AVC, ZVCORR                      02120830
 0081      CONTINUE                                                     02130830
CT009*  TEST 9                          TEST OF AINT, NINT, EXP AND LOG 02140830
C*****                                            WITH REAL AND COMPLEX 02150830
           IVTNUM = 9                                                   02160830
        AVC = AINT(2.25) * NINT(1.50) + EXP((1.0, 2.0)) - LOG(5.125)    02170830
           IF (R2E(1) -  0.12346E+01) 20090, 40092, 40091               02180830
40091      IF (R2E(1) -  0.12348E+01) 40092, 40092, 20090               02190830
40092      IF (R2E(2) -  0.24716E+01) 20090, 10090, 40090               02200830
40090      IF (R2E(2) -  0.24719E+01) 10090, 10090, 20090               02210830
10090      IVPASS = IVPASS + 1                                          02220830
           WRITE (NUVI, 80002) IVTNUM                                   02230830
           GO TO 0091                                                   02240830
20090      IVFAIL = IVFAIL + 1                                          02250830
           ZVCORR = (1.234665192, 2.471726672)                          02260830
           WRITE (NUVI, 80045) IVTNUM, AVC, ZVCORR                      02270830
 0091      CONTINUE                                                     02280830
C*****                                                                  02290830
CBB** ********************** BBCSUM0  **********************************02300830
C**** WRITE OUT TEST SUMMARY                                            02310830
C****                                                                   02320830
      IVTOTN = IVPASS + IVFAIL + IVDELE + IVINSP                        02330830
      WRITE (I02, 90004)                                                02340830
      WRITE (I02, 90014)                                                02350830
      WRITE (I02, 90004)                                                02360830
      WRITE (I02, 90020) IVPASS                                         02370830
      WRITE (I02, 90022) IVFAIL                                         02380830
      WRITE (I02, 90024) IVDELE                                         02390830
      WRITE (I02, 90026) IVINSP                                         02400830
      WRITE (I02, 90028) IVTOTN, IVTOTL                                 02410830
CBE** ********************** BBCSUM0  **********************************02420830
CBB** ********************** BBCFOOT0 **********************************02430830
C**** WRITE OUT REPORT FOOTINGS                                         02440830
C****                                                                   02450830
      WRITE (I02,90016) ZPROG, ZPROG                                    02460830
      WRITE (I02,90018) ZPROJ, ZNAME, ZTAPE, ZTAPED                     02470830
      WRITE (I02,90019)                                                 02480830
CBE** ********************** BBCFOOT0 **********************************02490830
CBB** ********************** BBCFMT0A **********************************02500830
C**** FORMATS FOR TEST DETAIL LINES                                     02510830
C****                                                                   02520830
80000 FORMAT (" ",2X,I3,4X,"DELETED",32X,A31)                           02530830
80002 FORMAT (" ",2X,I3,4X," PASS  ",32X,A31)                           02540830
80004 FORMAT (" ",2X,I3,4X,"INSPECT",32X,A31)                           02550830
80008 FORMAT (" ",2X,I3,4X," FAIL  ",32X,A31)                           02560830
80010 FORMAT (" ",2X,I3,4X," FAIL  ",/," ",15X,"COMPUTED= " ,           02570830
     1I6,/," ",15X,"CORRECT=  " ,I6)                                    02580830
80012 FORMAT (" ",2X,I3,4X," FAIL  ",/," ",16X,"COMPUTED= " ,           02590830
     1E12.5,/," ",16X,"CORRECT=  " ,E12.5)                              02600830
80018 FORMAT (" ",2X,I3,4X," FAIL  ",/," ",16X,"COMPUTED= " ,           02610830
     1A21,/," ",16X,"CORRECT=  " ,A21)                                  02620830
80020 FORMAT (" ",16X,"COMPUTED= " ,A21,1X,A31)                         02630830
80022 FORMAT (" ",16X,"CORRECT=  " ,A21,1X,A31)                         02640830
80024 FORMAT (" ",16X,"COMPUTED= " ,I6,16X,A31)                         02650830
80026 FORMAT (" ",16X,"CORRECT=  " ,I6,16X,A31)                         02660830
80028 FORMAT (" ",16X,"COMPUTED= " ,E12.5,10X,A31)                      02670830
80030 FORMAT (" ",16X,"CORRECT=  " ,E12.5,10X,A31)                      02680830
80050 FORMAT (" ",48X,A31)                                              02690830
CBE** ********************** BBCFMT0A **********************************02700830
CBB** ********************** BBCFMAT1 **********************************02710830
C**** FORMATS FOR TEST DETAIL LINES - FULL LANGUAGE                     02720830
C****                                                                   02730830
80031 FORMAT (" ",2X,I3,4X," FAIL  ",/," ",16X,"COMPUTED= " ,           02740830
     1D17.10,/," ",16X,"CORRECT=  " ,D17.10)                            02750830
80033 FORMAT (" ",16X,"COMPUTED= " ,D17.10,10X,A31)                     02760830
80035 FORMAT (" ",16X,"CORRECT=  " ,D17.10,10X,A31)                     02770830
80037 FORMAT (" ",16X,"COMPUTED= " ,"(",E12.5,", ",E12.5,")",6X,A31)    02780830
80039 FORMAT (" ",16X,"CORRECT=  " ,"(",E12.5,", ",E12.5,")",6X,A31)    02790830
80041 FORMAT (" ",16X,"COMPUTED= " ,"(",F12.5,", ",F12.5,")",6X,A31)    02800830
80043 FORMAT (" ",16X,"CORRECT=  " ,"(",F12.5,", ",F12.5,")",6X,A31)    02810830
80045 FORMAT (" ",2X,I3,4X," FAIL  ",/," ",16X,"COMPUTED= " ,           02820830
     1"(",F12.5,", ",F12.5,")"/," ",16X,"CORRECT=  " ,                  02830830
     2"(",F12.5,", ",F12.5,")")                                         02840830
CBE** ********************** BBCFMAT1 **********************************02850830
CBB** ********************** BBCFMT0B **********************************02860830
C**** FORMAT STATEMENTS FOR PAGE HEADERS                                02870830
C****                                                                   02880830
90002 FORMAT ("1")                                                      02890830
90004 FORMAT (" ")                                                      02900830
90006 FORMAT (" ",20X,"NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY" )02910830
90007 FORMAT (" ",19X,"FORTRAN COMPILER VALIDATION SYSTEM" )            02920830
90008 FORMAT (" ",21X,A13,A17)                                          02930830
90009 FORMAT (" ",/," *",A5,"BEGIN*",12X,"TEST RESULTS - " ,A5,/)       02940830
90010 FORMAT (" ",8X,"TEST DATE*TIME= " ,A17,"  -  COMPILER= " ,A20)    02950830
90013 FORMAT (" "," TEST   ","PASS/FAIL " ,6X,"DISPLAYED RESULTS" ,     02960830
     1       7X,"REMARKS",24X)                                          02970830
90014 FORMAT (" ","----------------------------------------------" ,    02980830
     1        "---------------------------------" )                     02990830
90015 FORMAT (" ",48X,"THIS PROGRAM HAS " ,I3," TESTS",/)               03000830
C****                                                                   03010830
C**** FORMAT STATEMENTS FOR REPORT FOOTINGS                             03020830
C****                                                                   03030830
90016 FORMAT (" ",/," *",A5,"END*",14X,"END OF TEST - " ,A5,/)          03040830
90018 FORMAT (" ",A13,13X,A20,"   *   ",A10,"/",                        03050830
     1        A13)                                                      03060830
90019 FORMAT (" ","FOR OFFICIAL USE ONLY     " ,35X,"COPYRIGHT  1982" ) 03070830
C****                                                                   03080830
C**** FORMAT STATEMENTS FOR RUN SUMMARY                                 03090830
C****                                                                   03100830
90020 FORMAT (" ",21X,I5," TESTS PASSED" )                              03110830
90022 FORMAT (" ",21X,I5," TESTS FAILED" )                              03120830
90024 FORMAT (" ",21X,I5," TESTS DELETED" )                             03130830
90026 FORMAT (" ",21X,I5," TESTS REQUIRE INSPECTION" )                  03140830
90028 FORMAT (" ",21X,I5," OF ",I3," TESTS EXECUTED" )                  03150830
CBE** ********************** BBCFMT0B **********************************03160830
C*****                                                                  03170830
C*****    END OF TEST SEGMENT 207                                       03180830
      STOP                                                              03190830
      END                                                               03200830