      PROGRAM FM804

C***********************************************************************00010804
C*****  FORTRAN 77                                                      00020804
C*****   FM804               YDMOD - (160)                              00030804
C*****                                                                  00040804
C***********************************************************************00050804
C*****  GENERAL PURPOSE                                         ANS REF 00060804
C*****     TO TEST INTRINSIC FUNCTION - DMOD -                   15.3   00070804
C*****     (REMAINDERING -TYPE DOUBLE PRECISION)               (TABLE 5)00080804
CBB** ********************** BBCCOMNT **********************************00090804
C****                                                                   00100804
C****            1978 FORTRAN COMPILER VALIDATION SYSTEM                00110804
C****                          VERSION 2.1                              00120804
C****                                                                   00130804
C****                                                                   00140804
C****           SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO         00150804
C****          NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY           00160804
C****               SOFTWARE STANDARDS VALIDATION GROUP                 00170804
C****                      BUILDING 225  RM A266                        00180804
C****                     GAITHERSBURG, MD  20899                       00190804
C****                                                                   00200804
C****                                                                   00210804
C****                                                                   00220804
CBE** ********************** BBCCOMNT **********************************00230804
C*****                                                                  00240804
C*****  S P E C I F I C A T I O N S  SEGMENT 160                        00250804
C*****                                                                  00260804
        DOUBLE PRECISION DQAVD, DQBVD, DQDVD, DQEVD, DQFVD              00270804
C*****                                                                  00280804
CBB** ********************** BBCINITA **********************************00290804
C**** SPECIFICATION STATEMENTS                                          00300804
C****                                                                   00310804
      CHARACTER ZVERS*13, ZVERSD*17, ZDATE*17, ZPROG*5, ZCOMPL*20,      00320804
     1          ZNAME*20, ZTAPE*10, ZPROJ*13, REMRKS*31, ZTAPED*13      00330804
CBE** ********************** BBCINITA **********************************00340804
CBB** ********************** BBCINITB **********************************00350804
C**** INITIALIZE SECTION                                                00360804
      DATA  ZVERS,                  ZVERSD,             ZDATE           00370804
     1      /'VERSION 2.1  ',  '93/10/21*21.02.00',  '*NO DATE*TIME'/   00380804
      DATA       ZCOMPL,             ZNAME,             ZTAPE           00390804
     1      /'*NONE SPECIFIED*', '*NO COMPANY NAME*', '*NO TAPE*'/      00400804
      DATA       ZPROJ,           ZTAPED,         ZPROG                 00410804
     1      /'*NO PROJECT*',   '*NO TAPE DATE',  'XXXXX'/               00420804
      DATA   REMRKS /'                               '/                 00430804
C**** THE FOLLOWING 9 COMMENT LINES (CZ01, CZ02, ...) CAN BE REPLACED   00440804
C**** FOR IDENTIFYING THE TEST ENVIRONMENT                              00450804
C****                                                                   00460804
CZ01  ZVERS  = 'VERSION OF THE COMPILER VALIDATION SYSTEM'              00470804
CZ02  ZVERSD = 'CREATION DATE/TIME OF THE COMPILER VALIDATION SYSTEM'   00480804
CZ03  ZPROG  = 'PROGRAM NAME'                                           00490804
CZ04  ZDATE  = 'DATE OF TEST'                                           00500804
CZ05  ZCOMPL = 'COMPILER IDENTIFICATION'                                00510804
CZ06  ZPROJ  = 'PROJECT NUMBER/IDENTIFICATION'                          00520804
CZ07  ZNAME  = 'NAME OF USER'                                           00530804
CZ08  ZTAPE  = 'TAPE OWNER/ID'                                          00540804
CZ09  ZTAPED = 'DATE TAPE COPIED'                                       00550804
C                                                                       00560804
      IVPASS = 0                                                        00570804
      IVFAIL = 0                                                        00580804
      IVDELE = 0                                                        00590804
      IVINSP = 0                                                        00600804
      IVTOTL = 0                                                        00610804
      IVTOTN = 0                                                        00620804
      ICZERO = 0                                                        00630804
