PROGRAM FM800 C***********************************************************************00010800 C***** FORTRAN 77 00020800 C***** FM800 YIDINT - (151) 00030800 C***** 00040800 C***********************************************************************00050800 C***** GENERAL PURPOSE ANS REF 00060800 C***** TEST INTRINSIC FUNCTION IDINT -- 15.3 00070800 C***** TRUNCATION (SIGN OF A * LARGEST INTEGER LE ABS(A) ) (TABLE 5)00080800 C***** 00090800 CBB** ********************** BBCCOMNT **********************************00100800 C**** 00110800 C**** 1978 FORTRAN COMPILER VALIDATION SYSTEM 00120800 C**** VERSION 2.1 00130800 C**** 00140800 C**** 00150800 C**** SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO 00160800 C**** NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY 00170800 C**** SOFTWARE STANDARDS VALIDATION GROUP 00180800 C**** BUILDING 225 RM A266 00190800 C**** GAITHERSBURG, MD 20899 00200800 C**** 00210800 C**** 00220800 C**** 00230800 CBE** ********************** BBCCOMNT **********************************00240800 C***** S P E C I F I C A T I O N S SEGMENT 151 00250800 C***** 00260800 DOUBLE PRECISION DLAVD, DLBVD 00270800 C***** 00280800 CBB** ********************** BBCINITA **********************************00290800 C**** SPECIFICATION STATEMENTS 00300800 C**** 00310800 CHARACTER ZVERS*13, ZVERSD*17, ZDATE*17, ZPROG*5, ZCOMPL*20, 00320800 1 ZNAME*20, ZTAPE*10, ZPROJ*13, REMRKS*31, ZTAPED*13 00330800 CBE** ********************** BBCINITA **********************************00340800 CBB** ********************** BBCINITB **********************************00350800 C**** INITIALIZE SECTION 00360800 DATA ZVERS, ZVERSD, ZDATE 00370800 1 /'VERSION 2.1 ', '93/10/21*21.02.00', '*NO DATE*TIME'/ 00380800 DATA ZCOMPL, ZNAME, ZTAPE 00390800 1 /'*NONE SPECIFIED*', '*NO COMPANY NAME*', '*NO TAPE*'/ 00400800 DATA ZPROJ, ZTAPED, ZPROG 00410800 1 /'*NO PROJECT*', '*NO TAPE DATE', 'XXXXX'/ 00420800 DATA REMRKS /' '/ 00430800 C**** THE FOLLOWING 9 COMMENT LINES (CZ01, CZ02, ...) CAN BE REPLACED 00440800 C**** FOR IDENTIFYING THE TEST ENVIRONMENT 00450800 C**** 00460800 CZ01 ZVERS = 'VERSION OF THE COMPILER VALIDATION SYSTEM' 00470800 CZ02 ZVERSD = 'CREATION DATE/TIME OF THE COMPILER VALIDATION SYSTEM' 00480800 CZ03 ZPROG = 'PROGRAM NAME' 00490800 CZ04 ZDATE = 'DATE OF TEST' 00500800 CZ05 ZCOMPL = 'COMPILER IDENTIFICATION' 00510800 CZ06 ZPROJ = 'PROJECT NUMBER/IDENTIFICATION' 00520800 CZ07 ZNAME = 'NAME OF USER' 00530800 CZ08 ZTAPE = 'TAPE OWNER/ID' 00540800 CZ09 ZTAPED = 'DATE TAPE COPIED' 00550800 C 00560800 IVPASS = 0 00570800 IVFAIL = 0 00580800 IVDELE = 0 00590800 IVINSP = 0 00600800 IVTOTL = 0 00610800 IVTOTN = 0 00620800 ICZERO = 0 00630800 C 00640800 C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER. 00650800 I01 = 05 00660800 C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER. 00670800 I02 = 06 00680800 C 00690800 CX010 REPLACED BY FEXEC X-010 CONTROL CARD (CARD-READER UNIT NUMBER). 00700800 C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 00710800 CX011 REPLACED BY FEXEC X-011 CONTROL CARD. CX011 IS FOR SYSTEMS 00720800 C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX010. 00730800 C 00740800 CX020 REPLACED BY FEXEC X-020 CONTROL CARD (PRINTER UNIT NUMBER). 00750800 C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02= 6 00760800 CX021 REPLACED BY FEXEC X-021 CONTROL CARD. CX021 IS FOR SYSTEMS 00770800 C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX020. 00780800 C 00790800 CBE** ********************** BBCINITB **********************************00800800 NUVI = I02 00810800 IVTOTL = 12 00820800 ZPROG = 'FM800' 00830800 CBB** ********************** BBCHED0A **********************************00840800 C**** 00850800 C**** WRITE REPORT TITLE 00860800 C**** 00870800 WRITE (I02, 90002) 00880800 WRITE (I02, 90006) 00890800 WRITE (I02, 90007) 00900800 WRITE (I02, 90008) ZVERS, ZVERSD 00910800 WRITE (I02, 90009) ZPROG, ZPROG 00920800 WRITE (I02, 90010) ZDATE, ZCOMPL 00930800 CBE** ********************** BBCHED0A **********************************00940800 C***** 00950800 C***** HEADER FOR SEGMENT 151 WRITTEN 00960800 WRITE (NUVI,15101) 00970800 15101 FORMAT (" ", // 1X,"YIDINT - (151) INTRINSIC FUNCTION--" //17X, 00980800 1 "IDINT (TYPE CONVERSION)" //" ANS REF. - 15.3" ) 00990800 CBB** ********************** BBCHED0B **********************************01000800 C**** WRITE DETAIL REPORT HEADERS 01010800 C**** 01020800 WRITE (I02,90004) 01030800 WRITE (I02,90004) 01040800 WRITE (I02,90013) 01050800 WRITE (I02,90014) 01060800 WRITE (I02,90015) IVTOTL 01070800 CBE** ********************** BBCHED0B **********************************01080800 C***** 01090800 CT001* TEST 1 THE VALUE ZERO 01100800 IVTNUM = 1 01110800 DLBVD = 0.0D0 01120800 ILAVI = IDINT(DLBVD) 01130800 IF (ILAVI - 0) 20010, 10010, 20010 01140800 10010 IVPASS = IVPASS + 1 01150800 WRITE (NUVI, 80002) IVTNUM 01160800 GO TO 0011 01170800 20010 IVFAIL = IVFAIL + 1 01180800 IVCORR = 0 01190800 WRITE (NUVI, 80010) IVTNUM, ILAVI, IVCORR 01200800 0011 CONTINUE 01210800 CT002* TEST 2 A VALUE IN (0,1) 01220800 IVTNUM = 2 01230800 DLBVD = 3.57D-1 01240800 ILAVI = IDINT(DLBVD) 01250800 IF (ILAVI - 0) 20020, 10020, 20020 01260800 10020 IVPASS = IVPASS + 1 01270800 WRITE (NUVI, 80002) IVTNUM 01280800 GO TO 0021 01290800 20020 IVFAIL = IVFAIL + 1 01300800 IVCORR = 0 01310800 WRITE (NUVI, 80010) IVTNUM, ILAVI, IVCORR 01320800 0021 CONTINUE 01330800 CT003* TEST 3 THE VALUE ONE 01340800 IVTNUM = 3 01350800 DLBVD = 1.00001D0 01360800 ILAVI = IDINT(DLBVD) 01370800 IF (ILAVI - 1) 20030, 10030, 20030 01380800 10030 IVPASS = IVPASS + 1 01390800 WRITE (NUVI, 80002) IVTNUM 01400800 GO TO 0031 01410800 20030 IVFAIL = IVFAIL + 1 01420800 IVCORR = 1 01430800 WRITE (NUVI, 80010) IVTNUM, ILAVI, IVCORR 01440800 0031 CONTINUE 01450800 CT004* TEST 4 A INTEGRAL VALUE OTHER THAN O, 1 01460800 IVTNUM = 4 01470800 DLBVD = 6.00001D0 01480800 ILAVI = IDINT(DLBVD) 01490800 IF (ILAVI - 6) 20040, 10040, 20040 01500800 10040 IVPASS = IVPASS + 1 01510800 WRITE (NUVI, 80002) IVTNUM 01520800 GO TO 0041 01530800 20040 IVFAIL = IVFAIL + 1 01540800 IVCORR = 6 01550800 WRITE (NUVI, 80010) IVTNUM, ILAVI, IVCORR 01560800 0041 CONTINUE 01570800 CT005* TEST 5 A VALUE IN (X,X+1) 01580800 IVTNUM = 5 01590800 DLBVD = 0.375D1 01600800 ILAVI = IDINT(DLBVD) 01610800 IF (ILAVI - 3) 20050, 10050, 20050 01620800 10050 IVPASS = IVPASS + 1 01630800 WRITE (NUVI, 80002) IVTNUM 01640800 GO TO 0051 01650800 20050 IVFAIL = IVFAIL + 1 01660800 IVCORR = 3 01670800 WRITE (NUVI, 80010) IVTNUM, ILAVI, IVCORR 01680800 0051 CONTINUE 01690800 CT006* TEST 6 A NEGATIVE VALUE WITH MAGNITUDE IN (0,1) 01700800 IVTNUM = 6 01710800 DLBVD = -0.375D0 01720800 ILAVI = IDINT(DLBVD) 01730800 IF (ILAVI - 0) 20060, 10060, 20060 01740800 10060 IVPASS = IVPASS + 1 01750800 WRITE (NUVI, 80002) IVTNUM 01760800 GO TO 0061 01770800 20060 IVFAIL = IVFAIL + 1 01780800 IVCORR = 0 01790800 WRITE (NUVI, 80010) IVTNUM, ILAVI, IVCORR 01800800 0061 CONTINUE 01810800 CT007* TEST 7 THE VALUE -1 01820800 IVTNUM = 7 01830800 DLBVD = -0.100001D1 01840800 ILAVI = IDINT(DLBVD) 01850800 IF (ILAVI + 1) 20070, 10070, 20070 01860800 10070 IVPASS = IVPASS + 1 01870800 WRITE (NUVI, 80002) IVTNUM 01880800 GO TO 0071 01890800 20070 IVFAIL = IVFAIL + 1 01900800 IVCORR = -1 01910800 WRITE (NUVI, 80010) IVTNUM, ILAVI, IVCORR 01920800 0071 CONTINUE 01930800 CT008* TEST 8 A NEGATIVE INTEGRAL VALUE 01940800 IVTNUM = 8 01950800 DLBVD = -6.00001D0 01960800 ILAVI = IDINT(DLBVD) 01970800 IF (ILAVI + 6) 20080, 10080, 20080 01980800 10080 IVPASS = IVPASS + 1 01990800 WRITE (NUVI, 80002) IVTNUM 02000800 GO TO 0081 02010800 20080 IVFAIL = IVFAIL + 1 02020800 IVCORR = -6 02030800 WRITE (NUVI, 80010) IVTNUM, ILAVI, IVCORR 02040800 0081 CONTINUE 02050800 CT009* TEST 9 A NEGATIVE VALUE WITH MAGNITUDE IN (X,X+1) 02060800 IVTNUM = 9 02070800 DLBVD = -0.375D1 02080800 ILAVI = IDINT(DLBVD) 02090800 IF (ILAVI + 3) 20090, 10090, 20090 02100800 10090 IVPASS = IVPASS + 1 02110800 WRITE (NUVI, 80002) IVTNUM 02120800 GO TO 0091 02130800 20090 IVFAIL = IVFAIL + 1 02140800 IVCORR = -3 02150800 WRITE (NUVI, 80010) IVTNUM, ILAVI, IVCORR 02160800 0091 CONTINUE 02170800 CT010* TEST 10 ZERO PREFIXED WITH A MINUS SIGN 02180800 IVTNUM = 10 02190800 DLAVD = 0.0D0 02200800 ILAVI = IDINT(-DLAVD) 02210800 IF (ILAVI + 0) 20100, 10100, 20100 02220800 10100 IVPASS = IVPASS + 1 02230800 WRITE (NUVI, 80002) IVTNUM 02240800 GO TO 0101 02250800 20100 IVFAIL = IVFAIL + 1 02260800 IVCORR = 0 02270800 WRITE (NUVI, 80010) IVTNUM, ILAVI, IVCORR 02280800 0101 CONTINUE 02290800 CT011* TEST 11 AN ARITHMETIC EXPRESSION PRESENTED TO IDINT 02300800 IVTNUM = 11 02310800 DLAVD = 0.375D1 02320800 DLBVD = 3.5D0 02330800 ILAVI = (IDINT(DLAVD + DLBVD * 0.5D1)) 02340800 IF (ILAVI - 21) 20110, 10110, 20110 02350800 10110 IVPASS = IVPASS + 1 02360800 WRITE (NUVI, 80002) IVTNUM 02370800 GO TO 0111 02380800 20110 IVFAIL = IVFAIL + 1 02390800 IVCORR = 21 02400800 WRITE (NUVI, 80010) IVTNUM, ILAVI, IVCORR 02410800 0111 CONTINUE 02420800 CT012* TEST 12 COMPARE AUTOMATIC TYPE CONVERSION TO EXPLICIT 02430800 IVTNUM = 12 02440800 DLAVD = 3.5D0 02450800 ILAVI = IDINT(DLAVD ** 2.5) 02460800 ILBVI = DLAVD ** 2.5 02470800 IF (ILAVI - ILBVI) 20120, 10120, 20120 02480800 10120 IVPASS = IVPASS + 1 02490800 WRITE (NUVI, 80002) IVTNUM 02500800 GO TO 0121 02510800 20120 IVFAIL = IVFAIL + 1 02520800 IVCORR = ILBVI 02530800 WRITE (NUVI, 80010) IVTNUM, ILAVI, IVCORR 02540800 0121 CONTINUE 02550800 CBB** ********************** BBCSUM0 **********************************02560800 C**** WRITE OUT TEST SUMMARY 02570800 C**** 02580800 IVTOTN = IVPASS + IVFAIL + IVDELE + IVINSP 02590800 WRITE (I02, 90004) 02600800 WRITE (I02, 90014) 02610800 WRITE (I02, 90004) 02620800 WRITE (I02, 90020) IVPASS 02630800 WRITE (I02, 90022) IVFAIL 02640800 WRITE (I02, 90024) IVDELE 02650800 WRITE (I02, 90026) IVINSP 02660800 WRITE (I02, 90028) IVTOTN, IVTOTL 02670800 CBE** ********************** BBCSUM0 **********************************02680800 CBB** ********************** BBCFOOT0 **********************************02690800 C**** WRITE OUT REPORT FOOTINGS 02700800 C**** 02710800 WRITE (I02,90016) ZPROG, ZPROG 02720800 WRITE (I02,90018) ZPROJ, ZNAME, ZTAPE, ZTAPED 02730800 WRITE (I02,90019) 02740800 CBE** ********************** BBCFOOT0 **********************************02750800 CBB** ********************** BBCFMT0A **********************************02760800 C**** FORMATS FOR TEST DETAIL LINES 02770800 C**** 02780800 80000 FORMAT (" ",2X,I3,4X,"DELETED",32X,A31) 02790800 80002 FORMAT (" ",2X,I3,4X," PASS ",32X,A31) 02800800 80004 FORMAT (" ",2X,I3,4X,"INSPECT",32X,A31) 02810800 80008 FORMAT (" ",2X,I3,4X," FAIL ",32X,A31) 02820800 80010 FORMAT (" ",2X,I3,4X," FAIL ",/," ",15X,"COMPUTED= " , 02830800 1I6,/," ",15X,"CORRECT= " ,I6) 02840800 80012 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 02850800 1E12.5,/," ",16X,"CORRECT= " ,E12.5) 02860800 80018 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 02870800 1A21,/," ",16X,"CORRECT= " ,A21) 02880800 80020 FORMAT (" ",16X,"COMPUTED= " ,A21,1X,A31) 02890800 80022 FORMAT (" ",16X,"CORRECT= " ,A21,1X,A31) 02900800 80024 FORMAT (" ",16X,"COMPUTED= " ,I6,16X,A31) 02910800 80026 FORMAT (" ",16X,"CORRECT= " ,I6,16X,A31) 02920800 80028 FORMAT (" ",16X,"COMPUTED= " ,E12.5,10X,A31) 02930800 80030 FORMAT (" ",16X,"CORRECT= " ,E12.5,10X,A31) 02940800 80050 FORMAT (" ",48X,A31) 02950800 CBE** ********************** BBCFMT0A **********************************02960800 CBB** ********************** BBCFMAT1 **********************************02970800 C**** FORMATS FOR TEST DETAIL LINES - FULL LANGUAGE 02980800 C**** 02990800 80031 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 03000800 1D17.10,/," ",16X,"CORRECT= " ,D17.10) 03010800 80033 FORMAT (" ",16X,"COMPUTED= " ,D17.10,10X,A31) 03020800 80035 FORMAT (" ",16X,"CORRECT= " ,D17.10,10X,A31) 03030800 80037 FORMAT (" ",16X,"COMPUTED= " ,"(",E12.5,", ",E12.5,")",6X,A31) 03040800 80039 FORMAT (" ",16X,"CORRECT= " ,"(",E12.5,", ",E12.5,")",6X,A31) 03050800 80041 FORMAT (" ",16X,"COMPUTED= " ,"(",F12.5,", ",F12.5,")",6X,A31) 03060800 80043 FORMAT (" ",16X,"CORRECT= " ,"(",F12.5,", ",F12.5,")",6X,A31) 03070800 80045 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 03080800 1"(",F12.5,", ",F12.5,")"/," ",16X,"CORRECT= " , 03090800 2"(",F12.5,", ",F12.5,")") 03100800 CBE** ********************** BBCFMAT1 **********************************03110800 CBB** ********************** BBCFMT0B **********************************03120800 C**** FORMAT STATEMENTS FOR PAGE HEADERS 03130800 C**** 03140800 90002 FORMAT ("1") 03150800 90004 FORMAT (" ") 03160800 90006 FORMAT (" ",20X,"NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY" )03170800 90007 FORMAT (" ",19X,"FORTRAN COMPILER VALIDATION SYSTEM" ) 03180800 90008 FORMAT (" ",21X,A13,A17) 03190800 90009 FORMAT (" ",/," *",A5,"BEGIN*",12X,"TEST RESULTS - " ,A5,/) 03200800 90010 FORMAT (" ",8X,"TEST DATE*TIME= " ,A17," - COMPILER= " ,A20) 03210800 90013 FORMAT (" "," TEST ","PASS/FAIL " ,6X,"DISPLAYED RESULTS" , 03220800 1 7X,"REMARKS",24X) 03230800 90014 FORMAT (" ","----------------------------------------------" , 03240800 1 "---------------------------------" ) 03250800 90015 FORMAT (" ",48X,"THIS PROGRAM HAS " ,I3," TESTS",/) 03260800 C**** 03270800 C**** FORMAT STATEMENTS FOR REPORT FOOTINGS 03280800 C**** 03290800 90016 FORMAT (" ",/," *",A5,"END*",14X,"END OF TEST - " ,A5,/) 03300800 90018 FORMAT (" ",A13,13X,A20," * ",A10,"/", 03310800 1 A13) 03320800 90019 FORMAT (" ","FOR OFFICIAL USE ONLY " ,35X,"COPYRIGHT 1982" ) 03330800 C**** 03340800 C**** FORMAT STATEMENTS FOR RUN SUMMARY 03350800 C**** 03360800 90020 FORMAT (" ",21X,I5," TESTS PASSED" ) 03370800 90022 FORMAT (" ",21X,I5," TESTS FAILED" ) 03380800 90024 FORMAT (" ",21X,I5," TESTS DELETED" ) 03390800 90026 FORMAT (" ",21X,I5," TESTS REQUIRE INSPECTION" ) 03400800 90028 FORMAT (" ",21X,I5," OF ",I3," TESTS EXECUTED" ) 03410800 CBE** ********************** BBCFMT0B **********************************03420800 C***** 03430800 C***** END OF TEST SEGMENT 151 03440800 STOP 03450800 END 03460800 03470800