      PROGRAM FM360

C***********************************************************************00010360
C*****  FORTRAN 77                                                      00020360
C*****   FM360               XDIM - (163)                               00030360
C*****                                                                  00040360
C***********************************************************************00050360
C*****  GENERAL PURPOSE                                       SUBSET REF00060360
C*****    TEST INTRINSIC FUNCTION DIM AND IDIM--POSITIVE         15.3   00070360
C*****    DIFFERENCE, WHICH IS DEFINED AS A1 - MIN(A1,A2)      (TABLE 5)00080360
C*****                                                                  00090360
CBB** ********************** BBCCOMNT **********************************00100360
C****                                                                   00110360
C****            1978 FORTRAN COMPILER VALIDATION SYSTEM                00120360
C****                          VERSION 2.1                              00130360
C****                                                                   00140360
C****                                                                   00150360
C****           SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO         00160360
C****          NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY           00170360
C****               SOFTWARE STANDARDS VALIDATION GROUP                 00180360
C****                      BUILDING 225  RM A266                        00190360
C****                     GAITHERSBURG, MD  20899                       00200360
C****                                                                   00210360
C****                                                                   00220360
C****                                                                   00230360
CBE** ********************** BBCCOMNT **********************************00240360
CBB** ********************** BBCINITA **********************************00250360
C**** SPECIFICATION STATEMENTS                                          00260360
C****                                                                   00270360
      CHARACTER ZVERS*13, ZVERSD*17, ZDATE*17, ZPROG*5, ZCOMPL*20,      00280360
     1          ZNAME*20, ZTAPE*10, ZPROJ*13, REMRKS*31, ZTAPED*13      00290360
CBE** ********************** BBCINITA **********************************00300360
CBB** ********************** BBCINITB **********************************00310360
C**** INITIALIZE SECTION                                                00320360
      DATA  ZVERS,                  ZVERSD,             ZDATE           00330360
     1      /'VERSION 2.1  ',  '93/10/21*21.02.00',  '*NO DATE*TIME'/   00340360
      DATA       ZCOMPL,             ZNAME,             ZTAPE           00350360
     1      /'*NONE SPECIFIED*', '*NO COMPANY NAME*', '*NO TAPE*'/      00360360
      DATA       ZPROJ,           ZTAPED,         ZPROG                 00370360
     1      /'*NO PROJECT*',   '*NO TAPE DATE',  'XXXXX'/               00380360
      DATA   REMRKS /'                               '/                 00390360
C**** THE FOLLOWING 9 COMMENT LINES (CZ01, CZ02, ...) CAN BE REPLACED   00400360
C**** FOR IDENTIFYING THE TEST ENVIRONMENT                              00410360
C****                                                                   00420360
CZ01  ZVERS  = 'VERSION OF THE COMPILER VALIDATION SYSTEM'              00430360
CZ02  ZVERSD = 'CREATION DATE/TIME OF THE COMPILER VALIDATION SYSTEM'   00440360
CZ03  ZPROG  = 'PROGRAM NAME'                                           00450360
CZ04  ZDATE  = 'DATE OF TEST'                                           00460360
CZ05  ZCOMPL = 'COMPILER IDENTIFICATION'                                00470360
CZ06  ZPROJ  = 'PROJECT NUMBER/IDENTIFICATION'                          00480360
CZ07  ZNAME  = 'NAME OF USER'                                           00490360
CZ08  ZTAPE  = 'TAPE OWNER/ID'                                          00500360
CZ09  ZTAPED = 'DATE TAPE COPIED'                                       00510360
C                                                                       00520360
      IVPASS = 0                                                        00530360
      IVFAIL = 0                                                        00540360
      IVDELE = 0                                                        00550360
      IVINSP = 0                                                        00560360
      IVTOTL = 0                                                        00570360
      IVTOTN = 0                                                        00580360
      ICZERO = 0                                                        00590360
C                                                                       00600360
C     I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER.         00610360
      I01 = 05                                                          00620360
C     I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER.             00630360
      I02 = 06                                                          00640360