C                                                                       00640804
C     I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER.         00650804
      I01 = 05                                                          00660804
C     I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER.             00670804
      I02 = 06                                                          00680804
C                                                                       00690804
CX010   REPLACED BY FEXEC X-010 CONTROL CARD (CARD-READER UNIT NUMBER). 00700804
C     THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5      00710804
CX011   REPLACED BY FEXEC X-011 CONTROL CARD.  CX011 IS FOR SYSTEMS     00720804
C     REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX010.  00730804
C                                                                       00740804
CX020   REPLACED BY FEXEC X-020 CONTROL CARD (PRINTER UNIT NUMBER).     00750804
C     THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02= 6       00760804
CX021   REPLACED BY FEXEC X-021 CONTROL CARD.  CX021 IS FOR SYSTEMS     00770804
C     REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX020.  00780804
C                                                                       00790804
CBE** ********************** BBCINITB **********************************00800804
      NUVI = I02                                                        00810804
      IVTOTL = 11                                                       00820804
      ZPROG = 'FM804'                                                   00830804
CBB** ********************** BBCHED0A **********************************00840804
C****                                                                   00850804
C**** WRITE REPORT TITLE                                                00860804
C****                                                                   00870804
      WRITE (I02, 90002)                                                00880804
      WRITE (I02, 90006)                                                00890804
      WRITE (I02, 90007)                                                00900804
      WRITE (I02, 90008)  ZVERS, ZVERSD                                 00910804
      WRITE (I02, 90009)  ZPROG, ZPROG                                  00920804
      WRITE (I02, 90010)  ZDATE, ZCOMPL                                 00930804
CBE** ********************** BBCHED0A **********************************00940804
C*****                                                                  00950804
C*****    HEADER FOR SEGMENT 160                                        00960804
        WRITE (NUVI, 16001)                                             00970804
16001   FORMAT( " ", //" YDMOD - (160) INTRINSIC FUNCTION--" //         00980804
     1          16X,"DMOD (REMAINDERING)"  //                           00990804
     2          "  ANS REF. - 15.3  " )                                 01000804
CBB** ********************** BBCHED0B **********************************01010804
C**** WRITE DETAIL REPORT HEADERS                                       01020804
C****                                                                   01030804
      WRITE (I02,90004)                                                 01040804
      WRITE (I02,90004)                                                 01050804
      WRITE (I02,90013)                                                 01060804
      WRITE (I02,90014)                                                 01070804
      WRITE (I02,90015) IVTOTL                                          01080804
CBE** ********************** BBCHED0B **********************************01090804
C*****                                                                  01100804
CT001*  TEST 1                        FIRST VALUE ZERO, SECOND NON-ZERO 01110804
           IVTNUM = 1                                                   01120804
        DQBVD = 0.0D0                                                   01130804
        DQDVD = 4.5D0                                                   01140804
        DQAVD = DMOD(DQBVD, DQDVD)                                      01150804
           IF (DQAVD + 5.0D-10) 20010, 10010, 40010                     01160804
40010      IF (DQAVD - 5.0D-10) 10010, 10010, 20010                     01170804
10010      IVPASS = IVPASS + 1                                          01180804
           WRITE (NUVI, 80002) IVTNUM                                   01190804
           GO TO 0011                                                   01200804
20010      IVFAIL = IVFAIL + 1                                          01210804
           DVCORR = 0.0D0                                               01220804
           WRITE (NUVI, 80031) IVTNUM, DQAVD, DVCORR                    01230804
 0011      CONTINUE                                                     01240804
CT002*  TEST 2                                        BOTH VALUES EQUAL 01250804
           IVTNUM = 2                                                   01260804
        DQBVD = 0.35D1                                                  01270804
        DQDVD = 0.35D1                                                  01280804
        DQAVD = DMOD(DQBVD, DQDVD)                                      01290804
           IF (DQAVD + 5.0D-10) 20020, 10020, 40020                     01300804
40020      IF (DQAVD - 5.0D-10) 10020, 10020, 20020                     01310804
10020      IVPASS = IVPASS + 1                                          01320804
           WRITE (NUVI, 80002) IVTNUM                                   01330804
           GO TO 0021                                                   01340804
