| 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 |