C                                                                       00650360
CX010   REPLACED BY FEXEC X-010 CONTROL CARD (CARD-READER UNIT NUMBER). 00660360
C     THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5      00670360
CX011   REPLACED BY FEXEC X-011 CONTROL CARD.  CX011 IS FOR SYSTEMS     00680360
C     REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX010.  00690360
C                                                                       00700360
CX020   REPLACED BY FEXEC X-020 CONTROL CARD (PRINTER UNIT NUMBER).     00710360
C     THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02= 6       00720360
CX021   REPLACED BY FEXEC X-021 CONTROL CARD.  CX021 IS FOR SYSTEMS     00730360
C     REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX020.  00740360
C                                                                       00750360
CBE** ********************** BBCINITB **********************************00760360
      NUVI = I02                                                        00770360
           IVTOTL = 14                                                  00780360
           ZPROG = 'FM360'                                              00790360
CBB** ********************** BBCHED0A **********************************00800360
C****                                                                   00810360
C**** WRITE REPORT TITLE                                                00820360
C****                                                                   00830360
      WRITE (I02, 90002)                                                00840360
      WRITE (I02, 90006)                                                00850360
      WRITE (I02, 90007)                                                00860360
      WRITE (I02, 90008)  ZVERS, ZVERSD                                 00870360
      WRITE (I02, 90009)  ZPROG, ZPROG                                  00880360
      WRITE (I02, 90010)  ZDATE, ZCOMPL                                 00890360
CBE** ********************** BBCHED0A **********************************00900360
C*****                                                                  00910360
C*****    HEADER FOR SEGMENT 163                                        00920360
        WRITE (NUVI,16301)                                              00930360
16301   FORMAT(" ", //,2X,"XDIM - (163) INTRINSIC FUNCTIONS-- " //12X,  00940360
     1        "DIM, IDIM (POSITIVE DIFFERENCE)" //                      00950360
     2          2X,"SUBSET REF. - 15.3" )                               00960360
CBB** ********************** BBCHED0B **********************************00970360
C**** WRITE DETAIL REPORT HEADERS                                       00980360
C****                                                                   00990360
      WRITE (I02,90004)                                                 01000360
      WRITE (I02,90004)                                                 01010360
      WRITE (I02,90013)                                                 01020360
      WRITE (I02,90014)                                                 01030360
      WRITE (I02,90015) IVTOTL                                          01040360
CBE** ********************** BBCHED0B **********************************01050360
C*****                                                                  01060360
C*****    TEST OF DIM                                                   01070360
C*****                                                                  01080360
        WRITE(NUVI, 16304)                                              01090360
16304   FORMAT (/ 8X, "TEST OF DIM" )                                   01100360
CT001*  TEST 1                                        BOTH VALUES EQUAL 01110360
           IVTNUM = 1                                                   01120360
        RGBVS = 2.5                                                     01130360
        RGDVS = 2.5                                                     01140360
        RGAVS = DIM(RGBVS, RGDVS)                                       01150360
           IF (RGAVS + .00005) 20010, 10010, 40010                      01160360
40010      IF (RGAVS - .00005) 10010, 10010, 20010                      01170360
10010      IVPASS = IVPASS + 1                                          01180360
           WRITE (NUVI, 80002) IVTNUM                                   01190360
           GO TO 0011                                                   01200360
20010      IVFAIL = IVFAIL + 1                                          01210360
           RVCORR = 0.0                                                 01220360
           WRITE (NUVI, 80012) IVTNUM, RGAVS, RVCORR                    01230360
 0011      CONTINUE                                                     01240360
CT002*  TEST 2                             FIRST VALUE LESS THAN SECOND 01250360
           IVTNUM = 2                                                   01260360
        RGBVS = 2.5                                                     01270360
        RGDVS = 5.5                                                     01280360
        RGAVS = DIM(RGBVS, RGDVS)                                       01290360
           IF (RGAVS + .00005) 20020, 10020, 40020                      01300360
40020      IF (RGAVS - .00005) 10020, 10020, 20020                      01310360
10020      IVPASS = IVPASS + 1                                          01320360
           WRITE (NUVI, 80002) IVTNUM                                   01330360
           GO TO 0021                                                   01340360
