blob: b7f935ef03fccf4fb50eb9d5435e49f22a3ffe1e [file] [log] [blame]
PROGRAM FM317 00010317
C 00020317
C 00030317
C THIS ROUTINE TESTS SUBSET LEVEL FEATURES OF EXTERNAL 00040317
C FUNCTION SUBPROGRAMS. TESTS ARE DESIGNED TO CHECK THE 00050317
C ASSOCIATION OF ALL PERMISSIBLE FORMS OF ACTUAL ARGUMENTS WITH 00060317
C VARIABLE, ARRAY AND PROCEDURE NAME DUMMY ARGUMENTS. THESE 00070317
C INCLUDE, 00080317
C 00090317
C 1) ACTUAL ARGUMENTS ASSOCIATED TO VARIABLE NAME DUMMY 00100317
C ARGUMENT INCLUDE, 00110317
C 00120317
C A) CONSTANT 00130317
C B) VARIABLE NAME 00140317
C C) ARRAY ELEMENT NAME 00150317
C D) EXPRESSION INVOLVING OPERATORS 00160317
C E) EXPRESSION ENCLOSED IN PARENTHESES 00170317
C F) INTRINSIC FUNCTION REFERENCE 00180317
C G) EXTERNAL FUNCTION REFERENCE 00190317
C H) STATEMENT FUNCTION REFERENCE 00200317
C I) ACTUAL ARGUMENT NAME SAME AS DUMMY ARGUMENT NAME 00210317
C 00220317
C 2) ACTUAL ARGUMENTS ASSOCIATED TO ARRAY NAME DUMMY 00230317
C ARGUMENT INCLUDE, 00240317
C 00250317
C A) ARRAY NAME 00260317
C B) ARRAY ELEMENT NAME 00270317
C 00280317
C 3) ACTUAL ARGUMENTS ASSOCIATED TO PROCEDURE NAME DUMMY 00290317
C ARGUMENT INCLUDE, 00300317
C 00310317
C A) EXTERNAL FUNCTION NAME 00320317
C B) INTRINSIC FUNCTION NAME 00330317
C C) SUBROUTINE NAME 00340317
C 00350317
C SUBSET LEVEL ROUTINES FM028,FM050 AND FM080 ALSO TEST THE USE OF 00360317
C EXTERNAL FUNCTIONS. 00370317
C 00380317
C REFERENCES. 00390317
C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN, 00400317
C X3.9-1978 00410317
C 00420317
C SECTION 2.8, DUMMY ARGUMENTS 00430317
C SECTION 5.1.2.2, DUMMY ARRAY DECLARATOR 00440317
C SECTION 5.5, DUMMY AND ACTUAL ARRAYS 00450317
C SECTION 8.1, DIMENSION STATEMENT 00460317
C SECTION 8.3, COMMON STATEMENT 00470317
C SECTION 8.4, TYPE-STATEMENT 00480317
C SECTION 8.7, EXTERNAL STATEMENT 00490317
C SECTION 8.8, INTRINSIC STATEMENT 00500317
C SECTION 15.2, REFERENCING A FUNCTION 00510317
C SECTION 15.3, INTRINSIC FUNCTIONS 00520317
C SECTION 15.5, EXTERNAL FUNCTIONS 00530317
C SECTION 15.6, SUBROUTINES 00540317
C SECTION 15.9, ARGUMENTS AND COMMON BLOCKS 00550317
C 00560317
C 00570317
C ******************************************************************00580317
C A COMPILER VALIDATION SYSTEM FOR THE FORTRAN LANGUAGE 00590317
C BASED ON SPECIFICATIONS AS DEFINED IN AMERICAN STANDARD FORTRAN 00600317
C X3.9-1978, HAS BEEN DEVELOPED BY THE DEPARTMENT OF THE NAVY. THE 00610317
C FORTRAN COMPILER VALIDATION SYSTEM (FCVS) CONSISTS OF AUDIT 00620317
C ROUTINES, THEIR RELATED DATA, AND AN EXECUTIVE SYSTEM. EACH AUDIT00630317
C ROUTINE IS A FORTRAN PROGRAM OR SUBPROGRAM WHICH INCLUDES TESTS 00640317
C OF SPECIFIC LANGUAGE ELEMENTS AND SUPPORTING PROCEDURES INDICATING00650317
C THE RESULT OF EXECUTING THESE TESTS. 00660317
C 00670317
C THIS PARTICULAR PROGRAM OR SUBPROGRAM CONTAINS ONLY FEATURES 00680317
C FOUND IN THE SUBSET LEVEL OF THE STANDARD. 00690317
C 00700317
C SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO 00710317
C NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY 00720317
C SOFTWARE STANDARDS VALIDATION GROUP 00730317
C BUILDING 225 RM A266 00740317
C GAITHERSBURG, MD 20899 00750317
C ******************************************************************00760317
C 00770317
C 00780317
IMPLICIT LOGICAL (L) 00790317
IMPLICIT CHARACTER*14 (C) 00800317
C 00810317
INTEGER FF318, FF321, FF322, FF324, FF325 00820317
LOGICAL FF320 00830317
INTRINSIC ABS, IABS, NINT 00840317
EXTERNAL FF318, FF321, FF325, FS327 00850317
DIMENSION IADN11(4), IADN12(4) 00860317
DIMENSION RADN11(4), RADN12(4) 00870317
DIMENSION LADN11(4) 00880317
COMMON IACN11(6), RACN11(10) 00890317
INTEGER IATN11(2,3) 00900317
REAL RATN11(3,4) 00910317
IFOS01(IDON04) = IDON04 + 1 00920317
C 00930317
C 00940317
C 00950317
C INITIALIZATION SECTION. 00960317
C 00970317
C INITIALIZE CONSTANTS 00980317
C ******************** 00990317
C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER 01000317
I01 = 5 01010317
C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER 01020317
I02 = 6 01030317
C SYSTEM ENVIRONMENT SECTION 01040317
C 01050317
CX010 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-010 CONTROL CARD.01060317
C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 01070317
C (UNIT NUMBER FOR CARD READER). 01080317
CX011 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-011 CONTROL CARD01090317
C THE CX011 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 01100317
C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX010 ABOVE. 01110317
C 01120317
CX020 THIS CARD IS PEPLACED BY CONTENTS OF FEXEC X-020 CONTROL CARD.01130317
C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02 = 6 01140317
C (UNIT NUMBER FOR PRINTER). 01150317
CX021 THIS CARD IS PEPLACED BY CONTENTS OF FEXEC X-021 CONTROL CARD.01160317
C THE CX021 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 01170317
C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX020 ABOVE. 01180317
C 01190317
IVPASS = 0 01200317
IVFAIL = 0 01210317
IVDELE = 0 01220317
ICZERO = 0 01230317
C 01240317
C WRITE OUT PAGE HEADERS 01250317
C 01260317
WRITE (I02,90002) 01270317
WRITE (I02,90006) 01280317
WRITE (I02,90008) 01290317
WRITE (I02,90004) 01300317
WRITE (I02,90010) 01310317
WRITE (I02,90004) 01320317
WRITE (I02,90016) 01330317
WRITE (I02,90001) 01340317
WRITE (I02,90004) 01350317
WRITE (I02,90012) 01360317
WRITE (I02,90014) 01370317
WRITE (I02,90004) 01380317
C 01390317
C 01400317
C TEST 001 THROUGH TEST 022 ARE DESIGNED TO ASSOCIATE VARIOUS FORMS 01410317
C OF ACTUAL ARGUMENTS TO VARIABLE NAMES USED AS EXTERNAL FUNCTION 01420317
C DUMMY ARGUMENTS. INTEGER, REAL AND LOGICAL DUMMY ARGUMENTS ARE 01430317
C TESTED. 01440317
C 01450317
C 01460317
C **** FCVS PROGRAM 317 - TEST 001 **** 01470317
C 01480317
C INTEGER CONSTANT AS ACTUAL ARGUMENT 01490317
C 01500317
IVTNUM = 1 01510317
IF (ICZERO) 30010, 0010, 30010 01520317
0010 CONTINUE 01530317
IVCOMP = 0 01540317
IVCOMP = FF318(3) 01550317
IVCORR = 4 01560317
40010 IF (IVCOMP - 4) 20010, 10010, 20010 01570317
30010 IVDELE = IVDELE + 1 01580317
WRITE (I02,80000) IVTNUM 01590317
IF (ICZERO) 10010, 0021, 20010 01600317
10010 IVPASS = IVPASS + 1 01610317
WRITE (I02,80002) IVTNUM 01620317
GO TO 0021 01630317
20010 IVFAIL = IVFAIL + 1 01640317
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 01650317
0021 CONTINUE 01660317
C 01670317
C **** FCVS PROGRAM 317 - TEST 002 **** 01680317
C 01690317
C REAL CONSTANT AS ACTUAL ARGUMENT 01700317
C 01710317
IVTNUM = 2 01720317
IF (ICZERO) 30020, 0020, 30020 01730317
0020 CONTINUE 01740317
RVCOMP = 0.0 01750317
RVCOMP = FF319(3.0) 01760317
RVCORR = 4.0 01770317
40020 IF (RVCOMP - 3.9995) 20020, 10020, 40021 01780317
40021 IF (RVCOMP - 4.0005) 10020, 10020, 20020 01790317
30020 IVDELE = IVDELE + 1 01800317
WRITE (I02,80000) IVTNUM 01810317
IF (ICZERO) 10020, 0031, 20020 01820317
10020 IVPASS = IVPASS + 1 01830317
WRITE (I02,80002) IVTNUM 01840317
GO TO 0031 01850317
20020 IVFAIL = IVFAIL + 1 01860317
WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 01870317
0031 CONTINUE 01880317
C 01890317
C **** FCVS PROGRAM 317 - TEST 003 **** 01900317
C 01910317
C LOGICAL CONSTANT AS ACTUAL ARGUMENT 01920317
C 01930317
IVTNUM = 3 01940317
IF (ICZERO) 30030, 0030, 30030 01950317
0030 CONTINUE 01960317
IVCOMP = 0 01970317
IF (FF320(.FALSE.)) IVCOMP = 1 01980317
IVCORR = 1 01990317
40030 IF (IVCOMP - 1) 20030, 10030, 20030 02000317
30030 IVDELE = IVDELE + 1 02010317
WRITE (I02,80000) IVTNUM 02020317
IF (ICZERO) 10030, 0041, 20030 02030317
10030 IVPASS = IVPASS + 1 02040317
WRITE (I02,80002) IVTNUM 02050317
GO TO 0041 02060317
20030 IVFAIL = IVFAIL + 1 02070317
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 02080317
0041 CONTINUE 02090317
C 02100317
C **** FCVS PROGRAM 317 - TEST 004 **** 02110317
C 02120317
C INTEGER VARIABLE AS ACTUAL ARGUMENT 02130317
C 02140317
IVTNUM = 4 02150317
IF (ICZERO) 30040, 0040, 30040 02160317
0040 CONTINUE 02170317
IVCOMP = 0 02180317
IVON01 = 7 02190317
IVCOMP = FF318(IVON01) 02200317
IVCORR = 8 02210317
40040 IF (IVCOMP - 8) 20040, 10040, 20040 02220317
30040 IVDELE = IVDELE + 1 02230317
WRITE (I02,80000) IVTNUM 02240317
IF (ICZERO) 10040, 0051, 20040 02250317
10040 IVPASS = IVPASS + 1 02260317
WRITE (I02,80002) IVTNUM 02270317
GO TO 0051 02280317
20040 IVFAIL = IVFAIL + 1 02290317
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 02300317
0051 CONTINUE 02310317
C 02320317
C **** FCVS PROGRAM 317 - TEST 005 **** 02330317
C 02340317
C REAL VARIABLE AS ACTUAL ARGUMENT 02350317
C 02360317
IVTNUM = 5 02370317
IF (ICZERO) 30050, 0050, 30050 02380317
0050 CONTINUE 02390317
RVCOMP = 0.0 02400317
RVON01 = 7.0 02410317
RVCOMP = FF319(RVON01) 02420317
RVCORR = 8.0 02430317
40050 IF (RVCOMP - 7.9995) 20050, 10050, 40051 02440317
40051 IF (RVCOMP - 8.0005) 10050, 10050, 20050 02450317
30050 IVDELE = IVDELE + 1 02460317
WRITE (I02,80000) IVTNUM 02470317
IF (ICZERO) 10050, 0061, 20050 02480317
10050 IVPASS = IVPASS + 1 02490317
WRITE (I02,80002) IVTNUM 02500317
GO TO 0061 02510317
20050 IVFAIL = IVFAIL + 1 02520317
WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 02530317
0061 CONTINUE 02540317
C 02550317
C **** FCVS PROGRAM 317 - TEST 006 **** 02560317
C 02570317
C LOGICAL VARIABLE AS ACTUAL ARGUMENT 02580317
C 02590317
IVTNUM = 6 02600317
IF (ICZERO) 30060, 0060, 30060 02610317
0060 CONTINUE 02620317
LVON01 = .TRUE. 02630317
IVCOMP = 0 02640317
IF (.NOT. FF320(LVON01)) IVCOMP = 1 02650317
IVCORR = 1 02660317
40060 IF (IVCOMP - 1) 20060, 10060, 20060 02670317
30060 IVDELE = IVDELE + 1 02680317
WRITE (I02,80000) IVTNUM 02690317
IF (ICZERO) 10060, 0071, 20060 02700317
10060 IVPASS = IVPASS + 1 02710317
WRITE (I02,80002) IVTNUM 02720317
GO TO 0071 02730317
20060 IVFAIL = IVFAIL + 1 02740317
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 02750317
0071 CONTINUE 02760317
C 02770317
C **** FCVS PROGRAM 317 - TEST 007 **** 02780317
C 02790317
C INTEGER ARRAY ELEMENT NAME AS ACTUAL ARGUMENT 02800317
C 02810317
IVTNUM = 7 02820317
IF (ICZERO) 30070, 0070, 30070 02830317
0070 CONTINUE 02840317
IVCOMP = 0 02850317
IADN11(2) = 2 02860317
IVCOMP = FF318(IADN11(2)) 02870317
IVCORR = 3 02880317
40070 IF (IVCOMP - 3) 20070, 10070, 20070 02890317
30070 IVDELE = IVDELE + 1 02900317
WRITE (I02,80000) IVTNUM 02910317
IF (ICZERO) 10070, 0081, 20070 02920317
10070 IVPASS = IVPASS + 1 02930317
WRITE (I02,80002) IVTNUM 02940317
GO TO 0081 02950317
20070 IVFAIL = IVFAIL + 1 02960317
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 02970317
0081 CONTINUE 02980317
C 02990317
C **** FCVS PROGRAM 317 - TEST 008 **** 03000317
C 03010317
C REAL ARRAY ELEMENT NAME AS ACTUAL ARGUMENT 03020317
C 03030317
IVTNUM = 8 03040317
IF (ICZERO) 30080, 0080, 30080 03050317
0080 CONTINUE 03060317
RVCOMP = 0.0 03070317
RADN11(4) = 4.0 03080317
RVCOMP = FF319(RADN11(4)) 03090317
RVCORR = 5.0 03100317
40080 IF (RVCOMP - 4.9995) 20080, 10080, 40081 03110317
40081 IF (RVCOMP - 5.0005) 10080, 10080, 20080 03120317
30080 IVDELE = IVDELE + 1 03130317
WRITE (I02,80000) IVTNUM 03140317
IF (ICZERO) 10080, 0091, 20080 03150317
10080 IVPASS = IVPASS + 1 03160317
WRITE (I02,80002) IVTNUM 03170317
GO TO 0091 03180317
20080 IVFAIL = IVFAIL + 1 03190317
WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 03200317
0091 CONTINUE 03210317
C 03220317
C **** FCVS PROGRAM 317 - TEST 009 **** 03230317
C 03240317
C LOGICAL ARRAY ELEMENT NAME AS ACTUAL ARGUMENT 03250317
C 03260317
IVTNUM = 9 03270317
IF (ICZERO) 30090, 0090, 30090 03280317
0090 CONTINUE 03290317
LADN11(1) = .FALSE. 03300317
IVCOMP = 0 03310317
IF (FF320(LADN11(1))) IVCOMP = 1 03320317
IVCORR = 1 03330317
40090 IF (IVCOMP - 1) 20090, 10090, 20090 03340317
30090 IVDELE = IVDELE + 1 03350317
WRITE (I02,80000) IVTNUM 03360317
IF (ICZERO) 10090, 0101, 20090 03370317
10090 IVPASS = IVPASS + 1 03380317
WRITE (I02,80002) IVTNUM 03390317
GO TO 0101 03400317
20090 IVFAIL = IVFAIL + 1 03410317
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 03420317
0101 CONTINUE 03430317
C 03440317
C **** FCVS PROGRAM 317 - TEST 010 **** 03450317
C 03460317
C INTEGER EXPRESSION INVOLVING OPERATORS AS ACTUAL ARGUMENT 03470317
C 03480317
IVTNUM = 10 03490317
IF (ICZERO) 30100, 0100, 30100 03500317
0100 CONTINUE 03510317
IVCOMP = 0 03520317
IVON02 = 2 03530317
IVON03 = 3 03540317
IVCOMP = FF318(IVON02 + 3 * IVON03 - 7) 03550317
IVCORR = 5 03560317
40100 IF (IVCOMP - 5) 20100, 10100, 20100 03570317
30100 IVDELE = IVDELE + 1 03580317
WRITE (I02,80000) IVTNUM 03590317
IF (ICZERO) 10100, 0111, 20100 03600317
10100 IVPASS = IVPASS + 1 03610317
WRITE (I02,80002) IVTNUM 03620317
GO TO 0111 03630317
20100 IVFAIL = IVFAIL + 1 03640317
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 03650317
0111 CONTINUE 03660317
C 03670317
C **** FCVS PROGRAM 317 - TEST 011 **** 03680317
C 03690317
C REAL EXPRESSION INVOLVING OPERATORS AS ACTUAL ARGUMENT 03700317
C 03710317
IVTNUM = 11 03720317
IF (ICZERO) 30110, 0110, 30110 03730317
0110 CONTINUE 03740317
RVCOMP = 0.0 03750317
RVON02 = 2. 03760317
RVON03 = 1.2 03770317
RVCOMP = FF319(RVON02 * RVON03 /.6) 03780317
RVCORR = 5.0 03790317
40110 IF (RVCOMP - 4.9995) 20110, 10110, 40111 03800317
40111 IF (RVCOMP - 5.0005) 10110, 10110, 20110 03810317
30110 IVDELE = IVDELE + 1 03820317
WRITE (I02,80000) IVTNUM 03830317
IF (ICZERO) 10110, 0121, 20110 03840317
10110 IVPASS = IVPASS + 1 03850317
WRITE (I02,80002) IVTNUM 03860317
GO TO 0121 03870317
20110 IVFAIL = IVFAIL + 1 03880317
WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 03890317
0121 CONTINUE 03900317
C 03910317
C **** FCVS PROGRAM 317 - TEST 012 **** 03920317
C 03930317
C REAL EXPRESSION INVOLVING INTEGER AND REAL PRIMARIES AND OPERATORS03940317
C AS ACTUAL ARGUMENT. 03950317
C 03960317
IVTNUM = 12 03970317
IF (ICZERO) 30120, 0120, 30120 03980317
0120 CONTINUE 03990317
RVCOMP = 0.0 04000317
IVON01 = 2 04010317
RADN11(2) = 2.5 04020317
RVCOMP = FF319(IVON01**3 * (RADN11(2) - 1) + 2.0) 04030317
RVCORR = 15.0 04040317
40120 IF (RVCOMP - 14.995) 20120, 10120, 40121 04050317
40121 IF (RVCOMP - 15.005) 10120, 10120, 20120 04060317
30120 IVDELE = IVDELE + 1 04070317
WRITE (I02,80000) IVTNUM 04080317
IF (ICZERO) 10120, 0131, 20120 04090317
10120 IVPASS = IVPASS + 1 04100317
WRITE (I02,80002) IVTNUM 04110317
GO TO 0131 04120317
20120 IVFAIL = IVFAIL + 1 04130317
WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 04140317
0131 CONTINUE 04150317
C 04160317
C **** FCVS PROGRAM 317 - TEST 013 **** 04170317
C 04180317
C LOGICAL EXPRESSION INVOLVING LOGICAL OPERATOR (.NOT.) AS ACTUAL 04190317
C ARGUMENT. 04200317
C 04210317
IVTNUM = 13 04220317
IF (ICZERO) 30130, 0130, 30130 04230317
0130 CONTINUE 04240317
LVON01 = .TRUE. 04250317
IVCOMP = 0 04260317
IF (FF320(.NOT. LVON01)) IVCOMP = 1 04270317
IVCORR = 1 04280317
40130 IF (IVCOMP - 1) 20130, 10130, 20130 04290317
30130 IVDELE = IVDELE + 1 04300317
WRITE (I02,80000) IVTNUM 04310317
IF (ICZERO) 10130, 0141, 20130 04320317
10130 IVPASS = IVPASS + 1 04330317
WRITE (I02,80002) IVTNUM 04340317
GO TO 0141 04350317
20130 IVFAIL = IVFAIL + 1 04360317
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 04370317
0141 CONTINUE 04380317
C 04390317
C **** FCVS PROGRAM 317 - TEST 014 **** 04400317
C 04410317
C LOGICAL EXPRESSION INVOLVING LOGICAL OPERATOR (.OR.) AS ACTIVE 04420317
C ARGUMENT. 04430317
C 04440317
IVTNUM = 14 04450317
IF (ICZERO) 30140, 0140, 30140 04460317
0140 CONTINUE 04470317
LVON01 = .TRUE. 04480317
LVON02 = .FALSE. 04490317
IVCOMP = 0 04500317
IF (.NOT. FF320(LVON01 .OR. LVON02)) IVCOMP = 1 04510317
IVCORR = 1 04520317
40140 IF (IVCOMP - 1) 20140, 10140, 20140 04530317
30140 IVDELE = IVDELE + 1 04540317
WRITE (I02,80000) IVTNUM 04550317
IF (ICZERO) 10140, 0151, 20140 04560317
10140 IVPASS = IVPASS + 1 04570317
WRITE (I02,80002) IVTNUM 04580317
GO TO 0151 04590317
20140 IVFAIL = IVFAIL + 1 04600317
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 04610317
0151 CONTINUE 04620317
C 04630317
C **** FCVS PROGRAM 317 - TEST 015 **** 04640317
C 04650317
C LOGICAL EXPRESSION INVOLVING LOGICAL OPERATOR (.AND.) AS ACTUAL 04660317
C ARGUMENT. 04670317
C 04680317
IVTNUM = 15 04690317
IF (ICZERO) 30150, 0150, 30150 04700317
0150 CONTINUE 04710317
LVON01 = .FALSE. 04720317
LVON02 = .TRUE. 04730317
IVCOMP = 0 04740317
IF (FF320(LVON01 .AND. LVON02)) IVCOMP = 1 04750317
IVCORR = 1 04760317
40150 IF (IVCOMP - 1) 20150, 10150, 20150 04770317
30150 IVDELE = IVDELE + 1 04780317
WRITE (I02,80000) IVTNUM 04790317
IF (ICZERO) 10150, 0161, 20150 04800317
10150 IVPASS = IVPASS + 1 04810317
WRITE (I02,80002) IVTNUM 04820317
GO TO 0161 04830317
20150 IVFAIL = IVFAIL + 1 04840317
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 04850317
0161 CONTINUE 04860317
C 04870317
C **** FCVS PROGRAM 317 - TEST 016 **** 04880317
C 04890317
C EXPRESSION ENCLOSED IN PARENTHESES AS ACTUAL ARGUMENT 04900317
C 04910317
IVTNUM = 16 04920317
IF (ICZERO) 30160, 0160, 30160 04930317
0160 CONTINUE 04940317
IVCOMP = 0 04950317
IVON01 = 6 04960317
IVCOMP = FF318((IVON01 + 3)) 04970317
IVCORR = 10 04980317
40160 IF (IVCOMP - 10) 20160, 10160, 20160 04990317
30160 IVDELE = IVDELE + 1 05000317
WRITE (I02,80000) IVTNUM 05010317
IF (ICZERO) 10160, 0171, 20160 05020317
10160 IVPASS = IVPASS + 1 05030317
WRITE (I02,80002) IVTNUM 05040317
GO TO 0171 05050317
20160 IVFAIL = IVFAIL + 1 05060317
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 05070317
0171 CONTINUE 05080317
C 05090317
C **** FCVS PROGRAM 317 - TEST 017 **** 05100317
C 05110317
C REAL INTRINSIC FUNCTION REFERENCE AS ACTUAL ARGUMENT. 05120317
C 05130317
IVTNUM = 17 05140317
IF (ICZERO) 30170, 0170, 30170 05150317
0170 CONTINUE 05160317
RVCOMP = 0.0 05170317
RVON01 = -5.2 05180317
RVCOMP = FF319(ABS(RVON01)) 05190317
RVCORR = 6.2 05200317
40170 IF (RVCOMP - 6.1995) 20170, 10170, 40171 05210317
40171 IF (RVCOMP - 6.2005) 10170, 10170, 20170 05220317
30170 IVDELE = IVDELE + 1 05230317
WRITE (I02,80000) IVTNUM 05240317
IF (ICZERO) 10170, 0181, 20170 05250317
10170 IVPASS = IVPASS + 1 05260317
WRITE (I02,80002) IVTNUM 05270317
GO TO 0181 05280317
20170 IVFAIL = IVFAIL + 1 05290317
WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 05300317
0181 CONTINUE 05310317
C 05320317
C **** FCVS PROGRAM 317 - TEST 018 **** 05330317
C 05340317
C INTEGER INTRINSIC FUNCTION REFERENCE AS ACTUAL ARGUMENT. 05350317
C 05360317
IVTNUM = 18 05370317
IF (ICZERO) 30180, 0180, 30180 05380317
0180 CONTINUE 05390317
IVCOMP = 0 05400317
RVON01 = 4.7 05410317
IVCOMP = FF318(NINT(RVON01)) 05420317
IVCORR = 6 05430317
40180 IF (IVCOMP - 6) 20180, 10180, 20180 05440317
30180 IVDELE = IVDELE + 1 05450317
WRITE (I02,80000) IVTNUM 05460317
IF (ICZERO) 10180, 0191, 20180 05470317
10180 IVPASS = IVPASS + 1 05480317
WRITE (I02,80002) IVTNUM 05490317
GO TO 0191 05500317
20180 IVFAIL = IVFAIL + 1 05510317
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 05520317
0191 CONTINUE 05530317
C 05540317
C **** FCVS PROGRAM 317 - TEST 019 **** 05550317
C 05560317
C EXTERNAL FUNCTION REFERENCE AS ACTUAL ARGUMENT. 05570317
C 05580317
IVTNUM = 19 05590317
IF (ICZERO) 30190, 0190, 30190 05600317
0190 CONTINUE 05610317
IVCOMP = 0 05620317
IVON01 = 4 05630317
IVCOMP = FF318(FF321(IVON01)) 05640317
IVCORR = 6 05650317
40190 IF (IVCOMP - 6) 20190, 10190, 20190 05660317
30190 IVDELE = IVDELE + 1 05670317
WRITE (I02,80000) IVTNUM 05680317
IF (ICZERO) 10190, 0201, 20190 05690317
10190 IVPASS = IVPASS + 1 05700317
WRITE (I02,80002) IVTNUM 05710317
GO TO 0201 05720317
20190 IVFAIL = IVFAIL + 1 05730317
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 05740317
0201 CONTINUE 05750317
C 05760317
C **** FCVS PROGRAM 317 - TEST 020 **** 05770317
C 05780317
C EXTERNAL FUNCTION REFERENCE WHICH USES A REFERENCE TO ITSELF 05790317
C AS AN ACTUAL ARGUMENT. 05800317
C 05810317
IVTNUM = 20 05820317
IF (ICZERO) 30200, 0200, 30200 05830317
0200 CONTINUE 05840317
IVCOMP = 0 05850317
IVCOMP = FF318(FF318(4)) 05860317
IVCORR = 6 05870317
40200 IF (IVCOMP - 6) 20200, 10200, 20200 05880317
30200 IVDELE = IVDELE + 1 05890317
WRITE (I02,80000) IVTNUM 05900317
IF (ICZERO) 10200, 0211, 20200 05910317
10200 IVPASS = IVPASS + 1 05920317
WRITE (I02,80002) IVTNUM 05930317
GO TO 0211 05940317
20200 IVFAIL = IVFAIL + 1 05950317
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 05960317
0211 CONTINUE 05970317
C 05980317
C **** FCVS PROGRAM 317 - TEST 021 **** 05990317
C 06000317
C USE AN ACTUAL ARGUMENT NAME WHICH IS IDENTICAL TO THE DUMMY 06010317
C ARGUMENT NAME. 06020317
C 06030317
IVTNUM = 21 06040317
IF (ICZERO) 30210, 0210, 30210 06050317
0210 CONTINUE 06060317
IVCOMP = 0 06070317
IDON01 = 10 06080317
IVCOMP = FF318(IDON01) 06090317
IVCORR = 11 06100317
40210 IF (IVCOMP - 11) 20210, 10210, 20210 06110317
30210 IVDELE = IVDELE + 1 06120317
WRITE (I02,80000) IVTNUM 06130317
IF (ICZERO) 10210, 0221, 20210 06140317
10210 IVPASS = IVPASS + 1 06150317
WRITE (I02,80002) IVTNUM 06160317
GO TO 0221 06170317
20210 IVFAIL = IVFAIL + 1 06180317
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 06190317
0221 CONTINUE 06200317
C 06210317
C **** FCVS PROGRAM 317 - TEST 022 **** 06220317
C 06230317
C USE STATEMENT FUNCTION REFERENCE AS ACTUAL ARGUMENT. 06240317
C 06250317
IVTNUM = 22 06260317
IF (ICZERO) 30220, 0220, 30220 06270317
0220 CONTINUE 06280317
IVCOMP = 0 06290317
IVCOMP = FF318(IFOS01(4)) 06300317
IVCORR = 6 06310317
40220 IF (IVCOMP - 6) 20220, 10220, 20220 06320317
30220 IVDELE = IVDELE + 1 06330317
WRITE (I02,80000) IVTNUM 06340317
IF (ICZERO) 10220, 0231, 20220 06350317
10220 IVPASS = IVPASS + 1 06360317
WRITE (I02,80002) IVTNUM 06370317
GO TO 0231 06380317
20220 IVFAIL = IVFAIL + 1 06390317
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 06400317
0231 CONTINUE 06410317
C 06420317
C TEST 023 THROUGH TEST 028 ARE DESIGNED TO ASSOCIATE VARIOUS 06430317
C FORMS OF ACTUAL ARGUMENTS TO ARRAY NAMES USED AS EXTERNAL 06440317
C FUNCTION DUMMY ARGUMENTS. 06450317
C 06460317
C 06470317
C **** FCVS PROGRAM 317 - TEST 023 **** 06480317
C 06490317
C USE AN ARRAY NAME AS AN ACTUAL ARGUMENT IN WHICH THE ACTUAL 06500317
C ARGUMENT ARRAY DECLARATOR IS IDENTICAL TO THE ASSOCIATED DUMMY 06510317
C ARGUMENT ARRAY DECLARATOR. 06520317
C 06530317
IVTNUM = 23 06540317
IF (ICZERO) 30230, 0230, 30230 06550317
0230 CONTINUE 06560317
IVCOMP = 0 06570317
IADN12(1) = 1 06580317
IADN12(2) = 10 06590317
IADN12(3) = 100 06600317
IADN12(4) = 1000 06610317
IVCOMP = FF322(IADN12) 06620317
IVCORR = 1111 06630317
40230 IF (IVCOMP - 1111) 20230, 10230, 20230 06640317
30230 IVDELE = IVDELE + 1 06650317
WRITE (I02,80000) IVTNUM 06660317
IF (ICZERO) 10230, 0241, 20230 06670317
10230 IVPASS = IVPASS + 1 06680317
WRITE (I02,80002) IVTNUM 06690317
GO TO 0241 06700317
20230 IVFAIL = IVFAIL + 1 06710317
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 06720317
0241 CONTINUE 06730317
C 06740317
C **** FCVS PROGRAM 317 - TEST 024 **** 06750317
C 06760317
C USE AN ARRAY NAME AS AN ACTUAL ARGUMENT IN WHICH THE SIZE OF THE 06770317
C ACTUAL ARGUMENT ARRAY IS LARGER THAN THE SIZE OF THE ASSOCIATED 06780317
C DUMMY ARGUMENT ARRAY. 06790317
C 06800317
IVTNUM = 24 06810317
IF (ICZERO) 30240, 0240, 30240 06820317
0240 CONTINUE 06830317
IVCOMP = 0 06840317
IACN11(1) = 1 06850317
IACN11(2) = 10 06860317
IACN11(3) = 100 06870317
IACN11(4) = 1000 06880317
IACN11(5) = 10000 06890317
IVCOMP = FF322(IACN11) 06900317
IVCORR = 1111 06910317
40240 IF (IVCOMP - 1111) 20240, 10240, 20240 06920317
30240 IVDELE = IVDELE + 1 06930317
WRITE (I02,80000) IVTNUM 06940317
IF (ICZERO) 10240, 0251, 20240 06950317
10240 IVPASS = IVPASS + 1 06960317
WRITE (I02,80002) IVTNUM 06970317
GO TO 0251 06980317
20240 IVFAIL = IVFAIL + 1 06990317
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 07000317
0251 CONTINUE 07010317
C 07020317
C **** FCVS PROGRAM 317 - TEST 025 **** 07030317
C 07040317
C USE AN ARRAY NAME AS AN ACTUAL ARGUMENT IN WHICH THE ACTUAL 07050317
C ARGUMENT ARRAY DECLARATOR IS LARGER AND HAS MORE SUBSCRIPT 07060317
C EXPRESSIONS THAN THE ASSOCIATED DUMMY ARGUMENT ARRAY DECLARATOR. 07070317
C THE ASSOCIATED DUMMY ARGUMENT ARRAY DECLARATOR. 07080317
C 07090317
IVTNUM = 25 07100317
IF (ICZERO) 30250, 0250, 30250 07110317
0250 CONTINUE 07120317
IVCOMP = 0 07130317
IATN11(1,1) = 1 07140317
IATN11(2,1) = 10 07150317
IATN11(1,2) = 100 07160317
IATN11(2,2) = 1000 07170317
IATN11(1,3) = 10000 07180317
IVCOMP = FF322(IATN11) 07190317
IVCORR = 1111 07200317
40250 IF (IVCOMP - 1111) 20250, 10250, 20250 07210317
30250 IVDELE = IVDELE + 1 07220317
WRITE (I02,80000) IVTNUM 07230317
IF (ICZERO) 10250, 0261, 20250 07240317
10250 IVPASS = IVPASS + 1 07250317
WRITE (I02,80002) IVTNUM 07260317
GO TO 0261 07270317
20250 IVFAIL = IVFAIL + 1 07280317
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 07290317
0261 CONTINUE 07300317
C 07310317
C **** FCVS PROGRAM 317 - TEST 026 **** 07320317
C 07330317
C USE AN ARRAY ELEMENT NAME AS AN ACTUAL ARGUMENT IN WHICH THE 07340317
C ASSOCIATED ACTUAL AND DUMMY ARRAY DECLARATORS ARE IDENTICAL. ALL 07350317
C ARRAY ELEMENTS OF THE ACTUAL ARRAY SHOULD BE PASSED TO THE 07360317
C DUMMY ARRAY OF THE EXTERNAL FUNCTION. 07370317
C 07380317
IVTNUM = 26 07390317
IF (ICZERO) 30260, 0260, 30260 07400317
0260 CONTINUE 07410317
RVCOMP = 0.0 07420317
RADN12(1) = 1. 07430317
RADN12(2) = 10. 07440317
RADN12(3) = 100. 07450317
RADN12(4) = 1000. 07460317
RVCOMP = FF323(RADN12(1)) 07470317
RVCORR = 1111. 07480317
40260 IF (RVCOMP - 1110.5) 20260, 10260, 40261 07490317
40261 IF (RVCOMP - 1111.5) 10260, 10260, 20260 07500317
30260 IVDELE = IVDELE + 1 07510317
WRITE (I02,80000) IVTNUM 07520317
IF (ICZERO) 10260, 0271, 20260 07530317
10260 IVPASS = IVPASS + 1 07540317
WRITE (I02,80002) IVTNUM 07550317
GO TO 0271 07560317
20260 IVFAIL = IVFAIL + 1 07570317
WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 07580317
0271 CONTINUE 07590317
C 07600317
C **** FCVS PROGRAM 317 - TEST 027 **** 07610317
C 07620317
C USE AN ARRAY ELEMENT NAME AS AN ACTUAL ARGUMENT IN WHICH THE SIZE 07630317
C OF THE ACTUAL ARGUMENT ARRAY IS LARGER AND HAS FEWER SUBSCRIPT 07640317
C EXPRESSIONS THAN THE ASSOCIATED DUMMY ARGUMENT ARRAY. ONLY ACTUAL07650317
C ARRAY ELEMENTS WITH SUBSCRIPT VALUES OF 5, 6, 7 AND 8 (OUT OF A 07660317
C POSSIBLE 10 ELEMENTS) SHOULD BE PASSED TO THE DUMMY ARRAY OF THE 07670317
C EXTERNAL FUNCTION. 07680317
C 07690317
IVTNUM = 27 07700317
IF (ICZERO) 30270, 0270, 30270 07710317
0270 CONTINUE 07720317
RVCOMP = 0.0 07730317
RACN11(4) = 1. 07740317
RACN11(5) = 10. 07750317
RACN11(6) = 100. 07760317
RACN11(7) = 1000. 07770317
RACN11(8) = 10000. 07780317
RACN11(9) = 100000. 07790317
RVCORR = 11110. 07800317
RVCOMP = FF323(RACN11(5)) 07810317
40270 IF (RVCOMP - 11105.) 20270, 10270, 40271 07820317
40271 IF (RVCOMP - 11115.) 10270, 10270, 20270 07830317
30270 IVDELE = IVDELE + 1 07840317
WRITE (I02,80000) IVTNUM 07850317
IF (ICZERO) 10270, 0281, 20270 07860317
10270 IVPASS = IVPASS + 1 07870317
WRITE (I02,80002) IVTNUM 07880317
GO TO 0281 07890317
20270 IVFAIL = IVFAIL + 1 07900317
WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 07910317
0281 CONTINUE 07920317
C 07930317
C **** FCVS PROGRAM 317 - TEST 028 **** 07940317
C 07950317
C USE AN ARRAY ELEMENT NAME AS AN ACTUAL ARGUMENT IN WHICH THE SIZE 07960317
C OF THE ACTUAL ARGUMENT ARRAY IS LARGE THAN THE SIZE OF THE 07970317
C ASSOCIATED DUMMY ARGUMENT ARRAY. ONLY ACTUAL ARRAY ELEMENTS WITH 07980317
C SUBSCRIPT VALUES OF 9, 10, 11 AND 12 (OUT OF A POSSIBLE 12 07990317
C ELEMENTS) SHOULD BE PASSED TO THE DUMMY ARRAY OF THE EXTERNAL 08000317
C FUNCTION. 08010317
C 08020317
IVTNUM = 28 08030317
IF (ICZERO) 30280, 0280, 30280 08040317
0280 CONTINUE 08050317
RVCOMP = 0.0 08060317
RATN11(2,3) = 1. 08070317
RATN11(3,3) = 10. 08080317
RATN11(1,4) = 100. 08090317
RATN11(2,4) = 1000. 08100317
RATN11(3,4) = 10000. 08110317
RVCOMP = FF323(RATN11(3,3)) 08120317
RVCORR = 11110. 08130317
40280 IF (RVCOMP - 11105.) 20280, 10280, 40281 08140317
40281 IF (RVCOMP - 11115.) 10280, 10280, 20280 08150317
30280 IVDELE = IVDELE + 1 08160317
WRITE (I02,80000) IVTNUM 08170317
IF (ICZERO) 10280, 0291, 20280 08180317
10280 IVPASS = IVPASS + 1 08190317
WRITE (I02,80002) IVTNUM 08200317
GO TO 0291 08210317
20280 IVFAIL = IVFAIL + 1 08220317
WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 08230317
0291 CONTINUE 08240317
C 08250317
C TEST 029 THROUGH TEST 032 ARE DESIGNED TO ASSOCIATE VARIOUS FORMS 08260317
C OF ACTUAL ARGUMENTS TO PROCEDURES USED AS DUMMY ARGUMENTS. 08270317
C ACTUAL ARGUMENTS TESTED INCLUDE THE NAMES OF AN EXTERNAL FUNCTION,08280317
C AN INTRINSIC FUNCTION, AND A SUBROUTINE. 08290317
C 08300317
C 08310317
C **** FCVS PROGRAM 317 - TEST 029 **** 08320317
C 08330317
C USE AN EXTERNAL FUNCTION NAME AS AN ACTUAL ARGUMENT. 08340317
C 08350317
IVTNUM = 29 08360317
IF (ICZERO) 30290, 0290, 30290 08370317
0290 CONTINUE 08380317
IVCOMP = 0 08390317
IVCOMP = FF324(FF325,5) 08400317
IVCORR = 7 08410317
40290 IF (IVCOMP - 7) 20290, 10290, 20290 08420317
30290 IVDELE = IVDELE + 1 08430317
WRITE (I02,80000) IVTNUM 08440317
IF (ICZERO) 10290, 0301, 20290 08450317
10290 IVPASS = IVPASS + 1 08460317
WRITE (I02,80002) IVTNUM 08470317
GO TO 0301 08480317
20290 IVFAIL = IVFAIL + 1 08490317
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 08500317
0301 CONTINUE 08510317
C 08520317
C **** FCVS PROGRAM 317 - TEST 030 **** 08530317
C 08540317
C USE AN INTRINSIC FUNCTION NAME AS AN ACTUAL ARGUMENT. 08550317
C 08560317
IVTNUM = 30 08570317
IF (ICZERO) 30300, 0300, 30300 08580317
0300 CONTINUE 08590317
IVCOMP = 0 08600317
IVCOMP = FF324(IABS,-7) 08610317
IVCORR = 8 08620317
40300 IF (IVCOMP - 8) 20300, 10300, 20300 08630317
30300 IVDELE = IVDELE + 1 08640317
WRITE (I02,80000) IVTNUM 08650317
IF (ICZERO) 10300, 0311, 20300 08660317
10300 IVPASS = IVPASS + 1 08670317
WRITE (I02,80002) IVTNUM 08680317
GO TO 0311 08690317
20300 IVFAIL = IVFAIL + 1 08700317
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 08710317
0311 CONTINUE 08720317
C 08730317
C **** FCVS PROGRAM 317 - TEST 031 **** 08740317
C 08750317
C USE AN EXTERNAL FUNCTION NAME AS AN ACTUAL ARGUMENT. THE 08760317
C INTRINSIC FUNCTION NAME (NINT) IS USED AS THE DUMMY PROCEDURE 08770317
C NAME IN THE EXTERNAL FUNCTION AND THEREFORE CAN NOT BE USED AS 08780317
C AN INTRINSIC FUNCTION WITHIN THAT PROGRAM UNIT. HOWEVER IT CAN 08790317
C BE REFERENCED IN THE MAIN PROGRAM FM317 AND IN THE SUBPROGRAM 08800317
C FF325. 08810317
C 08820317
IVTNUM = 31 08830317
IF (ICZERO) 30310, 0310, 30310 08840317
0310 CONTINUE 08850317
IVCOMP = 0 08860317
IVCOMP = NINT(3.7) + FF324(FF325,2) 08870317
IVCORR = 8 08880317
40310 IF (IVCOMP - 8) 20310, 10310, 20310 08890317
30310 IVDELE = IVDELE + 1 08900317
WRITE (I02,80000) IVTNUM 08910317
IF (ICZERO) 10310, 0321, 20310 08920317
10310 IVPASS = IVPASS + 1 08930317
WRITE (I02,80002) IVTNUM 08940317
GO TO 0321 08950317
20310 IVFAIL = IVFAIL + 1 08960317
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 08970317
0321 CONTINUE 08980317
C 08990317
C **** FCVS PROGRAM 317 - TEST 032 **** 09000317
C 09010317
C USE A SUBROUTINE NAME AS AN ACTUAL ARGUMENT. 09020317
C 09030317
IVTNUM = 32 09040317
IF (ICZERO) 30320, 0320, 30320 09050317
0320 CONTINUE 09060317
RVCOMP = 0.0 09070317
RVON01 = 3.5 09080317
RVCOMP = FF326(FS327,RVON01) 09090317
RVCORR = 5.5 09100317
40320 IF (RVCOMP - 5.4995) 20320, 10320, 40321 09110317
40321 IF (RVCOMP - 5.5005) 10320, 10320, 20320 09120317
30320 IVDELE = IVDELE + 1 09130317
WRITE (I02,80000) IVTNUM 09140317
IF (ICZERO) 10320, 0331, 20320 09150317
10320 IVPASS = IVPASS + 1 09160317
WRITE (I02,80002) IVTNUM 09170317
GO TO 0331 09180317
20320 IVFAIL = IVFAIL + 1 09190317
WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 09200317
0331 CONTINUE 09210317
C 09220317
C 09230317
C WRITE OUT TEST SUMMARY 09240317
C 09250317
WRITE (I02,90004) 09260317
WRITE (I02,90014) 09270317
WRITE (I02,90004) 09280317
WRITE (I02,90000) 09290317
WRITE (I02,90004) 09300317
WRITE (I02,90020) IVFAIL 09310317
WRITE (I02,90022) IVPASS 09320317
WRITE (I02,90024) IVDELE 09330317
STOP 09340317
90001 FORMAT (" ",24X,"FM317") 09350317
90000 FORMAT (" ",20X,"END OF PROGRAM FM317" ) 09360317
C 09370317
C FORMATS FOR TEST DETAIL LINES 09380317
C 09390317
80000 FORMAT (" ",4X,I5,6X,"DELETED") 09400317
80002 FORMAT (" ",4X,I5,7X,"PASS") 09410317
80010 FORMAT (" ",4X,I5,7X,"FAIL",10X,I6,9X,I6) 09420317
80012 FORMAT (" ",4X,I5,7X,"FAIL",4X,E12.5,3X,E12.5) 09430317
80018 FORMAT (" ",4X,I5,7X,"FAIL",2X,A14,1X,A14) 09440317
C 09450317
C FORMAT STATEMENTS FOR PAGE HEADERS 09460317
C 09470317
90002 FORMAT ("1") 09480317
90004 FORMAT (" ") 09490317
90006 FORMAT (" ",10X,"FORTRAN COMPILER VALIDATION SYSTEM" ) 09500317
90008 FORMAT (" ",21X,"VERSION 2.1" ) 09510317
90010 FORMAT (" ",8X,"FOR OFFICIAL USE ONLY - COPYRIGHT 1978" ) 09520317
90012 FORMAT (" ",5X,"TEST",5X,"PASS/FAIL",5X,"COMPUTED",8X,"CORRECT") 09530317
90014 FORMAT (" ",5X,"----------------------------------------------" ) 09540317
90016 FORMAT (" ",18X,"SUBSET LEVEL TEST" ) 09550317
C 09560317
C FORMAT STATEMENTS FOR RUN SUMMARY 09570317
C 09580317
90020 FORMAT (" ",19X,I5," TESTS FAILED" ) 09590317
90022 FORMAT (" ",19X,I5," TESTS PASSED" ) 09600317
90024 FORMAT (" ",19X,I5," TESTS DELETED" ) 09610317
END 09620317
INTEGER FUNCTION FF318(IDON01) 00010318
C THIS FUNCTION IS USED BY VARIOUS TESTS IN MAIN PROGRAM FM317 00020318
C TO TEST THE ASSOCIATION OF VARIOUS FORMS OF INTEGER ACTUAL 00030318
C ARGUMENTS TO AN INTEGER VARIABLE NAME USED AS AN EXTERNAL 00040318
C FUNCTION DUMMY ARGUMENT. THIS ROUTINE INCREMENTS THE ARGUMENT 00050318
C VALUE BY ONE AND RETURNS THE RESULT AS THE FUNCTION VALUE. 00060318
FF318 = IDON01 + 1 00070318
RETURN 00080318
END 00090318
REAL FUNCTION FF319(RDON01) 00010319
C THIS FUNCTION IS USED BY VARIOUS TESTS IN MAIN PROGRAM FM317 00020319
C TO TEST THE ASSOCIATION OF VARIOUS FORMS OF REAL ACTUAL 00030319
C ARGUMENTS TO A REAL VARIABLE NAME USED AS AN EXTERNAL FUNCTION 00040319
C DUMMY ARGUMENT. THIS ROUTINE INCREMENTS THE ARGUMENT VALUE BY 00050319
C ONE AND RETURNS THE RESULT AS THE FUNCTION VALUE. 00060319
FF319 = RDON01 + 1.0 00070319
RETURN 00080319
END 00090319
LOGICAL FUNCTION FF320(LDON01) 00010320
C THIS FUNCTION IS USED BY VARIOUS TESTS IN MAIN PROGRAM FM317 00020320
C TO TEST THE ASSOCIATION OF VARIOUS FORMS OF LOGICAL ACTUAL 00030320
C ARGUMENTS TO A LOGICAL VARIABLE NAME USED AS AN EXTERNAL 00040320
C FUNCTION DUMMY ARGUMENT. THIS ROUTINE NEGATES THE ARGUMENT 00050320
C VALUE AND RETURNS THE RESULT AS THE FUNCTION VALUE. 00060320
LOGICAL LDON01 00070320
FF320 = .NOT. LDON01 00080320
RETURN 00090320
END 00100320
INTEGER FUNCTION FF321(IDON02) 00010321
C THIS FUNCTION IS USED IN TEST 019 OF MAIN PROGRAM FM317 AS 00020321
C THE TEST OF THE USE OF AN EXTERNAL FUNCTION REFERENCE AS AN 00030321
C ACTUAL ARGUMENT TO A VARIABLE NAME USED AS AN EXTERNAL FUNCTION 00040321
C DUMMY ARGUMENT. THIS ROUTINE INCREMENTS THE ARGUMENT VALUE BY 00050321
C ONE AND RETURNS THE RESULT AS THE FUNCTION VALUE. 00060321
FF321 = IDON02 + 1 00070321
RETURN 00080321
END 00090321
INTEGER FUNCTION FF322(IDDN11) 00010322
C THIS FUNCTION IS USED BY VARIOUS TESTS IN MAIN PROGRAM FM317 00020322
C TO TEST THE ASSOCIATION OF VARIOUS FORMS OF ARRAY NAMES USED AS 00030322
C ACTUAL ARGUMENTS TO AN ARRAY NAME USED AS AN EXTERNAL FUNCTION 00040322
C DUMMY ARGUMENT. THIS ROUTINE ADDS TOGETHER THE FOUR ELEMENTS IN 00050322
C THE DUMMY ARRAY AND RETURNS THE SUM AS THE FUNCTION VALUE. 00060322
DIMENSION IDDN11(4) 00070322
FF322 = IDDN11(1) + IDDN11(2) + IDDN11(3) + IDDN11(4) 00080322
RETURN 00090322
END 00100322
REAL FUNCTION FF323(RDTN21) 00010323
C THIS FUNCTION IS USED BY VARIOUS TESTS IN MAIN PROGRAM FM317 00020323
C TO TEST THE ASSOCIATION OF VARIOUS FORMS OF ARRAY ELEMENT NAMES 00030323
C USED AS ACTUAL ARGUMENTS TO AN ARRAY NAME USED AS AN EXTERNAL 00040323
C FUNCTION DUMMY ARGUMENT. THIS ROUTINE ADDS TOGETHER THE FOUR 00050323
C ELEMENTS IN THE DUMMY ARRAY AND RETURNS THE SUM AS THE FUNCTION 00060323
C VALUE. 00070323
REAL RDTN21(2,2) 00080323
FF323 = RDTN21(1,1) + RDTN21(2,1) + RDTN21(1,2) + RDTN21(2,2) 00090323
RETURN 00100323
END 00110323
INTEGER FUNCTION FF324(NINT, IDON03) 00010324
C THIS FUNCTION IS USED BY TESTS 029, 030 AND 031 OF MAIN 00020324
C PROGRAM FM317 TO TEST THE ASSOCIATION OF EXTERNAL FUNCTION AND 00030324
C INTRINSIC FUNCTION NAMES USED AS ACTUAL ARGUMENTS TO A PROCEDURE 00040324
C NAME USED AS A DUMMY ARGUMENT. THIS FUNCTION REFERENCES THE 00050324
C EXTERNAL FUNCTION OR INTRINSIC FUNCTION PASSED AS A PROCEDURE 00060324
C NAME ARGUMENT, INCREMENTING THE RESULT BY ONE BEFORE RETURNING 00070324
C THE RESULT AS THE FUNCTION VALUE. 00080324
FF324 = NINT(IDON03) + 1 00090324
C **** THE NAME NINT IS A DUMMY ARGUMENT 00100324
C AND NOT AN INTRINSIC FUNCTION REFERENCE ***** 00110324
RETURN 00120324
END 00130324
INTEGER FUNCTION FF325(IDON05) 00010325
C THIS FUNCTION IS USED BY TESTS 029 AND 031 OF MAIN PROGRAM 00020325
C FM317 TO TEST THE ASSOCIATION OF AN EXTERNAL FUNCTION NAME USED AS00030325
C AN ACTUAL ARGUMENT TO A PROCEDURE NAME USED AS A DUMMY ARGUMENT. 00040325
C FF325 IS REFERENCED FROM EXTERNAL FUNCTION FF324 VIA A DUMMY 00050325
C PROCEDURE NAME REFERENCE. THIS ROUTINE ADDS THE RESULT OF AN 00060325
C INTRINSIC FUNCTION REFERENCE (NINT) TO THE ARGUMENT VALUE AND 00070325
C RETURNS THE SUM AS THE FUNCTION VALUE. 00080325
FF325 = IDON05 + NINT(1.2) 00090325
RETURN 00100325
END 00110325
REAL FUNCTION FF326(RDON02,RDON03) 00010326
C THIS FUNCTION IS USED BY TEST 032 OF MAIN PROGRAM FM317 TO 00020326
C TEST THE ASSOCIATION OF A SUBROUTINE NAME USED AS AN ACTUAL 00030326
C ARGUMENT TO A PROCEDURE NAME USED AS A DUMMY ARGUMENT. THIS 00040326
C FUNCTION CALLS THE SUBROUTINE (FS327) PASSED AS A PROCEDURE NAME 00050326
C ARGUMENT. THE VALUE OF THE ARGUMENT RETURNED FROM THIS 00060326
C REFERENCE IS THEN INCREMENTED BY ONE BEFORE RETURNING THE SUM AS 00070326
C THE FUNCTION VALUE. 00080326
CALL RDON02(RDON03) 00090326
FF326 = RDON03 + 1.0 00100326
RETURN 00110326
END 00120326
SUBROUTINE FS327(RDON04) 00010327
C THIS SUBROUTINE IS USED BY TEST 032 OF MAIN PROGRAM FM317 TO 00020327
C TEST THE ASSOCIATION OF A SUBROUTINE NAME USED AS AN ACTUAL 00030327
C ARGUMENT TO A PROCEDURE NAME USED AS A DUMMY ARGUMENT. FS327 IS 00040327
C CALLED FROM EXTERNAL PROGRAM FF326 VIA A DUMMY PROCEDURE NAME 00050327
C REFERENCE. THIS ROUTINE INCREMENTS THE ARGUMENT VALUE BY ONE. 00060327
RDON04 = RDON04 + 1.0 00070327
RETURN 00080327
END 00090327