20020      IVFAIL = IVFAIL + 1                                          01350804
           DVCORR = 0.0D0                                               01360804
           WRITE (NUVI, 80031) IVTNUM, DQAVD, DVCORR                    01370804
 0021      CONTINUE                                                     01380804
CT003*  TEST 3           FIRST MAGNITUDE LARGER, NOT MULTIPLE OF SECOND 01390804
           IVTNUM = 3                                                   01400804
        DQBVD = -0.10D2                                                 01410804
        DQDVD = -0.3D1                                                  01420804
        DQAVD = DMOD(DQBVD, DQDVD)                                      01430804
           IF (DQAVD + 1.000000001D0) 20030, 10030, 40030               01440804
40030      IF (DQAVD + 0.9999999995D0) 10030, 10030, 20030              01450804
10030      IVPASS = IVPASS + 1                                          01460804
           WRITE (NUVI, 80002) IVTNUM                                   01470804
           GO TO 0031                                                   01480804
20030      IVFAIL = IVFAIL + 1                                          01490804
           DVCORR = -1.0D0                                              01500804
           WRITE (NUVI, 80031) IVTNUM, DQAVD, DVCORR                    01510804
 0031      CONTINUE                                                     01520804
CT004*  TEST 4               FIRST MAGNITUDE LARGER, MULTIPLE OF SECOND 01530804
           IVTNUM = 4                                                   01540804
        DQDVD = 1.5D0                                                   01550804
        DQBVD = 1.5D0 + DQDVD + 1.5D0                                   01560804
        DQAVD = DMOD(DQBVD, DQDVD)                                      01570804
           IF (DQAVD + 5.0D-10) 20040, 10040, 40040                     01580804
40040      IF (DQAVD - 5.0D-10) 10040, 10040, 20040                     01590804
10040      IVPASS = IVPASS + 1                                          01600804
           WRITE (NUVI, 80002) IVTNUM                                   01610804
           GO TO 0041                                                   01620804
20040      IVFAIL = IVFAIL + 1                                          01630804
           DVCORR = 0.0D0                                               01640804
           WRITE (NUVI, 80031) IVTNUM, DQAVD, DVCORR                    01650804
 0041      CONTINUE                                                     01660804
CT005*  TEST 5           FIRST MAGNITUDE LARGER, NOT MULTIPLE OF SECOND 01670804
           IVTNUM = 5                                                   01680804
        DQBVD = 7.625D0                                                 01690804
        DQDVD = 2.125D0                                                 01700804
        DQAVD = DMOD(DQBVD, DQDVD)                                      01710804
           IF (DQAVD - 1.249999999D0) 20050, 10050, 40050               01720804
40050      IF (DQAVD - 1.250000001D0) 10050, 10050, 20050               01730804
10050      IVPASS = IVPASS + 1                                          01740804
           WRITE (NUVI, 80002) IVTNUM                                   01750804
           GO TO 0051                                                   01760804
20050      IVFAIL = IVFAIL + 1                                          01770804
           DVCORR = 1.25D0                                              01780804
           WRITE (NUVI, 80031) IVTNUM, DQAVD, DVCORR                    01790804
 0051      CONTINUE                                                     01800804
CT006*  TEST 6                        FIRST VALUE ZERO, SECOND NEGATIVE 01810804
           IVTNUM = 6                                                   01820804
        DQBVD = 0.0D0                                                   01830804
        DQDVD = -0.45D1                                                 01840804
        DQAVD = DMOD(DQBVD, DQDVD)                                      01850804
           IF (DQAVD + 5.0D-10) 20060, 10060, 40060                     01860804
40060      IF (DQAVD - 5.0D-10) 10060, 10060, 20060                     01870804
10060      IVPASS = IVPASS + 1                                          01880804
           WRITE (NUVI, 80002) IVTNUM                                   01890804
           GO TO 0061                                                   01900804
20060      IVFAIL = IVFAIL + 1                                          01910804
           DVCORR = 0.0D0                                               01920804
           WRITE (NUVI, 80031) IVTNUM, DQAVD, DVCORR                    01930804
 0061      CONTINUE                                                     01940804