20020      IVFAIL = IVFAIL + 1                                          01350360
           RVCORR = 0.0                                                 01360360
           WRITE (NUVI, 80012) IVTNUM, RGAVS, RVCORR                    01370360
 0021      CONTINUE                                                     01380360
CT003*  TEST 3                          FIRST VALUE GREATER THAN SECOND 01390360
           IVTNUM = 3                                                   01400360
        RGBVS = 5.5                                                     01410360
        RGDVS = 2.5                                                     01420360
        RGAVS = DIM(RGBVS, RGDVS)                                       01430360
           IF (RGAVS - 2.9998) 20030, 10030, 40030                      01440360
40030      IF (RGAVS - 3.0002) 10030, 10030, 20030                      01450360
10030      IVPASS = IVPASS + 1                                          01460360
           WRITE (NUVI, 80002) IVTNUM                                   01470360
           GO TO 0031                                                   01480360
20030      IVFAIL = IVFAIL + 1                                          01490360
           RVCORR = 3.0                                                 01500360
           WRITE (NUVI, 80012) IVTNUM, RGAVS, RVCORR                    01510360
 0031      CONTINUE                                                     01520360
CT004*  TEST 4                         BOTH VALUES EQUAL, BOTH NEGATIVE 01530360
           IVTNUM = 4                                                   01540360
        RGBVS = -2.5                                                    01550360
        RGDVS = -2.5                                                    01560360
        RGAVS = DIM(RGBVS, RGDVS)                                       01570360
           IF (RGAVS + .00005) 20040, 10040, 40040                      01580360
40040      IF (RGAVS - .00005) 10040, 10040, 20040                      01590360
10040      IVPASS = IVPASS + 1                                          01600360
           WRITE (NUVI, 80002) IVTNUM                                   01610360
           GO TO 0041                                                   01620360
20040      IVFAIL = IVFAIL + 1                                          01630360
           RVCORR = 0.0                                                 01640360
           WRITE (NUVI, 80012) IVTNUM, RGAVS, RVCORR                    01650360
 0041      CONTINUE                                                     01660360
CT005*  TEST 5           FIRST VALUE GREATER THAN SECOND, BOTH NEGATIVE 01670360
           IVTNUM = 5                                                   01680360
        RGBVS = -2.5                                                    01690360
        RGDVS = -5.5                                                    01700360
        RGAVS = DIM(RGBVS, RGDVS)                                       01710360
           IF (RGAVS - 2.9998) 20050, 10050, 40050                      01720360
40050      IF (RGAVS - 3.0002) 10050, 10050, 20050                      01730360
10050      IVPASS = IVPASS + 1                                          01740360
           WRITE (NUVI, 80002) IVTNUM                                   01750360
           GO TO 0051                                                   01760360
20050      IVFAIL = IVFAIL + 1                                          01770360
           RVCORR = 3.0                                                 01780360
           WRITE (NUVI, 80012) IVTNUM, RGAVS, RVCORR                    01790360
 0051      CONTINUE                                                     01800360
CT006*  TEST 6              FIRST VALUE LESS THAN SECOND, BOTH NEGATIVE 01810360
           IVTNUM = 6                                                   01820360
        RGBVS = -5.5                                                    01830360
        RGDVS = -2.5                                                    01840360
        RGAVS = DIM(RGBVS, RGDVS)                                       01850360
           IF (RGAVS + .00005) 20060, 10060, 40060                      01860360
40060      IF (RGAVS - .00005) 10060, 10060, 20060                      01870360
10060      IVPASS = IVPASS + 1                                          01880360
           WRITE (NUVI, 80002) IVTNUM                                   01890360
           GO TO 0061                                                   01900360
20060      IVFAIL = IVFAIL + 1                                          01910360
           RVCORR = 0.0                                                 01920360
           WRITE (NUVI, 80012) IVTNUM, RGAVS, RVCORR                    01930360
 0061      CONTINUE                                                     01940360
CT007*  TEST 7                             EXPRESSIONS PRESENTED TO DIM 01950360
           IVTNUM = 7                                                   01960360
        RGDVS = 2.5                                                     01970360
        RGEVS = 1.25                                                    01980360
        RGAVS = DIM(RGDVS / RGEVS, RGDVS * RGEVS)                       01990360
           IF (RGAVS + .00005) 20070, 10070, 40070                      02000360
