blob: e80ce0a352722c077702c0a50ae08f792b6cc3fb [file] [log] [blame]
PROGRAM FM807
C***********************************************************************00010807
C***** FORTRAN 77 00020807
C***** FM807 YDMIN1 - (168) 00030807
C***** 00040807
C***********************************************************************00050807
C***** GENERAL PURPOSE ANS REF 00060807
C***** TEST OF INTRINSIC FUNCTION -- 15.3 00070807
C***** DMIN1 -- CHOOSING SMALLEST VALUE (TABLE 5)00080807
C***** 00090807
CBB** ********************** BBCCOMNT **********************************00100807
C**** 00110807
C**** 1978 FORTRAN COMPILER VALIDATION SYSTEM 00120807
C**** VERSION 2.1 00130807
C**** 00140807
C**** 00150807
C**** SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO 00160807
C**** NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY 00170807
C**** SOFTWARE STANDARDS VALIDATION GROUP 00180807
C**** BUILDING 225 RM A266 00190807
C**** GAITHERSBURG, MD 20899 00200807
C**** 00210807
C**** 00220807
C**** 00230807
CBE** ********************** BBCCOMNT **********************************00240807
C***** S P E C I F I C A T I O N S SEGMENT 168 00250807
DOUBLE PRECISION DUAVD, DUBVD, DUCVD, DUDVD, DUEVD, DVCORR 00260807
CBB** ********************** BBCINITA **********************************00270807
C**** SPECIFICATION STATEMENTS 00280807
C**** 00290807
CHARACTER ZVERS*13, ZVERSD*17, ZDATE*17, ZPROG*5, ZCOMPL*20, 00300807
1 ZNAME*20, ZTAPE*10, ZPROJ*13, REMRKS*31, ZTAPED*13 00310807
CBE** ********************** BBCINITA **********************************00320807
CBB** ********************** BBCINITB **********************************00330807
C**** INITIALIZE SECTION 00340807
DATA ZVERS, ZVERSD, ZDATE 00350807
1 /'VERSION 2.1 ', '93/10/21*21.02.00', '*NO DATE*TIME'/ 00360807
DATA ZCOMPL, ZNAME, ZTAPE 00370807
1 /'*NONE SPECIFIED*', '*NO COMPANY NAME*', '*NO TAPE*'/ 00380807
DATA ZPROJ, ZTAPED, ZPROG 00390807
1 /'*NO PROJECT*', '*NO TAPE DATE', 'XXXXX'/ 00400807
DATA REMRKS /' '/ 00410807
C**** THE FOLLOWING 9 COMMENT LINES (CZ01, CZ02, ...) CAN BE REPLACED 00420807
C**** FOR IDENTIFYING THE TEST ENVIRONMENT 00430807
C**** 00440807
CZ01 ZVERS = 'VERSION OF THE COMPILER VALIDATION SYSTEM' 00450807
CZ02 ZVERSD = 'CREATION DATE/TIME OF THE COMPILER VALIDATION SYSTEM' 00460807
CZ03 ZPROG = 'PROGRAM NAME' 00470807
CZ04 ZDATE = 'DATE OF TEST' 00480807
CZ05 ZCOMPL = 'COMPILER IDENTIFICATION' 00490807
CZ06 ZPROJ = 'PROJECT NUMBER/IDENTIFICATION' 00500807
CZ07 ZNAME = 'NAME OF USER' 00510807
CZ08 ZTAPE = 'TAPE OWNER/ID' 00520807
CZ09 ZTAPED = 'DATE TAPE COPIED' 00530807
C 00540807
IVPASS = 0 00550807
IVFAIL = 0 00560807
IVDELE = 0 00570807
IVINSP = 0 00580807
IVTOTL = 0 00590807
IVTOTN = 0 00600807
ICZERO = 0 00610807
C 00620807
C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER. 00630807
I01 = 05 00640807
C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER. 00650807
I02 = 06 00660807
C 00670807
CX010 REPLACED BY FEXEC X-010 CONTROL CARD (CARD-READER UNIT NUMBER). 00680807
C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 00690807
CX011 REPLACED BY FEXEC X-011 CONTROL CARD. CX011 IS FOR SYSTEMS 00700807
C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX010. 00710807
C 00720807
CX020 REPLACED BY FEXEC X-020 CONTROL CARD (PRINTER UNIT NUMBER). 00730807
C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02= 6 00740807
CX021 REPLACED BY FEXEC X-021 CONTROL CARD. CX021 IS FOR SYSTEMS 00750807
C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX020. 00760807
C 00770807
CBE** ********************** BBCINITB **********************************00780807
NUVI = I02 00790807
IVTOTL = 12 00800807
ZPROG = 'FM807' 00810807
CBB** ********************** BBCHED0A **********************************00820807
C**** 00830807
C**** WRITE REPORT TITLE 00840807
C**** 00850807
WRITE (I02, 90002) 00860807
WRITE (I02, 90006) 00870807
WRITE (I02, 90007) 00880807
WRITE (I02, 90008) ZVERS, ZVERSD 00890807
WRITE (I02, 90009) ZPROG, ZPROG 00900807
WRITE (I02, 90010) ZDATE, ZCOMPL 00910807
CBE** ********************** BBCHED0A **********************************00920807
C***** 00930807
C***** 00940807
WRITE (NUVI,16801) 00950807
16801 FORMAT (" ", // 1X,"YDMIN1 - (168) INTRINSIC FUNCTION-- " //17X,00960807
1 "DMIN1 (CHOOSING SMALLEST VALUE) " //2X, 00970807
2 "ANS REF. - 15.3" ) 00980807
CBB** ********************** BBCHED0B **********************************00990807
C**** WRITE DETAIL REPORT HEADERS 01000807
C**** 01010807
WRITE (I02,90004) 01020807
WRITE (I02,90004) 01030807
WRITE (I02,90013) 01040807
WRITE (I02,90014) 01050807
WRITE (I02,90015) IVTOTL 01060807
CBE** ********************** BBCHED0B **********************************01070807
C***** 01080807
CT001* TEST 1 BOTH VALUES EQUAL 01090807
IVTNUM = 1 01100807
DUBVD = 0.0D0 01110807
DUDVD = 0.0D0 01120807
DUAVD = DMIN1(DUBVD, DUDVD) 01130807
IF (DUAVD + 5.0D-10) 20010, 10010, 40010 01140807
40010 IF (DUAVD - 5.0D-10) 10010, 10010, 20010 01150807
10010 IVPASS = IVPASS + 1 01160807
WRITE (NUVI, 80002) IVTNUM 01170807
GO TO 0011 01180807
20010 IVFAIL = IVFAIL + 1 01190807
DVCORR = 0.0D0 01200807
WRITE (NUVI, 80031) IVTNUM, DUAVD, DVCORR 01210807
0011 CONTINUE 01220807
CT002* TEST 2 FIRST VALUE NON-ZERO, SECOND ZERO 01230807
IVTNUM = 2 01240807
DUBVD = 5.625D0 01250807
DUDVD = 0.0D0 01260807
DUAVD = DMIN1(DUBVD, DUDVD) 01270807
IF (DUAVD + 5.0D-10) 20020, 10020, 40020 01280807
40020 IF (DUAVD - 5.0D-10) 10020, 10020, 20020 01290807
10020 IVPASS = IVPASS + 1 01300807
WRITE (NUVI, 80002) IVTNUM 01310807
GO TO 0021 01320807
20020 IVFAIL = IVFAIL + 1 01330807
DVCORR = 0.0D0 01340807
WRITE (NUVI, 80031) IVTNUM, DUAVD, DVCORR 01350807
0021 CONTINUE 01360807
CT003* TEST 3 BOTH VALUES EQUAL 01370807
IVTNUM = 3 01380807
DUBVD = 6.5D0 01390807
DUDVD = 6.5D0 01400807
DUAVD = DMIN1(DUBVD, DUDVD) 01410807
IF (DUAVD - 6.499999996D0) 20030, 10030, 40030 01420807
40030 IF (DUAVD - 6.500000004D0) 10030, 10030, 20030 01430807
10030 IVPASS = IVPASS + 1 01440807
WRITE (NUVI, 80002) IVTNUM 01450807
GO TO 0031 01460807
20030 IVFAIL = IVFAIL + 1 01470807
DVCORR = 6.5D0 01480807
WRITE (NUVI, 80031) IVTNUM, DUAVD, DVCORR 01490807
0031 CONTINUE 01500807
CT004* TEST 4 VALUES NOT EQUAL 01510807
IVTNUM = 4 01520807
DUBVD = 7.125D0 01530807
DUDVD = 5.125D0 01540807
DUAVD = DMIN1(DUBVD, DUDVD) 01550807
IF (DUAVD - 5.124999997D0) 20040, 10040, 40040 01560807
40040 IF (DUAVD - 5.125000003D0) 10040, 10040, 20040 01570807
10040 IVPASS = IVPASS + 1 01580807
WRITE (NUVI, 80002) IVTNUM 01590807
GO TO 0041 01600807
20040 IVFAIL = IVFAIL + 1 01610807
DVCORR = 5.125D0 01620807
WRITE (NUVI, 80031) IVTNUM, DUAVD, DVCORR 01630807
0041 CONTINUE 01640807
CT005* TEST 5 FIRST VALUE NEGATIVE, SECOND ZERO 01650807
IVTNUM = 5 01660807
DUBVD = -5.625D0 01670807
DUDVD = 0.0D0 01680807
DUAVD = DMIN1(DUBVD, DUDVD) 01690807
IF (DUAVD + 5.625000003D0) 20050, 10050, 40050 01700807
40050 IF (DUAVD + 5.624999997D0) 10050, 10050, 20050 01710807
10050 IVPASS = IVPASS + 1 01720807
WRITE (NUVI, 80002) IVTNUM 01730807
GO TO 0051 01740807
20050 IVFAIL = IVFAIL + 1 01750807
DVCORR = -5.625D0 01760807
WRITE (NUVI, 80031) IVTNUM, DUAVD, DVCORR 01770807
0051 CONTINUE 01780807
CT006* TEST 6 BOTH VALUES EQUAL, BOTH NEGATIVE 01790807
IVTNUM = 6 01800807
DUBVD = -6.5D0 01810807
DUDVD = -6.5D0 01820807
DUAVD = DMIN1(DUBVD, DUDVD) 01830807
IF (DUAVD + 6.500000004D0) 20060, 10060, 40060 01840807
40060 IF (DUAVD + 6.499999996D0) 10060, 10060, 20060 01850807
10060 IVPASS = IVPASS + 1 01860807
WRITE (NUVI, 80002) IVTNUM 01870807
GO TO 0061 01880807
20060 IVFAIL = IVFAIL + 1 01890807
DVCORR = -6.5D0 01900807
WRITE (NUVI, 80031) IVTNUM, DUAVD, DVCORR 01910807
0061 CONTINUE 01920807
CT007* TEST 7 VALUES NOT EQUAL, BOTH NEGATIVE 01930807
IVTNUM = 7 01940807
DUBVD = -7.125D0 01950807
DUDVD = -5.125D0 01960807
DUAVD = DMIN1(DUBVD, DUDVD) 01970807
IF (DUAVD + 7.125000004D0) 20070, 10070, 40070 01980807
40070 IF (DUAVD + 7.124999996D0) 10070, 10070, 20070 01990807
10070 IVPASS = IVPASS + 1 02000807
WRITE (NUVI, 80002) IVTNUM 02010807
GO TO 0071 02020807
20070 IVFAIL = IVFAIL + 1 02030807
DVCORR = -7.125D0 02040807
WRITE (NUVI, 80031) IVTNUM, DUAVD, DVCORR 02050807
0071 CONTINUE 02060807
CT008* TEST 8 1ST VALUE NON-ZERO, 2ND ZERO PRECEDED BY MINUS SIGN 02070807
IVTNUM = 8 02080807
DUDVD = 5.625D0 02090807
DUEVD = 0.0D0 02100807
DUAVD = DMIN1(DUDVD, -DUEVD) 02110807
IF (DUAVD + 5.0D-10) 20080, 10080, 40080 02120807
40080 IF (DUAVD - 5.0D-10) 10080, 10080, 20080 02130807
10080 IVPASS = IVPASS + 1 02140807
WRITE (NUVI, 80002) IVTNUM 02150807
GO TO 0081 02160807
20080 IVFAIL = IVFAIL + 1 02170807
DVCORR = 0.0D0 02180807
WRITE (NUVI, 80031) IVTNUM, DUAVD, DVCORR 02190807
0081 CONTINUE 02200807
CT009* TEST 9 ARITHMETIC EXPRESSIONS PRESENTED TO FUNCTION 02210807
IVTNUM = 9 02220807
DUDVD = 3.5D0 02230807
DUEVD = 4.0D0 02240807
DUAVD = DMIN1(DUDVD + DUEVD, -DUEVD - DUDVD) 02250807
IF (DUAVD + 7.500000004D0) 20090, 10090, 40090 02260807
40090 IF (DUAVD + 7.499999996D0) 10090, 10090, 20090 02270807
10090 IVPASS = IVPASS + 1 02280807
WRITE (NUVI, 80002) IVTNUM 02290807
GO TO 0091 02300807
20090 IVFAIL = IVFAIL + 1 02310807
DVCORR = -7.5D0 02320807
WRITE (NUVI, 80031) IVTNUM, DUAVD, DVCORR 02330807
0091 CONTINUE 02340807
CT010* TEST 10 3 ARGUMENTS 02350807
IVTNUM = 10 02360807
DUBVD = 0.0D0 02370807
DUCVD = 1.0D0 02380807
DUDVD = 2.0D0 02390807
DUAVD = DMIN1(DUBVD, DUCVD, DUDVD) 02400807
IF (DUAVD + 5.0D-10) 20100, 10100, 40100 02410807
40100 IF (DUAVD - 5.0D-10) 10100, 10100, 20100 02420807
10100 IVPASS = IVPASS + 1 02430807
WRITE (NUVI, 80002) IVTNUM 02440807
GO TO 0101 02450807
20100 IVFAIL = IVFAIL + 1 02460807
DVCORR = 0.0D0 02470807
WRITE (NUVI, 80031) IVTNUM, DUAVD, DVCORR 02480807
0101 CONTINUE 02490807
CT011* TEST 11 4 ARGUMENTS 02500807
IVTNUM = 11 02510807
C***** ARGUMENTS OF HIGH AND LOW MAGNITUDES 02520807
DUAVD = 1.0D+14 02530807
DUBVD = -1.0D+14 02540807
DUCVD = 1.0D-14 02550807
DUAVD = DMIN1(DUAVD, DUBVD, DUCVD, -DUCVD) 02560807
IF (DUAVD + 1.000000001D14) 20110, 10110, 40110 02570807
40110 IF (DUAVD + 0.9999999995D14) 10110, 10110, 20110 02580807
10110 IVPASS = IVPASS + 1 02590807
WRITE (NUVI, 80002) IVTNUM 02600807
GO TO 0111 02610807
20110 IVFAIL = IVFAIL + 1 02620807
DVCORR = -1.0D14 02630807
WRITE (NUVI, 80031) IVTNUM, DUAVD, DVCORR 02640807
0111 CONTINUE 02650807
CT012* TEST 12 5 ARGUMENTS 02660807
IVTNUM = 12 02670807
DUDVD = 3.5D0 02680807
DUEVD = 4.5D0 02690807
DUAVD = DMIN1(DUDVD, -DUDVD, -DUEVD, +DUDVD, DUEVD) 02700807
IF (DUAVD + 4.500000003D0) 20120, 10120, 40120 02710807
40120 IF (DUAVD + 4.499999997D0) 10120, 10120, 20120 02720807
10120 IVPASS = IVPASS + 1 02730807
WRITE (NUVI, 80002) IVTNUM 02740807
GO TO 0121 02750807
20120 IVFAIL = IVFAIL + 1 02760807
DVCORR = -4.5D0 02770807
WRITE (NUVI, 80031) IVTNUM, DUAVD, DVCORR 02780807
0121 CONTINUE 02790807
C***** 02800807
CBB** ********************** BBCSUM0 **********************************02810807
C**** WRITE OUT TEST SUMMARY 02820807
C**** 02830807
IVTOTN = IVPASS + IVFAIL + IVDELE + IVINSP 02840807
WRITE (I02, 90004) 02850807
WRITE (I02, 90014) 02860807
WRITE (I02, 90004) 02870807
WRITE (I02, 90020) IVPASS 02880807
WRITE (I02, 90022) IVFAIL 02890807
WRITE (I02, 90024) IVDELE 02900807
WRITE (I02, 90026) IVINSP 02910807
WRITE (I02, 90028) IVTOTN, IVTOTL 02920807
CBE** ********************** BBCSUM0 **********************************02930807
CBB** ********************** BBCFOOT0 **********************************02940807
C**** WRITE OUT REPORT FOOTINGS 02950807
C**** 02960807
WRITE (I02,90016) ZPROG, ZPROG 02970807
WRITE (I02,90018) ZPROJ, ZNAME, ZTAPE, ZTAPED 02980807
WRITE (I02,90019) 02990807
CBE** ********************** BBCFOOT0 **********************************03000807
CBB** ********************** BBCFMT0A **********************************03010807
C**** FORMATS FOR TEST DETAIL LINES 03020807
C**** 03030807
80000 FORMAT (" ",2X,I3,4X,"DELETED",32X,A31) 03040807
80002 FORMAT (" ",2X,I3,4X," PASS ",32X,A31) 03050807
80004 FORMAT (" ",2X,I3,4X,"INSPECT",32X,A31) 03060807
80008 FORMAT (" ",2X,I3,4X," FAIL ",32X,A31) 03070807
80010 FORMAT (" ",2X,I3,4X," FAIL ",/," ",15X,"COMPUTED= " , 03080807
1I6,/," ",15X,"CORRECT= " ,I6) 03090807
80012 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 03100807
1E12.5,/," ",16X,"CORRECT= " ,E12.5) 03110807
80018 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 03120807
1A21,/," ",16X,"CORRECT= " ,A21) 03130807
80020 FORMAT (" ",16X,"COMPUTED= " ,A21,1X,A31) 03140807
80022 FORMAT (" ",16X,"CORRECT= " ,A21,1X,A31) 03150807
80024 FORMAT (" ",16X,"COMPUTED= " ,I6,16X,A31) 03160807
80026 FORMAT (" ",16X,"CORRECT= " ,I6,16X,A31) 03170807
80028 FORMAT (" ",16X,"COMPUTED= " ,E12.5,10X,A31) 03180807
80030 FORMAT (" ",16X,"CORRECT= " ,E12.5,10X,A31) 03190807
80050 FORMAT (" ",48X,A31) 03200807
CBE** ********************** BBCFMT0A **********************************03210807
CBB** ********************** BBCFMAT1 **********************************03220807
C**** FORMATS FOR TEST DETAIL LINES - FULL LANGUAGE 03230807
C**** 03240807
80031 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 03250807
1D17.10,/," ",16X,"CORRECT= " ,D17.10) 03260807
80033 FORMAT (" ",16X,"COMPUTED= " ,D17.10,10X,A31) 03270807
80035 FORMAT (" ",16X,"CORRECT= " ,D17.10,10X,A31) 03280807
80037 FORMAT (" ",16X,"COMPUTED= " ,"(",E12.5,", ",E12.5,")",6X,A31) 03290807
80039 FORMAT (" ",16X,"CORRECT= " ,"(",E12.5,", ",E12.5,")",6X,A31) 03300807
80041 FORMAT (" ",16X,"COMPUTED= " ,"(",F12.5,", ",F12.5,")",6X,A31) 03310807
80043 FORMAT (" ",16X,"CORRECT= " ,"(",F12.5,", ",F12.5,")",6X,A31) 03320807
80045 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 03330807
1"(",F12.5,", ",F12.5,")"/," ",16X,"CORRECT= " , 03340807
2"(",F12.5,", ",F12.5,")") 03350807
CBE** ********************** BBCFMAT1 **********************************03360807
CBB** ********************** BBCFMT0B **********************************03370807
C**** FORMAT STATEMENTS FOR PAGE HEADERS 03380807
C**** 03390807
90002 FORMAT ("1") 03400807
90004 FORMAT (" ") 03410807
90006 FORMAT (" ",20X,"NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY" )03420807
90007 FORMAT (" ",19X,"FORTRAN COMPILER VALIDATION SYSTEM" ) 03430807
90008 FORMAT (" ",21X,A13,A17) 03440807
90009 FORMAT (" ",/," *",A5,"BEGIN*",12X,"TEST RESULTS - " ,A5,/) 03450807
90010 FORMAT (" ",8X,"TEST DATE*TIME= " ,A17," - COMPILER= " ,A20) 03460807
90013 FORMAT (" "," TEST ","PASS/FAIL " ,6X,"DISPLAYED RESULTS" , 03470807
1 7X,"REMARKS",24X) 03480807
90014 FORMAT (" ","----------------------------------------------" , 03490807
1 "---------------------------------" ) 03500807
90015 FORMAT (" ",48X,"THIS PROGRAM HAS " ,I3," TESTS",/) 03510807
C**** 03520807
C**** FORMAT STATEMENTS FOR REPORT FOOTINGS 03530807
C**** 03540807
90016 FORMAT (" ",/," *",A5,"END*",14X,"END OF TEST - " ,A5,/) 03550807
90018 FORMAT (" ",A13,13X,A20," * ",A10,"/", 03560807
1 A13) 03570807
90019 FORMAT (" ","FOR OFFICIAL USE ONLY " ,35X,"COPYRIGHT 1982" ) 03580807
C**** 03590807
C**** FORMAT STATEMENTS FOR RUN SUMMARY 03600807
C**** 03610807
90020 FORMAT (" ",21X,I5," TESTS PASSED" ) 03620807
90022 FORMAT (" ",21X,I5," TESTS FAILED" ) 03630807
90024 FORMAT (" ",21X,I5," TESTS DELETED" ) 03640807
90026 FORMAT (" ",21X,I5," TESTS REQUIRE INSPECTION" ) 03650807
90028 FORMAT (" ",21X,I5," OF ",I3," TESTS EXECUTED" ) 03660807
CBE** ********************** BBCFMT0B **********************************03670807
C***** END OF TEST SEGMENT 168 03680807
STOP 03690807
END 03700807
03710807