PROGRAM FM098 C COMMENT SECTION 00010098 C 00020098 C FM098 00030098 C 00040098 C THIS ROUTINE TESTS INTRINSIC FUNCTIONS WHERE THE FUNCTION TYPE IS 00050098 C INTEGER AND THE ARGUMENTS ARE EITHER INTEGER OR REAL. THE REAL 00060098 C AND INTEGER VARIABLES AND THE REAL AND INTEGER CONSTANTS CONTAIN 00070098 C BOTH POSITIVE AND NEGATIVE VALUES. THE INTRINSIC FUNCTIONS TESTED00080098 C BY FM098 INCLUDE 00090098 C TYPE OF 00100098 C INTRINSIC FUNCTION NAME ARGUMENT FUNCTION 00110098 C ------------------ ---- -------- -------- 00120098 C ABSOLUTE VALUE IABS INTEGER INTEGER 00130098 C TRUNCATION INT REAL INTEGER 00140098 C REMAINDERING MOD INTEGER INTEGER 00150098 C CHOOSING LARGEST VALUE MAX0 INTEGER INTEGER 00160098 C MAX1 REAL INTEGER 00170098 C CHOOSING SMALLEST VALUE MIN0 INTEGER INTEGER 00180098 C MIN1 REAL INTEGER 00190098 C FIX IFIX REAL INTEGER 00200098 C TRANSFER OF SIGN ISIGN INTEGER INTEGER 00210098 C POSITIVE DIFFERENCE IDIM INTEGER INTEGER 00220098 C 00230098 C REFERENCES 00240098 C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN, 00250098 C X3.9-1978 00260098 C 00270098 C SECTION 4.1.2, TYPE RULES FOR DATA AND PROCEDURE IDENTIFIERS 00280098 C SECTION 15.3, INTRINSIC FUNCTION 00290098 C SECTION 15.3.2, INTRINSIC FUNCTIONS AND THEIR REFERENCE 00300098 C 00310098 C 00320098 C ********************************************************** 00330098 C 00340098 C A COMPILER VALIDATION SYSTEM FOR THE FORTRAN LANGUAGE 00350098 C BASED ON SPECIFICATIONS AS DEFINED IN AMERICAN NATIONAL STANDARD 00360098 C PROGRAMMING LANGUAGE FORTRAN X3.9-1978, HAS BEEN DEVELOPED BY THE 00370098 C FEDERAL COBOL COMPILER TESTING SERVICE. THE FORTRAN COMPILER 00380098 C VALIDATION SYSTEM (FCVS) CONSISTS OF AUDIT ROUTINES, THEIR RELATED00390098 C DATA, AND AN EXECUTIVE SYSTEM. EACH AUDIT ROUTINE IS A FORTRAN 00400098 C PROGRAM, SUBPROGRAM OR FUNCTION WHICH INCLUDES TESTS OF SPECIFIC 00410098 C LANGUAGE ELEMENTS AND SUPPORTING PROCEDURES INDICATING THE RESULT 00420098 C OF EXECUTING THESE TESTS. 00430098 C 00440098 C THIS PARTICULAR PROGRAM/SUBPROGRAM/FUNCTION CONTAINS FEATURES 00450098 C FOUND ONLY IN THE SUBSET AS DEFINED IN X3.9-1978. 00460098 C 00470098 C SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO - 00480098 C 00490098 C NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY 00500098 C SOFTWARE STANDARDS VALIDATION GROUP 00510098 C BUILDING 225 RM A266 00520098 C GAITHERSBURG, MD 20899 00530098 C ********************************************************** 00540098 C 00550098 C 00560098 C 00570098 C INITIALIZATION SECTION 00580098 C 00590098 C INITIALIZE CONSTANTS 00600098 C ************** 00610098 C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER. 00620098 I01 = 5 00630098 C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER. 00640098 I02 = 6 00650098 C SYSTEM ENVIRONMENT SECTION 00660098 C 00670098 CX010 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-010 CONTROL CARD. 00680098 C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 00690098 C (UNIT NUMBER FOR CARD READER). 00700098 CX011 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-011 CONTROL CARD. 00710098 C THE CX011 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 00720098 C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX010 ABOVE. 00730098 C 00740098 CX020 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-020 CONTROL CARD. 00750098 C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02 = 6 00760098 C (UNIT NUMBER FOR PRINTER). 00770098 CX021 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-021 CONTROL CARD. 00780098 C THE CX021 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 00790098 C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX020 ABOVE. 00800098 C 00810098 IVPASS=0 00820098 IVFAIL=0 00830098 IVDELE=0 00840098 ICZERO=0 00850098 C 00860098 C WRITE PAGE HEADERS 00870098 WRITE (I02,90000) 00880098 WRITE (I02,90001) 00890098 WRITE (I02,90002) 00900098 WRITE (I02, 90002) 00910098 WRITE (I02,90003) 00920098 WRITE (I02,90002) 00930098 WRITE (I02,90004) 00940098 WRITE (I02,90002) 00950098 WRITE (I02,90011) 00960098 WRITE (I02,90002) 00970098 WRITE (I02,90002) 00980098 WRITE (I02,90005) 00990098 WRITE (I02,90006) 01000098 WRITE (I02,90002) 01010098 C 01020098 C TEST SECTION 01030098 C 01040098 C TEST 907 THROUGH TEST 909 CONTAIN INTRINSIC FUNCTION TESTS FOR 01050098 C ABSOLUTE VALUE WHERE ARGUMENT AND FUNCTION ARE INTEGER 01060098 C 01070098 9071 CONTINUE 01080098 IVTNUM = 907 01090098 C 01100098 C **** TEST 907 **** 01110098 C 01120098 IF (ICZERO) 39070, 9070, 39070 01130098 9070 CONTINUE 01140098 IVCOMP = IABS (-382) 01150098 GO TO 49070 01160098 39070 IVDELE = IVDELE + 1 01170098 WRITE (I02,80003) IVTNUM 01180098 IF (ICZERO) 49070, 9081, 49070 01190098 49070 IF (IVCOMP - 382) 29070,19070,29070 01200098 19070 IVPASS = IVPASS + 1 01210098 WRITE (I02,80001) IVTNUM 01220098 GO TO 9081 01230098 29070 IVFAIL = IVFAIL + 1 01240098 IVCORR = 382 01250098 WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR 01260098 9081 CONTINUE 01270098 IVTNUM = 908 01280098 C 01290098 C **** TEST 908 **** 01300098 C 01310098 IF (ICZERO) 39080, 9080, 39080 01320098 9080 CONTINUE 01330098 IVON01 = 445 01340098 IVCOMP = IABS (IVON01) 01350098 GO TO 49080 01360098 39080 IVDELE = IVDELE + 1 01370098 WRITE (I02,80003) IVTNUM 01380098 IF (ICZERO) 49080, 9091, 49080 01390098 49080 IF (IVCOMP - 445) 29080,19080,29080 01400098 19080 IVPASS = IVPASS + 1 01410098 WRITE (I02,80001) IVTNUM 01420098 GO TO 9091 01430098 29080 IVFAIL = IVFAIL + 1 01440098 IVCORR = 445 01450098 WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR 01460098 9091 CONTINUE 01470098 IVTNUM = 909 01480098 C 01490098 C **** TEST 909 **** 01500098 C 01510098 IF (ICZERO) 39090, 9090, 39090 01520098 9090 CONTINUE 01530098 IVON01 = -32176 01540098 IVCOMP = IABS (IVON01) 01550098 GO TO 49090 01560098 39090 IVDELE = IVDELE + 1 01570098 WRITE (I02,80003) IVTNUM 01580098 IF (ICZERO) 49090, 9101, 49090 01590098 49090 IF (IVCOMP - 32176) 29090,19090,29090 01600098 19090 IVPASS = IVPASS + 1 01610098 WRITE (I02,80001) IVTNUM 01620098 GO TO 9101 01630098 29090 IVFAIL = IVFAIL + 1 01640098 IVCORR = 32176 01650098 WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR 01660098 C 01670098 C TEST 910 THROUGH TEST 913 CONTAIN INTRINSIC FUNCTION TESTS FOR 01680098 C TRUNCATION WHERE ARGUMENT IS REAL AND FUNCTION IS INTEGER 01690098 C 01700098 9101 CONTINUE 01710098 IVTNUM = 910 01720098 C 01730098 C **** TEST 910 **** 01740098 C 01750098 IF (ICZERO) 39100, 9100, 39100 01760098 9100 CONTINUE 01770098 IVCOMP = INT (38.2) 01780098 GO TO 49100 01790098 39100 IVDELE = IVDELE + 1 01800098 WRITE (I02,80003) IVTNUM 01810098 IF (ICZERO) 49100, 9111, 49100 01820098 49100 IF (IVCOMP - 38) 29100,19100,29100 01830098 19100 IVPASS = IVPASS + 1 01840098 WRITE (I02,80001) IVTNUM 01850098 GO TO 9111 01860098 29100 IVFAIL = IVFAIL + 1 01870098 IVCORR = 38 01880098 WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR 01890098 9111 CONTINUE 01900098 IVTNUM = 911 01910098 C 01920098 C **** TEST 911 **** 01930098 C 01940098 IF (ICZERO) 39110, 9110, 39110 01950098 9110 CONTINUE 01960098 RVON01 = -445.95 01970098 IVCOMP = INT (RVON01) 01980098 GO TO 49110 01990098 39110 IVDELE = IVDELE + 1 02000098 WRITE (I02,80003) IVTNUM 02010098 IF (ICZERO) 49110, 9121, 49110 02020098 49110 IF (IVCOMP + 445) 29110,19110,29110 02030098 19110 IVPASS = IVPASS + 1 02040098 WRITE (I02,80001) IVTNUM 02050098 GO TO 9121 02060098 29110 IVFAIL = IVFAIL + 1 02070098 IVCORR = -445 02080098 WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR 02090098 9121 CONTINUE 02100098 IVTNUM = 912 02110098 C 02120098 C **** TEST 912 **** 02130098 C 02140098 IF (ICZERO) 39120, 9120, 39120 02150098 9120 CONTINUE 02160098 RVON01 = 466.01 02170098 IVCOMP = INT (RVON01) 02180098 GO TO 49120 02190098 39120 IVDELE = IVDELE + 1 02200098 WRITE (I02,80003) IVTNUM 02210098 IF (ICZERO) 49120, 9131, 49120 02220098 49120 IF (IVCOMP - 466) 29120,19120,29120 02230098 19120 IVPASS = IVPASS + 1 02240098 WRITE (I02,80001) IVTNUM 02250098 GO TO 9131 02260098 29120 IVFAIL = IVFAIL + 1 02270098 IVCORR = 466 02280098 WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR 02290098 9131 CONTINUE 02300098 IVTNUM = 913 02310098 C 02320098 C **** TEST 913 **** 02330098 C 02340098 IF (ICZERO) 39130, 9130, 39130 02350098 9130 CONTINUE 02360098 RVON01 = 382E-1 02370098 IVCOMP = INT (RVON01) 02380098 GO TO 49130 02390098 39130 IVDELE = IVDELE + 1 02400098 WRITE (I02,80003) IVTNUM 02410098 IF (ICZERO) 49130, 9141, 49130 02420098 49130 IF (IVCOMP - 38) 29130,19130,29130 02430098 19130 IVPASS = IVPASS + 1 02440098 WRITE (I02,80001) IVTNUM 02450098 GO TO 9141 02460098 29130 IVFAIL = IVFAIL + 1 02470098 IVCORR = 38 02480098 WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR 02490098 C 02500098 C TEST 914 THROUGH TEST 917 CONTAIN INTRINSIC FUNCTION TESTS FOR 02510098 C REMAINDERING WHERE ARGUMENTS AND FUNCTION ARE INTEGERS 02520098 C 02530098 9141 CONTINUE 02540098 IVTNUM = 914 02550098 C 02560098 C **** TEST 914 **** 02570098 C 02580098 IF (ICZERO) 39140, 9140, 39140 02590098 9140 CONTINUE 02600098 IVCOMP = MOD (42,19) 02610098 GO TO 49140 02620098 39140 IVDELE = IVDELE + 1 02630098 WRITE (I02,80003) IVTNUM 02640098 IF (ICZERO) 49140, 9151, 49140 02650098 49140 IF (IVCOMP - 4) 29140,19140,29140 02660098 19140 IVPASS = IVPASS + 1 02670098 WRITE (I02,80001) IVTNUM 02680098 GO TO 9151 02690098 29140 IVFAIL = IVFAIL + 1 02700098 IVCORR = 4 02710098 WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR 02720098 9151 CONTINUE 02730098 IVTNUM = 915 02740098 C 02750098 C **** TEST 915 **** 02760098 C 02770098 IF (ICZERO) 39150, 9150, 39150 02780098 9150 CONTINUE 02790098 IVON01 = 6667 02800098 IVON02 = 2 02810098 IVCOMP = MOD (IVON01,IVON02) 02820098 GO TO 49150 02830098 39150 IVDELE = IVDELE + 1 02840098 WRITE (I02,80003) IVTNUM 02850098 IF (ICZERO) 49150, 9161, 49150 02860098 49150 IF (IVCOMP - 1) 29150,19150,29150 02870098 19150 IVPASS = IVPASS + 1 02880098 WRITE (I02,80001) IVTNUM 02890098 GO TO 9161 02900098 29150 IVFAIL = IVFAIL + 1 02910098 IVCORR = 1 02920098 WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR 02930098 9161 CONTINUE 02940098 IVTNUM = 916 02950098 C 02960098 C **** TEST 916 **** 02970098 C 02980098 IF (ICZERO) 39160, 9160, 39160 02990098 9160 CONTINUE 03000098 IVON01 = 225 03010098 IVON02 = 50 03020098 IVCOMP = MOD (IVON01,IVON02) 03030098 GO TO 49160 03040098 39160 IVDELE = IVDELE + 1 03050098 WRITE (I02,80003) IVTNUM 03060098 IF (ICZERO) 49160, 9171, 49160 03070098 49160 IF (IVCOMP - 25) 29160,19160,29160 03080098 19160 IVPASS = IVPASS + 1 03090098 WRITE (I02,80001) IVTNUM 03100098 GO TO 9171 03110098 29160 IVFAIL = IVFAIL + 1 03120098 IVCORR = 25 03130098 WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR 03140098 9171 CONTINUE 03150098 IVTNUM = 917 03160098 C 03170098 C **** TEST 917 **** 03180098 C 03190098 IF (ICZERO) 39170, 9170, 39170 03200098 9170 CONTINUE 03210098 IVON01 = -39 03220098 IVON02 = 500 03230098 IVCOMP = MOD (IVON01,IVON02) 03240098 GO TO 49170 03250098 39170 IVDELE = IVDELE + 1 03260098 WRITE (I02,80003) IVTNUM 03270098 IF (ICZERO) 49170, 9181, 49170 03280098 49170 IF (IVCOMP + 39) 29170,19170,29170 03290098 19170 IVPASS = IVPASS + 1 03300098 WRITE (I02,80001) IVTNUM 03310098 GO TO 9181 03320098 29170 IVFAIL = IVFAIL + 1 03330098 IVCORR = -39 03340098 WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR 03350098 C 03360098 C TEST 918 AND 919 CONTAIN INTRINSIC FUNCTION TESTS FOR CHOOSING 03370098 C LARGEST VALUE WHERE ARGUMENTS AND FUNCTION ARE INTEGER 03380098 C 03390098 9181 CONTINUE 03400098 IVTNUM = 918 03410098 C 03420098 C **** TEST 918 **** 03430098 C 03440098 IF (ICZERO) 39180, 9180, 39180 03450098 9180 CONTINUE 03460098 IVON01 = 317 03470098 IVON02 = -99 03480098 IVON03 = 1 03490098 IVCOMP = MAX0 (263,IVON01,IVON02,IVON03) 03500098 GO TO 49180 03510098 39180 IVDELE = IVDELE + 1 03520098 WRITE (I02,80003) IVTNUM 03530098 IF (ICZERO) 49180, 9191, 49180 03540098 49180 IF (IVCOMP - 317) 29180,19180,29180 03550098 19180 IVPASS = IVPASS + 1 03560098 WRITE (I02,80001) IVTNUM 03570098 GO TO 9191 03580098 29180 IVFAIL = IVFAIL + 1 03590098 IVCORR = 317 03600098 WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR 03610098 9191 CONTINUE 03620098 IVTNUM = 919 03630098 C 03640098 C **** TEST 919 **** 03650098 C 03660098 IF (ICZERO) 39190, 9190, 39190 03670098 9190 CONTINUE 03680098 IVON01 = 2572 03690098 IVON02 = 2570 03700098 IVCOMP = MAX0 (IVON01,IVON02) 03710098 GO TO 49190 03720098 39190 IVDELE = IVDELE + 1 03730098 WRITE (I02,80003) IVTNUM 03740098 IF (ICZERO) 49190, 9201, 49190 03750098 49190 IF (IVCOMP - 2572) 29190,19190,29190 03760098 19190 IVPASS = IVPASS + 1 03770098 WRITE (I02,80001) IVTNUM 03780098 GO TO 9201 03790098 29190 IVFAIL = IVFAIL + 1 03800098 IVCORR = 2572 03810098 WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR 03820098 C 03830098 C TEST 920 AND 921 CONTAIN INTRINSIC FUNCTION TESTS FOR CHOOSING 03840098 C LARGEST VALUE WHERE ARGUMENTS ARE REAL AND FUNCTION IS INTEGER 03850098 C 03860098 9201 CONTINUE 03870098 IVTNUM = 920 03880098 C 03890098 C **** TEST 920 **** 03900098 C 03910098 IF (ICZERO) 39200, 9200, 39200 03920098 9200 CONTINUE 03930098 RVON01 = .326E+2 03940098 RVON02 = 22.075 03950098 RVON03 = 76E-1 03960098 IVCOMP = MAX1 (RVON01,RVON02,RVON03) 03970098 GO TO 49200 03980098 39200 IVDELE = IVDELE + 1 03990098 WRITE (I02,80003) IVTNUM 04000098 IF (ICZERO) 49200, 9211, 49200 04010098 49200 IF (IVCOMP - 32) 29200,19200,29200 04020098 19200 IVPASS = IVPASS + 1 04030098 WRITE (I02,80001) IVTNUM 04040098 GO TO 9211 04050098 29200 IVFAIL = IVFAIL + 1 04060098 IVCORR = 32 04070098 WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR 04080098 9211 CONTINUE 04090098 IVTNUM = 921 04100098 C 04110098 C **** TEST 921 **** 04120098 C 04130098 IF (ICZERO) 39210, 9210, 39210 04140098 9210 CONTINUE 04150098 RVON01 = -6.3E2 04160098 RVON02 = -21.0 04170098 IVCOMP = MAX1 (-463.3,RVON01,RVON02) 04180098 GO TO 49210 04190098 39210 IVDELE = IVDELE + 1 04200098 WRITE (I02,80003) IVTNUM 04210098 IF (ICZERO) 49210, 9221, 49210 04220098 49210 IF (IVCOMP + 21) 29210,19210,29210 04230098 19210 IVPASS = IVPASS + 1 04240098 WRITE (I02,80001) IVTNUM 04250098 GO TO 9221 04260098 29210 IVFAIL = IVFAIL + 1 04270098 IVCORR = -21 04280098 WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR 04290098 C 04300098 C TEST 922 AND 923 CONTAIN INTRINSIC FUNCTION TESTS FOR CHOOSING 04310098 C SMALLEST VALUE WHERE ARGUMENTS AND FUNCTION ARE INTEGER 04320098 C 04330098 9221 CONTINUE 04340098 IVTNUM = 922 04350098 C 04360098 C **** TEST 922 **** 04370098 C 04380098 IF (ICZERO) 39220, 9220, 39220 04390098 9220 CONTINUE 04400098 IVON01 = -75 04410098 IVON02 = -243 04420098 IVCOMP = MIN0 (IVON01,IVON02) 04430098 GO TO 49220 04440098 39220 IVDELE = IVDELE + 1 04450098 WRITE (I02,80003) IVTNUM 04460098 IF (ICZERO) 49220, 9231, 49220 04470098 49220 IF (IVCOMP + 243) 29220,19220,29220 04480098 19220 IVPASS = IVPASS + 1 04490098 WRITE (I02,80001) IVTNUM 04500098 GO TO 9231 04510098 29220 IVFAIL = IVFAIL + 1 04520098 IVCORR = -243 04530098 WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR 04540098 9231 CONTINUE 04550098 IVTNUM = 923 04560098 C 04570098 C **** TEST 923 **** 04580098 C 04590098 IF (ICZERO) 39230, 9230, 39230 04600098 9230 CONTINUE 04610098 IVON01 = -11 04620098 IVON02 = 11 04630098 IVCOMP = MIN0 (0,IVON01,IVON02) 04640098 GO TO 49230 04650098 39230 IVDELE = IVDELE + 1 04660098 WRITE (I02,80003) IVTNUM 04670098 IF (ICZERO) 49230, 9241, 49230 04680098 49230 IF (IVCOMP + 11) 29230,19230,29230 04690098 19230 IVPASS = IVPASS + 1 04700098 WRITE (I02,80001) IVTNUM 04710098 GO TO 9241 04720098 29230 IVFAIL = IVFAIL + 1 04730098 IVCORR = -11 04740098 WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR 04750098 C 04760098 C TEST 924 AND 925 CONTAIN INTRINSIC FUNCTION TESTS FOR CHOOSING 04770098 C SMALLEST VALUE WHERE ARGUMENTS ARE REAL AND FUNCTION IS INTEGER 04780098 C 04790098 9241 CONTINUE 04800098 IVTNUM = 924 04810098 C 04820098 C **** TEST 924 **** 04830098 C 04840098 IF (ICZERO) 39240, 9240, 39240 04850098 9240 CONTINUE 04860098 RVON01 = 1.1111 04870098 RVON02 = 22.222 04880098 RVON03 = 333.33 04890098 IVCOMP = MIN1 (RVON01,RVON02,RVON03) 04900098 GO TO 49240 04910098 39240 IVDELE = IVDELE + 1 04920098 WRITE (I02,80003) IVTNUM 04930098 IF (ICZERO) 49240, 9251, 49240 04940098 49240 IF (IVCOMP - 1) 29240,19240,29240 04950098 19240 IVPASS = IVPASS + 1 04960098 WRITE (I02,80001) IVTNUM 04970098 GO TO 9251 04980098 29240 IVFAIL = IVFAIL + 1 04990098 IVCORR = 1 05000098 WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR 05010098 9251 CONTINUE 05020098 IVTNUM = 925 05030098 C 05040098 C **** TEST 925 **** 05050098 C 05060098 IF (ICZERO) 39250, 9250, 39250 05070098 9250 CONTINUE 05080098 RVON01 = 28.8 05090098 RVON02 = 2.88E1 05100098 RVON03 = 288E-1 05110098 RVON04 = 35.0 05120098 IVCOMP = MIN1 (RVON01,RVON02,RVON03,RVON04) 05130098 GO TO 49250 05140098 39250 IVDELE = IVDELE + 1 05150098 WRITE (I02,80003) IVTNUM 05160098 IF (ICZERO) 49250, 9261, 49250 05170098 49250 IF (IVCOMP - 28) 29250,19250,29250 05180098 19250 IVPASS = IVPASS + 1 05190098 WRITE (I02,80001) IVTNUM 05200098 GO TO 9261 05210098 29250 IVFAIL = IVFAIL + 1 05220098 IVCORR = 28 05230098 WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR 05240098 C 05250098 C TEST 926 THROUGH TEST 929 CONTAIN THE INTRINSIC FUNCTION FIX 05260098 C WHICH CONVERTS REAL ARGUMENTS TO INTEGER FUNCTION RESULTS 05270098 C 05280098 9261 CONTINUE 05290098 IVTNUM = 926 05300098 C 05310098 C **** TEST 926 **** 05320098 C 05330098 IF (ICZERO) 39260, 9260, 39260 05340098 9260 CONTINUE 05350098 IVCOMP = IFIX (-6.06) 05360098 GO TO 49260 05370098 39260 IVDELE = IVDELE + 1 05380098 WRITE (I02,80003) IVTNUM 05390098 IF (ICZERO) 49260, 9271, 49260 05400098 49260 IF (IVCOMP + 6) 29260,19260,29260 05410098 19260 IVPASS = IVPASS + 1 05420098 WRITE (I02,80001) IVTNUM 05430098 GO TO 9271 05440098 29260 IVFAIL = IVFAIL + 1 05450098 IVCORR = -6 05460098 WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR 05470098 9271 CONTINUE 05480098 IVTNUM = 927 05490098 C 05500098 C **** TEST 927 **** 05510098 C 05520098 IF (ICZERO) 39270, 9270, 39270 05530098 9270 CONTINUE 05540098 RVON01 = 71.01 05550098 IVCOMP = IFIX (RVON01) 05560098 GO TO 49270 05570098 39270 IVDELE = IVDELE + 1 05580098 WRITE (I02,80003) IVTNUM 05590098 IF (ICZERO) 49270, 9281, 49270 05600098 49270 IF (IVCOMP - 71) 29270,19270,29270 05610098 19270 IVPASS = IVPASS + 1 05620098 WRITE (I02,80001) IVTNUM 05630098 GO TO 9281 05640098 29270 IVFAIL = IVFAIL + 1 05650098 IVCORR = 71 05660098 WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR 05670098 9281 CONTINUE 05680098 IVTNUM = 928 05690098 C 05700098 C **** TEST 928 **** 05710098 C 05720098 IF (ICZERO) 39280, 9280, 39280 05730098 9280 CONTINUE 05740098 RVON01 = 3.211E2 05750098 IVCOMP = IFIX (RVON01) 05760098 GO TO 49280 05770098 39280 IVDELE = IVDELE + 1 05780098 WRITE (I02,80003) IVTNUM 05790098 IF (ICZERO) 49280, 9291, 49280 05800098 49280 IF (IVCOMP - 321) 29280,19280,29280 05810098 19280 IVPASS = IVPASS + 1 05820098 WRITE (I02,80001) IVTNUM 05830098 GO TO 9291 05840098 29280 IVFAIL = IVFAIL + 1 05850098 IVCORR = 321 05860098 WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR 05870098 9291 CONTINUE 05880098 IVTNUM = 929 05890098 C 05900098 C **** TEST 929 **** 05910098 C 05920098 IF (ICZERO) 39290, 9290, 39290 05930098 9290 CONTINUE 05940098 RVON01 = 777E-1 05950098 IVCOMP = IFIX (RVON01) 05960098 GO TO 49290 05970098 39290 IVDELE = IVDELE + 1 05980098 WRITE (I02,80003) IVTNUM 05990098 IF (ICZERO) 49290, 9301, 49290 06000098 49290 IF (IVCOMP - 77) 29290,19290,29290 06010098 19290 IVPASS = IVPASS + 1 06020098 WRITE (I02,80001) IVTNUM 06030098 GO TO 9301 06040098 29290 IVFAIL = IVFAIL + 1 06050098 IVCORR = 77 06060098 WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR 06070098 C 06080098 C TEST 930 THROUGH TEST 932 CONTAIN INTRINSIC FUNCTION TESTS FOR 06090098 C TRANSFER OF SIGN WHERE ARGUMENTS AND FUNCTION ARE INTEGER 06100098 C 06110098 9301 CONTINUE 06120098 IVTNUM = 930 06130098 C 06140098 C **** TEST 930 **** 06150098 C 06160098 IF (ICZERO) 39300, 9300, 39300 06170098 9300 CONTINUE 06180098 IVON01 = 643 06190098 IVCOMP = ISIGN (IVON01,-1) 06200098 GO TO 49300 06210098 39300 IVDELE = IVDELE + 1 06220098 WRITE (I02,80003) IVTNUM 06230098 IF (ICZERO) 49300, 9311, 49300 06240098 49300 IF (IVCOMP + 643) 29300,19300,29300 06250098 19300 IVPASS = IVPASS + 1 06260098 WRITE (I02,80001) IVTNUM 06270098 GO TO 9311 06280098 29300 IVFAIL = IVFAIL + 1 06290098 IVCORR = -643 06300098 WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR 06310098 9311 CONTINUE 06320098 IVTNUM = 931 06330098 C 06340098 C **** TEST 931 **** 06350098 C 06360098 IF (ICZERO) 39310, 9310, 39310 06370098 9310 CONTINUE 06380098 IVON01 = -22 06390098 IVON02 = 723 06400098 IVCOMP = ISIGN (IVON01,IVON02) 06410098 GO TO 49310 06420098 39310 IVDELE = IVDELE + 1 06430098 WRITE (I02,80003) IVTNUM 06440098 IF (ICZERO) 49310, 9321, 49310 06450098 49310 IF (IVCOMP - 22) 29310,19310,29310 06460098 19310 IVPASS = IVPASS + 1 06470098 WRITE (I02,80001) IVTNUM 06480098 GO TO 9321 06490098 29310 IVFAIL = IVFAIL + 1 06500098 IVCORR = 22 06510098 WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR 06520098 9321 CONTINUE 06530098 IVTNUM = 932 06540098 C 06550098 C **** TEST 932 **** 06560098 C 06570098 IF (ICZERO) 39320, 9320, 39320 06580098 9320 CONTINUE 06590098 IVON01 = 3532 06600098 IVON02 = 1 06610098 IVCOMP = ISIGN (IVON01,IVON02) 06620098 GO TO 49320 06630098 39320 IVDELE = IVDELE + 1 06640098 WRITE (I02,80003) IVTNUM 06650098 IF (ICZERO) 49320, 9331, 49320 06660098 49320 IF (IVCOMP - 3532) 29320,19320,29320 06670098 19320 IVPASS = IVPASS + 1 06680098 WRITE (I02,80001) IVTNUM 06690098 GO TO 9331 06700098 29320 IVFAIL = IVFAIL + 1 06710098 IVCORR = 3532 06720098 WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR 06730098 C 06740098 C TEST 933 THROUGH TEST 936 CONTAIN INTRINSIC FUNCTION TESTS FOR 06750098 C POSITIVE DIFFERENCE WHERE ARGUMENTS AND FUNCTION ARE INTEGERS 06760098 C 06770098 9331 CONTINUE 06780098 IVTNUM = 933 06790098 C 06800098 C **** TEST 933 **** 06810098 C 06820098 IF (ICZERO) 39330, 9330, 39330 06830098 9330 CONTINUE 06840098 IVON01 = 222 06850098 IVCOMP = IDIM (IVON01,1) 06860098 GO TO 49330 06870098 39330 IVDELE = IVDELE + 1 06880098 WRITE (I02,80003) IVTNUM 06890098 IF (ICZERO) 49330, 9341, 49330 06900098 49330 IF (IVCOMP - 221) 29330,19330,29330 06910098 19330 IVPASS = IVPASS + 1 06920098 WRITE (I02,80001) IVTNUM 06930098 GO TO 9341 06940098 29330 IVFAIL = IVFAIL + 1 06950098 IVCORR = 221 06960098 WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR 06970098 9341 CONTINUE 06980098 IVTNUM = 934 06990098 C 07000098 C **** TEST 934 **** 07010098 C 07020098 IF (ICZERO) 39340, 9340, 39340 07030098 9340 CONTINUE 07040098 IVON01 = 45 07050098 IVON02 = 41 07060098 IVCOMP = IDIM (IVON01,IVON02) 07070098 GO TO 49340 07080098 39340 IVDELE = IVDELE + 1 07090098 WRITE (I02,80003) IVTNUM 07100098 IF (ICZERO) 49340, 9351, 49340 07110098 49340 IF (IVCOMP - 4) 29340,19340,29340 07120098 19340 IVPASS = IVPASS + 1 07130098 WRITE (I02,80001) IVTNUM 07140098 GO TO 9351 07150098 29340 IVFAIL = IVFAIL + 1 07160098 IVCORR = 4 07170098 WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR 07180098 9351 CONTINUE 07190098 IVTNUM = 935 07200098 C 07210098 C **** TEST 935 **** 07220098 C 07230098 IF (ICZERO) 39350, 9350, 39350 07240098 9350 CONTINUE 07250098 IVON01 = 2 07260098 IVON02 = 10 07270098 IVCOMP = IDIM (IVON01,IVON02) 07280098 GO TO 49350 07290098 39350 IVDELE = IVDELE + 1 07300098 WRITE (I02,80003) IVTNUM 07310098 IF (ICZERO) 49350, 9361, 49350 07320098 49350 IF (IVCOMP) 29350,19350,29350 07330098 19350 IVPASS = IVPASS + 1 07340098 WRITE (I02,80001) IVTNUM 07350098 GO TO 9361 07360098 29350 IVFAIL = IVFAIL + 1 07370098 IVCORR = 0 07380098 WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR 07390098 9361 CONTINUE 07400098 IVTNUM = 936 07410098 C 07420098 C **** TEST 936 **** 07430098 C 07440098 IF (ICZERO) 39360, 9360, 39360 07450098 9360 CONTINUE 07460098 IVON01 = 165 07470098 IVON02 = -2 07480098 IVCOMP = IDIM (IVON01,IVON02) 07490098 GO TO 49360 07500098 39360 IVDELE = IVDELE + 1 07510098 WRITE (I02,80003) IVTNUM 07520098 IF (ICZERO) 49360, 9371, 49360 07530098 49360 IF (IVCOMP - 167) 29360,19360,29360 07540098 19360 IVPASS = IVPASS + 1 07550098 WRITE (I02,80001) IVTNUM 07560098 GO TO 9371 07570098 29360 IVFAIL = IVFAIL + 1 07580098 IVCORR = 167 07590098 WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR 07600098 C 07610098 C TESTS 937 AND 938 CONTAIN EXPRESSIONS CONTAINING MORE THAN ONE 07620098 C INTRINSIC FUNCTION - THE FUNCTIONS ARE INTEGER AND THE ARGUMENTS 07630098 C ARE REAL AND INTEGER 07640098 C 07650098 9371 CONTINUE 07660098 IVTNUM = 937 07670098 C 07680098 C **** TEST 937 **** 07690098 C 07700098 IF (ICZERO) 39370, 9370, 39370 07710098 9370 CONTINUE 07720098 RVON01 = 33.3 07730098 IVON01 = -12 07740098 IVCOMP = INT (RVON01) + IABS (IVON01) 07750098 GO TO 49370 07760098 39370 IVDELE = IVDELE + 1 07770098 WRITE (I02,80003) IVTNUM 07780098 IF (ICZERO) 49370, 9381, 49370 07790098 49370 IF (IVCOMP - 45) 29370,19370,29370 07800098 19370 IVPASS = IVPASS + 1 07810098 WRITE (I02,80001) IVTNUM 07820098 GO TO 9381 07830098 29370 IVFAIL = IVFAIL + 1 07840098 IVCORR = 45 07850098 WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR 07860098 9381 CONTINUE 07870098 IVTNUM = 938 07880098 C 07890098 C **** TEST 938 **** 07900098 C 07910098 IF (ICZERO) 39380, 9380, 39380 07920098 9380 CONTINUE 07930098 IVON01 = 76 07940098 IVON02 = 21 07950098 IVON03 = 30 07960098 IVCOMP = MAX0 (IVON01,IVON02,IVON03) - MIN0 (IVON01,IVON02,IVON03)07970098 GO TO 49380 07980098 39380 IVDELE = IVDELE + 1 07990098 WRITE (I02,80003) IVTNUM 08000098 IF (ICZERO) 49380, 9391, 49380 08010098 49380 IF (IVCOMP - 55) 29380,19380,29380 08020098 19380 IVPASS = IVPASS + 1 08030098 WRITE (I02,80001) IVTNUM 08040098 GO TO 9391 08050098 29380 IVFAIL = IVFAIL + 1 08060098 IVCORR = 55 08070098 WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR 08080098 9391 CONTINUE 08090098 C 08100098 C WRITE PAGE FOOTINGS AND RUN SUMMARIES 08110098 99999 CONTINUE 08120098 WRITE (I02,90002) 08130098 WRITE (I02,90006) 08140098 WRITE (I02,90002) 08150098 WRITE (I02,90002) 08160098 WRITE (I02,90007) 08170098 WRITE (I02,90002) 08180098 WRITE (I02,90008) IVFAIL 08190098 WRITE (I02,90009) IVPASS 08200098 WRITE (I02,90010) IVDELE 08210098 C 08220098 C 08230098 C TERMINATE ROUTINE EXECUTION 08240098 STOP 08250098 C 08260098 C FORMAT STATEMENTS FOR PAGE HEADERS 08270098 90000 FORMAT ("1") 08280098 90002 FORMAT (" ") 08290098 90001 FORMAT (" ",10X,"FORTRAN COMPILER VALIDATION SYSTEM" ) 08300098 90003 FORMAT (" ",21X,"VERSION 2.1" ) 08310098 90004 FORMAT (" ",10X,"FOR OFFICIAL USE ONLY - COPYRIGHT 1978" ) 08320098 90005 FORMAT (" ",5X,"TEST",5X,"PASS/FAIL", 5X,"COMPUTED",8X,"CORRECT") 08330098 90006 FORMAT (" ",5X,"----------------------------------------------" ) 08340098 90011 FORMAT (" ",18X,"SUBSET LEVEL TEST" ) 08350098 C 08360098 C FORMAT STATEMENTS FOR RUN SUMMARIES 08370098 90008 FORMAT (" ",15X,I5," ERRORS ENCOUNTERED" ) 08380098 90009 FORMAT (" ",15X,I5," TESTS PASSED" ) 08390098 90010 FORMAT (" ",15X,I5," TESTS DELETED" ) 08400098 C 08410098 C FORMAT STATEMENTS FOR TEST RESULTS 08420098 80001 FORMAT (" ",4X,I5,7X,"PASS") 08430098 80002 FORMAT (" ",4X,I5,7X,"FAIL") 08440098 80003 FORMAT (" ",4X,I5,7X,"DELETED") 08450098 80004 FORMAT (" ",4X,I5,7X,"FAIL",10X,I6,9X,I6) 08460098 80005 FORMAT (" ",4X,I5,7X,"FAIL",4X,E12.5,3X,E12.5) 08470098 C 08480098 90007 FORMAT (" ",20X,"END OF PROGRAM FM098" ) 08490098 END 08500098