blob: 1fef3fecfe791265c6a533c857a8df158511bc68 [file] [log] [blame]
PROGRAM FM311 00010311
C 00020311
C 00030311
C THIS ROUTINE TESTS THE USE OF THE FORTRAN IN-LINE STATEMENT 00040311
C FUNCTION OF TYPES INTEGER, REAL AND LOGICAL. SPECIFIC FEATURES 00050311
C TESTED INCLUDE, 00060311
C 00070311
C A) REAL STATEMENT FUNCTIONS USING REAL CONSTANTS AND VARIABLES 00080311
C IN THE EXPRESSION AND AS ACTUAL ARGUMENTS. 00090311
C 00100311
C B) STATEMENT FUNCTIONS WHICH REQUIRE CONVERSION OF THE 00110311
C EXPRESSION TO REAL AND INTEGER TYPING. 00120311
C 00130311
C C) THE USE OF VARIABLES, ARRAY ELEMENTS, EXTERNAL REFERENCES, 00140311
C AND INITIALLY DEFINED ENITIIES IN THE EXPRESSION. 00150311
C 00160311
C D) VARIOUS DEFINITIONS AND USES OF DUMMY ARGUMENTS. 00170311
C 00180311
C E) ACTUAL ARGUMENTS CONSISTING OF EXPRESSIONS, INTRINSIC 00190311
C FUNCTION REFERENCES, AND EXTERNAL FUNCTION REFERENCES. 00200311
C 00210311
C F) CONFIRMING AND OVERRIDING THE TYPING OF STATEMENT FUNCTIONS 00220311
C AND DUMMY ARGUMENTS. 00230311
C 00240311
C G) USE OF STATEMENT FUNCTIONS AND DUMMY ARGUMENTS IN THE MAIN 00250311
C PROGRAM AND IN EXTERNAL FUNCTION AND SUBROUTINE SUBPROGRAMS.00260311
C 00270311
C THE SUBSET LEVEL FEATURES OF STATEMENT FUNCTIONS ARE ALSO TESTED 00280311
C IN ROUTINE FM020. 00290311
C 00300311
C REFERENCES. 00310311
C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN, 00320311
C X3.9-1978 00330311
C 00340311
C SECTION 8.3, COMMON STATEMENT 00350311
C SECTION 8.4, TYPE-STATEMENT 00360311
C SECTION 8.5, IMPLICIT STATEMENT 00370311
C SECTION 8.7, EXTERNAL STATEMENT 00380311
C SECTION 8.8, INTRINSIC STATEMENT 00390311
C SECTION 9, DATA STATEMENT 00400311
C SECTION 15.3, INTRINSIC FUNCTIONS 00410311
C SECTION 15.4, STATEMENT FUNCTION 00420311
C SECTION 15.5, EXTERNAL FUNCTIONS 00430311
C SECTION 15.6, SUBROUTINES 00440311
C SECTION 15.9.1, DUMMY ARGUMENTS 00450311
C SECTION 15.9.2, ACTUAL ARGUMENTS 00460311
C SECTION 15.9.3, ASSOCIATION OF DUMMY AND ACTUAL ARGUMENTS 00470311
C 00480311
C 00490311
C ******************************************************************00500311
C A COMPILER VALIDATION SYSTEM FOR THE FORTRAN LANGUAGE 00510311
C BASED ON SPECIFICATIONS AS DEFINED IN AMERICAN STANDARD FORTRAN 00520311
C X3.9-1978, HAS BEEN DEVELOPED BY THE DEPARTMENT OF THE NAVY. THE 00530311
C FORTRAN COMPILER VALIDATION SYSTEM (FCVS) CONSISTS OF AUDIT 00540311
C ROUTINES, THEIR RELATED DATA, AND AN EXECUTIVE SYSTEM. EACH AUDIT00550311
C ROUTINE IS A FORTRAN PROGRAM OR SUBPROGRAM WHICH INCLUDES TESTS 00560311
C OF SPECIFIC LANGUAGE ELEMENTS AND SUPPORTING PROCEDURES INDICATING00570311
C THE RESULT OF EXECUTING THESE TESTS. 00580311
C 00590311
C THIS PARTICULAR PROGRAM OR SUBPROGRAM CONTAINS ONLY FEATURES 00600311
C FOUND IN THE SUBSET LEVEL OF THE STANDARD. 00610311
C 00620311
C SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO 00630311
C NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY 00640311
C SOFTWARE STANDARDS VALIDATION GROUP 00650311
C BUILDING 225 RM A266 00660311
C GAITHERSBURG, MD 20899 00670311
C ******************************************************************00680311
C 00690311
C 00700311
IMPLICIT LOGICAL (L) 00710311
IMPLICIT CHARACTER*14 (C) 00720311
C 00730311
IMPLICIT INTEGER (A) 00740311
IMPLICIT INTEGER (B) 00750311
IMPLICIT REAL (K) 00760311
IMPLICIT REAL (M) 00770311
REAL NDON01 00780311
INTEGER EDON01 00790311
INTEGER FF312, FF314 00800311
EXTERNAL FF312 00810311
INTRINSIC NINT 00820311
DIMENSION RADN11(4), RADN12(4), RADN13(4) 00830311
DIMENSION IADN11(4), IADN12(4) 00840311
DIMENSION LADN11(4) 00850311
COMMON /IFOS19/IVCN01 00860311
DATA IVOND1/6/ 00870311
C TEST 001 00880311
RFOS01(RDON01) = 3.5 00890311
C TEST 002 00900311
RFOS02(RDON02) = RDON02 00910311
C TEST 003 00920311
RFOS03(RDON03) = RDON03 + 1.0 00930311
C TEST 004 00940311
IFOS01(RDON04) = RDON04 + 1.0 00950311
C TEST 005 00960311
RFOS04(IDON01) = IDON01 + 1 00970311
C TEST 006 00980311
IFOS02(IDON02) = IDON02 + 1.95 00990311
C TEST 007 01000311
IFOS03(IDON03) = IDON03 + IVON01 01010311
C TEST 008 01020311
RFOS05(RDON05) = RDON05 + RVON02 01030311
C TEST 009 01040311
LFOS01(LDON01) = LDON01 .OR. LVON01 01050311
C TEST 010 01060311
IFOS04(IDON04) = IDON04 + IADN11(1) 01070311
C TEST 011 01080311
RFOS06(RDON06) = RDON06 + RADN12(3) 01090311
C TEST 012 01100311
LFOS02(LDON02) = .NOT. LDON02 .AND. LADN11(2) 01110311
C TEST 013 01120311
RFOS07(IDON05) = RADN13(IDON05) 01130311
C TEST 014 01140311
IFOS05(IDON06) = IDON06 + FF312(4) 01150311
C TEST 015 01160311
IFOS06(IDON07) = (IDON07 + 1) 01170311
C TEST 016 01180311
IFOS07(IDON08) = IDON08 + IVOND1 01190311
C TEST 017 01200311
IFOS08(IDON09) = IDON09 + 1 01210311
IFOS09(IDON10) = IFOS08(IDON10) + 1 01220311
C TEST 018 01230311
IFOS10() = IVON02 01240311
C TEST 019 01250311
IFOS11(IDON11,IDON12,IDON13) = IDON11 + IDON12 + IDON13 01260311
C TEST 020 01270311
IFOS12(IDON14) = IDON14 + 1 01280311
IFOS13(IDON14) = IDON14 + 2 01290311
C TEST 021,022,023 01300311
IFOS14(IDON15) = IDON15 + 1 01310311
C TEST 024 01320311
KFOS01(IDON16) = IDON16 + 1.0 01330311
C TEST 025 01340311
AFOS01(RDON07) = RDON07 + 1.0 01350311
C TEST 026 01360311
RFOS08(MDON01) = MDON01 / 5 01370311
C TEST 027 01380311
RFOS09(BDON01) = BDON01 / 5 01390311
C TEST 028 01400311
RFOS10(NDON01) = NDON01 / 5 01410311
C TEST 029 01420311
RFOS11(EDON01) = EDON01 / 5 01430311
C TEST 030 01440311
IFOS15(IVON04) = IVON04 + 1 01450311
C TEST 031 01460311
IFOS16(IDON17) = IDON17 + 1 01470311
C TEST 032 01480311
IFOS17(IDON18) = IDON18 + 1 01490311
C TEST 037 01500311
IFOS19(IDON21) = IDON21 + 1 01510311
C 01520311
C 01530311
C 01540311
C INITIALIZATION SECTION. 01550311
C 01560311
C INITIALIZE CONSTANTS 01570311
C ******************** 01580311
C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER 01590311
I01 = 5 01600311
C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER 01610311
I02 = 6 01620311
C SYSTEM ENVIRONMENT SECTION 01630311
C 01640311
CX010 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-010 CONTROL CARD.01650311
C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 01660311
C (UNIT NUMBER FOR CARD READER). 01670311
CX011 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-011 CONTROL CARD01680311
C THE CX011 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 01690311
C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX010 ABOVE. 01700311
C 01710311
CX020 THIS CARD IS PEPLACED BY CONTENTS OF FEXEC X-020 CONTROL CARD.01720311
C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02 = 6 01730311
C (UNIT NUMBER FOR PRINTER). 01740311
CX021 THIS CARD IS PEPLACED BY CONTENTS OF FEXEC X-021 CONTROL CARD.01750311
C THE CX021 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 01760311
C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX020 ABOVE. 01770311
C 01780311
IVPASS = 0 01790311
IVFAIL = 0 01800311
IVDELE = 0 01810311
ICZERO = 0 01820311
C 01830311
C WRITE OUT PAGE HEADERS 01840311
C 01850311
WRITE (I02,90002) 01860311
WRITE (I02,90006) 01870311
WRITE (I02,90008) 01880311
WRITE (I02,90004) 01890311
WRITE (I02,90010) 01900311
WRITE (I02,90004) 01910311
WRITE (I02,90016) 01920311
WRITE (I02,90001) 01930311
WRITE (I02,90004) 01940311
WRITE (I02,90012) 01950311
WRITE (I02,90014) 01960311
WRITE (I02,90004) 01970311
C 01980311
C 01990311
C TEST 001 THROUGH TEST 003 TEST REAL STATEMENT FUNCTIONS WHERE THE 02000311
C EXPRESSION CONSISTS OF REAL CONSTANTS AND VARIABLES AND THE ACTUAL02010311
C ARGUMENTS ARE EITHER REAL CONSTANTS OR VARIABLES. 02020311
C 02030311
C 02040311
C **** FCVS PROGRAM 311 - TEST 001 **** 02050311
C 02060311
C EXPRESSION CONSISTS OF REAL CONSTANT (NO DUMMY ARGUMENT). 02070311
C 02080311
IVTNUM = 1 02090311
IF (ICZERO) 30010, 0010, 30010 02100311
0010 CONTINUE 02110311
RVCOMP = 0.0 02120311
RVCOMP = RFOS01(1.0) 02130311
RVCORR = 3.5 02140311
40010 IF (RVCOMP - 3.4995) 20010, 10010, 40011 02150311
40011 IF (RVCOMP - 3.5005) 10010, 10010, 20010 02160311
30010 IVDELE = IVDELE + 1 02170311
WRITE (I02,80000) IVTNUM 02180311
IF (ICZERO) 10010, 0021, 20010 02190311
10010 IVPASS = IVPASS + 1 02200311
WRITE (I02,80002) IVTNUM 02210311
GO TO 0021 02220311
20010 IVFAIL = IVFAIL + 1 02230311
WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 02240311
0021 CONTINUE 02250311
C 02260311
C **** FCVS PROGRAM 311 - TEST 002 **** 02270311
C 02280311
C DUMMY ARGUMENT USED IN EXPRESSION AND ACTUAL ARGUMENT IS REAL 02290311
C CONSTANT. 02300311
C 02310311
IVTNUM = 2 02320311
IF (ICZERO) 30020, 0020, 30020 02330311
0020 CONTINUE 02340311
RVCOMP = 0.0 02350311
RVCOMP = RFOS02(1.3333) 02360311
RVCORR = 1.3333 02370311
40020 IF (RVCOMP - 1.3328) 20020, 10020, 40021 02380311
40021 IF (RVCOMP - 1.3338) 10020, 10020, 20020 02390311
30020 IVDELE = IVDELE + 1 02400311
WRITE (I02,80000) IVTNUM 02410311
IF (ICZERO) 10020, 0031, 20020 02420311
10020 IVPASS = IVPASS + 1 02430311
WRITE (I02,80002) IVTNUM 02440311
GO TO 0031 02450311
20020 IVFAIL = IVFAIL + 1 02460311
WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 02470311
0031 CONTINUE 02480311
C 02490311
C **** FCVS PROGRAM 311 - TEST 003 **** 02500311
C 02510311
C DUMMY ARGUMENT USED IN EXPRESSION AND ACTUAL ARGUMENT IS REAL 02520311
C VARIABLE. 02530311
C 02540311
IVTNUM = 3 02550311
IF (ICZERO) 30030, 0030, 30030 02560311
0030 CONTINUE 02570311
RVCOMP = 0.0 02580311
RVON01 = 4.5 02590311
RVCOMP = RFOS03(RVON01) 02600311
RVCORR = 5.5 02610311
40030 IF (RVCOMP - 5.4995) 20030, 10030, 40031 02620311
40031 IF (RVCOMP - 5.5005) 10030, 10030, 20030 02630311
30030 IVDELE = IVDELE + 1 02640311
WRITE (I02,80000) IVTNUM 02650311
IF (ICZERO) 10030, 0041, 20030 02660311
10030 IVPASS = IVPASS + 1 02670311
WRITE (I02,80002) IVTNUM 02680311
GO TO 0041 02690311
20030 IVFAIL = IVFAIL + 1 02700311
WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 02710311
0041 CONTINUE 02720311
C 02730311
C TEST 004 THROUGH TEST 006 TEST STATEMENT FUNCTIONS WHICH REQUIRE 02740311
C TYPE CONVERSION OF THE EXPRESSION. 02750311
C 02760311
C 02770311
C **** FCVS PROGRAM 311 - TEST 004 **** 02780311
C 02790311
C INTEGER STATEMENT FUNCTION WITH REAL EXPRESSION. 02800311
C 02810311
IVTNUM = 4 02820311
IF (ICZERO) 30040, 0040, 30040 02830311
0040 CONTINUE 02840311
IVCOMP = 0 02850311
IVCOMP = IFOS01(2.3) 02860311
IVCORR = 3 02870311
40040 IF (IVCOMP - 3) 20040, 10040, 20040 02880311
30040 IVDELE = IVDELE + 1 02890311
WRITE (I02,80000) IVTNUM 02900311
IF (ICZERO) 10040, 0051, 20040 02910311
10040 IVPASS = IVPASS + 1 02920311
WRITE (I02,80002) IVTNUM 02930311
GO TO 0051 02940311
20040 IVFAIL = IVFAIL + 1 02950311
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 02960311
0051 CONTINUE 02970311
C 02980311
C **** FCVS PROGRAM 311 - TEST 005 **** 02990311
C 03000311
C REAL STATEMENT FUNCTION WITH INTEGER EXPRESSION 03010311
C 03020311
IVTNUM = 5 03030311
IF (ICZERO) 30050, 0050, 30050 03040311
0050 CONTINUE 03050311
RVCOMP = 0.0 03060311
RVCOMP = RFOS04(3) 03070311
RVCORR = 4.0 03080311
40050 IF (RVCOMP - 3.9995) 20050, 10050, 40051 03090311
40051 IF (RVCOMP - 4.0005) 10050, 10050, 20050 03100311
30050 IVDELE = IVDELE + 1 03110311
WRITE (I02,80000) IVTNUM 03120311
IF (ICZERO) 10050, 0061, 20050 03130311
10050 IVPASS = IVPASS + 1 03140311
WRITE (I02,80002) IVTNUM 03150311
GO TO 0061 03160311
20050 IVFAIL = IVFAIL + 1 03170311
WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 03180311
0061 CONTINUE 03190311
C 03200311
C **** FCVS PROGRAM 311 - TEST 006 **** 03210311
C 03220311
C INTEGER STATEMENT FUNCTION WITH EXPRESSION CONSISTING OF INTEGER 03230311
C AND REAL PRIMARIES. 03240311
C 03250311
IVTNUM = 6 03260311
IF (ICZERO) 30060, 0060, 30060 03270311
0060 CONTINUE 03280311
IVCOMP = 0 03290311
IVCOMP = IFOS02(2) 03300311
IVCORR = 3 03310311
40060 IF (IVCOMP - 3) 20060, 10060, 20060 03320311
30060 IVDELE = IVDELE + 1 03330311
WRITE (I02,80000) IVTNUM 03340311
IF (ICZERO) 10060, 0071, 20060 03350311
10060 IVPASS = IVPASS + 1 03360311
WRITE (I02,80002) IVTNUM 03370311
GO TO 0071 03380311
20060 IVFAIL = IVFAIL + 1 03390311
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 03400311
0071 CONTINUE 03410311
C 03420311
C TEST 007 THROUGH TEST 017 TEST THE USAGE OF VARIOUS PRIMARIES 03430311
C IN THE EXPRESSION OF A STATEMENT FUNCTION. 03440311
C 03450311
C 03460311
C **** FCVS PROGRAM 311 - TEST 007 **** 03470311
C 03480311
C USE INTEGER VARIABLE AS PRIMARY 03490311
C 03500311
IVTNUM = 7 03510311
IF (ICZERO) 30070, 0070, 30070 03520311
0070 CONTINUE 03530311
IVCOMP = 0 03540311
IVON01 = 3 03550311
IVCOMP = IFOS03(4) 03560311
IVCORR = 7 03570311
40070 IF (IVCOMP - 7) 20070, 10070, 20070 03580311
30070 IVDELE = IVDELE + 1 03590311
WRITE (I02,80000) IVTNUM 03600311
IF (ICZERO) 10070, 0081, 20070 03610311
10070 IVPASS = IVPASS + 1 03620311
WRITE (I02,80002) IVTNUM 03630311
GO TO 0081 03640311
20070 IVFAIL = IVFAIL + 1 03650311
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 03660311
0081 CONTINUE 03670311
C 03680311
C **** FCVS PROGRAM 311 - TEST 008 **** 03690311
C 03700311
C USE REAL VARIABLE AS PRIMARY. 03710311
C 03720311
IVTNUM = 8 03730311
IF (ICZERO) 30080, 0080, 30080 03740311
0080 CONTINUE 03750311
RVCOMP = 0.0 03760311
RVON02 = 1.5 03770311
RADN11(2) = 1.3 03780311
RVCOMP = RFOS05(RADN11(2)) 03790311
RVCORR = 2.8 03800311
40080 IF (RVCOMP - 2.7995) 20080, 10080, 40081 03810311
40081 IF (RVCOMP - 2.8005) 10080, 10080, 20080 03820311
30080 IVDELE = IVDELE + 1 03830311
WRITE (I02,80000) IVTNUM 03840311
IF (ICZERO) 10080, 0091, 20080 03850311
10080 IVPASS = IVPASS + 1 03860311
WRITE (I02,80002) IVTNUM 03870311
GO TO 0091 03880311
20080 IVFAIL = IVFAIL + 1 03890311
WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 03900311
0091 CONTINUE 03910311
C 03920311
C **** FCVS PROGRAM 311 - TEST 009 **** 03930311
C 03940311
C USE LOGICAL VARIABLE AS PRIMARY. 03950311
C 03960311
IVTNUM = 9 03970311
IF (ICZERO) 30090, 0090, 30090 03980311
0090 CONTINUE 03990311
LVON01 = .TRUE. 04000311
IVCOMP = 0 04010311
IF (LFOS01(.FALSE.)) IVCOMP = 1 04020311
IVCORR = 1 04030311
40090 IF (IVCOMP - 1) 20090, 10090, 20090 04040311
30090 IVDELE = IVDELE + 1 04050311
WRITE (I02,80000) IVTNUM 04060311
IF (ICZERO) 10090, 0101, 20090 04070311
10090 IVPASS = IVPASS + 1 04080311
WRITE (I02,80002) IVTNUM 04090311
GO TO 0101 04100311
20090 IVFAIL = IVFAIL + 1 04110311
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 04120311
0101 CONTINUE 04130311
C 04140311
C **** FCVS PROGRAM 311 - TEST 010 **** 04150311
C 04160311
C USE INTEGER ARRAY ELEMENT NAME AS PRIMARY. 04170311
C 04180311
IVTNUM = 10 04190311
IF (ICZERO) 30100, 0100, 30100 04200311
0100 CONTINUE 04210311
IVCOMP = 0 04220311
IADN11(1) = 7 04230311
IVCOMP = IFOS04(-4) 04240311
IVCORR = 3 04250311
40100 IF (IVCOMP - 3) 20100, 10100, 20100 04260311
30100 IVDELE = IVDELE + 1 04270311
WRITE (I02,80000) IVTNUM 04280311
IF (ICZERO) 10100, 0111, 20100 04290311
10100 IVPASS = IVPASS + 1 04300311
WRITE (I02,80002) IVTNUM 04310311
GO TO 0111 04320311
20100 IVFAIL = IVFAIL + 1 04330311
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 04340311
0111 CONTINUE 04350311
C 04360311
C **** FCVS PROGRAM 311 - TEST 011 **** 04370311
C 04380311
C USE REAL ARRAY ELEMENT NAME AS PRIMARY. 04390311
C 04400311
IVTNUM = 11 04410311
IF (ICZERO) 30110, 0110, 30110 04420311
0110 CONTINUE 04430311
RVCOMP = 0.0 04440311
RADN12(3) = 1.23 04450311
RVCOMP = RFOS06(3.0) 04460311
RVCORR = 4.23 04470311
40110 IF (RVCOMP - 4.2295) 20110, 10110, 40111 04480311
40111 IF (RVCOMP - 4.2305) 10110, 10110, 20110 04490311
30110 IVDELE = IVDELE + 1 04500311
WRITE (I02,80000) IVTNUM 04510311
IF (ICZERO) 10110, 0121, 20110 04520311
10110 IVPASS = IVPASS + 1 04530311
WRITE (I02,80002) IVTNUM 04540311
GO TO 0121 04550311
20110 IVFAIL = IVFAIL + 1 04560311
WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 04570311
0121 CONTINUE 04580311
C 04590311
C **** FCVS PROGRAM 311 - TEST 012 **** 04600311
C 04610311
C USE LOGICAL ARRAY ELEMENT NAME AS PRIMARY. 04620311
C 04630311
IVTNUM = 12 04640311
IF (ICZERO) 30120, 0120, 30120 04650311
0120 CONTINUE 04660311
LADN11(2) = .TRUE. 04670311
IVCOMP = 0 04680311
IF (LFOS02(.FALSE.)) IVCOMP = 1 04690311
IVCORR = 1 04700311
40120 IF (IVCOMP - 1) 20120, 10120, 20120 04710311
30120 IVDELE = IVDELE + 1 04720311
WRITE (I02,80000) IVTNUM 04730311
IF (ICZERO) 10120, 0131, 20120 04740311
10120 IVPASS = IVPASS + 1 04750311
WRITE (I02,80002) IVTNUM 04760311
GO TO 0131 04770311
20120 IVFAIL = IVFAIL + 1 04780311
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 04790311
0131 CONTINUE 04800311
C 04810311
C **** FCVS PROGRAM 311 - TEST 013 **** 04820311
C 04830311
C USE A REAL ARRAY ELEMENT NAME AS PRIMARY WHERE THE SUBSCRIPT 04840311
C VALUE IS THE DUMMY ARGUMENT NAME. 04850311
C 04860311
IVTNUM = 13 04870311
IF (ICZERO) 30130, 0130, 30130 04880311
0130 CONTINUE 04890311
RVCOMP = 0.0 04900311
RADN13(4) = 13.4 04910311
RVCOMP = RFOS07(4) 04920311
RVCORR = 13.4 04930311
40130 IF (RVCOMP - 13.395) 20130, 10130, 40131 04940311
40131 IF (RVCOMP - 13.405) 10130, 10130, 20130 04950311
30130 IVDELE = IVDELE + 1 04960311
WRITE (I02,80000) IVTNUM 04970311
IF (ICZERO) 10130, 0141, 20130 04980311
10130 IVPASS = IVPASS + 1 04990311
WRITE (I02,80002) IVTNUM 05000311
GO TO 0141 05010311
20130 IVFAIL = IVFAIL + 1 05020311
WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 05030311
0141 CONTINUE 05040311
C 05050311
C **** FCVS PROGRAM 311 - TEST 014 **** 05060311
C 05070311
C USE EXTERNAL FUNCTION REFERENCE AS PRIMARY. 05080311
C 05090311
IVTNUM = 14 05100311
IF (ICZERO) 30140, 0140, 30140 05110311
0140 CONTINUE 05120311
IVCOMP = 0 05130311
IVCOMP = IFOS05(6) 05140311
IVCORR = 11 05150311
40140 IF (IVCOMP - 11) 20140, 10140, 20140 05160311
30140 IVDELE = IVDELE + 1 05170311
WRITE (I02,80000) IVTNUM 05180311
IF (ICZERO) 10140, 0151, 20140 05190311
10140 IVPASS = IVPASS + 1 05200311
WRITE (I02,80002) IVTNUM 05210311
GO TO 0151 05220311
20140 IVFAIL = IVFAIL + 1 05230311
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 05240311
0151 CONTINUE 05250311
C 05260311
C **** FCVS PROGRAM 311 - TEST 015 **** 05270311
C 05280311
C USE EXPRESSION ENCLOSED IN PARENTHESES. 05290311
C 05300311
IVTNUM = 15 05310311
IF (ICZERO) 30150, 0150, 30150 05320311
0150 CONTINUE 05330311
IVCOMP = 0 05340311
IVCOMP = IFOS06(4) 05350311
IVCORR = 5 05360311
40150 IF (IVCOMP - 5) 20150, 10150, 20150 05370311
30150 IVDELE = IVDELE + 1 05380311
WRITE (I02,80000) IVTNUM 05390311
IF (ICZERO) 10150, 0161, 20150 05400311
10150 IVPASS = IVPASS + 1 05410311
WRITE (I02,80002) IVTNUM 05420311
GO TO 0161 05430311
20150 IVFAIL = IVFAIL + 1 05440311
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 05450311
0161 CONTINUE 05460311
C 05470311
C **** FCVS PROGRAM 311 - TEST 016 **** 05480311
C 05490311
C USE VARIABLE INITIALLY DEFINED IN DATA STATEMENT AS PRIMARY. 05500311
C 05510311
IVTNUM = 16 05520311
IF (ICZERO) 30160, 0160, 30160 05530311
0160 CONTINUE 05540311
IVCOMP = 0 05550311
IVCOMP = IFOS07(3) 05560311
IVCORR = 9 05570311
40160 IF (IVCOMP - 9) 20160, 10160, 20160 05580311
30160 IVDELE = IVDELE + 1 05590311
WRITE (I02,80000) IVTNUM 05600311
IF (ICZERO) 10160, 0171, 20160 05610311
10160 IVPASS = IVPASS + 1 05620311
WRITE (I02,80002) IVTNUM 05630311
GO TO 0171 05640311
20160 IVFAIL = IVFAIL + 1 05650311
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 05660311
0171 CONTINUE 05670311
C 05680311
C **** FCVS PROGRAM 311 - TEST 017 **** 05690311
C 05700311
C USE PREVIOUSLY DEFINED STATEMENT FUNCTION REFERENCE AS PRIMARY. 05710311
C 05720311
IVTNUM = 17 05730311
IF (ICZERO) 30170, 0170, 30170 05740311
0170 CONTINUE 05750311
IVCOMP = 0 05760311
IVCOMP = IFOS09(3) 05770311
IVCORR = 5 05780311
40170 IF (IVCOMP - 5) 20170, 10170, 20170 05790311
30170 IVDELE = IVDELE + 1 05800311
WRITE (I02,80000) IVTNUM 05810311
IF (ICZERO) 10170, 0181, 20170 05820311
10170 IVPASS = IVPASS + 1 05830311
WRITE (I02,80002) IVTNUM 05840311
GO TO 0181 05850311
20170 IVFAIL = IVFAIL + 1 05860311
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 05870311
0181 CONTINUE 05880311
C 05890311
C TEST 018 THROUGH TEST 020 APPLY TO THE DEFINITION OF THE 05900311
C STATEMENT FUNCTION DUMMY ARGUMENTS. 05910311
C 05920311
C 05930311
C **** FCVS PROGRAM 311 - TEST 018 **** 05940311
C 05950311
C DEFINE STATEMENT FUNCTION WITH NO DUMMY ARGUMENTS. 05960311
C 05970311
IVTNUM = 18 05980311
IF (ICZERO) 30180, 0180, 30180 05990311
0180 CONTINUE 06000311
IVCOMP = 0 06010311
IVON02 = 4 06020311
IVCOMP = IFOS10() 06030311
IVCORR = 4 06040311
40180 IF (IVCOMP - 4) 20180, 10180, 20180 06050311
30180 IVDELE = IVDELE + 1 06060311
WRITE (I02,80000) IVTNUM 06070311
IF (ICZERO) 10180, 0191, 20180 06080311
10180 IVPASS = IVPASS + 1 06090311
WRITE (I02,80002) IVTNUM 06100311
GO TO 0191 06110311
20180 IVFAIL = IVFAIL + 1 06120311
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 06130311
0191 CONTINUE 06140311
C 06150311
C **** FCVS PROGRAM 311 - TEST 019 **** 06160311
C 06170311
C DEFINE STATEMENT FUNCTION WITH THREE DUMMY ARGUMENTS. 06180311
C 06190311
IVTNUM = 19 06200311
IF (ICZERO) 30190, 0190, 30190 06210311
0190 CONTINUE 06220311
IVCOMP = 0 06230311
IVCOMP = IFOS11(1,2,3) 06240311
IVCORR = 6 06250311
40190 IF (IVCOMP - 6) 20190, 10190, 20190 06260311
30190 IVDELE = IVDELE + 1 06270311
WRITE (I02,80000) IVTNUM 06280311
IF (ICZERO) 10190, 0201, 20190 06290311
10190 IVPASS = IVPASS + 1 06300311
WRITE (I02,80002) IVTNUM 06310311
GO TO 0201 06320311
20190 IVFAIL = IVFAIL + 1 06330311
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 06340311
0201 CONTINUE 06350311
C 06360311
C **** FCVS PROGRAM 311 - TEST 020 **** 06370311
C 06380311
C USE THE SAME DUMMY ARGUMENT NAME IN TWO DIFFERENT 06390311
C STATEMENT FUNCTIONS. 06400311
C 06410311
IVTNUM = 20 06420311
IF (ICZERO) 30200, 0200, 30200 06430311
0200 CONTINUE 06440311
IVCOMP = 1 06450311
IF (IFOS12(3) .EQ. 4) IVCOMP = IVCOMP * 2 06460311
IF (IFOS13(4) .EQ. 6) IVCOMP = IVCOMP * 3 06470311
IVCORR = 6 06480311
C 6 = 2 * 3 06490311
40200 IF (IVCOMP - 6) 20200, 10200, 20200 06500311
30200 IVDELE = IVDELE + 1 06510311
WRITE (I02,80000) IVTNUM 06520311
IF (ICZERO) 10200, 0211, 20200 06530311
10200 IVPASS = IVPASS + 1 06540311
WRITE (I02,80002) IVTNUM 06550311
GO TO 0211 06560311
20200 IVFAIL = IVFAIL + 1 06570311
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 06580311
0211 CONTINUE 06590311
C 06600311
C TEST 021 THROUGH TEST 022 TEST THE USAGE OF DIFFERENT TYPES OF 06610311
C ACTUAL ARGUMENTS IN A STATEMENT FUNCTION REFERENCE. 06620311
C 06630311
C 06640311
C **** FCVS PROGRAM 311 - TEST 021 **** 06650311
C 06660311
C USE AN EXPRESSION WITH OPERATORS AS AN ACTUAL ARGUMENT. 06670311
C 06680311
IVTNUM = 21 06690311
IF (ICZERO) 30210, 0210, 30210 06700311
0210 CONTINUE 06710311
IVCOMP = 0 06720311
IVON03 = 4 06730311
IVCOMP = IFOS14(IVON03 * 4 + 1) 06740311
IVCORR = 18 06750311
40210 IF (IVCOMP - 18) 20210, 10210, 20210 06760311
30210 IVDELE = IVDELE + 1 06770311
WRITE (I02,80000) IVTNUM 06780311
IF (ICZERO) 10210, 0221, 20210 06790311
10210 IVPASS = IVPASS + 1 06800311
WRITE (I02,80002) IVTNUM 06810311
GO TO 0221 06820311
20210 IVFAIL = IVFAIL + 1 06830311
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 06840311
0221 CONTINUE 06850311
C 06860311
C **** FCVS PROGRAM 311 - TEST 022 **** 06870311
C 06880311
C USE AN INTRINSIC FUNCTION REFERENCE AS AN ACTUAL ARGUMENT. 06890311
C 06900311
IVTNUM = 22 06910311
IF (ICZERO) 30220, 0220, 30220 06920311
0220 CONTINUE 06930311
IVCOMP = 0 06940311
RVON01 = 1.75 06950311
IVCOMP = IFOS14(NINT(RVON01)) 06960311
IVCORR = 3 06970311
40220 IF (IVCOMP - 3) 20220, 10220, 20220 06980311
30220 IVDELE = IVDELE + 1 06990311
WRITE (I02,80000) IVTNUM 07000311
IF (ICZERO) 10220, 0231, 20220 07010311
10220 IVPASS = IVPASS + 1 07020311
WRITE (I02,80002) IVTNUM 07030311
GO TO 0231 07040311
20220 IVFAIL = IVFAIL + 1 07050311
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 07060311
0231 CONTINUE 07070311
C 07080311
C **** FCVS PROGRAM 311 - TEST 023 **** 07090311
C 07100311
C USE AN EXTERNAL FUNCTION REFERENCE AS AN ACTUAL ARGUMENT. 07110311
C 07120311
IVTNUM = 23 07130311
IF (ICZERO) 30230, 0230, 30230 07140311
0230 CONTINUE 07150311
IVCOMP = 0 07160311
IVCOMP = IFOS14(FF312(5)) 07170311
IVCORR = 7 07180311
40230 IF (IVCOMP - 7) 20230, 10230, 20230 07190311
30230 IVDELE = IVDELE + 1 07200311
WRITE (I02,80000) IVTNUM 07210311
IF (ICZERO) 10230, 0241, 20230 07220311
10230 IVPASS = IVPASS + 1 07230311
WRITE (I02,80002) IVTNUM 07240311
GO TO 0241 07250311
20230 IVFAIL = IVFAIL + 1 07260311
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 07270311
0241 CONTINUE 07280311
C 07290311
C TEST 024 THROUGH TEST 029 APPLY TO THE TYPING OF STATEMENT 07300311
C FUNCTIONS AND THE ASSOCIATED DUMMY ARGUMENT NAMES. 07310311
C 07320311
C 07330311
C **** FCVS PROGRAM 311 - TEST 024 **** 07340311
C 07350311
C OVERRIDE THE INTEGER DEFAULT TYPING OF A STATEMENT FUNCTION WITH 07360311
C THE IMPLICIT STATEMENT TYPING OF REAL. 07370311
C 07380311
IVTNUM = 24 07390311
IF (ICZERO) 30240, 0240, 30240 07400311
0240 CONTINUE 07410311
RVCOMP = 10.0 07420311
RVCOMP = KFOS01(3) / 5 07430311
RVCORR = 0.8 07440311
40240 IF (RVCOMP - .79995) 20240, 10240, 40241 07450311
40241 IF (RVCOMP - .80005) 10240, 10240, 20240 07460311
30240 IVDELE = IVDELE + 1 07470311
WRITE (I02,80000) IVTNUM 07480311
IF (ICZERO) 10240, 0251, 20240 07490311
10240 IVPASS = IVPASS + 1 07500311
WRITE (I02,80002) IVTNUM 07510311
GO TO 0251 07520311
20240 IVFAIL = IVFAIL + 1 07530311
WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 07540311
0251 CONTINUE 07550311
C 07560311
C **** FCVS PROGRAM 311 - TEST 025 **** 07570311
C 07580311
C OVERRIDE THE REAL DEFAULT TYPING OF A STATEMENT FUNCTION WITH 07590311
C THE IMPLICIT STATEMENT TYPING OF INTEGER. 07600311
C 07610311
IVTNUM = 25 07620311
IF (ICZERO) 30250, 0250, 30250 07630311
0250 CONTINUE 07640311
RVCOMP = 10.0 07650311
RVCOMP = AFOS01(3.0) / 5 07660311
RVCORR = 0.0 07670311
40250 IF (RVCOMP + .00005) 20250, 10250, 40251 07680311
40251 IF (RVCOMP - .00005) 10250, 10250, 20250 07690311
30250 IVDELE = IVDELE + 1 07700311
WRITE (I02,80000) IVTNUM 07710311
IF (ICZERO) 10250, 0261, 20250 07720311
10250 IVPASS = IVPASS + 1 07730311
WRITE (I02,80002) IVTNUM 07740311
GO TO 0261 07750311
20250 IVFAIL = IVFAIL + 1 07760311
WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 07770311
0261 CONTINUE 07780311
C 07790311
C **** FCVS PROGRAM 311 - TEST 026 **** 07800311
C 07810311
C OVERRIDE THE INTEGER DEFAULT TYPING OF A STATEMENT FUNCTION 07820311
C DUMMY ARGUMENT WITH THE IMPLICIT STATEMENT TYPING OF REAL. 07830311
C 07840311
IVTNUM = 26 07850311
IF (ICZERO) 30260, 0260, 30260 07860311
0260 CONTINUE 07870311
RVCOMP = 10.0 07880311
RVCOMP = RFOS08(4.0) 07890311
RVCORR = 0.8 07900311
40260 IF (RVCOMP - .79995) 20260, 10260, 40261 07910311
40261 IF (RVCOMP - .80005) 10260, 10260, 20260 07920311
30260 IVDELE = IVDELE + 1 07930311
WRITE (I02,80000) IVTNUM 07940311
IF (ICZERO) 10260, 0271, 20260 07950311
10260 IVPASS = IVPASS + 1 07960311
WRITE (I02,80002) IVTNUM 07970311
GO TO 0271 07980311
20260 IVFAIL = IVFAIL + 1 07990311
WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 08000311
0271 CONTINUE 08010311
C 08020311
C **** FCVS PROGRAM 311 - TEST 027 **** 08030311
C 08040311
C OVERRIDE THE REAL DEFAULT TYPING OF A STATEMENT FUNCTION DUMMY 08050311
C ARGUMENT WITH THE IMPLICIT STATEMENT TYPING OF INTEGER. 08060311
C 08070311
IVTNUM = 27 08080311
IF (ICZERO) 30270, 0270, 30270 08090311
0270 CONTINUE 08100311
RVCOMP = 10.0 08110311
RVCOMP = RFOS09(4) 08120311
RVCORR = 0.0 08130311
40270 IF (RVCOMP + .00005) 20270, 10270, 40271 08140311
40271 IF (RVCOMP - .00005) 10270, 10270, 20270 08150311
30270 IVDELE = IVDELE + 1 08160311
WRITE (I02,80000) IVTNUM 08170311
IF (ICZERO) 10270, 0281, 20270 08180311
10270 IVPASS = IVPASS + 1 08190311
WRITE (I02,80002) IVTNUM 08200311
GO TO 0281 08210311
20270 IVFAIL = IVFAIL + 1 08220311
WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 08230311
0281 CONTINUE 08240311
C 08250311
C **** FCVS PROGRAM 311 - TEST 028 **** 08260311
C 08270311
C OVERRIDE INTEGER DEFAULT TYPING OF A STATEMENT FUNCTION DUMMY 08280311
C ARGUMENT WITH TYPE-STATEMENT TYPING OF REAL. 08290311
C 08300311
IVTNUM = 28 08310311
IF (ICZERO) 30280, 0280, 30280 08320311
0280 CONTINUE 08330311
RVCOMP = 10.0 08340311
RVCOMP = RFOS10(4.0) 08350311
RVCORR = 0.8 08360311
40280 IF (RVCOMP - .79995) 20280, 10280, 40281 08370311
40281 IF (RVCOMP - .80005) 10280, 10280, 20280 08380311
30280 IVDELE = IVDELE + 1 08390311
WRITE (I02,80000) IVTNUM 08400311
IF (ICZERO) 10280, 0291, 20280 08410311
10280 IVPASS = IVPASS + 1 08420311
WRITE (I02,80002) IVTNUM 08430311
GO TO 0291 08440311
20280 IVFAIL = IVFAIL + 1 08450311
WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 08460311
0291 CONTINUE 08470311
C 08480311
C **** FCVS PROGRAM 311 - TEST 029 **** 08490311
C 08500311
C OVERRIDE THE REAL DEFAULT TYPING OF A STATEMENT FUNCTION DUMMY 08510311
C ARGUMENT WITH TYPE-STATEMENT TYPING OF INTEGER. 08520311
C 08530311
IVTNUM = 29 08540311
IF (ICZERO) 30290, 0290, 30290 08550311
0290 CONTINUE 08560311
RVCOMP = 10.0 08570311
RVCOMP = RFOS11(4) 08580311
RVCORR = 0.0 08590311
40290 IF (RVCOMP + .00005) 20290, 10290, 40291 08600311
40291 IF (RVCOMP - .00005) 10290, 10290, 20290 08610311
30290 IVDELE = IVDELE + 1 08620311
WRITE (I02,80000) IVTNUM 08630311
IF (ICZERO) 10290, 0301, 20290 08640311
10290 IVPASS = IVPASS + 1 08650311
WRITE (I02,80002) IVTNUM 08660311
GO TO 0301 08670311
20290 IVFAIL = IVFAIL + 1 08680311
WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 08690311
0301 CONTINUE 08700311
C 08710311
C **** FCVS PROGRAM 311 - TEST 030 **** 08720311
C 08730311
C TEST 030 TESTS A STATEMENT FUNCTION WHERE THE DUMMY ARGUMENT 08740311
C NAME IS IDENTICAL TO A VARIABLE NAME WITHIN THE PROGRAM. 08750311
C 08760311
IVTNUM = 30 08770311
IF (ICZERO) 30300, 0300, 30300 08780311
0300 CONTINUE 08790311
IVON04 = 10 08800311
IVCOMP = 1 08810311
IF (IFOS15(3) .EQ. 4) IVCOMP = IVCOMP * 2 08820311
IF (IVON04 .EQ. 10) IVCOMP = IVCOMP * 3 08830311
IVCORR = 6 08840311
C 6 = 2 * 3 08850311
40300 IF (IVCOMP - 6) 20300, 10300, 20300 08860311
30300 IVDELE = IVDELE + 1 08870311
WRITE (I02,80000) IVTNUM 08880311
IF (ICZERO) 10300, 0311, 20300 08890311
10300 IVPASS = IVPASS + 1 08900311
WRITE (I02,80002) IVTNUM 08910311
GO TO 0311 08920311
20300 IVFAIL = IVFAIL + 1 08930311
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 08940311
0311 CONTINUE 08950311
C 08960311
C **** FCVS PROGRAM 311 - TEST 031 **** 08970311
C 08980311
C TEST 031 TESTS THE ASSIGNMENT OF A STATEMENT FUNCTION TO AN 08990311
C ARRAY ELEMENT. 09000311
C 09010311
IVTNUM = 31 09020311
IF (ICZERO) 30310, 0310, 30310 09030311
0310 CONTINUE 09040311
IVCOMP = 0 09050311
IADN12(3) = IFOS16(4) 09060311
IVCOMP = IADN12(3) 09070311
IVCORR = 5 09080311
40310 IF (IVCOMP - 5) 20310, 10310, 20310 09090311
30310 IVDELE = IVDELE + 1 09100311
WRITE (I02,80000) IVTNUM 09110311
IF (ICZERO) 10310, 0321, 20310 09120311
10310 IVPASS = IVPASS + 1 09130311
WRITE (I02,80002) IVTNUM 09140311
GO TO 0321 09150311
20310 IVFAIL = IVFAIL + 1 09160311
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 09170311
0321 CONTINUE 09180311
C 09190311
C **** FCVS PROGRAM 311 - TEST 032 **** 09200311
C 09210311
C TEST 032 TESTS THE USE OF A STATEMENT FUNCTION REFERENCE 09220311
C IN AN ARITHMETIC EXPRESSION. 09230311
C 09240311
IVTNUM = 32 09250311
IF (ICZERO) 30320, 0320, 30320 09260311
0320 CONTINUE 09270311
IVCOMP = 0 09280311
IVON05 = 12 09290311
IVCOMP = IVON05 + IFOS17(4) * 2 - 3 09300311
IVCORR = 19 09310311
40320 IF (IVCOMP - 19) 20320, 10320, 20320 09320311
30320 IVDELE = IVDELE + 1 09330311
WRITE (I02,80000) IVTNUM 09340311
IF (ICZERO) 10320, 0331, 20320 09350311
10320 IVPASS = IVPASS + 1 09360311
WRITE (I02,80002) IVTNUM 09370311
GO TO 0331 09380311
20320 IVFAIL = IVFAIL + 1 09390311
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 09400311
0331 CONTINUE 09410311
C 09420311
C **** FCVS PROGRAM 311 - TEST 033 **** 09430311
C 09440311
C TEST 033 TESTS THE USE OF A STATEMENT FUNCTION DEFINITION AND 09450311
C REFERENCE WITHIN AN EXTERNAL FUNCTION. 09460311
C 09470311
IVTNUM = 33 09480311
IF (ICZERO) 30330, 0330, 30330 09490311
0330 CONTINUE 09500311
RVCOMP = 0.0 09510311
RVCOMP = FF313(1.3) 09520311
RVCORR = 5.8 09530311
40330 IF (RVCOMP - 5.7995) 20330, 10330, 40331 09540311
40331 IF (RVCOMP - 5.8005) 10330, 10330, 20330 09550311
30330 IVDELE = IVDELE + 1 09560311
WRITE (I02,80000) IVTNUM 09570311
IF (ICZERO) 10330, 0341, 20330 09580311
10330 IVPASS = IVPASS + 1 09590311
WRITE (I02,80002) IVTNUM 09600311
GO TO 0341 09610311
20330 IVFAIL = IVFAIL + 1 09620311
WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 09630311
0341 CONTINUE 09640311
C 09650311
C **** FCVS PROGRAM 311 - TEST 034 **** 09660311
C 09670311
C TEST 034 TESTS THE USE OF A STATEMENT FUNCTION DEFINITION AND 09680311
C REFERENCE WITHIN A SUBROUTINE. 09690311
C 09700311
IVTNUM = 34 09710311
IF (ICZERO) 30340, 0340, 30340 09720311
0340 CONTINUE 09730311
RVCOMP = 0.0 09740311
RVON05 = 10.0 09750311
CALL FS316(RVON05) 09760311
RVCOMP = RVON05 09770311
RVCORR = 5.5 09780311
40340 IF (RVCOMP - 5.4995) 20340, 10340, 40341 09790311
40341 IF (RVCOMP - 5.5005) 10340, 10340, 20340 09800311
30340 IVDELE = IVDELE + 1 09810311
WRITE (I02,80000) IVTNUM 09820311
IF (ICZERO) 10340, 0351, 20340 09830311
10340 IVPASS = IVPASS + 1 09840311
WRITE (I02,80002) IVTNUM 09850311
GO TO 0351 09860311
20340 IVFAIL = IVFAIL + 1 09870311
WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 09880311
0351 CONTINUE 09890311
C 09900311
C **** FCVS PROGRAM 311 - TEST 035 **** 09910311
C 09920311
C TEST 035 REFERENCES THE DUMMY ARGUMENT NAME OF AN EXTERNAL 09930311
C FUNCTION WITHIN THE EXPRESSION OF A STATEMENT FUNCTION DEFINED 09940311
C IN THAT EXTERNAL FUNCTION. 09950311
C 09960311
IVTNUM = 35 09970311
IF (ICZERO) 30350, 0350, 30350 09980311
0350 CONTINUE 09990311
IVCOMP = 0 10000311
IVCOMP = FF314(4) 10010311
IVCORR = 7 10020311
40350 IF (IVCOMP - 7) 20350, 10350, 20350 10030311
30350 IVDELE = IVDELE + 1 10040311
WRITE (I02,80000) IVTNUM 10050311
IF (ICZERO) 10350, 0361, 20350 10060311
10350 IVPASS = IVPASS + 1 10070311
WRITE (I02,80002) IVTNUM 10080311
GO TO 0361 10090311
20350 IVFAIL = IVFAIL + 1 10100311
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 10110311
0361 CONTINUE 10120311
C 10130311
C **** FCVS PROGRAM 311 - TEST 036 **** 10140311
C 10150311
C TEST 036 TESTS A STATEMENT FUNCTION DEFINED WITHIN AN EXTERNAL 10160311
C FUNCTION IN WHICH THE STATEMENT FUNCTION DUMMY ARGUMENT NAME IS 10170311
C IDENTICAL TO THE EXTERNAL FUNCTION DUMMY ARGUMENT NAME. 10180311
C 10190311
IVTNUM = 36 10200311
IF (ICZERO) 30360, 0360, 30360 10210311
0360 CONTINUE 10220311
RVCOMP = 0.0 10230311
RVCOMP = FF315(5.5) 10240311
RVCORR = 16.7 10250311
40360 IF (RVCOMP - 16.695) 20360, 10360, 40361 10260311
40361 IF (RVCOMP - 16.705) 10360, 10360, 20360 10270311
30360 IVDELE = IVDELE + 1 10280311
WRITE (I02,80000) IVTNUM 10290311
IF (ICZERO) 10360, 0371, 20360 10300311
10360 IVPASS = IVPASS + 1 10310311
WRITE (I02,80002) IVTNUM 10320311
GO TO 0371 10330311
20360 IVFAIL = IVFAIL + 1 10340311
WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 10350311
0371 CONTINUE 10360311
C 10370311
C **** FCVS PROGRAM 311 - TEST 037 **** 10380311
C 10390311
C TEST 037 TESTS THE USAGE OF THE NAME OF A COMMON BLOCK AS THE 10400311
C SYMBOLIC NAME OF A STATEMENT FUNCTION. 10410311
C 10420311
IVTNUM = 37 10430311
IF (ICZERO) 30370, 0370, 30370 10440311
0370 CONTINUE 10450311
IVCOMP = 0 10460311
IVCOMP = IFOS19(4) 10470311
IVCORR = 5 10480311
40370 IF (IVCOMP - 5) 20370, 10370, 20370 10490311
30370 IVDELE = IVDELE + 1 10500311
WRITE (I02,80000) IVTNUM 10510311
IF (ICZERO) 10370, 0381, 20370 10520311
10370 IVPASS = IVPASS + 1 10530311
WRITE (I02,80002) IVTNUM 10540311
GO TO 0381 10550311
20370 IVFAIL = IVFAIL + 1 10560311
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 10570311
0381 CONTINUE 10580311
C 10590311
C 10600311
C WRITE OUT TEST SUMMARY 10610311
C 10620311
WRITE (I02,90004) 10630311
WRITE (I02,90014) 10640311
WRITE (I02,90004) 10650311
WRITE (I02,90000) 10660311
WRITE (I02,90004) 10670311
WRITE (I02,90020) IVFAIL 10680311
WRITE (I02,90022) IVPASS 10690311
WRITE (I02,90024) IVDELE 10700311
STOP 10710311
90001 FORMAT (" ",24X,"FM311") 10720311
90000 FORMAT (" ",20X,"END OF PROGRAM FM311" ) 10730311
C 10740311
C FORMATS FOR TEST DETAIL LINES 10750311
C 10760311
80000 FORMAT (" ",4X,I5,6X,"DELETED") 10770311
80002 FORMAT (" ",4X,I5,7X,"PASS") 10780311
80010 FORMAT (" ",4X,I5,7X,"FAIL",10X,I6,9X,I6) 10790311
80012 FORMAT (" ",4X,I5,7X,"FAIL",4X,E12.5,3X,E12.5) 10800311
80018 FORMAT (" ",4X,I5,7X,"FAIL",2X,A14,1X,A14) 10810311
C 10820311
C FORMAT STATEMENTS FOR PAGE HEADERS 10830311
C 10840311
90002 FORMAT ("1") 10850311
90004 FORMAT (" ") 10860311
90006 FORMAT (" ",10X,"FORTRAN COMPILER VALIDATION SYSTEM" ) 10870311
90008 FORMAT (" ",21X,"VERSION 2.1" ) 10880311
90010 FORMAT (" ",8X,"FOR OFFICIAL USE ONLY - COPYRIGHT 1978" ) 10890311
90012 FORMAT (" ",5X,"TEST",5X,"PASS/FAIL",5X,"COMPUTED",8X,"CORRECT") 10900311
90014 FORMAT (" ",5X,"----------------------------------------------" ) 10910311
90016 FORMAT (" ",18X,"SUBSET LEVEL TEST" ) 10920311
C 10930311
C FORMAT STATEMENTS FOR RUN SUMMARY 10940311
C 10950311
90020 FORMAT (" ",19X,I5," TESTS FAILED" ) 10960311
90022 FORMAT (" ",19X,I5," TESTS PASSED" ) 10970311
90024 FORMAT (" ",19X,I5," TESTS DELETED" ) 10980311
END 10990311
INTEGER FUNCTION FF312(IDONX1) 00010312
C THIS SUBPROGRAM IS USED BY TESTS 014 AND 023 OF THE MAIN PROGRAM 00020312
C FM311 TO TEST STATEMENT FUNCTION. IN TEST 014 REFERENCE TO FF312 00030312
C IS USED IN THE EXPRESSION OF A STATEMENT FUNCTION. IN TEST 023 00040312
C REFERENCE TO FF312 IS USED AS AN ACTUAL ARGUMENT IN A STATEMENT 00050312
C FUNCTION REFERENCE. THIS ROUTINE MERELY INCREMENTS THE VALUE OF 00060312
C ACTUAL/DUMMY ARGUMENT BY ONE AND RETURN THE RESULT AS THE 00070312
C FUNCTION VALUE. 00080312
IDONX2 = IDONX1 + 1 00090312
FF312 = IDONX2 00100312
RETURN 00110312
END 00120312
REAL FUNCTION FF313(RDON08) 00010313
C THIS SUBPROGRAM IS USED BY TEST 033 OF THE MAIN PROGRAM FM311 TO 00020313
C TEST THE DEFINITION AND REFERENCE OF A STATEMENT FUNCTION WITHIN 00030313
C AN EXTERNAL FUNCTION. 00040313
RFOS12(RDON09) = RDON09 + 1.0 00050313
RVON04 = RFOS12(3.5) 00060313
FF313 = RDON08 + RVON04 00070313
RETURN 00080313
END 00090313
INTEGER FUNCTION FF314(IDON19) 00010314
C THIS SUBPROGRAM IS USED BY TEST 035 OF THE MAIN PROGRAM FM311 TO 00020314
C TEST THE DEFINITION AND REFERENCE OF A STATEMENT FUNCTION WITHIN 00030314
C AN EXTERNAL FUNCTION. IN THIS TEST THE EXTERNAL FUNCTION DUMMY 00040314
C ARGUMENT IS REFERENCED WITHIN THE EXPRESSION OF THE STATEMENT 00050314
C FUNCTION. 00060314
IFOS18(IDON20) = IDON19 + IDON20 00070314
FF314 = IFOS18(3) 00080314
RETURN 00090314
END 00100314
REAL FUNCTION FF315(RDON12) 00010315
C THIS SUBPROGRAM IS USED BY TEST 036 OF THE MAIN PROGRAM FM311 TO 00020315
C TEST THE DEFINITION AND REFERENCE OF A STATEMENT FUNCTION WITHIN 00030315
C AN EXTERNAL FUNCTION. IN THIS TEST THE EXTERNAL FUNCTION AND 00040315
C STATEMENT FUNCTION DUMMY ARGUMENTS NAMES ARE IDENTICAL. 00050315
RFOS14(RDON12) = RDON12 + 1.0 00060315
RVON06 = 10.2 00070315
RVON07 = RFOS14(RVON06) 00080315
FF315 = RDON12 + RVON07 00090315
RETURN 00100315
END 00110315
SUBROUTINE FS316(RDON10) 00010316
C THIS SUBPROGRAM IS USED BY TEST 034 OF THE MAIN PROGRAM FM311 TO 00020316
C TEST THE DEFINITION AND REFERENCE OF A STATEMENT FUNCTION WITHIN 00030316
C A SUBROUTINE. 00040316
RFOS13(RDON11) = RDON11 + 1.0 00050316
RDON10 = RFOS13(3.5) + 1.0 00060316
RETURN 00070316
END 00080316