blob: c3bfd6ddcd070c4acb56209f0e11d790abee793f [file] [log] [blame]
PROGRAM FM097
C COMMENT SECTION 00010097
C 00020097
C FM097 00030097
C 00040097
C THIS ROUTINE TESTS INTRINSIC FUNCTIONS WHERE THE FUNCTION TYPE IS 00050097
C REAL AND THE ARGUMENTS ARE EITHER INTEGER OR REAL. THE REAL AND 00060097
C INTEGER VARIABLES AND THE REAL AND INTEGER CONSTANTS CONTAIN BOTH 00070097
C POSITIVE AND NEGATIVE VALUES. THE INTRINSIC FUNCTIONS TESTED BY 00080097
C FM097 INCLUDE 00090097
C TYPE OF 00100097
C INTRINSIC FUNCTION NAME ARGUMENT FUNCTION 00110097
C ------------------ ---- -------- -------- 00120097
C ABSOLUTE VALUE ABS REAL REAL 00130097
C TRUNCATION AINT REAL REAL 00140097
C REMAINDERING AMOD REAL REAL 00150097
C CHOOSING LARGEST VALUE AMAX0 INTEGER REAL 00160097
C AMAX1 REAL REAL 00170097
C CHOOSING SMALLEST VALUE AMIN0 INTEGER REAL 00180097
C AMIN1 REAL REAL 00190097
C FLOAT FLOAT INTEGER REAL 00200097
C TRANSFER OF SIGN SIGN REAL REAL 00210097
C POSITIVE DIFFERENCE DIM REAL REAL 00220097
C 00230097
C REFERENCES 00240097
C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN, 00250097
C X3.9-1978 00260097
C 00270097
C SECTION 4.1.2, TYPE RULES FOR DATA AND PROCEDURE IDENTIFIERS 00280097
C SECTION 15.3, INTRINSIC FUNCTION 00290097
C SECTION 15.3.2, INTRINSIC FUNCTIONS AND THEIR REFERENCE 00300097
C 00310097
C 00320097
C ********************************************************** 00330097
C 00340097
C A COMPILER VALIDATION SYSTEM FOR THE FORTRAN LANGUAGE 00350097
C BASED ON SPECIFICATIONS AS DEFINED IN AMERICAN NATIONAL STANDARD 00360097
C PROGRAMMING LANGUAGE FORTRAN X3.9-1978, HAS BEEN DEVELOPED BY THE 00370097
C FEDERAL COBOL COMPILER TESTING SERVICE. THE FORTRAN COMPILER 00380097
C VALIDATION SYSTEM (FCVS) CONSISTS OF AUDIT ROUTINES, THEIR RELATED00390097
C DATA, AND AN EXECUTIVE SYSTEM. EACH AUDIT ROUTINE IS A FORTRAN 00400097
C PROGRAM, SUBPROGRAM OR FUNCTION WHICH INCLUDES TESTS OF SPECIFIC 00410097
C LANGUAGE ELEMENTS AND SUPPORTING PROCEDURES INDICATING THE RESULT 00420097
C OF EXECUTING THESE TESTS. 00430097
C 00440097
C THIS PARTICULAR PROGRAM/SUBPROGRAM/FUNCTION CONTAINS FEATURES 00450097
C FOUND ONLY IN THE SUBSET AS DEFINED IN X3.9-1978. 00460097
C 00470097
C SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO - 00480097
C 00490097
C NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY 00500097
C SOFTWARE STANDARDS VALIDATION GROUP 00510097
C BUILDING 225 RM A266 00520097
C GAITHERSBURG, MD 20899 00530097
C ********************************************************** 00540097
C 00550097
C 00560097
C 00570097
C INITIALIZATION SECTION 00580097
C 00590097
C INITIALIZE CONSTANTS 00600097
C ************** 00610097
C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER. 00620097
I01 = 5 00630097
C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER. 00640097
I02 = 6 00650097
C SYSTEM ENVIRONMENT SECTION 00660097
C 00670097
CX010 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-010 CONTROL CARD. 00680097
C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 00690097
C (UNIT NUMBER FOR CARD READER). 00700097
CX011 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-011 CONTROL CARD. 00710097
C THE CX011 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 00720097
C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX010 ABOVE. 00730097
C 00740097
CX020 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-020 CONTROL CARD. 00750097
C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02 = 6 00760097
C (UNIT NUMBER FOR PRINTER). 00770097
CX021 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-021 CONTROL CARD. 00780097
C THE CX021 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 00790097
C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX020 ABOVE. 00800097
C 00810097
IVPASS=0 00820097
IVFAIL=0 00830097
IVDELE=0 00840097
ICZERO=0 00850097
C 00860097
C WRITE PAGE HEADERS 00870097
WRITE (I02,90000) 00880097
WRITE (I02,90001) 00890097
WRITE (I02,90002) 00900097
WRITE (I02, 90002) 00910097
WRITE (I02,90003) 00920097
WRITE (I02,90002) 00930097
WRITE (I02,90004) 00940097
WRITE (I02,90002) 00950097
WRITE (I02,90011) 00960097
WRITE (I02,90002) 00970097
WRITE (I02,90002) 00980097
WRITE (I02,90005) 00990097
WRITE (I02,90006) 01000097
WRITE (I02,90002) 01010097
C 01020097
C TEST SECTION 01030097
C 01040097
C TEST 875 THROUGH TEST 878 CONTAIN INTRINSIC FUNCTION TESTS FOR 01050097
C ABSOLUTE VALUE WHERE ARGUMENT AND FUNCTION ARE REAL 01060097
C 01070097
IVTNUM = 875 01080097
C 01090097
C **** TEST 875 **** 01100097
C 01110097
IF (ICZERO) 38750, 8750, 38750 01120097
8750 CONTINUE 01130097
RVCOMP = ABS (-38.2) 01140097
GO TO 48750 01150097
38750 IVDELE = IVDELE + 1 01160097
WRITE (I02,80003) IVTNUM 01170097
IF (ICZERO) 48750, 8761, 48750 01180097
48750 IF (RVCOMP - 38.195) 28750,18750,48751 01190097
48751 IF (RVCOMP - 38.205) 18750,18750,28750 01200097
18750 IVPASS = IVPASS + 1 01210097
WRITE (I02,80001) IVTNUM 01220097
GO TO 8761 01230097
28750 IVFAIL = IVFAIL + 1 01240097
RVCORR = 38.200 01250097
WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 01260097
8761 CONTINUE 01270097
IVTNUM = 876 01280097
C 01290097
C **** TEST 876 **** 01300097
C 01310097
IF (ICZERO) 38760, 8760, 38760 01320097
8760 CONTINUE 01330097
RVON01 = 445.06 01340097
RVCOMP = ABS (RVON01) 01350097
GO TO 48760 01360097
38760 IVDELE = IVDELE + 1 01370097
WRITE (I02,80003) IVTNUM 01380097
IF (ICZERO) 48760, 8771, 48760 01390097
48760 IF (RVCOMP - 445.01) 28760,18760,48761 01400097
48761 IF (RVCOMP - 445.11) 18760,18760,28760 01410097
18760 IVPASS = IVPASS + 1 01420097
WRITE (I02,80001) IVTNUM 01430097
GO TO 8771 01440097
28760 IVFAIL = IVFAIL + 1 01450097
RVCORR = 445.06 01460097
WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 01470097
8771 CONTINUE 01480097
IVTNUM = 877 01490097
C 01500097
C **** TEST 877 **** 01510097
C 01520097
IF (ICZERO) 38770, 8770, 38770 01530097
8770 CONTINUE 01540097
RVON01 = -32.176 01550097
RVCOMP = ABS (RVON01) 01560097
GO TO 48770 01570097
38770 IVDELE = IVDELE + 1 01580097
WRITE (I02,80003) IVTNUM 01590097
IF (ICZERO) 48770, 8781, 48770 01600097
48770 IF (RVCOMP - 32.171) 28770,18770,48771 01610097
48771 IF (RVCOMP - 32.181) 18770,18770,28770 01620097
18770 IVPASS = IVPASS + 1 01630097
WRITE (I02,80001) IVTNUM 01640097
GO TO 8781 01650097
28770 IVFAIL = IVFAIL + 1 01660097
RVCORR = 32.176 01670097
WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 01680097
8781 CONTINUE 01690097
IVTNUM = 878 01700097
C 01710097
C **** TEST 878 **** 01720097
C 01730097
IF (ICZERO) 38780, 8780, 38780 01740097
8780 CONTINUE 01750097
RVON01 = -2.2E+2 01760097
RVCOMP = ABS (RVON01) 01770097
GO TO 48780 01780097
38780 IVDELE = IVDELE + 1 01790097
WRITE (I02,80003) IVTNUM 01800097
IF (ICZERO) 48780, 8791, 48780 01810097
48780 IF (RVCOMP - 219.95) 28780,18780,48781 01820097
48781 IF (RVCOMP - 220.05) 18780,18780,28780 01830097
18780 IVPASS = IVPASS + 1 01840097
WRITE (I02,80001) IVTNUM 01850097
GO TO 8791 01860097
28780 IVFAIL = IVFAIL + 1 01870097
RVCORR = 220.00 01880097
WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 01890097
8791 CONTINUE 01900097
IVTNUM = 879 01910097
C 01920097
C **** TEST 879 **** 01930097
C 01940097
C TEST 879 THROUGH TEST 882 CONTAIN INTRINSIC FUNCTION TESTS FOR 01950097
C TRUNCATION WHERE ARGUMENT AND FUNCTION ARE REAL 01960097
C 01970097
C 01980097
IF (ICZERO) 38790, 8790, 38790 01990097
8790 CONTINUE 02000097
RVCOMP = AINT (38.2) 02010097
GO TO 48790 02020097
38790 IVDELE = IVDELE + 1 02030097
WRITE (I02,80003) IVTNUM 02040097
IF (ICZERO) 48790, 8801, 48790 02050097
48790 IF (RVCOMP - 37.995) 28790,18790,48791 02060097
48791 IF (RVCOMP - 38.005) 18790,18790,28790 02070097
18790 IVPASS = IVPASS + 1 02080097
WRITE (I02,80001) IVTNUM 02090097
GO TO 8801 02100097
28790 IVFAIL = IVFAIL + 1 02110097
RVCORR = 38.000 02120097
WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 02130097
8801 CONTINUE 02140097
IVTNUM = 880 02150097
C 02160097
C **** TEST 880 **** 02170097
C 02180097
IF (ICZERO) 38800, 8800, 38800 02190097
8800 CONTINUE 02200097
RVON01 = -445.95 02210097
RVCOMP = AINT (RVON01) 02220097
GO TO 48800 02230097
38800 IVDELE = IVDELE + 1 02240097
WRITE (I02,80003) IVTNUM 02250097
IF (ICZERO) 48800, 8811, 48800 02260097
48800 IF (RVCOMP + 445.05) 28800,18800,48801 02270097
48801 IF (RVCOMP + 444.95) 18800,18800,28800 02280097
18800 IVPASS = IVPASS + 1 02290097
WRITE (I02,80001) IVTNUM 02300097
GO TO 8811 02310097
28800 IVFAIL = IVFAIL + 1 02320097
RVCORR = -445.00 02330097
WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 02340097
8811 CONTINUE 02350097
IVTNUM = 881 02360097
C 02370097
C **** TEST 881 **** 02380097
C 02390097
IF (ICZERO) 38810, 8810, 38810 02400097
8810 CONTINUE 02410097
RVON01 = 466.01 02420097
RVCOMP = AINT (RVON01) 02430097
GO TO 48810 02440097
38810 IVDELE = IVDELE + 1 02450097
WRITE (I02,80003) IVTNUM 02460097
IF (ICZERO) 48810, 8821, 48810 02470097
48810 IF (RVCOMP - 465.95) 28810,18810,48811 02480097
48811 IF (RVCOMP - 466.05) 18810,18810,28810 02490097
18810 IVPASS = IVPASS + 1 02500097
WRITE (I02,80001) IVTNUM 02510097
GO TO 8821 02520097
28810 IVFAIL = IVFAIL + 1 02530097
RVCOMP = 466.00 02540097
WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 02550097
8821 CONTINUE 02560097
IVTNUM = 882 02570097
C 02580097
C **** TEST 882 **** 02590097
C 02600097
IF (ICZERO) 38820, 8820, 38820 02610097
8820 CONTINUE 02620097
RVON01 = 382E-1 02630097
RVCOMP = AINT (RVON01) 02640097
GO TO 48820 02650097
38820 IVDELE = IVDELE + 1 02660097
WRITE (I02,80003) IVTNUM 02670097
IF (ICZERO) 48820, 8831, 48820 02680097
48820 IF (RVCOMP - 37.995) 28820,18820,48821 02690097
48821 IF (RVCOMP - 38.005) 18820,18820,28820 02700097
18820 IVPASS = IVPASS + 1 02710097
WRITE (I02,80001) IVTNUM 02720097
GO TO 8831 02730097
28820 IVFAIL = IVFAIL + 1 02740097
RVCORR = 38.000 02750097
WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 02760097
8831 CONTINUE 02770097
C 02780097
C TEST 883 THROUGH 886 CONTAIN INTRINSIC FUNCTION TESTS FOR 02790097
C REMAINDERING WHERE ARGUMENT AND FUNCTION ARE REAL 02800097
C 02810097
IVTNUM = 883 02820097
C 02830097
C **** TEST 883 **** 02840097
C 02850097
IF (ICZERO) 38830, 8830, 38830 02860097
8830 CONTINUE 02870097
RVCOMP = AMOD (42.0,19.0) 02880097
GO TO 48830 02890097
38830 IVDELE = IVDELE + 1 02900097
WRITE (I02,80003) IVTNUM 02910097
IF (ICZERO) 48830, 8841, 48830 02920097
48830 IF (RVCOMP - 3.9995) 28830,18830,48831 02930097
48831 IF (RVCOMP - 4.0005) 18830,18830,28830 02940097
18830 IVPASS = IVPASS + 1 02950097
WRITE (I02,80001) IVTNUM 02960097
GO TO 8841 02970097
28830 IVFAIL = IVFAIL + 1 02980097
RVCORR = 4.0000 02990097
WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 03000097
8841 CONTINUE 03010097
IVTNUM = 884 03020097
C 03030097
C **** TEST 884 **** 03040097
C 03050097
IF (ICZERO) 38840, 8840, 38840 03060097
8840 CONTINUE 03070097
RVON01 = 16.27 03080097
RVON02 = 2.0 03090097
RVCOMP = AMOD (RVON01,RVON02) 03100097
GO TO 48840 03110097
38840 IVDELE = IVDELE + 1 03120097
WRITE (I02,80003) IVTNUM 03130097
IF (ICZERO) 48840, 8851, 48840 03140097
48840 IF (RVCOMP - .26995) 28840,18840,48841 03150097
48841 IF (RVCOMP - .27005) 18840,18840,28840 03160097
18840 IVPASS = IVPASS + 1 03170097
WRITE (I02,80001) IVTNUM 03180097
GO TO 8851 03190097
28840 IVFAIL = IVFAIL + 1 03200097
RVCORR = .27000 03210097
WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 03220097
8851 CONTINUE 03230097
IVTNUM = 885 03240097
C 03250097
C **** TEST 885 **** 03260097
C 03270097
IF (ICZERO) 38850, 8850, 38850 03280097
8850 CONTINUE 03290097
RVON01 = 225.0 03300097
RVON02 = 5.0E1 03310097
RVCOMP = AMOD (RVON01,RVON02) 03320097
GO TO 48850 03330097
38850 IVDELE = IVDELE + 1 03340097
WRITE (I02,80003) IVTNUM 03350097
IF (ICZERO) 48850, 8861, 48850 03360097
48850 IF (RVCOMP - 24.995) 28850,18850,48851 03370097
48851 IF (RVCOMP - 25.005) 18850,18850,28850 03380097
18850 IVPASS = IVPASS + 1 03390097
WRITE (I02,80001) IVTNUM 03400097
GO TO 8861 03410097
28850 IVFAIL = IVFAIL + 1 03420097
RVCORR = 25.000 03430097
WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 03440097
8861 CONTINUE 03450097
IVTNUM = 886 03460097
C 03470097
C **** TEST 886 **** 03480097
C 03490097
IF (ICZERO) 38860, 8860, 38860 03500097
8860 CONTINUE 03510097
RVON01 = -0.390E+2 03520097
RVON02 = 5E2 03530097
RVCOMP = AMOD (RVON01,RVON02) 03540097
GO TO 48860 03550097
38860 IVDELE = IVDELE + 1 03560097
WRITE (I02,80003) IVTNUM 03570097
IF (ICZERO) 48860, 8871, 48860 03580097
48860 IF (RVCOMP + 39.005) 28860,18860,48861 03590097
48861 IF (RVCOMP + 38.995) 18860,18860,28860 03600097
18860 IVPASS = IVPASS + 1 03610097
WRITE (I02,80001) IVTNUM 03620097
GO TO 8871 03630097
28860 IVFAIL = IVFAIL + 1 03640097
RVCORR = -39.000 03650097
WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 03660097
8871 CONTINUE 03670097
C 03680097
C TEST 887 AND 888 CONTAIN INTRINSIC FUNCTION TESTS FOR CHOOSING 03690097
C LARGEST VALUE WHERE ARGUMENTS ARE INTEGER AND FUNCTION IS REAL 03700097
C 03710097
IVTNUM = 887 03720097
C 03730097
C **** TEST 887 **** 03740097
C 03750097
IF (ICZERO) 38870, 8870, 38870 03760097
8870 CONTINUE 03770097
IVON01 = 317 03780097
IVON02 = -99 03790097
IVON03 = 1 03800097
RVCOMP = AMAX0 (263,IVON01,IVON02,IVON03) 03810097
GO TO 48870 03820097
38870 IVDELE = IVDELE + 1 03830097
WRITE (I02,80003) IVTNUM 03840097
IF (ICZERO) 48870, 8881, 48870 03850097
48870 IF (RVCOMP - 316.95) 28870,18870,48871 03860097
48871 IF (RVCOMP - 317.05) 18870,18870,28870 03870097
18870 IVPASS = IVPASS + 1 03880097
WRITE (I02,80001) IVTNUM 03890097
GO TO 8881 03900097
28870 IVFAIL = IVFAIL + 1 03910097
RVCORR = 317.00 03920097
WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 03930097
8881 CONTINUE 03940097
IVTNUM = 888 03950097
C 03960097
C **** TEST 888 **** 03970097
C 03980097
IF (ICZERO) 38880, 8880, 38880 03990097
8880 CONTINUE 04000097
IVON01 = 2572 04010097
IVON02 = 2570 04020097
RVCOMP = AMAX0 (IVON01,IVON02) 04030097
GO TO 48880 04040097
38880 IVDELE = IVDELE + 1 04050097
WRITE (I02,80003) IVTNUM 04060097
IF (ICZERO) 48880, 8891, 48880 04070097
48880 IF (RVCOMP - 2571.5) 28880,18880,48881 04080097
48881 IF (RVCOMP - 2572.5) 18880,18880,28880 04090097
18880 IVPASS = IVPASS + 1 04100097
WRITE (I02,80001) IVTNUM 04110097
GO TO 8891 04120097
28880 IVFAIL = IVFAIL + 1 04130097
RVCORR = 2572.0 04140097
WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 04150097
8891 CONTINUE 04160097
C 04170097
C TEST 889 AND 890 CONTAIN INTRINSIC FUNCTION TESTS FOR CHOOSING 04180097
C LARGEST VALUE WHERE THE ARGUMENTS AND FUNCTION ARE REAL 04190097
C 04200097
IVTNUM = 889 04210097
C 04220097
C **** TEST 889 **** 04230097
C 04240097
IF (ICZERO) 38890, 8890, 38890 04250097
8890 CONTINUE 04260097
RVON01 = .326E+2 04270097
RVON02 = 22.075 04280097
RVON03 = 76E-1 04290097
RVCOMP = AMAX1 (RVON01,RVON02,RVON03) 04300097
GO TO 48890 04310097
38890 IVDELE = IVDELE + 1 04320097
WRITE (I02,80003) IVTNUM 04330097
IF (ICZERO) 48890, 8901, 48890 04340097
48890 IF (RVCOMP - 32.595) 28890,18890,48891 04350097
48891 IF (RVCOMP - 32.605) 18890,18890,28890 04360097
18890 IVPASS = IVPASS + 1 04370097
WRITE (I02,80001) IVTNUM 04380097
GO TO 8901 04390097
28890 IVFAIL = IVFAIL + 1 04400097
RVCORR = 32.600 04410097
WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 04420097
8901 CONTINUE 04430097
IVTNUM = 890 04440097
C 04450097
C **** TEST 890 **** 04460097
C 04470097
IF (ICZERO) 38900, 8900, 38900 04480097
8900 CONTINUE 04490097
RVON01 = -6.3E2 04500097
RVON02 = -21.0 04510097
RVCOMP = AMAX1 (-463.3,RVON01,RVON02) 04520097
GO TO 48900 04530097
38900 IVDELE = IVDELE + 1 04540097
WRITE (I02,80003) IVTNUM 04550097
IF (ICZERO) 48900, 8911, 48900 04560097
48900 IF (RVCOMP + 21.005) 28900,18900,48901 04570097
48901 IF (RVCOMP + 20.995) 18900,18900,28900 04580097
18900 IVPASS = IVPASS + 1 04590097
WRITE (I02,80001) IVTNUM 04600097
GO TO 8911 04610097
28900 IVFAIL = IVFAIL + 1 04620097
RVCORR = -21.000 04630097
WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 04640097
8911 CONTINUE 04650097
C 04660097
C TESTS 891 AND 892 CONTAIN INTRINSIC FUNCTION TESTS FOR CHOOSING 04670097
C SMALLEST VALUE WHERE ARGUMENTS ARE INTEGER AND FUNCTION IS REAL 04680097
C 04690097
IVTNUM = 891 04700097
C 04710097
C **** TEST 891 **** 04720097
C 04730097
IF (ICZERO) 38910, 8910, 38910 04740097
8910 CONTINUE 04750097
IVON01 = -75 04760097
IVON02 = -243 04770097
RVCOMP = AMIN0 (IVON01,IVON02) 04780097
GO TO 48910 04790097
38910 IVDELE = IVDELE + 1 04800097
WRITE (I02,80003) IVTNUM 04810097
IF (ICZERO) 48910, 8921, 48910 04820097
48910 IF (RVCOMP + 243.05) 28910,18910,48911 04830097
48911 IF (RVCOMP + 242.95) 18910,18910,28910 04840097
18910 IVPASS = IVPASS + 1 04850097
WRITE (I02,80001) IVTNUM 04860097
GO TO 8921 04870097
28910 IVFAIL = IVFAIL + 1 04880097
RVCORR = -243.00 04890097
WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 04900097
8921 CONTINUE 04910097
IVTNUM = 892 04920097
C 04930097
C **** TEST 892 **** 04940097
C 04950097
IF (ICZERO) 38920, 8920, 38920 04960097
8920 CONTINUE 04970097
IVON01 = -11 04980097
IVON02 = 11 04990097
RVCOMP = AMIN0 (0,IVON01,IVON02) 05000097
GO TO 48920 05010097
38920 IVDELE = IVDELE + 1 05020097
WRITE (I02,80003) IVTNUM 05030097
IF (ICZERO) 48920, 8931, 48920 05040097
48920 IF (RVCOMP + 11.005) 28920,18920,48921 05050097
48921 IF (RVCOMP + 10.995) 18920,18920,28920 05060097
18920 IVPASS = IVPASS + 1 05070097
WRITE (I02,80001) IVTNUM 05080097
GO TO 8931 05090097
28920 IVFAIL = IVFAIL + 1 05100097
RVCORR = -11.000 05110097
WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 05120097
8931 CONTINUE 05130097
C 05140097
C TESTS 893 AND 894 CONTAIN INTRINSIC FUNCTION TESTS FOR CHOOSING 05150097
C SMALLEST VALUE WHERE ARGUMENTS AND FUNCTION ARE REAL 05160097
C 05170097
IVTNUM = 893 05180097
C 05190097
C **** TEST 893 **** 05200097
C 05210097
IF (ICZERO) 38930, 8930, 38930 05220097
8930 CONTINUE 05230097
RVON01 = 1.1111 05240097
RVON02 = 22.222 05250097
RVON03 = 333.33 05260097
RVCOMP = AMIN1 (RVON01,RVON02,RVON03) 05270097
GO TO 48930 05280097
38930 IVDELE = IVDELE + 1 05290097
WRITE (I02,80003) IVTNUM 05300097
IF (ICZERO) 48930, 8941, 48930 05310097
48930 IF (RVCOMP - 1.1106) 28930,18930,48931 05320097
48931 IF (RVCOMP - 1.1116) 18930,18930,28930 05330097
18930 IVPASS = IVPASS + 1 05340097
WRITE (I02,80001) IVTNUM 05350097
GO TO 8941 05360097
28930 IVFAIL = IVFAIL + 1 05370097
RVCORR = 1.1111 05380097
WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 05390097
8941 CONTINUE 05400097
IVTNUM = 894 05410097
C 05420097
C **** TEST 894 **** 05430097
C 05440097
IF (ICZERO) 38940, 8940, 38940 05450097
8940 CONTINUE 05460097
RVON01 = 28.8 05470097
RVON02 = 2.88E1 05480097
RVON03 = 288E-1 05490097
RVON04 = 35.0 05500097
RVCOMP = AMIN1 (RVON01,RVON02,RVON03,RVON04) 05510097
GO TO 48940 05520097
38940 IVDELE = IVDELE + 1 05530097
WRITE (I02,80003) IVTNUM 05540097
IF (ICZERO) 48940, 8951, 48940 05550097
48940 IF (RVCOMP - 28.795) 28940,18940,48941 05560097
48941 IF (RVCOMP - 28.805) 18940,18940,28940 05570097
18940 IVPASS = IVPASS + 1 05580097
WRITE (I02,80001) IVTNUM 05590097
GO TO 8951 05600097
28940 IVFAIL = IVFAIL + 1 05610097
RVCORR = 28.800 05620097
WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 05630097
8951 CONTINUE 05640097
C 05650097
C TEST 895 THROUGH TEST 897 CONTAIN INTRINSIC FUNCTION TESTS FOR 05660097
C FLOAT - CONVERSION OF AN INTEGER ARGUMENT TO REAL FUNCTION 05670097
C 05680097
IVTNUM = 895 05690097
C 05700097
C **** TEST 895 **** 05710097
C 05720097
IF (ICZERO) 38950, 8950, 38950 05730097
8950 CONTINUE 05740097
RVCOMP = FLOAT (-606) 05750097
GO TO 48950 05760097
38950 IVDELE = IVDELE + 1 05770097
WRITE (I02,80003) IVTNUM 05780097
IF (ICZERO) 48950, 8961, 48950 05790097
48950 IF (RVCOMP + 606.05) 28950,18950,48951 05800097
48951 IF (RVCOMP + 605.95) 18950,18950,28950 05810097
18950 IVPASS = IVPASS + 1 05820097
WRITE (I02,80001) IVTNUM 05830097
GO TO 8961 05840097
28950 IVFAIL = IVFAIL + 1 05850097
RVCORR = -606.00 05860097
WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 05870097
8961 CONTINUE 05880097
IVTNUM = 896 05890097
C 05900097
C **** TEST 896 **** 05910097
C 05920097
IF (ICZERO) 38960, 8960, 38960 05930097
8960 CONTINUE 05940097
IVON01 = 71 05950097
RVCOMP = FLOAT (IVON01) 05960097
GO TO 48960 05970097
38960 IVDELE = IVDELE + 1 05980097
WRITE (I02,80003) IVTNUM 05990097
IF (ICZERO) 48960, 8971, 48960 06000097
48960 IF (RVCOMP - 70.995) 28960,18960,48961 06010097
48961 IF (RVCOMP - 71.005) 18960,18960,28960 06020097
18960 IVPASS = IVPASS + 1 06030097
WRITE (I02,80001) IVTNUM 06040097
GO TO 8971 06050097
28960 IVFAIL = IVFAIL + 1 06060097
RVCORR = 71.000 06070097
WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 06080097
8971 CONTINUE 06090097
IVTNUM = 897 06100097
C 06110097
C **** TEST 897 **** 06120097
C 06130097
IF (ICZERO) 38970, 8970, 38970 06140097
8970 CONTINUE 06150097
IVON01 = 321 06160097
RVCOMP = FLOAT (-IVON01) 06170097
GO TO 48970 06180097
38970 IVDELE = IVDELE + 1 06190097
WRITE (I02,80003) IVTNUM 06200097
IF (ICZERO) 48970, 8981, 48970 06210097
48970 IF (RVCOMP + 321.05) 28970,18970,48971 06220097
48971 IF (RVCOMP + 320.95) 18970,18970,28970 06230097
18970 IVPASS = IVPASS + 1 06240097
WRITE (I02,80001) IVTNUM 06250097
GO TO 8981 06260097
28970 IVFAIL = IVFAIL + 1 06270097
RVCORR = -321.00 06280097
WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 06290097
8981 CONTINUE 06300097
C 06310097
C TEST 898 THROUGH TEST 900 CONTAIN INTRINSIC FUNCTION TESTS FOR 06320097
C TRANSFER OF SIGN - BOTH ARGUMENTS AND FUNCTION ARE REAL 06330097
C 06340097
IVTNUM = 898 06350097
C 06360097
C **** TEST 898 **** 06370097
C 06380097
IF (ICZERO) 38980, 8980, 38980 06390097
8980 CONTINUE 06400097
RVON01 = 64.3 06410097
RVCOMP = SIGN (RVON01,-1.0) 06420097
GO TO 48980 06430097
38980 IVDELE = IVDELE + 1 06440097
WRITE (I02,80003) IVTNUM 06450097
IF (ICZERO) 48980, 8991, 48980 06460097
48980 IF (RVCOMP + 64.305) 28980,18980,48981 06470097
48981 IF (RVCOMP + 64.295) 18980,18980,28980 06480097
18980 IVPASS = IVPASS + 1 06490097
WRITE (I02,80001) IVTNUM 06500097
GO TO 8991 06510097
28980 IVFAIL = IVFAIL + 1 06520097
RVCORR = -64.300 06530097
WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 06540097
8991 CONTINUE 06550097
IVTNUM = 899 06560097
C 06570097
C **** TEST 899 **** 06580097
C 06590097
IF (ICZERO) 38990, 8990, 38990 06600097
8990 CONTINUE 06610097
RVON01 = -2.2 06620097
RVON02 = 7.23E1 06630097
RVCOMP = SIGN (RVON01,RVON02) 06640097
GO TO 48990 06650097
38990 IVDELE = IVDELE + 1 06660097
WRITE (I02,80003) IVTNUM 06670097
IF (ICZERO) 48990, 9001, 48990 06680097
48990 IF (RVCOMP - 2.1995) 28990,18990,48991 06690097
48991 IF (RVCOMP - 2.2005) 18990,18990,28990 06700097
18990 IVPASS = IVPASS + 1 06710097
WRITE (I02,80001) IVTNUM 06720097
GO TO 9001 06730097
28990 IVFAIL = IVFAIL + 1 06740097
RVCORR = 2.2000 06750097
WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 06760097
9001 CONTINUE 06770097
IVTNUM = 900 06780097
C 06790097
C **** TEST 900 **** 06800097
C 06810097
IF (ICZERO) 39000, 9000, 39000 06820097
9000 CONTINUE 06830097
RVON01 = 35.32E+1 06840097
RVON02 = 1.0 06850097
RVCOMP = SIGN (RVON01,RVON02) 06860097
GO TO 49000 06870097
39000 IVDELE = IVDELE + 1 06880097
WRITE (I02,80003) IVTNUM 06890097
IF (ICZERO) 49000, 9011, 49000 06900097
49000 IF (RVCOMP - 353.15) 29000,19000,49001 06910097
49001 IF (RVCOMP - 353.25) 19000,19000,29000 06920097
19000 IVPASS = IVPASS + 1 06930097
WRITE (I02,80001) IVTNUM 06940097
GO TO 9011 06950097
29000 IVFAIL = IVFAIL + 1 06960097
RVCORR = 353.20 06970097
WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 06980097
9011 CONTINUE 06990097
C 07000097
C TEST 901 THROUGH TEST 904 CONTAIN INTRINSIC FUNCTION TESTS FOR 07010097
C POSITIVE DIFFERENCE WHERE ARGUMENTS AND FUNCTION ARE REAL 07020097
C 07030097
IVTNUM = 901 07040097
C 07050097
C **** TEST 901 **** 07060097
C 07070097
IF (ICZERO) 39010, 9010, 39010 07080097
9010 CONTINUE 07090097
RVON01 = 22.2 07100097
RVCOMP = DIM (RVON01,1.0) 07110097
GO TO 49010 07120097
39010 IVDELE = IVDELE + 1 07130097
WRITE (I02,80003) IVTNUM 07140097
IF (ICZERO) 49010, 9021, 49010 07150097
49010 IF (RVCOMP - 21.195) 29010,19010,49011 07160097
49011 IF (RVCOMP - 21.205) 19010,19010,29010 07170097
19010 IVPASS = IVPASS + 1 07180097
WRITE (I02,80001) IVTNUM 07190097
GO TO 9021 07200097
29010 IVFAIL = IVFAIL + 1 07210097
RVCORR = 21.200 07220097
WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 07230097
9021 CONTINUE 07240097
IVTNUM = 902 07250097
C 07260097
C **** TEST 902 **** 07270097
C 07280097
IF (ICZERO) 39020, 9020, 39020 07290097
9020 CONTINUE 07300097
RVON01 = 4.5E1 07310097
RVON02 = 41.0 07320097
RVCOMP = DIM (RVON01,RVON02) 07330097
GO TO 49020 07340097
39020 IVDELE = IVDELE + 1 07350097
WRITE (I02,80003) IVTNUM 07360097
IF (ICZERO) 49020, 9031, 49020 07370097
49020 IF (RVCOMP - 3.9995) 29020,19020,49021 07380097
49021 IF (RVCOMP - 4.0005) 19020,19020,29020 07390097
19020 IVPASS = IVPASS + 1 07400097
WRITE (I02,80001) IVTNUM 07410097
GO TO 9031 07420097
29020 IVFAIL = IVFAIL + 1 07430097
RVCORR = 4.0000 07440097
WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 07450097
9031 CONTINUE 07460097
IVTNUM = 903 07470097
C 07480097
C **** TEST 903 **** 07490097
C 07500097
IF (ICZERO) 39030, 9030, 39030 07510097
9030 CONTINUE 07520097
RVON01 = 2.0 07530097
RVON02 = 10.0 07540097
RVCOMP = DIM (RVON01,RVON02) 07550097
GO TO 49030 07560097
39030 IVDELE = IVDELE + 1 07570097
WRITE (I02,80003) IVTNUM 07580097
IF (ICZERO) 49030, 9041, 49030 07590097
49030 IF (RVCOMP) 29030,19030,29030 07600097
19030 IVPASS = IVPASS + 1 07610097
WRITE (I02,80001) IVTNUM 07620097
GO TO 9041 07630097
29030 IVFAIL = IVFAIL + 1 07640097
RVCORR = 0.0000 07650097
WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 07660097
9041 CONTINUE 07670097
IVTNUM = 904 07680097
C 07690097
C **** TEST 904 **** 07700097
C 07710097
IF (ICZERO) 39040, 9040, 39040 07720097
9040 CONTINUE 07730097
RVON01 = 1.65E+1 07740097
RVON02 = -2.0 07750097
RVCOMP = DIM (RVON01,RVON02) 07760097
GO TO 49040 07770097
39040 IVDELE = IVDELE + 1 07780097
WRITE (I02,80003) IVTNUM 07790097
IF (ICZERO) 49040, 9051, 49040 07800097
49040 IF (RVCOMP - 18.495) 29040,19040,49041 07810097
49041 IF (RVCOMP - 18.505) 19040,19040,29040 07820097
19040 IVPASS = IVPASS + 1 07830097
WRITE (I02,80001) IVTNUM 07840097
GO TO 9051 07850097
29040 IVFAIL = IVFAIL + 1 07860097
RVCORR = 18.500 07870097
WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 07880097
9051 CONTINUE 07890097
C 07900097
C TESTS 905 AND 906 CONTAIN EXPRESSIONS CONTAINING MORE THAN ONE 07910097
C INTRINSIC FUNCTION - ALL ARGUMENTS AND FUNCTIONS ARE REAL 07920097
C 07930097
IVTNUM = 905 07940097
C 07950097
C **** TEST 905 **** 07960097
C 07970097
IF (ICZERO) 39050, 9050, 39050 07980097
9050 CONTINUE 07990097
RVON01 = 33.3 08000097
RVON02 = -12.1 08010097
RVCOMP = AINT (RVON01) + ABS (RVON02) 08020097
GO TO 49050 08030097
39050 IVDELE = IVDELE + 1 08040097
WRITE (I02,80003) IVTNUM 08050097
IF (ICZERO) 49050, 9061, 49050 08060097
49050 IF (RVCOMP - 45.095) 29050,19050,49051 08070097
49051 IF (RVCOMP - 45.105) 19050,19050,29050 08080097
19050 IVPASS = IVPASS + 1 08090097
WRITE (I02,80001) IVTNUM 08100097
GO TO 9061 08110097
29050 IVFAIL = IVFAIL + 1 08120097
RVCORR = 45.100 08130097
WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 08140097
9061 CONTINUE 08150097
IVTNUM = 906 08160097
C 08170097
C **** TEST 906 **** 08180097
C 08190097
IF (ICZERO) 39060, 9060, 39060 08200097
9060 CONTINUE 08210097
RVON01 = 76.3 08220097
RVON02 = 2.1E1 08230097
RVON03 = 3E1 08240097
RVCOMP = AMAX1(RVON01,RVON02,RVON03)-AMIN1(RVON01,RVON02,RVON03) 08250097
GO TO 49060 08260097
39060 IVDELE = IVDELE + 1 08270097
WRITE (I02,80003) IVTNUM 08280097
IF (ICZERO) 49060, 9071, 49060 08290097
49060 IF (RVCOMP - 55.295) 29060,19060,49061 08300097
49061 IF (RVCOMP - 55.305) 19060,19060,29060 08310097
19060 IVPASS = IVPASS + 1 08320097
WRITE (I02,80001) IVTNUM 08330097
GO TO 9071 08340097
29060 IVFAIL = IVFAIL + 1 08350097
RVCORR = 55.300 08360097
WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 08370097
9071 CONTINUE 08380097
C 08390097
C WRITE PAGE FOOTINGS AND RUN SUMMARIES 08400097
99999 CONTINUE 08410097
WRITE (I02,90002) 08420097
WRITE (I02,90006) 08430097
WRITE (I02,90002) 08440097
WRITE (I02,90002) 08450097
WRITE (I02,90007) 08460097
WRITE (I02,90002) 08470097
WRITE (I02,90008) IVFAIL 08480097
WRITE (I02,90009) IVPASS 08490097
WRITE (I02,90010) IVDELE 08500097
C 08510097
C 08520097
C TERMINATE ROUTINE EXECUTION 08530097
STOP 08540097
C 08550097
C FORMAT STATEMENTS FOR PAGE HEADERS 08560097
90000 FORMAT ("1") 08570097
90002 FORMAT (" ") 08580097
90001 FORMAT (" ",10X,"FORTRAN COMPILER VALIDATION SYSTEM" ) 08590097
90003 FORMAT (" ",21X,"VERSION 2.1" ) 08600097
90004 FORMAT (" ",10X,"FOR OFFICIAL USE ONLY - COPYRIGHT 1978" ) 08610097
90005 FORMAT (" ",5X,"TEST",5X,"PASS/FAIL", 5X,"COMPUTED",8X,"CORRECT") 08620097
90006 FORMAT (" ",5X,"----------------------------------------------" ) 08630097
90011 FORMAT (" ",18X,"SUBSET LEVEL TEST" ) 08640097
C 08650097
C FORMAT STATEMENTS FOR RUN SUMMARIES 08660097
90008 FORMAT (" ",15X,I5," ERRORS ENCOUNTERED" ) 08670097
90009 FORMAT (" ",15X,I5," TESTS PASSED" ) 08680097
90010 FORMAT (" ",15X,I5," TESTS DELETED" ) 08690097
C 08700097
C FORMAT STATEMENTS FOR TEST RESULTS 08710097
80001 FORMAT (" ",4X,I5,7X,"PASS") 08720097
80002 FORMAT (" ",4X,I5,7X,"FAIL") 08730097
80003 FORMAT (" ",4X,I5,7X,"DELETED") 08740097
80004 FORMAT (" ",4X,I5,7X,"FAIL",10X,I6,9X,I6) 08750097
80005 FORMAT (" ",4X,I5,7X,"FAIL",4X,E12.5,3X,E12.5) 08760097
C 08770097
90007 FORMAT (" ",20X,"END OF PROGRAM FM097" ) 08780097
END 08790097