40070      IF (RGAVS - .00005) 10070, 10070, 20070                      02010360
10070      IVPASS = IVPASS + 1                                          02020360
           WRITE (NUVI, 80002) IVTNUM                                   02030360
           GO TO 0071                                                   02040360
20070      IVFAIL = IVFAIL + 1                                          02050360
           RVCORR = 0.0                                                 02060360
           WRITE (NUVI, 80012) IVTNUM, RGAVS, RVCORR                    02070360
 0071      CONTINUE                                                     02080360
C*****                                                                  02090360
C*****    TEST OF IDIM                                                  02100360
C*****                                                                  02110360
        WRITE(NUVI, 16302)                                              02120360
16302   FORMAT (/ 08X, "TEST OF IDIM" )                                 02130360
CT008*  TEST 8                                        BOTH VALUES EQUAL 02140360
           IVTNUM = 8                                                   02150360
        IGBVI = 2                                                       02160360
        IGDVI = 2                                                       02170360
        IGAVI = IDIM(IGBVI, IGDVI)                                      02180360
           IF (IGAVI - 0) 20080, 10080, 20080                           02190360
10080      IVPASS = IVPASS + 1                                          02200360
           WRITE (NUVI, 80002) IVTNUM                                   02210360
           GO TO 0081                                                   02220360
20080      IVFAIL = IVFAIL + 1                                          02230360
           IVCORR = 0                                                   02240360
           WRITE (NUVI, 80010) IVTNUM, IGAVI, IVCORR                    02250360
 0081      CONTINUE                                                     02260360
CT009*  TEST 9                             FIRST VALUE LESS THAN SECOND 02270360
           IVTNUM = 9                                                   02280360
        IGBVI = 2                                                       02290360
        IGDVI = 5                                                       02300360
        IGAVI = IDIM(IGBVI, IGDVI)                                      02310360
           IF (IGAVI - 0) 20090, 10090, 20090                           02320360
10090      IVPASS = IVPASS + 1                                          02330360
           WRITE (NUVI, 80002) IVTNUM                                   02340360
           GO TO 0091                                                   02350360
20090      IVFAIL = IVFAIL + 1                                          02360360
           IVCORR = 0                                                   02370360
           WRITE (NUVI, 80010) IVTNUM, IGAVI, IVCORR                    02380360
 0091      CONTINUE                                                     02390360
CT010*  TEST 10                         FIRST VALUE GREATER THAN SECOND 02400360
           IVTNUM = 10                                                  02410360
        IGBVI = 5                                                       02420360
        IGDVI = 2                                                       02430360
        IGAVI = IDIM(IGBVI, IGDVI)                                      02440360
           IF (IGAVI - 3) 20100, 10100, 20100                           02450360
10100      IVPASS = IVPASS + 1                                          02460360
           WRITE (NUVI, 80002) IVTNUM                                   02470360
           GO TO 0101                                                   02480360
20100      IVFAIL = IVFAIL + 1                                          02490360
           IVCORR = 3                                                   02500360
           WRITE (NUVI, 80010) IVTNUM, IGAVI, IVCORR                    02510360
 0101      CONTINUE                                                     02520360
CT011*  TEST 11                        BOTH VALUES EQUAL, BOTH NEGATIVE 02530360
           IVTNUM = 11                                                  02540360
        IGBVI = -2                                                      02550360
        IGDVI = -2                                                      02560360
        IGAVI = IDIM(IGBVI, IGDVI)                                      02570360
           IF (IGAVI - 0) 20110, 10110, 20110                           02580360
10110      IVPASS = IVPASS + 1                                          02590360
           WRITE (NUVI, 80002) IVTNUM                                   02600360
           GO TO 0111                                                   02610360
20110      IVFAIL = IVFAIL + 1                                          02620360
           IVCORR = 0                                                   02630360
           WRITE (NUVI, 80010) IVTNUM, IGAVI, IVCORR                    02640360
 0111      CONTINUE                                                     02650360
