      PROGRAM FM810

C***********************************************************************00010810
C*****  FORTRAN 77                                                      00020810
C*****   FM810               YDMMX - (173)                              00030810
C*****                                                                  00040810
C***********************************************************************00050810
C*****  GENERAL PURPOSE                                         ANS REF 00060810
C*****    TESTS THE USE OF INTEGER, REAL, DOUBLE PRECISION,       15.3  00070810
C*****    AND MIXED MODE EXPRESSIONS CONTAINING REFERENCES TO     15.10 00080810
C*****    THE INTRINSIC FUNCTIONS OF THE FULL LANGUAGE            6.1.4 00090810
C*****                                                                  00100810
C*****  GENERAL COMMENTS                                                00110810
C*****    SEGMENTS TESTING XINT, XREAL, XAINT, XABS, XAMOD,             00120810
C*****    XSIGN, XDIM, XMAX, XMIN, YIDINT, YSNGL                        00130810
C*****    YDINT, YDABS, YCABS, YDMOD, YDSIGN,                           00140810
C*****    YDMAX1, YDMIN1, YDBLE, YCONJG ASSUMED WORKING                 00150810
CBB** ********************** BBCCOMNT **********************************00160810
C****                                                                   00170810
C****            1978 FORTRAN COMPILER VALIDATION SYSTEM                00180810
C****                          VERSION 2.1                              00190810
C****                                                                   00200810
C****                                                                   00210810
C****           SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO         00220810
C****          NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY           00230810
C****               SOFTWARE STANDARDS VALIDATION GROUP                 00240810
C****                      BUILDING 225  RM A266                        00250810
C****                     GAITHERSBURG, MD  20899                       00260810
C****                                                                   00270810
C****                                                                   00280810
C****                                                                   00290810
CBE** ********************** BBCCOMNT **********************************00300810
C*****                                                                  00310810
C*****    S P E C I F I C A T I O N S  SEGMENT 173                      00320810
        DOUBLE PRECISION DXAVD,DXBVD,DXDVD,DXEVD,DXFVD,DXGVD,DVCORR     00330810
CBB** ********************** BBCINITA **********************************00340810
C**** SPECIFICATION STATEMENTS                                          00350810
C****                                                                   00360810
      CHARACTER ZVERS*13, ZVERSD*17, ZDATE*17, ZPROG*5, ZCOMPL*20,      00370810
     1          ZNAME*20, ZTAPE*10, ZPROJ*13, REMRKS*31, ZTAPED*13      00380810
CBE** ********************** BBCINITA **********************************00390810
CBB** ********************** BBCINITB **********************************00400810
C**** INITIALIZE SECTION                                                00410810
      DATA  ZVERS,                  ZVERSD,             ZDATE           00420810
     1      /'VERSION 2.1  ',  '93/10/21*21.02.00',  '*NO DATE*TIME'/   00430810
      DATA       ZCOMPL,             ZNAME,             ZTAPE           00440810
     1      /'*NONE SPECIFIED*', '*NO COMPANY NAME*', '*NO TAPE*'/      00450810
      DATA       ZPROJ,           ZTAPED,         ZPROG                 00460810
     1      /'*NO PROJECT*',   '*NO TAPE DATE',  'XXXXX'/               00470810
      DATA   REMRKS /'                               '/                 00480810
C**** THE FOLLOWING 9 COMMENT LINES (CZ01, CZ02, ...) CAN BE REPLACED   00490810
C**** FOR IDENTIFYING THE TEST ENVIRONMENT                              00500810
C****                                                                   00510810
CZ01  ZVERS  = 'VERSION OF THE COMPILER VALIDATION SYSTEM'              00520810
CZ02  ZVERSD = 'CREATION DATE/TIME OF THE COMPILER VALIDATION SYSTEM'   00530810
CZ03  ZPROG  = 'PROGRAM NAME'                                           00540810
CZ04  ZDATE  = 'DATE OF TEST'                                           00550810
CZ05  ZCOMPL = 'COMPILER IDENTIFICATION'                                00560810
CZ06  ZPROJ  = 'PROJECT NUMBER/IDENTIFICATION'                          00570810
CZ07  ZNAME  = 'NAME OF USER'                                           00580810
CZ08  ZTAPE  = 'TAPE OWNER/ID'                                          00590810
CZ09  ZTAPED = 'DATE TAPE COPIED'                                       00600810
C                                                                       00610810
      IVPASS = 0                                                        00620810
      IVFAIL = 0                                                        00630810
      IVDELE = 0                                                        00640810
      IVINSP = 0                                                        00650810
      IVTOTL = 0                                                        00660810
      IVTOTN = 0                                                        00670810
      ICZERO = 0                                                        00680810