CT007*  TEST 7                         BOTH VALUES EQUAL, BOTH NEGATIVE 01950804
           IVTNUM = 7                                                   01960804
        DQBVD = -3.5D1                                                  01970804
        DQDVD = -3.5D1                                                  01980804
        DQAVD = DMOD(DQBVD, DQDVD)                                      01990804
           IF (DQAVD + 5.0D-10) 20070, 10070, 40070                     02000804
40070      IF (DQAVD - 5.0D-10) 10070, 10070, 20070                     02010804
10070      IVPASS = IVPASS + 1                                          02020804
           WRITE (NUVI, 80002) IVTNUM                                   02030804
           GO TO 0071                                                   02040804
20070      IVFAIL = IVFAIL + 1                                          02050804
           DVCORR = 0.0D0                                               02060804
           WRITE (NUVI, 80031) IVTNUM, DQAVD, DVCORR                    02070804
 0071      CONTINUE                                                     02080804
CT008*  TEST 8          FIRST MAGNITUDE LARGER, MULIPLES, BOTH NEGATIVE 02090804
           IVTNUM = 8                                                   02100804
        DQDVD = 3.5D0                                                   02110804
        DQBVD = -(3.5D0 + DQDVD + 3.5D0)                                02120804
        DQAVD = DMOD(DQBVD, -DQDVD)                                     02130804
           IF (DQAVD + 5.0D-10) 20080, 10080, 40080                     02140804
40080      IF (DQAVD - 5.0D-10) 10080, 10080, 20080                     02150804
10080      IVPASS = IVPASS + 1                                          02160804
           WRITE (NUVI, 80002) IVTNUM                                   02170804
           GO TO 0081                                                   02180804
20080      IVFAIL = IVFAIL + 1                                          02190804
           DVCORR = 0.0D0                                               02200804
           WRITE (NUVI, 80031) IVTNUM, DQAVD, DVCORR                    02210804
 0081      CONTINUE                                                     02220804
CT009*  TEST 9          FIRST VALUE POSITIVE, SECOND NEGATIVE, MULTIPLE 02230804
           IVTNUM = 9                                                   02240804
        DQBVD = 10.5D0                                                  02250804
        DQDVD = -3.5D0                                                  02260804
        DQAVD = DMOD(DQBVD, DQDVD)                                      02270804
           IF (DQAVD + 5.0D-10) 20090, 10090, 40090                     02280804
40090      IF (DQAVD - 5.0D-10) 10090, 10090, 20090                     02290804
10090      IVPASS = IVPASS + 1                                          02300804
           WRITE (NUVI, 80002) IVTNUM                                   02310804
           GO TO 0091                                                   02320804
20090      IVFAIL = IVFAIL + 1                                          02330804
           DVCORR = 0.0D0                                               02340804
           WRITE (NUVI, 80031) IVTNUM, DQAVD, DVCORR                    02350804
 0091      CONTINUE                                                     02360804
CT010*  TEST 10                 FIRST VALUE ZERO PRECEDED BY MINUS SIGN 02370804
           IVTNUM = 10                                                  02380804
        DQDVD = 0.0D0                                                   02390804
        DQEVD = 4.5D0                                                   02400804
        DQAVD = DMOD(-DQDVD, DQEVD)                                     02410804
           IF (DQAVD + 5.0D-10) 20100, 10100, 40100                     02420804
40100      IF (DQAVD - 5.0D-10) 10100, 10100, 20100                     02430804
10100      IVPASS = IVPASS + 1                                          02440804
           WRITE (NUVI, 80002) IVTNUM                                   02450804
           GO TO 0101                                                   02460804
20100      IVFAIL = IVFAIL + 1                                          02470804
           DVCORR = 0.0D0                                               02480804
           WRITE (NUVI, 80031) IVTNUM, DQAVD, DVCORR                    02490804
 0101      CONTINUE                                                     02500804
