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