C                                                                       00690810
C     I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER.         00700810
      I01 = 05                                                          00710810
C     I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER.             00720810
      I02 = 06                                                          00730810
C                                                                       00740810
CX010   REPLACED BY FEXEC X-010 CONTROL CARD (CARD-READER UNIT NUMBER). 00750810
C     THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5      00760810
CX011   REPLACED BY FEXEC X-011 CONTROL CARD.  CX011 IS FOR SYSTEMS     00770810
C     REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX010.  00780810
C                                                                       00790810
CX020   REPLACED BY FEXEC X-020 CONTROL CARD (PRINTER UNIT NUMBER).     00800810
C     THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02= 6       00810810
CX021   REPLACED BY FEXEC X-021 CONTROL CARD.  CX021 IS FOR SYSTEMS     00820810
C     REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX020.  00830810
C                                                                       00840810
CBE** ********************** BBCINITB **********************************00850810
      NUVI = I02                                                        00860810
      IVTOTL = 10                                                       00870810
      ZPROG = 'FM810'                                                   00880810
CBB** ********************** BBCHED0A **********************************00890810
C****                                                                   00900810
C**** WRITE REPORT TITLE                                                00910810
C****                                                                   00920810
      WRITE (I02, 90002)                                                00930810
      WRITE (I02, 90006)                                                00940810
      WRITE (I02, 90007)                                                00950810
      WRITE (I02, 90008)  ZVERS, ZVERSD                                 00960810
      WRITE (I02, 90009)  ZPROG, ZPROG                                  00970810
      WRITE (I02, 90010)  ZDATE, ZCOMPL                                 00980810
CBE** ********************** BBCHED0A **********************************00990810
C*****                                                                  01000810
C*****                                                                  01010810
C*****    HEADER FOR SEGMENT 173 WRITTEN                                01020810
        WRITE (NUVI,17301)                                              01030810
17301   FORMAT(" ", //1X, "YDMMX - (173) INTRINSIC FUNCTIONS--" //      01040810
     1        16X, "INTEGER, REAL AND D.P." /,                          01050810
     2        16X, "AND MIXED MODE EXPRESSIONS" //                      01060810
     3        2X,  "ANS REF. - 15.3, 15.10, 6.1.4" )                    01070810
CBB** ********************** BBCHED0B **********************************01080810
C**** WRITE DETAIL REPORT HEADERS                                       01090810
C****                                                                   01100810
      WRITE (I02,90004)                                                 01110810
      WRITE (I02,90004)                                                 01120810
      WRITE (I02,90013)                                                 01130810
      WRITE (I02,90014)                                                 01140810
      WRITE (I02,90015) IVTOTL                                          01150810
CBE** ********************** BBCHED0B **********************************01160810
C*****                                                                  01170810
CT001*  TEST 1                                                          01180810
           IVTNUM = 1                                                   01190810
        DXBVD = 3.5D0                                                   01200810
        IXAVI = IDINT(DXBVD) + 2                                        01210810
           IF (IXAVI - 5) 20010, 10010, 20010                           01220810
10010      IVPASS = IVPASS + 1                                          01230810
           WRITE (NUVI, 80002) IVTNUM                                   01240810
           GO TO 0011                                                   01250810