CT011*  TEST 11         PAIR OF ARITHMETIC EXPRESSIONS USED AS ARGUMENT 02510804
           IVTNUM = 11                                                  02520804
        DQDVD = 0.7625D1                                                02530804
        DQEVD = 0.2125D1                                                02540804
        DQFVD = 0.2D1                                                   02550804
        DQAVD = DMOD(DQDVD - DQFVD, DQEVD + DQFVD)                      02560804
           IF (DQAVD - 0.1499999999D1) 20110, 10110, 40110              02570804
40110      IF (DQAVD - 0.1500000001D1) 10110, 10110, 20110              02580804
10110      IVPASS = IVPASS + 1                                          02590804
           WRITE (NUVI, 80002) IVTNUM                                   02600804
           GO TO 0111                                                   02610804
20110      IVFAIL = IVFAIL + 1                                          02620804
           DVCORR = 0.15D1                                              02630804
           WRITE (NUVI, 80031) IVTNUM, DQAVD, DVCORR                    02640804
 0111      CONTINUE                                                     02650804
C*****                                                                  02660804
CBB** ********************** BBCSUM0  **********************************02670804
C**** WRITE OUT TEST SUMMARY                                            02680804
C****                                                                   02690804
      IVTOTN = IVPASS + IVFAIL + IVDELE + IVINSP                        02700804
      WRITE (I02, 90004)                                                02710804
      WRITE (I02, 90014)                                                02720804
      WRITE (I02, 90004)                                                02730804
      WRITE (I02, 90020) IVPASS                                         02740804
      WRITE (I02, 90022) IVFAIL                                         02750804
      WRITE (I02, 90024) IVDELE                                         02760804
      WRITE (I02, 90026) IVINSP                                         02770804
      WRITE (I02, 90028) IVTOTN, IVTOTL                                 02780804
CBE** ********************** BBCSUM0  **********************************02790804
CBB** ********************** BBCFOOT0 **********************************02800804
C**** WRITE OUT REPORT FOOTINGS                                         02810804
C****                                                                   02820804
      WRITE (I02,90016) ZPROG, ZPROG                                    02830804
      WRITE (I02,90018) ZPROJ, ZNAME, ZTAPE, ZTAPED                     02840804
      WRITE (I02,90019)                                                 02850804
CBE** ********************** BBCFOOT0 **********************************02860804
CBB** ********************** BBCFMT0A **********************************02870804
C**** FORMATS FOR TEST DETAIL LINES                                     02880804
C****                                                                   02890804
80000 FORMAT (" ",2X,I3,4X,"DELETED",32X,A31)                           02900804
80002 FORMAT (" ",2X,I3,4X," PASS  ",32X,A31)                           02910804
80004 FORMAT (" ",2X,I3,4X,"INSPECT",32X,A31)                           02920804
80008 FORMAT (" ",2X,I3,4X," FAIL  ",32X,A31)                           02930804
80010 FORMAT (" ",2X,I3,4X," FAIL  ",/," ",15X,"COMPUTED= " ,           02940804
     1I6,/," ",15X,"CORRECT=  " ,I6)                                    02950804
80012 FORMAT (" ",2X,I3,4X," FAIL  ",/," ",16X,"COMPUTED= " ,           02960804
     1E12.5,/," ",16X,"CORRECT=  " ,E12.5)                              02970804
80018 FORMAT (" ",2X,I3,4X," FAIL  ",/," ",16X,"COMPUTED= " ,           02980804
     1A21,/," ",16X,"CORRECT=  " ,A21)                                  02990804
80020 FORMAT (" ",16X,"COMPUTED= " ,A21,1X,A31)                         03000804
80022 FORMAT (" ",16X,"CORRECT=  " ,A21,1X,A31)                         03010804
80024 FORMAT (" ",16X,"COMPUTED= " ,I6,16X,A31)                         03020804
80026 FORMAT (" ",16X,"CORRECT=  " ,I6,16X,A31)                         03030804
80028 FORMAT (" ",16X,"COMPUTED= " ,E12.5,10X,A31)                      03040804
80030 FORMAT (" ",16X,"CORRECT=  " ,E12.5,10X,A31)                      03050804
80050 FORMAT (" ",48X,A31)                                              03060804
CBE** ********************** BBCFMT0A **********************************03070804
CBB** ********************** BBCFMAT1 **********************************03080804
C**** FORMATS FOR TEST DETAIL LINES - FULL LANGUAGE                     03090804
C****                                                                   03100804
80031 FORMAT (" ",2X,I3,4X," FAIL  ",/," ",16X,"COMPUTED= " ,           03110804
     1D17.10,/," ",16X,"CORRECT=  " ,D17.10)                            03120804