CT012*  TEST 12          FIRST VALUE GREATER THAN SECOND, BOTH NEGATIVE 02660360
           IVTNUM = 12                                                  02670360
        IGBVI = -2                                                      02680360
        IGDVI = -5                                                      02690360
        IGAVI = IDIM(IGBVI, IGDVI)                                      02700360
           IF (IGAVI - 3) 20120, 10120, 20120                           02710360
10120      IVPASS = IVPASS + 1                                          02720360
           WRITE (NUVI, 80002) IVTNUM                                   02730360
           GO TO 0121                                                   02740360
20120      IVFAIL = IVFAIL + 1                                          02750360
           IVCORR = 3                                                   02760360
           WRITE (NUVI, 80010) IVTNUM, IGAVI, IVCORR                    02770360
 0121      CONTINUE                                                     02780360
CT013*  TEST 13             FIRST VALUE LESS THAN SECOND, BOTH NEGATIVE 02790360
           IVTNUM = 13                                                  02800360
        IGBVI = -5                                                      02810360
        IGDVI = -2                                                      02820360
        IGAVI = IDIM(IGBVI, IGDVI)                                      02830360
           IF (IGAVI - 0) 20130, 10130, 20130                           02840360
10130      IVPASS = IVPASS + 1                                          02850360
           WRITE (NUVI, 80002) IVTNUM                                   02860360
           GO TO 0131                                                   02870360
20130      IVFAIL = IVFAIL + 1                                          02880360
           IVCORR = 0                                                   02890360
           WRITE (NUVI, 80010) IVTNUM, IGAVI, IVCORR                    02900360
 0131      CONTINUE                                                     02910360
CT014*  TEST 14                ARITHMETIC EXPRESSIONS PRESENTED TO IDIM 02920360
           IVTNUM = 14                                                  02930360
        IGDVI = 2                                                       02940360
        IGEVI = 1.25                                                    02950360
        IGAVI = IDIM(IGDVI / IGEVI, IGDVI * IGEVI)                      02960360
           IF (IGAVI - 0) 20140, 10140, 20140                           02970360
10140      IVPASS = IVPASS + 1                                          02980360
           WRITE (NUVI, 80002) IVTNUM                                   02990360
           GO TO 0141                                                   03000360
20140      IVFAIL = IVFAIL + 1                                          03010360
           IVCORR = 0                                                   03020360
           WRITE (NUVI, 80010) IVTNUM, IGAVI, IVCORR                    03030360
 0141      CONTINUE                                                     03040360
C*****                                                                  03050360
CBB** ********************** BBCSUM0  **********************************03060360
C**** WRITE OUT TEST SUMMARY                                            03070360
C****                                                                   03080360
      IVTOTN = IVPASS + IVFAIL + IVDELE + IVINSP                        03090360
      WRITE (I02, 90004)                                                03100360
      WRITE (I02, 90014)                                                03110360
      WRITE (I02, 90004)                                                03120360
      WRITE (I02, 90020) IVPASS                                         03130360
      WRITE (I02, 90022) IVFAIL                                         03140360
      WRITE (I02, 90024) IVDELE                                         03150360
      WRITE (I02, 90026) IVINSP                                         03160360
      WRITE (I02, 90028) IVTOTN, IVTOTL                                 03170360
CBE** ********************** BBCSUM0  **********************************03180360
CBB** ********************** BBCFOOT0 **********************************03190360
C**** WRITE OUT REPORT FOOTINGS                                         03200360
C****                                                                   03210360
      WRITE (I02,90016) ZPROG, ZPROG                                    03220360
      WRITE (I02,90018) ZPROJ, ZNAME, ZTAPE, ZTAPED                     03230360
      WRITE (I02,90019)                                                 03240360
CBE** ********************** BBCFOOT0 **********************************03250360
CBB** ********************** BBCFMT0A **********************************03260360
C**** FORMATS FOR TEST DETAIL LINES                                     03270360
C****                                                                   03280360
80000 FORMAT (" ",2X,I3,4X,"DELETED",32X,A31)                           03290360
80002 FORMAT (" ",2X,I3,4X," PASS  ",32X,A31)                           03300360
80004 FORMAT (" ",2X,I3,4X,"INSPECT",32X,A31)                           03310360
80008 FORMAT (" ",2X,I3,4X," FAIL  ",32X,A31)                           03320360
80010 FORMAT (" ",2X,I3,4X," FAIL  ",/," ",15X,"COMPUTED= " ,           03330360
     1I6,/," ",15X,"CORRECT=  " ,I6)                                    03340360