20010      IVFAIL = IVFAIL + 1                                          01260810
           IVCORR = 5                                                   01270810
           WRITE (NUVI, 80010) IVTNUM, IXAVI, IVCORR                    01280810
 0011      CONTINUE                                                     01290810
CT002*  TEST 2                                                          01300810
           IVTNUM = 2                                                   01310810
        DXBVD = 5.25D0                                                  01320810
        RXAVS = SNGL(DXBVD) * 3.0                                       01330810
           IF (RXAVS - 15.749) 20020, 10020, 40020                      01340810
40020      IF (RXAVS - 15.751) 10020, 10020, 20020                      01350810
10020      IVPASS = IVPASS + 1                                          01360810
           WRITE (NUVI, 80002) IVTNUM                                   01370810
           GO TO 0021                                                   01380810
20020      IVFAIL = IVFAIL + 1                                          01390810
           RVCORR = 15.75                                               01400810
           WRITE (NUVI, 80012) IVTNUM, RXAVS, RVCORR                    01410810
 0021      CONTINUE                                                     01420810
CT003*  TEST 3                                                          01430810
           IVTNUM = 3                                                   01440810
        DXBVD = 3.2D0                                                   01450810
        DXAVD = DINT(DXBVD) ** 2.0                                      01460810
           IF (DXAVD - 8.999999995D0) 20030, 10030, 40030               01470810
40030      IF (DXAVD - 9.000000005D0) 10030, 10030, 20030               01480810
10030      IVPASS = IVPASS + 1                                          01490810
           WRITE (NUVI, 80002) IVTNUM                                   01500810
           GO TO 0031                                                   01510810
20030      IVFAIL = IVFAIL + 1                                          01520810
           DVCORR = 9.0D0                                               01530810
           WRITE (NUVI, 80031) IVTNUM, DXAVD, DVCORR                    01540810
 0031      CONTINUE                                                     01550810
CT004*  TEST 4                                                          01560810
           IVTNUM = 4                                                   01570810
        DXBVD = 3.2D0                                                   01580810
        DXAVD = DNINT(DXBVD) + 2.5                                      01590810
           IF (DXAVD - 5.499999997D0) 20040, 10040, 40040               01600810
40040      IF (DXAVD - 5.500000003D0) 10040, 10040, 20040               01610810
10040      IVPASS = IVPASS + 1                                          01620810
           WRITE (NUVI, 80002) IVTNUM                                   01630810
           GO TO 0041                                                   01640810
20040      IVFAIL = IVFAIL + 1                                          01650810
           DVCORR = 5.5D0                                               01660810
           WRITE (NUVI, 80031) IVTNUM, DXAVD, DVCORR                    01670810
 0041      CONTINUE                                                     01680810
CT005*  TEST 5                                                          01690810
           IVTNUM = 5                                                   01700810
        DXBVD = 3.5D0                                                   01710810
        RXAVS = IDINT(DXBVD) * 2.5                                      01720810
           IF (RXAVS - 7.4996) 20050, 10050, 40050                      01730810
40050      IF (RXAVS - 7.5004) 10050, 10050, 20050                      01740810
10050      IVPASS = IVPASS + 1                                          01750810
           WRITE (NUVI, 80002) IVTNUM                                   01760810
           GO TO 0051                                                   01770810
20050      IVFAIL = IVFAIL + 1                                          01780810
           RVCORR = 7.5                                                 01790810
           WRITE (NUVI, 80012) IVTNUM, RXAVS, RVCORR                    01800810
 0051      CONTINUE                                                     01810810
CT006*  TEST 6                                                          01820810
           IVTNUM = 6                                                   01830810
        DXBVD = -2.5D0                                                  01840810
        DXAVD = DABS(DXBVD) * 2                                         01850810
           IF (DXAVD - 4.999999997D0) 20060, 10060, 40060               01860810
40060      IF (DXAVD - 5.000000003D0) 10060, 10060, 20060               01870810
10060      IVPASS = IVPASS + 1                                          01880810
           WRITE (NUVI, 80002) IVTNUM                                   01890810
           GO TO 0061                                                   01900810