80033 FORMAT (" ",16X,"COMPUTED= " ,D17.10,10X,A31)                     03130804
80035 FORMAT (" ",16X,"CORRECT=  " ,D17.10,10X,A31)                     03140804
80037 FORMAT (" ",16X,"COMPUTED= " ,"(",E12.5,", ",E12.5,")",6X,A31)    03150804
80039 FORMAT (" ",16X,"CORRECT=  " ,"(",E12.5,", ",E12.5,")",6X,A31)    03160804
80041 FORMAT (" ",16X,"COMPUTED= " ,"(",F12.5,", ",F12.5,")",6X,A31)    03170804
80043 FORMAT (" ",16X,"CORRECT=  " ,"(",F12.5,", ",F12.5,")",6X,A31)    03180804
80045 FORMAT (" ",2X,I3,4X," FAIL  ",/," ",16X,"COMPUTED= " ,           03190804
     1"(",F12.5,", ",F12.5,")"/," ",16X,"CORRECT=  " ,                  03200804
     2"(",F12.5,", ",F12.5,")")                                         03210804
CBE** ********************** BBCFMAT1 **********************************03220804
CBB** ********************** BBCFMT0B **********************************03230804
C**** FORMAT STATEMENTS FOR PAGE HEADERS                                03240804
C****                                                                   03250804
90002 FORMAT ("1")                                                      03260804
90004 FORMAT (" ")                                                      03270804
90006 FORMAT (" ",20X,"NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY" )03280804
90007 FORMAT (" ",19X,"FORTRAN COMPILER VALIDATION SYSTEM" )            03290804
90008 FORMAT (" ",21X,A13,A17)                                          03300804
90009 FORMAT (" ",/," *",A5,"BEGIN*",12X,"TEST RESULTS - " ,A5,/)       03310804
90010 FORMAT (" ",8X,"TEST DATE*TIME= " ,A17,"  -  COMPILER= " ,A20)    03320804
90013 FORMAT (" "," TEST   ","PASS/FAIL " ,6X,"DISPLAYED RESULTS" ,     03330804
     1       7X,"REMARKS",24X)                                          03340804
90014 FORMAT (" ","----------------------------------------------" ,    03350804
     1        "---------------------------------" )                     03360804
90015 FORMAT (" ",48X,"THIS PROGRAM HAS " ,I3," TESTS",/)               03370804
C****                                                                   03380804
C**** FORMAT STATEMENTS FOR REPORT FOOTINGS                             03390804
C****                                                                   03400804
90016 FORMAT (" ",/," *",A5,"END*",14X,"END OF TEST - " ,A5,/)          03410804
90018 FORMAT (" ",A13,13X,A20,"   *   ",A10,"/",                        03420804
     1        A13)                                                      03430804
90019 FORMAT (" ","FOR OFFICIAL USE ONLY     " ,35X,"COPYRIGHT  1982" ) 03440804
C****                                                                   03450804
C**** FORMAT STATEMENTS FOR RUN SUMMARY                                 03460804
C****                                                                   03470804
90020 FORMAT (" ",21X,I5," TESTS PASSED" )                              03480804
90022 FORMAT (" ",21X,I5," TESTS FAILED" )                              03490804
90024 FORMAT (" ",21X,I5," TESTS DELETED" )                             03500804
90026 FORMAT (" ",21X,I5," TESTS REQUIRE INSPECTION" )                  03510804
90028 FORMAT (" ",21X,I5," OF ",I3," TESTS EXECUTED" )                  03520804
CBE** ********************** BBCFMT0B **********************************03530804
C*****                                                                  03540804
C*****    END OF TEST SEGMENT 160                                       03550804
        STOP                                                            03560804
        END                                                             03570804
                                                                        03580804