80012 FORMAT (" ",2X,I3,4X," FAIL  ",/," ",16X,"COMPUTED= " ,           03350360
     1E12.5,/," ",16X,"CORRECT=  " ,E12.5)                              03360360
80018 FORMAT (" ",2X,I3,4X," FAIL  ",/," ",16X,"COMPUTED= " ,           03370360
     1A21,/," ",16X,"CORRECT=  " ,A21)                                  03380360
80020 FORMAT (" ",16X,"COMPUTED= " ,A21,1X,A31)                         03390360
80022 FORMAT (" ",16X,"CORRECT=  " ,A21,1X,A31)                         03400360
80024 FORMAT (" ",16X,"COMPUTED= " ,I6,16X,A31)                         03410360
80026 FORMAT (" ",16X,"CORRECT=  " ,I6,16X,A31)                         03420360
80028 FORMAT (" ",16X,"COMPUTED= " ,E12.5,10X,A31)                      03430360
80030 FORMAT (" ",16X,"CORRECT=  " ,E12.5,10X,A31)                      03440360
80050 FORMAT (" ",48X,A31)                                              03450360
CBE** ********************** BBCFMT0A **********************************03460360
CBB** ********************** BBCFMT0B **********************************03470360
C**** FORMAT STATEMENTS FOR PAGE HEADERS                                03480360
C****                                                                   03490360
90002 FORMAT ("1")                                                      03500360
90004 FORMAT (" ")                                                      03510360
90006 FORMAT (" ",20X,"NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY" )03520360
90007 FORMAT (" ",19X,"FORTRAN COMPILER VALIDATION SYSTEM" )            03530360
90008 FORMAT (" ",21X,A13,A17)                                          03540360
90009 FORMAT (" ",/," *",A5,"BEGIN*",12X,"TEST RESULTS - " ,A5,/)       03550360
90010 FORMAT (" ",8X,"TEST DATE*TIME= " ,A17,"  -  COMPILER= " ,A20)    03560360
90013 FORMAT (" "," TEST   ","PASS/FAIL " ,6X,"DISPLAYED RESULTS" ,     03570360
     1       7X,"REMARKS",24X)                                          03580360
90014 FORMAT (" ","----------------------------------------------" ,    03590360
     1        "---------------------------------" )                     03600360
90015 FORMAT (" ",48X,"THIS PROGRAM HAS " ,I3," TESTS",/)               03610360
C****                                                                   03620360
C**** FORMAT STATEMENTS FOR REPORT FOOTINGS                             03630360
C****                                                                   03640360
90016 FORMAT (" ",/," *",A5,"END*",14X,"END OF TEST - " ,A5,/)          03650360
90018 FORMAT (" ",A13,13X,A20,"   *   ",A10,"/",                        03660360
     1        A13)                                                      03670360
90019 FORMAT (" ","FOR OFFICIAL USE ONLY     " ,35X,"COPYRIGHT  1982" ) 03680360
C****                                                                   03690360
C**** FORMAT STATEMENTS FOR RUN SUMMARY                                 03700360
C****                                                                   03710360
90020 FORMAT (" ",21X,I5," TESTS PASSED" )                              03720360
90022 FORMAT (" ",21X,I5," TESTS FAILED" )                              03730360
90024 FORMAT (" ",21X,I5," TESTS DELETED" )                             03740360
90026 FORMAT (" ",21X,I5," TESTS REQUIRE INSPECTION" )                  03750360
90028 FORMAT (" ",21X,I5," OF ",I3," TESTS EXECUTED" )                  03760360
CBE** ********************** BBCFMT0B **********************************03770360
C*****                                                                  03780360
16303   FORMAT(2X, F7.2)                                                03790360
16305   FORMAT(3X, I5)                                                  03800360
C*****                                                                  03810360
C*****    END OF TEST SEGMENT 163                                       03820360
      STOP                                                              03830360
      END                                                               03840360
                                                                        03850360