20060      IVFAIL = IVFAIL + 1                                          01910810
           DVCORR = 5.0D0                                               01920810
           WRITE (NUVI, 80031) IVTNUM, DXAVD, DVCORR                    01930810
 0061      CONTINUE                                                     01940810
CT007*  TEST 7                                                          01950810
           IVTNUM = 7                                                   01960810
        DXBVD = 5.0D0                                                   01970810
        DXDVD = 2.0D0                                                   01980810
        DXEVD = 3.0D0                                                   01990810
        DXFVD = -1.0D0                                                  02000810
        DXAVD = DMOD(DXBVD, DXDVD) * 3 + DSIGN(DXEVD, DXFVD)            02010810
           IF (DXAVD + 5.0D-10) 20070, 10070, 40070                     02020810
40070      IF (DXAVD - 5.0D-10) 10070, 10070, 20070                     02030810
10070      IVPASS = IVPASS + 1                                          02040810
           WRITE (NUVI, 80002) IVTNUM                                   02050810
           GO TO 0071                                                   02060810
20070      IVFAIL = IVFAIL + 1                                          02070810
           DVCORR = 0.0D0                                               02080810
           WRITE (NUVI, 80031) IVTNUM, DXAVD, DVCORR                    02090810
 0071      CONTINUE                                                     02100810
CT008*  TEST 8                                                          02110810
           IVTNUM = 8                                                   02120810
        DXBVD = 1.5D1                                                   02130810
        DXDVD = 0.5D1                                                   02140810
        RXBVS = 5.0                                                     02150810
        RXDVS = 2.0                                                     02160810
        DXAVD = DDIM(DXBVD, DXDVD) / DPROD(RXBVS, RXDVS)                02170810
           IF (DXAVD - 0.9999999995D0) 20080, 10080, 40080              02180810
40080      IF (DXAVD - 1.000000001D0) 10080, 10080, 20080               02190810
10080      IVPASS = IVPASS + 1                                          02200810
           WRITE (NUVI, 80002) IVTNUM                                   02210810
           GO TO 0081                                                   02220810
20080      IVFAIL = IVFAIL + 1                                          02230810
           DVCORR = 1.0D0                                               02240810
           WRITE (NUVI, 80031) IVTNUM, DXAVD, DVCORR                    02250810
 0081      CONTINUE                                                     02260810
CT009*  TEST 9                                                          02270810
           IVTNUM = 9                                                   02280810
        DXBVD = 5.5D0                                                   02290810
        DXDVD = 2.5D0                                                   02300810
        DXEVD = 1.0D0                                                   02310810
        RXBVS = 1.0                                                     02320810
        DXAVD = (10 - DMAX1(DXBVD, DXDVD)) * (DMIN1(DXEVD, DXDVD)       02330810
     1          + DBLE(RXBVS))                                          02340810
           IF (DXAVD - 8.999999995D0) 20090, 10090, 40090               02350810
40090      IF (DXAVD - 9.000000005D0) 10090, 10090, 20090               02360810
10090      IVPASS = IVPASS + 1                                          02370810
           WRITE (NUVI, 80002) IVTNUM                                   02380810
           GO TO 0091                                                   02390810
20090      IVFAIL = IVFAIL + 1                                          02400810
           DVCORR = 9.0D0                                               02410810
           WRITE (NUVI, 80031) IVTNUM, DXAVD, DVCORR                    02420810
 0091      CONTINUE                                                     02430810
CT010*  TEST 10                                                         02440810
           IVTNUM = 10                                                  02450810
        DXBVD = 0.635D2                                                 02460810
        RXBVS = 5.0                                                     02470810
        DXDVD = 5.7D0                                                   02480810
        DXEVD = -6.0D0                                                  02490810
        DXFVD = 1.0D0                                                   02500810
        DXGVD = 3.0D0                                                   02510810
        DXAVD = (IDINT(DXBVD) + 1.0) / (7 - DBLE(RXBVS)) -              02520810
     1          (DINT(DXDVD) + 5 + 5.5) * (DSIGN(DXEVD, DXFVD) /        02530810
     2              SNGL(DXGVD))                                        02540810
           IF (DXAVD - 0.9999999995D0) 20100, 10100, 40100              02550810
40100      IF (DXAVD - 1.000000001D0) 10100, 10100, 20100               02560810
10100      IVPASS = IVPASS + 1                                          02570810
           WRITE (NUVI, 80002) IVTNUM                                   02580810
           GO TO 0101                                                   02590810
20100      IVFAIL = IVFAIL + 1                                          02600810
           DVCORR = 1.0D0                                               02610810
           WRITE (NUVI, 80031) IVTNUM, DXAVD, DVCORR                    02620810
 0101      CONTINUE                                                     02630810
C*****                                                                  02640810
CBB** ********************** BBCSUM0  **********************************02650810
C**** WRITE OUT TEST SUMMARY                                            02660810
C****                                                                   02670810
      IVTOTN = IVPASS + IVFAIL + IVDELE + IVINSP                        02680810
      WRITE (I02, 90004)                                                02690810
      WRITE (I02, 90014)                                                02700810
      WRITE (I02, 90004)                                                02710810
      WRITE (I02, 90020) IVPASS                                         02720810
      WRITE (I02, 90022) IVFAIL                                         02730810
      WRITE (I02, 90024) IVDELE                                         02740810
      WRITE (I02, 90026) IVINSP                                         02750810
      WRITE (I02, 90028) IVTOTN, IVTOTL                                 02760810
CBE** ********************** BBCSUM0  **********************************02770810
CBB** ********************** BBCFOOT0 **********************************02780810
C**** WRITE OUT REPORT FOOTINGS                                         02790810
C****                                                                   02800810
      WRITE (I02,90016) ZPROG, ZPROG                                    02810810
      WRITE (I02,90018) ZPROJ, ZNAME, ZTAPE, ZTAPED                     02820810
      WRITE (I02,90019)                                                 02830810
CBE** ********************** BBCFOOT0 **********************************02840810
CBB** ********************** BBCFMT0A **********************************02850810
C**** FORMATS FOR TEST DETAIL LINES                                     02860810
C****                                                                   02870810
80000 FORMAT (" ",2X,I3,4X,"DELETED",32X,A31)                           02880810
80002 FORMAT (" ",2X,I3,4X," PASS  ",32X,A31)                           02890810
80004 FORMAT (" ",2X,I3,4X,"INSPECT",32X,A31)                           02900810
80008 FORMAT (" ",2X,I3,4X," FAIL  ",32X,A31)                           02910810
80010 FORMAT (" ",2X,I3,4X," FAIL  ",/," ",15X,"COMPUTED= " ,           02920810
     1I6,/," ",15X,"CORRECT=  " ,I6)                                    02930810
80012 FORMAT (" ",2X,I3,4X," FAIL  ",/," ",16X,"COMPUTED= " ,           02940810
     1E12.5,/," ",16X,"CORRECT=  " ,E12.5)                              02950810
80018 FORMAT (" ",2X,I3,4X," FAIL  ",/," ",16X,"COMPUTED= " ,           02960810
     1A21,/," ",16X,"CORRECT=  " ,A21)                                  02970810
80020 FORMAT (" ",16X,"COMPUTED= " ,A21,1X,A31)                         02980810
80022 FORMAT (" ",16X,"CORRECT=  " ,A21,1X,A31)                         02990810
80024 FORMAT (" ",16X,"COMPUTED= " ,I6,16X,A31)                         03000810
80026 FORMAT (" ",16X,"CORRECT=  " ,I6,16X,A31)                         03010810
80028 FORMAT (" ",16X,"COMPUTED= " ,E12.5,10X,A31)                      03020810
80030 FORMAT (" ",16X,"CORRECT=  " ,E12.5,10X,A31)                      03030810
80050 FORMAT (" ",48X,A31)                                              03040810
CBE** ********************** BBCFMT0A **********************************03050810
CBB** ********************** BBCFMAT1 **********************************03060810
C**** FORMATS FOR TEST DETAIL LINES - FULL LANGUAGE                     03070810
C****                                                                   03080810
80031 FORMAT (" ",2X,I3,4X," FAIL  ",/," ",16X,"COMPUTED= " ,           03090810
     1D17.10,/," ",16X,"CORRECT=  " ,D17.10)                            03100810
80033 FORMAT (" ",16X,"COMPUTED= " ,D17.10,10X,A31)                     03110810
80035 FORMAT (" ",16X,"CORRECT=  " ,D17.10,10X,A31)                     03120810
80037 FORMAT (" ",16X,"COMPUTED= " ,"(",E12.5,", ",E12.5,")",6X,A31)    03130810
80039 FORMAT (" ",16X,"CORRECT=  " ,"(",E12.5,", ",E12.5,")",6X,A31)    03140810
80041 FORMAT (" ",16X,"COMPUTED= " ,"(",F12.5,", ",F12.5,")",6X,A31)    03150810
80043 FORMAT (" ",16X,"CORRECT=  " ,"(",F12.5,", ",F12.5,")",6X,A31)    03160810
80045 FORMAT (" ",2X,I3,4X," FAIL  ",/," ",16X,"COMPUTED= " ,           03170810
     1"(",F12.5,", ",F12.5,")"/," ",16X,"CORRECT=  " ,                  03180810
     2"(",F12.5,", ",F12.5,")")                                         03190810
CBE** ********************** BBCFMAT1 **********************************03200810
CBB** ********************** BBCFMT0B **********************************03210810
C**** FORMAT STATEMENTS FOR PAGE HEADERS                                03220810
C****                                                                   03230810
90002 FORMAT ("1")                                                      03240810
90004 FORMAT (" ")                                                      03250810
90006 FORMAT (" ",20X,"NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY" )03260810
90007 FORMAT (" ",19X,"FORTRAN COMPILER VALIDATION SYSTEM" )            03270810
90008 FORMAT (" ",21X,A13,A17)                                          03280810
90009 FORMAT (" ",/," *",A5,"BEGIN*",12X,"TEST RESULTS - " ,A5,/)       03290810
90010 FORMAT (" ",8X,"TEST DATE*TIME= " ,A17,"  -  COMPILER= " ,A20)    03300810
90013 FORMAT (" "," TEST   ","PASS/FAIL " ,6X,"DISPLAYED RESULTS" ,     03310810
     1       7X,"REMARKS",24X)                                          03320810
90014 FORMAT (" ","----------------------------------------------" ,    03330810
     1        "---------------------------------" )                     03340810
90015 FORMAT (" ",48X,"THIS PROGRAM HAS " ,I3," TESTS",/)               03350810
C****                                                                   03360810
C**** FORMAT STATEMENTS FOR REPORT FOOTINGS                             03370810
C****                                                                   03380810
90016 FORMAT (" ",/," *",A5,"END*",14X,"END OF TEST - " ,A5,/)          03390810
90018 FORMAT (" ",A13,13X,A20,"   *   ",A10,"/",                        03400810
     1        A13)                                                      03410810
90019 FORMAT (" ","FOR OFFICIAL USE ONLY     " ,35X,"COPYRIGHT  1982" ) 03420810
C****                                                                   03430810
C**** FORMAT STATEMENTS FOR RUN SUMMARY                                 03440810
C****                                                                   03450810
90020 FORMAT (" ",21X,I5," TESTS PASSED" )                              03460810
90022 FORMAT (" ",21X,I5," TESTS FAILED" )                              03470810
90024 FORMAT (" ",21X,I5," TESTS DELETED" )                             03480810
90026 FORMAT (" ",21X,I5," TESTS REQUIRE INSPECTION" )                  03490810
90028 FORMAT (" ",21X,I5," OF ",I3," TESTS EXECUTED" )                  03500810
CBE** ********************** BBCFMT0B **********************************03510810
C*****    END OF TEST SEGMENT 173                                       03520810
        STOP                                                            03530810
        END                                                             03540810
                                                                        03550810