| PROGRAM FM328 00010328 |
| C 00020328 |
| C 00030328 |
| C THIS ROUTINE TEST SUBSET LEVEL FEATURES OF 00040328 |
| C SUBROUTINE SUBPROGRAMS. TESTS ARE DESIGNED TO CHECK THE 00050328 |
| C ASSOCIATION OF ALL PERMISSIBLE FORMS OF ACTUAL ARGUMENTS WITH 00060328 |
| C VARIABLE, ARRAY AND PROCEDURE NAME DUMMY ARGUMENTS. THESE 00070328 |
| C INCLUDE, 00080328 |
| C 00090328 |
| C 1) ACTUAL ARGUMENTS ASSOCIATED TO VARIABLE NAME DUMMY 00100328 |
| C ARGUMENT INCLUDE, 00110328 |
| C 00120328 |
| C A) CONSTANT 00130328 |
| C B) VARIABLE NAME 00140328 |
| C C) ARRAY ELEMENT NAME 00150328 |
| C D) EXPRESSION INVOLVING OPERATORS 00160328 |
| C E) EXPRESSION ENCLOSED IN PARENTHESES 00170328 |
| C F) INTRINSIC FUNCTION REFERENCE 00180328 |
| C G) EXTERNAL FUNCTION REFERENCE 00190328 |
| C H) STATEMENT FUNCTION REFERENCE 00200328 |
| C I) ACTUAL ARGUMENT NAME SAME AS DUMMY ARGUMENT NAME 00210328 |
| C 00220328 |
| C 2) ACTUAL ARGUMENTS ASSOCIATED TO ARRAY NAME DUMMY 00230328 |
| C ARGUMENT INCLUDE, 00240328 |
| C 00250328 |
| C A) ARRAY NAME 00260328 |
| C B) ARRAY ELEMENT NAME 00270328 |
| C 00280328 |
| C 3) ACTUAL ARGUMENTS ASSOCIATED TO PROCEDURE NAME DUMMY 00290328 |
| C ARGUMENT INCLUDE, 00300328 |
| C 00310328 |
| C A) EXTERNAL FUNCTION NAME 00320328 |
| C B) INTRINSIC FUNCTION NAME 00330328 |
| C C) SUBROUTINE NAME 00340328 |
| C 00350328 |
| C ALL DATA PASSED TO THE REFERENCED SUBPROGRAMS ARE PASSED VIA 00360328 |
| C ARGUMENT VALUES, WHILE ALL RESULTS RETURNED TO FM328 ARE 00370328 |
| C RETURNED VIA VARIABLES IN NAMED COMMON. SUBSET LEVEL ROUTINES 00380328 |
| C FM026, FM050 AND FM056 ALSO TEST THE USE OF SUBROUTINES. 00390328 |
| C 00400328 |
| C REFERENCES. 00410328 |
| C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN, 00420328 |
| C X3.9-1978 00430328 |
| C 00440328 |
| C SECTION 2.8, DUMMY ARGUMENTS 00450328 |
| C SECTION 5.1.2.2, DUMMY ARRAY DECLARATOR 00460328 |
| C SECTION 5.5, DUMMY AND ACTUAL ARRAYS 00470328 |
| C SECTION 8.1, DIMENSION STATEMENT 00480328 |
| C SECTION 8.3, COMMON STATEMENT 00490328 |
| C SECTION 8.4, TYPE-STATEMENT 00500328 |
| C SECTION 8.7, EXTERNAL STATEMENT 00510328 |
| C SECTION 8.8, INTRINSIC STATEMENT 00520328 |
| C SECTION 15.2, REFERENCING A FUNCTION 00530328 |
| C SECTION 15.3, INTRINSIC FUNCTIONS 00540328 |
| C SECTION 15.5, EXTERNAL FUNCTIONS 00550328 |
| C SECTION 15.6, SUBROUTINES 00560328 |
| C SECTION 15.9, ARGUMENTS AND COMMON BLOCKS 00570328 |
| C 00580328 |
| C 00590328 |
| C ******************************************************************00600328 |
| C A COMPILER VALIDATION SYSTEM FOR THE FORTRAN LANGUAGE 00610328 |
| C BASED ON SPECIFICATIONS AS DEFINED IN AMERICAN STANDARD FORTRAN 00620328 |
| C X3.9-1978, HAS BEEN DEVELOPED BY THE DEPARTMENT OF THE NAVY. THE 00630328 |
| C FORTRAN COMPILER VALIDATION SYSTEM (FCVS) CONSISTS OF AUDIT 00640328 |
| C ROUTINES, THEIR RELATED DATA, AND AN EXECUTIVE SYSTEM. EACH AUDIT00650328 |
| C ROUTINE IS A FORTRAN PROGRAM OR SUBPROGRAM WHICH INCLUDES TESTS 00660328 |
| C OF SPECIFIC LANGUAGE ELEMENTS AND SUPPORTING PROCEDURES INDICATING00670328 |
| C THE RESULT OF EXECUTING THESE TESTS. 00680328 |
| C 00690328 |
| C THIS PARTICULAR PROGRAM OR SUBPROGRAM CONTAINS ONLY FEATURES 00700328 |
| C FOUND IN THE SUBSET LEVEL OF THE STANDARD. 00710328 |
| C 00720328 |
| C SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO 00730328 |
| C NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY 00740328 |
| C SOFTWARE STANDARDS VALIDATION GROUP 00750328 |
| C BUILDING 225 RM A266 00760328 |
| C GAITHERSBURG, MD 20899 00770328 |
| C ******************************************************************00780328 |
| C 00790328 |
| C 00800328 |
| IMPLICIT LOGICAL (L) 00810328 |
| IMPLICIT CHARACTER*14 (C) 00820328 |
| C 00830328 |
| INTEGER IATN11(2,3) 00840328 |
| REAL RATN11(3,4) 00850328 |
| INTEGER FF330 00860328 |
| DIMENSION IADN11(4), IADN12(4) 00870328 |
| DIMENSION RADN11(4), RADN12(4) 00880328 |
| DIMENSION LADN11(4) 00890328 |
| COMMON /BLK1/IVCN01, RVCN01, LVCN01 00900328 |
| COMMON IACN11(6), RACN11(10) 00910328 |
| EXTERNAL FF330, FS335 00920328 |
| INTRINSIC ABS, IABS, NINT 00930328 |
| IFOS01(IDON04) = IDON04 + 1 00940328 |
| RFOS01(RDON04) = RDON04 + 1.0 00950328 |
| LFOS01(LDON04) = .NOT. LDON04 00960328 |
| C 00970328 |
| C 00980328 |
| C 00990328 |
| C INITIALIZATION SECTION. 01000328 |
| C 01010328 |
| C INITIALIZE CONSTANTS 01020328 |
| C ******************** 01030328 |
| C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER 01040328 |
| I01 = 5 01050328 |
| C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER 01060328 |
| I02 = 6 01070328 |
| C SYSTEM ENVIRONMENT SECTION 01080328 |
| C 01090328 |
| CX010 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-010 CONTROL CARD.01100328 |
| C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 01110328 |
| C (UNIT NUMBER FOR CARD READER). 01120328 |
| CX011 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-011 CONTROL CARD01130328 |
| C THE CX011 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 01140328 |
| C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX010 ABOVE. 01150328 |
| C 01160328 |
| CX020 THIS CARD IS PEPLACED BY CONTENTS OF FEXEC X-020 CONTROL CARD.01170328 |
| C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02 = 6 01180328 |
| C (UNIT NUMBER FOR PRINTER). 01190328 |
| CX021 THIS CARD IS PEPLACED BY CONTENTS OF FEXEC X-021 CONTROL CARD.01200328 |
| C THE CX021 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 01210328 |
| C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX020 ABOVE. 01220328 |
| C 01230328 |
| IVPASS = 0 01240328 |
| IVFAIL = 0 01250328 |
| IVDELE = 0 01260328 |
| ICZERO = 0 01270328 |
| C 01280328 |
| C WRITE OUT PAGE HEADERS 01290328 |
| C 01300328 |
| WRITE (I02,90002) 01310328 |
| WRITE (I02,90006) 01320328 |
| WRITE (I02,90008) 01330328 |
| WRITE (I02,90004) 01340328 |
| WRITE (I02,90010) 01350328 |
| WRITE (I02,90004) 01360328 |
| WRITE (I02,90016) 01370328 |
| WRITE (I02,90001) 01380328 |
| WRITE (I02,90004) 01390328 |
| WRITE (I02,90012) 01400328 |
| WRITE (I02,90014) 01410328 |
| WRITE (I02,90004) 01420328 |
| C 01430328 |
| C 01440328 |
| C TEST 001 THROUGH TEST 013 ARE DESIGNED TO ASSOCIATE VARIOUS FORMS 01450328 |
| C OF ACTUAL ARGUMENTS TO VARIABLE NAMES USED AS SUBROUTINE 01460328 |
| C DUMMY ARGUMENTS. INTEGER, REAL AND LOGICAL DUMMY ARGUMENTS ARE 01470328 |
| C TESTED. 01480328 |
| C 01490328 |
| C 01500328 |
| C **** FCVS PROGRAM 328 - TEST 001 **** 01510328 |
| C 01520328 |
| C USE INTEGER, REAL AND LOGICAL CONSTANTS AS ACTUAL ARGUMENTS. 01530328 |
| C 01540328 |
| IVTNUM = 1 01550328 |
| IF (ICZERO) 30010, 0010, 30010 01560328 |
| 0010 CONTINUE 01570328 |
| CALL FS329(3, 3.0, .FALSE.) 01580328 |
| IVCOMP = 1 01590328 |
| IF (IVCN01 .EQ. 4) IVCOMP = IVCOMP * 2 01600328 |
| IF (RVCN01 .GE. 3.9995 .AND. RVCN01 .LE. 4.0005) IVCOMP = IVCOMP*301610328 |
| IF (LVCN01) IVCOMP = IVCOMP * 5 01620328 |
| IVCORR = 30 01630328 |
| 40010 IF (IVCOMP - 30) 20010, 10010, 20010 01640328 |
| 30010 IVDELE = IVDELE + 1 01650328 |
| WRITE (I02,80000) IVTNUM 01660328 |
| IF (ICZERO) 10010, 0021, 20010 01670328 |
| 10010 IVPASS = IVPASS + 1 01680328 |
| WRITE (I02,80002) IVTNUM 01690328 |
| GO TO 0021 01700328 |
| 20010 IVFAIL = IVFAIL + 1 01710328 |
| WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 01720328 |
| 0021 CONTINUE 01730328 |
| C 01740328 |
| C **** FCVS PROGRAM 328 - TEST 002 **** 01750328 |
| C 01760328 |
| C USE INTEGER, REAL AND LOGICAL VARIABLES AS ACTUAL ARGUMENTS. 01770328 |
| C 01780328 |
| IVTNUM = 2 01790328 |
| IF (ICZERO) 30020, 0020, 30020 01800328 |
| 0020 CONTINUE 01810328 |
| IVON01 = 7 01820328 |
| RVON01 = 7.0 01830328 |
| LVON01 = .TRUE. 01840328 |
| CALL FS329(IVON01, RVON01, LVON01) 01850328 |
| IVCOMP = 1 01860328 |
| IF (IVCN01 .EQ. 8) IVCOMP =IVCOMP * 2 01870328 |
| IF (RVCN01 .GE. 7.9995 .AND. RVCN01 .LE. 8.0005) IVCOMP = IVCOMP*301880328 |
| IF (.NOT. LVCN01) IVCOMP = IVCOMP * 5 01890328 |
| IVCORR = 30 01900328 |
| 40020 IF (IVCOMP - 30) 20020, 10020, 20020 01910328 |
| 30020 IVDELE = IVDELE + 1 01920328 |
| WRITE (I02,80000) IVTNUM 01930328 |
| IF (ICZERO) 10020, 0031, 20020 01940328 |
| 10020 IVPASS = IVPASS + 1 01950328 |
| WRITE (I02,80002) IVTNUM 01960328 |
| GO TO 0031 01970328 |
| 20020 IVFAIL = IVFAIL + 1 01980328 |
| WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 01990328 |
| 0031 CONTINUE 02000328 |
| C 02010328 |
| C **** FCVS PROGRAM 328 - TEST 003 **** 02020328 |
| C 02030328 |
| C USE INTEGER, REAL AND LOGICAL ARRAY ELEMENT NAMES AS ACTUAL 02040328 |
| C ARGUMENTS. 02050328 |
| C 02060328 |
| IVTNUM = 3 02070328 |
| IF (ICZERO) 30030, 0030, 30030 02080328 |
| 0030 CONTINUE 02090328 |
| IADN11(2) = 2 02100328 |
| RADN11(4) = 4.0 02110328 |
| LADN11(1) = .FALSE. 02120328 |
| CALL FS329(IADN11(2), RADN11(4), LADN11(1)) 02130328 |
| IVCOMP = 1 02140328 |
| IF (IVCN01 .EQ. 3) IVCOMP = IVCOMP * 2 02150328 |
| IF (RVCN01 .GE. 4.9995 .AND. RVCN01 .LE. 5.0005) IVCOMP = IVCOMP*302160328 |
| IF (LVCN01) IVCOMP = IVCOMP * 5 02170328 |
| IVCORR = 30 02180328 |
| 40030 IF (IVCOMP - 30) 20030, 10030, 20030 02190328 |
| 30030 IVDELE = IVDELE + 1 02200328 |
| WRITE (I02,80000) IVTNUM 02210328 |
| IF (ICZERO) 10030, 0041, 20030 02220328 |
| 10030 IVPASS = IVPASS + 1 02230328 |
| WRITE (I02,80002) IVTNUM 02240328 |
| GO TO 0041 02250328 |
| 20030 IVFAIL = IVFAIL + 1 02260328 |
| WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 02270328 |
| 0041 CONTINUE 02280328 |
| C 02290328 |
| C **** FCVS PROGRAM 328 - TEST 004 **** 02300328 |
| C 02310328 |
| C INTEGER AND REAL EXPRESSIONS INVOLVING OPERATORS AS ACTUAL 02320328 |
| C ARGUMENTS. 02330328 |
| C 02340328 |
| IVTNUM = 4 02350328 |
| IF (ICZERO) 30040, 0040, 30040 02360328 |
| 0040 CONTINUE 02370328 |
| IVON02 = 2 02380328 |
| IVON03 = 3 02390328 |
| RVON02 = 2. 02400328 |
| RVON03 = 1.2 02410328 |
| CALL FS329(IVON02 + 3 * IVON03 - 7, RVON02 *RVON03 / .6, .TRUE.) 02420328 |
| IVCOMP = 1 02430328 |
| IF (IVCN01 .EQ. 5) IVCOMP = IVCOMP * 2 02440328 |
| IF (RVCN01 .GE. 4.9995 .AND. RVCN01 .LE. 5.0005) IVCOMP = IVCOMP*302450328 |
| IVCORR = 6 02460328 |
| 40040 IF (IVCOMP - 6) 20040, 10040, 20040 02470328 |
| 30040 IVDELE = IVDELE + 1 02480328 |
| WRITE (I02,80000) IVTNUM 02490328 |
| IF (ICZERO) 10040, 0051, 20040 02500328 |
| 10040 IVPASS = IVPASS + 1 02510328 |
| WRITE (I02,80002) IVTNUM 02520328 |
| GO TO 0051 02530328 |
| 20040 IVFAIL = IVFAIL + 1 02540328 |
| WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 02550328 |
| 0051 CONTINUE 02560328 |
| C 02570328 |
| C **** FCVS PROGRAM 328 - TEST 005 **** 02580328 |
| C 02590328 |
| C REAL EXPRESSION INVOLVING INTEGER AND REAL PRIMARIES AND OPERATORS02600328 |
| C AS ACTUAL ARGUMENT. 02610328 |
| C 02620328 |
| IVTNUM = 5 02630328 |
| IF (ICZERO) 30050, 0050, 30050 02640328 |
| 0050 CONTINUE 02650328 |
| RVCOMP = 0.0 02660328 |
| IVON01 = 2 02670328 |
| RADN11(2) = 2.5 02680328 |
| CALL FS329(1, IVON01**3 * (RADN11(2) - 1) + 2.0, .TRUE.) 02690328 |
| RVCOMP = RVCN01 02700328 |
| RVCORR = 15.0 02710328 |
| 40050 IF (RVCOMP - 14.995) 20050, 10050, 40051 02720328 |
| 40051 IF (RVCOMP - 15.005) 10050, 10050, 20050 02730328 |
| 30050 IVDELE = IVDELE + 1 02740328 |
| WRITE (I02,80000) IVTNUM 02750328 |
| IF (ICZERO) 10050, 0061, 20050 02760328 |
| 10050 IVPASS = IVPASS + 1 02770328 |
| WRITE (I02,80002) IVTNUM 02780328 |
| GO TO 0061 02790328 |
| 20050 IVFAIL = IVFAIL + 1 02800328 |
| WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 02810328 |
| 0061 CONTINUE 02820328 |
| C 02830328 |
| C **** FCVS PROGRAM 328 - TEST 006 **** 02840328 |
| C 02850328 |
| C LOGICAL EXPRESSION INVOLVING LOGICAL OPERATOR (.NOT.) AS ACTUAL 02860328 |
| C ARGUMENT. 02870328 |
| C 02880328 |
| IVTNUM = 6 02890328 |
| IF (ICZERO) 30060, 0060, 30060 02900328 |
| 0060 CONTINUE 02910328 |
| LVON01 = .TRUE. 02920328 |
| CALL FS329(1, 1.0, .NOT. LVON01) 02930328 |
| IVCOMP = 0 02940328 |
| IF (LVCN01) IVCOMP = 1 02950328 |
| IVCORR = 1 02960328 |
| 40060 IF (IVCOMP - 1) 20060, 10060, 20060 02970328 |
| 30060 IVDELE = IVDELE + 1 02980328 |
| WRITE (I02,80000) IVTNUM 02990328 |
| IF (ICZERO) 10060, 0071, 20060 03000328 |
| 10060 IVPASS = IVPASS + 1 03010328 |
| WRITE (I02,80002) IVTNUM 03020328 |
| GO TO 0071 03030328 |
| 20060 IVFAIL = IVFAIL + 1 03040328 |
| WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 03050328 |
| 0071 CONTINUE 03060328 |
| C 03070328 |
| C **** FCVS PROGRAM 328 - TEST 007 **** 03080328 |
| C 03090328 |
| C LOGICAL EXPRESSION INVOLVING LOGICAL OPERATOR (.OR.) AS ACTIVE 03100328 |
| C ARGUMENT. 03110328 |
| C 03120328 |
| IVTNUM = 7 03130328 |
| IF (ICZERO) 30070, 0070, 30070 03140328 |
| 0070 CONTINUE 03150328 |
| LVON01 = .TRUE. 03160328 |
| LVON02 = .FALSE. 03170328 |
| CALL FS329(1, 1.0, LVON01 .OR. LVON02) 03180328 |
| IVCOMP = 0 03190328 |
| IF (.NOT. LVCN01) IVCOMP = 1 03200328 |
| IVCORR = 1 03210328 |
| 40070 IF (IVCOMP - 1) 20070, 10070, 20070 03220328 |
| 30070 IVDELE = IVDELE + 1 03230328 |
| WRITE (I02,80000) IVTNUM 03240328 |
| IF (ICZERO) 10070, 0081, 20070 03250328 |
| 10070 IVPASS = IVPASS + 1 03260328 |
| WRITE (I02,80002) IVTNUM 03270328 |
| GO TO 0081 03280328 |
| 20070 IVFAIL = IVFAIL + 1 03290328 |
| WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 03300328 |
| 0081 CONTINUE 03310328 |
| C 03320328 |
| C **** FCVS PROGRAM 328 - TEST 008 **** 03330328 |
| C 03340328 |
| C LOGICAL EXPRESSION INVOLVING LOGICAL OPERATOR (.AND.) AS ACTUAL 03350328 |
| C ARGUMENT. 03360328 |
| C 03370328 |
| IVTNUM = 8 03380328 |
| IF (ICZERO) 30080, 0080, 30080 03390328 |
| 0080 CONTINUE 03400328 |
| LVON01 = .FALSE. 03410328 |
| LVON02 = .TRUE. 03420328 |
| CALL FS329(1, 1.0, LVON01 .AND. LVON02) 03430328 |
| IVCOMP = 0 03440328 |
| IF (LVCN01) IVCOMP = 1 03450328 |
| IVCORR = 1 03460328 |
| 40080 IF (IVCOMP - 1) 20080, 10080, 20080 03470328 |
| 30080 IVDELE = IVDELE + 1 03480328 |
| WRITE (I02,80000) IVTNUM 03490328 |
| IF (ICZERO) 10080, 0091, 20080 03500328 |
| 10080 IVPASS = IVPASS + 1 03510328 |
| WRITE (I02,80002) IVTNUM 03520328 |
| GO TO 0091 03530328 |
| 20080 IVFAIL = IVFAIL + 1 03540328 |
| WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 03550328 |
| 0091 CONTINUE 03560328 |
| C 03570328 |
| C **** FCVS PROGRAM 328 - TEST 009 **** 03580328 |
| C 03590328 |
| C EXPRESSION ENCLOSED IN PARENTHESES AS ACTUAL ARGUMENT. 03600328 |
| C 03610328 |
| IVTNUM = 9 03620328 |
| IF (ICZERO) 30090, 0090, 30090 03630328 |
| 0090 CONTINUE 03640328 |
| IVCOMP = 0 03650328 |
| IVON01 = 6 03660328 |
| CALL FS329((IVON01 + 3), 1.0, .TRUE.) 03670328 |
| IVCOMP = IVCN01 03680328 |
| IVCORR = 10 03690328 |
| 40090 IF (IVCOMP - 10) 20090, 10090, 20090 03700328 |
| 30090 IVDELE = IVDELE + 1 03710328 |
| WRITE (I02,80000) IVTNUM 03720328 |
| IF (ICZERO) 10090, 0101, 20090 03730328 |
| 10090 IVPASS = IVPASS + 1 03740328 |
| WRITE (I02,80002) IVTNUM 03750328 |
| GO TO 0101 03760328 |
| 20090 IVFAIL = IVFAIL + 1 03770328 |
| WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 03780328 |
| 0101 CONTINUE 03790328 |
| C 03800328 |
| C **** FCVS PROGRAM 328 - TEST 010 **** 03810328 |
| C 03820328 |
| C INTEGER AND REAL INTRINSIC FUNCTION REFERENCES AS ACTUAL ARGUMENTS03830328 |
| C 03840328 |
| IVTNUM = 10 03850328 |
| IF (ICZERO) 30100, 0100, 30100 03860328 |
| 0100 CONTINUE 03870328 |
| RVON01 = 4.7 03880328 |
| RVON02 = -5.2 03890328 |
| CALL FS329(NINT(RVON01), ABS(RVON02), .TRUE.) 03900328 |
| IVCOMP = 1 03910328 |
| IF (IVCN01 .EQ. 6) IVCOMP = IVCOMP * 2 03920328 |
| IF (RVCN01 .GE. 6.1995 .AND. RVCN01 .LE. 6.2005) IVCOMP = IVCOMP*303930328 |
| IVCORR = 6 03940328 |
| 40100 IF (IVCOMP - 6) 20100, 10100, 20100 03950328 |
| 30100 IVDELE = IVDELE + 1 03960328 |
| WRITE (I02,80000) IVTNUM 03970328 |
| IF (ICZERO) 10100, 0111, 20100 03980328 |
| 10100 IVPASS = IVPASS + 1 03990328 |
| WRITE (I02,80002) IVTNUM 04000328 |
| GO TO 0111 04010328 |
| 20100 IVFAIL = IVFAIL + 1 04020328 |
| WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 04030328 |
| 0111 CONTINUE 04040328 |
| C 04050328 |
| C **** FCVS PROGRAM 328 - TEST 011 **** 04060328 |
| C 04070328 |
| C EXTERNAL FUNCTION REFERENCE AS ACTUAL ARGUMENT. 04080328 |
| C 04090328 |
| IVTNUM = 11 04100328 |
| IF (ICZERO) 30110, 0110, 30110 04110328 |
| 0110 CONTINUE 04120328 |
| IVCOMP = 0 04130328 |
| IVON01 = 4 04140328 |
| CALL FS329(FF330(IVON01), 1.0, .TRUE.) 04150328 |
| IVCOMP = IVCN01 04160328 |
| IVCORR = 6 04170328 |
| 40110 IF (IVCOMP - 6) 20110, 10110, 20110 04180328 |
| 30110 IVDELE = IVDELE + 1 04190328 |
| WRITE (I02,80000) IVTNUM 04200328 |
| IF (ICZERO) 10110, 0121, 20110 04210328 |
| 10110 IVPASS = IVPASS + 1 04220328 |
| WRITE (I02,80002) IVTNUM 04230328 |
| GO TO 0121 04240328 |
| 20110 IVFAIL = IVFAIL + 1 04250328 |
| WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 04260328 |
| 0121 CONTINUE 04270328 |
| C 04280328 |
| C **** FCVS PROGRAM 328 - TEST 012 **** 04290328 |
| C 04300328 |
| C USE ACTUAL ARGUMENT NAMES WHICH ARE IDENTICAL TO THE DUMMY 04310328 |
| C ARGUMENT NAMES. 04320328 |
| C 04330328 |
| IVTNUM = 12 04340328 |
| IF (ICZERO) 30120, 0120, 30120 04350328 |
| 0120 CONTINUE 04360328 |
| IDON01 = 10 04370328 |
| RDON01 = 10.0 04380328 |
| LDON01 = .FALSE. 04390328 |
| CALL FS329(IDON01, RDON01, LDON01) 04400328 |
| IVCOMP = 1 04410328 |
| IF (IVCN01 .EQ. 11) IVCOMP = IVCOMP * 2 04420328 |
| IF (RVCN01 .GE. 10.995 .AND. RVCN01 .LE. 11.005) IVCOMP = IVCOMP*304430328 |
| IF (LVCN01) IVCOMP = IVCOMP * 5 04440328 |
| IVCORR = 30 04450328 |
| 40120 IF (IVCOMP - 30) 20120, 10120, 20120 04460328 |
| 30120 IVDELE = IVDELE + 1 04470328 |
| WRITE (I02,80000) IVTNUM 04480328 |
| IF (ICZERO) 10120, 0131, 20120 04490328 |
| 10120 IVPASS = IVPASS + 1 04500328 |
| WRITE (I02,80002) IVTNUM 04510328 |
| GO TO 0131 04520328 |
| 20120 IVFAIL = IVFAIL + 1 04530328 |
| WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 04540328 |
| 0131 CONTINUE 04550328 |
| C 04560328 |
| C **** FCVS PROGRAM 328 - TEST 013 **** 04570328 |
| C 04580328 |
| C USE INTEGER, REAL AND LOGICAL STATEMENT FUNCTION REFERENCES AS 04590328 |
| C ARGUMENT NAMES. 04600328 |
| C 04610328 |
| IVTNUM = 13 04620328 |
| IF (ICZERO) 30130, 0130, 30130 04630328 |
| 0130 CONTINUE 04640328 |
| RVON01 = 5.0 04650328 |
| CALL FS329(IFOS01(4), RFOS01(RVON01), LFOS01(.TRUE.)) 04660328 |
| IVCOMP = 1 04670328 |
| IF (IVCN01 .EQ. 6) IVCOMP = IVCOMP * 2 04680328 |
| IF (RVCN01 .GE. 6.9995 .AND. RVCN01 .LE. 7.0005) IVCOMP = IVCOMP*304690328 |
| IF (LVCN01) IVCOMP = IVCOMP * 5 04700328 |
| IVCORR = 30 04710328 |
| 40130 IF (IVCOMP - 30) 20130, 10130, 20130 04720328 |
| 30130 IVDELE = IVDELE + 1 04730328 |
| WRITE (I02,80000) IVTNUM 04740328 |
| IF (ICZERO) 10130, 0141, 20130 04750328 |
| 10130 IVPASS = IVPASS + 1 04760328 |
| WRITE (I02,80002) IVTNUM 04770328 |
| GO TO 0141 04780328 |
| 20130 IVFAIL = IVFAIL + 1 04790328 |
| WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 04800328 |
| 0141 CONTINUE 04810328 |
| C 04820328 |
| C TEST 014 THROUGH TEST 019 ARE DESIGNED TO ASSOCIATE VARIOUS FORMS 04830328 |
| C OF ACTUAL ARGUMENTS TO ARRAY NAMES USED AS SUBROUTINE DUMMY 04840328 |
| C ARGUMENTS. 04850328 |
| C 04860328 |
| C 04870328 |
| C **** FCVS PROGRAM 328 - TEST 014 **** 04880328 |
| C 04890328 |
| C USE AN ARRAY NAME AS AN ACTUAL ARGUMENT IN WHICH THE ACTUAL 04900328 |
| C ARGUMENT ARRAY DECLARATOR IS IDENTICAL TO THE ASSOCIATED DUMMY 04910328 |
| C ARGUMENT ARRAY DECLARATOR. 04920328 |
| C 04930328 |
| IVTNUM = 14 04940328 |
| IF (ICZERO) 30140, 0140, 30140 04950328 |
| 0140 CONTINUE 04960328 |
| IVCOMP = 0 04970328 |
| IADN12(1) = 1 04980328 |
| IADN12(2) = 10 04990328 |
| IADN12(3) = 100 05000328 |
| IADN12(4) = 1000 05010328 |
| CALL FS331(IADN12) 05020328 |
| IVCOMP = IVCN01 05030328 |
| IVCORR = 1111 05040328 |
| 40140 IF (IVCOMP - 1111) 20140, 10140, 20140 05050328 |
| 30140 IVDELE = IVDELE + 1 05060328 |
| WRITE (I02,80000) IVTNUM 05070328 |
| IF (ICZERO) 10140, 0151, 20140 05080328 |
| 10140 IVPASS = IVPASS + 1 05090328 |
| WRITE (I02,80002) IVTNUM 05100328 |
| GO TO 0151 05110328 |
| 20140 IVFAIL = IVFAIL + 1 05120328 |
| WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 05130328 |
| 0151 CONTINUE 05140328 |
| C 05150328 |
| C **** FCVS PROGRAM 328 - TEST 015 **** 05160328 |
| C 05170328 |
| C USE AN ARRAY NAME AS AN ACTUAL ARGUMENT IN WHICH THE SIZE OF THE 05180328 |
| C ACTUAL ARGUMENT ARRAY IS LARGER THAN THE SIZE OF THE ASSOCIATED 05190328 |
| C DUMMY ARGUMENT ARRAY. 05200328 |
| C 05210328 |
| IVTNUM = 15 05220328 |
| IF (ICZERO) 30150, 0150, 30150 05230328 |
| 0150 CONTINUE 05240328 |
| IVCOMP = 0 05250328 |
| IACN11(1) = 1 05260328 |
| IACN11(2) = 10 05270328 |
| IACN11(3) = 100 05280328 |
| IACN11(4) = 1000 05290328 |
| IACN11(5) = 10000 05300328 |
| CALL FS331(IACN11) 05310328 |
| IVCOMP = IVCN01 05320328 |
| IVCORR = 1111 05330328 |
| 40150 IF (IVCOMP - 1111) 20150, 10150, 20150 05340328 |
| 30150 IVDELE = IVDELE + 1 05350328 |
| WRITE (I02,80000) IVTNUM 05360328 |
| IF (ICZERO) 10150, 0161, 20150 05370328 |
| 10150 IVPASS = IVPASS + 1 05380328 |
| WRITE (I02,80002) IVTNUM 05390328 |
| GO TO 0161 05400328 |
| 20150 IVFAIL = IVFAIL + 1 05410328 |
| WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 05420328 |
| 0161 CONTINUE 05430328 |
| C 05440328 |
| C **** FCVS PROGRAM 328 - TEST 016 **** 05450328 |
| C 05460328 |
| C USE AN ARRAY NAME AS AN ACTUAL ARGUMENT IN WHICH THE ACTUAL 05470328 |
| C ARGUMENT ARRAY DECLARATOR IS LARGER AND HAS MORE SUBSCRIPT 05480328 |
| C EXPRESSIONS THAN THE ASSOCIATED DUMMY ARGUMENT ARRAY DECLARATOR. 05490328 |
| C 05500328 |
| IVTNUM = 16 05510328 |
| IF (ICZERO) 30160, 0160, 30160 05520328 |
| 0160 CONTINUE 05530328 |
| IVCOMP = 0 05540328 |
| IATN11(1,1) = 1 05550328 |
| IATN11(2,1) = 10 05560328 |
| IATN11(1,2) = 100 05570328 |
| IATN11(2,2) = 1000 05580328 |
| IATN11(1,3) = 10000 05590328 |
| CALL FS331(IATN11) 05600328 |
| IVCOMP = IVCN01 05610328 |
| IVCORR = 1111 05620328 |
| 40160 IF (IVCOMP - 1111) 20160, 10160, 20160 05630328 |
| 30160 IVDELE = IVDELE + 1 05640328 |
| WRITE (I02,80000) IVTNUM 05650328 |
| IF (ICZERO) 10160, 0171, 20160 05660328 |
| 10160 IVPASS = IVPASS + 1 05670328 |
| WRITE (I02,80002) IVTNUM 05680328 |
| GO TO 0171 05690328 |
| 20160 IVFAIL = IVFAIL + 1 05700328 |
| WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 05710328 |
| 0171 CONTINUE 05720328 |
| C 05730328 |
| C **** FCVS PROGRAM 328 - TEST 017 **** 05740328 |
| C 05750328 |
| C USE AN ARRAY ELEMENT NAME AS AN ACTUAL ARGUMENT IN WHICH THE 05760328 |
| C ASSOCIATED ACTUAL AND DUMMY ARRAY DECLARATORS ARE IDENTICAL. ALL 05770328 |
| C ARRAY ELEMENTS OF THE ACTUAL ARRAY SHOULD BE PASSED TO THE 05780328 |
| C DUMMY ARRAY OF THE SUBROUTINE. 05790328 |
| C 05800328 |
| IVTNUM = 17 05810328 |
| IF (ICZERO) 30170, 0170, 30170 05820328 |
| 0170 CONTINUE 05830328 |
| RVCOMP = 0.0 05840328 |
| RADN12(1) = 1. 05850328 |
| RADN12(2) = 10. 05860328 |
| RADN12(3) = 100. 05870328 |
| RADN12(4) = 1000. 05880328 |
| CALL FS332(RADN12(1)) 05890328 |
| RVCOMP = RVCN01 05900328 |
| RVCORR = 1111. 05910328 |
| 40170 IF (RVCOMP - 1110.5) 20170, 10170, 40171 05920328 |
| 40171 IF (RVCOMP - 1111.5) 10170, 10170, 20170 05930328 |
| 30170 IVDELE = IVDELE + 1 05940328 |
| WRITE (I02,80000) IVTNUM 05950328 |
| IF (ICZERO) 10170, 0181, 20170 05960328 |
| 10170 IVPASS = IVPASS + 1 05970328 |
| WRITE (I02,80002) IVTNUM 05980328 |
| GO TO 0181 05990328 |
| 20170 IVFAIL = IVFAIL + 1 06000328 |
| WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 06010328 |
| 0181 CONTINUE 06020328 |
| C 06030328 |
| C **** FCVS PROGRAM 328 - TEST 018 **** 06040328 |
| C 06050328 |
| C USE AN ARRAY ELEMENT NAME AS AN ACTUAL ARGUMENT IN WHICH THE SIZE 06060328 |
| C OF THE ACTUAL ARGUMENT ARRAY IS LARGER AND HAS FEWER SUBSCRIPT 06070328 |
| C EXPRESSIONS THAN THE ASSOCIATED DUMMY ARRAY. ONLY ACTUAL ARRAY 06080328 |
| C ELEMENTS WITH SUBSCRIPT VALUES OF 5, 6, 7 AND 8 ( OUT OF A 06090328 |
| C POSSIBLE 10 ELEMENTS) SHOULD BE PASSED TO THE DUMMY ARRAY OF 06100328 |
| C THE SUBROUTINE. 06110328 |
| C 06120328 |
| IVTNUM = 18 06130328 |
| IF (ICZERO) 30180, 0180, 30180 06140328 |
| 0180 CONTINUE 06150328 |
| RVCOMP = 0.0 06160328 |
| RACN11(4) = 1. 06170328 |
| RACN11(5) = 10. 06180328 |
| RACN11(6) = 100. 06190328 |
| RACN11(7) = 1000. 06200328 |
| RACN11(8) = 10000. 06210328 |
| RACN11(9) = 100000. 06220328 |
| CALL FS332(RACN11(5)) 06230328 |
| RVCOMP = RVCN01 06240328 |
| RVCORR = 11110. 06250328 |
| 40180 IF (RVCOMP - 11105.) 20180, 10180, 40181 06260328 |
| 40181 IF (RVCOMP - 11115.) 10180, 10180, 20180 06270328 |
| 30180 IVDELE = IVDELE + 1 06280328 |
| WRITE (I02,80000) IVTNUM 06290328 |
| IF (ICZERO) 10180, 0191, 20180 06300328 |
| 10180 IVPASS = IVPASS + 1 06310328 |
| WRITE (I02,80002) IVTNUM 06320328 |
| GO TO 0191 06330328 |
| 20180 IVFAIL = IVFAIL + 1 06340328 |
| WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 06350328 |
| 0191 CONTINUE 06360328 |
| C 06370328 |
| C **** FCVS PROGRAM 328 - TEST 019 **** 06380328 |
| C 06390328 |
| C USE AN ARRAY ELEMENT NAME AS AN ACTUAL ARGUMENT IN WHICH THE SIZE 06400328 |
| C OF THE ACTUAL ARGUMENT ARRAY IS LARGE THAN THE SIZE OF THE 06410328 |
| C ASSOCIATED DUMMY ARGUMENT ARRAY. ONLY ACTUAL ARRAY ELEMENTS WITH 06420328 |
| C SUBSCRIPT VALUES OF 9, 10, 11 AND 12 (OUT OF A POSSIBLE 12 06430328 |
| C ELEMENTS) SHOULD BE PASSED TO THE DUMMY ARRAY OF THE SUBROUTINE. 06440328 |
| C 06450328 |
| IVTNUM = 19 06460328 |
| IF (ICZERO) 30190, 0190, 30190 06470328 |
| 0190 CONTINUE 06480328 |
| RVCOMP = 0.0 06490328 |
| RATN11(2,3) = 1. 06500328 |
| RATN11(3,3) = 10. 06510328 |
| RATN11(1,4) = 100. 06520328 |
| RATN11(2,4) = 1000. 06530328 |
| RATN11(3,4) = 10000. 06540328 |
| CALL FS332(RATN11(3,3)) 06550328 |
| RVCOMP = RVCN01 06560328 |
| RVCORR = 11110. 06570328 |
| 40190 IF (RVCOMP - 11105.) 20190, 10190, 40191 06580328 |
| 40191 IF (RVCOMP - 11115.) 10190, 10190, 20190 06590328 |
| 30190 IVDELE = IVDELE + 1 06600328 |
| WRITE (I02,80000) IVTNUM 06610328 |
| IF (ICZERO) 10190, 0201, 20190 06620328 |
| 10190 IVPASS = IVPASS + 1 06630328 |
| WRITE (I02,80002) IVTNUM 06640328 |
| GO TO 0201 06650328 |
| 20190 IVFAIL = IVFAIL + 1 06660328 |
| WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 06670328 |
| 0201 CONTINUE 06680328 |
| C 06690328 |
| C TEST 020 THROUGH TEST 022 ARE DESIGNED TO ASSOCIATE VARIOUS FORMS 06700328 |
| C OF ACTUAL ARGUMENTS TO PROCEDURES USED AS SUBROUTINE DUMMY 06710328 |
| C ARGUMENTS. ACTUAL ARGUMENTS TESTED INCLUDE THE NAMES OF AN 06720328 |
| C EXTERNAL FUNCTION, AN INTRINSIC FUNCTION AND A SUBROUTINE. 06730328 |
| C 06740328 |
| C 06750328 |
| C **** FCVS PROGRAM 328 - TEST 020 **** 06760328 |
| C 06770328 |
| C USE AN EXTERNAL FUNCTION NAME AS AN ACTUAL ARGUMENT. 06780328 |
| C 06790328 |
| IVTNUM = 20 06800328 |
| IF (ICZERO) 30200, 0200, 30200 06810328 |
| 0200 CONTINUE 06820328 |
| IVCOMP = 0 06830328 |
| CALL FS333(FF330, 5) 06840328 |
| IVCOMP = IVCN01 06850328 |
| IVCORR = 7 06860328 |
| 40200 IF (IVCOMP - 7) 20200, 10200, 20200 06870328 |
| 30200 IVDELE = IVDELE + 1 06880328 |
| WRITE (I02,80000) IVTNUM 06890328 |
| IF (ICZERO) 10200, 0211, 20200 06900328 |
| 10200 IVPASS = IVPASS + 1 06910328 |
| WRITE (I02,80002) IVTNUM 06920328 |
| GO TO 0211 06930328 |
| 20200 IVFAIL = IVFAIL + 1 06940328 |
| WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 06950328 |
| 0211 CONTINUE 06960328 |
| C 06970328 |
| C **** FCVS PROGRAM 328 - TEST 021 **** 06980328 |
| C 06990328 |
| C USE AN INTRINSIC FUNCTION NAME AS AN ACTUAL ARGUMENT. 07000328 |
| C 07010328 |
| IVTNUM = 21 07020328 |
| IF (ICZERO) 30210, 0210, 30210 07030328 |
| 0210 CONTINUE 07040328 |
| IVCOMP = 0 07050328 |
| CALL FS333(IABS, -7) 07060328 |
| IVCOMP = IVCN01 07070328 |
| IVCORR = 8 07080328 |
| 40210 IF (IVCOMP - 8) 20210, 10210, 20210 07090328 |
| 30210 IVDELE = IVDELE + 1 07100328 |
| WRITE (I02,80000) IVTNUM 07110328 |
| IF (ICZERO) 10210, 0221, 20210 07120328 |
| 10210 IVPASS = IVPASS + 1 07130328 |
| WRITE (I02,80002) IVTNUM 07140328 |
| GO TO 0221 07150328 |
| 20210 IVFAIL = IVFAIL + 1 07160328 |
| WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 07170328 |
| 0221 CONTINUE 07180328 |
| C 07190328 |
| C **** FCVS PROGRAM 328 - TEST 022 **** 07200328 |
| C 07210328 |
| C USE A SUBROUTINE NAME AS AN ACTUAL ARGUMENT. 07220328 |
| C 07230328 |
| IVTNUM = 22 07240328 |
| IF (ICZERO) 30220, 0220, 30220 07250328 |
| 0220 CONTINUE 07260328 |
| RVCOMP = 0.0 07270328 |
| RVON01 = 3.5 07280328 |
| CALL FS334(FS335, RVON01) 07290328 |
| RVCOMP = RVCN01 07300328 |
| RVCORR = 5.5 07310328 |
| 40220 IF (RVCOMP - 5.4995) 20220, 10220, 40221 07320328 |
| 40221 IF (RVCOMP - 5.5005) 10220, 10220, 20220 07330328 |
| 30220 IVDELE = IVDELE + 1 07340328 |
| WRITE (I02,80000) IVTNUM 07350328 |
| IF (ICZERO) 10220, 0231, 20220 07360328 |
| 10220 IVPASS = IVPASS + 1 07370328 |
| WRITE (I02,80002) IVTNUM 07380328 |
| GO TO 0231 07390328 |
| 20220 IVFAIL = IVFAIL + 1 07400328 |
| WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 07410328 |
| 0231 CONTINUE 07420328 |
| C 07430328 |
| C 07440328 |
| C WRITE OUT TEST SUMMARY 07450328 |
| C 07460328 |
| WRITE (I02,90004) 07470328 |
| WRITE (I02,90014) 07480328 |
| WRITE (I02,90004) 07490328 |
| WRITE (I02,90000) 07500328 |
| WRITE (I02,90004) 07510328 |
| WRITE (I02,90020) IVFAIL 07520328 |
| WRITE (I02,90022) IVPASS 07530328 |
| WRITE (I02,90024) IVDELE 07540328 |
| STOP 07550328 |
| 90001 FORMAT (" ",24X,"FM328") 07560328 |
| 90000 FORMAT (" ",20X,"END OF PROGRAM FM328" ) 07570328 |
| C 07580328 |
| C FORMATS FOR TEST DETAIL LINES 07590328 |
| C 07600328 |
| 80000 FORMAT (" ",4X,I5,6X,"DELETED") 07610328 |
| 80002 FORMAT (" ",4X,I5,7X,"PASS") 07620328 |
| 80010 FORMAT (" ",4X,I5,7X,"FAIL",10X,I6,9X,I6) 07630328 |
| 80012 FORMAT (" ",4X,I5,7X,"FAIL",4X,E12.5,3X,E12.5) 07640328 |
| 80018 FORMAT (" ",4X,I5,7X,"FAIL",2X,A14,1X,A14) 07650328 |
| C 07660328 |
| C FORMAT STATEMENTS FOR PAGE HEADERS 07670328 |
| C 07680328 |
| 90002 FORMAT ("1") 07690328 |
| 90004 FORMAT (" ") 07700328 |
| 90006 FORMAT (" ",10X,"FORTRAN COMPILER VALIDATION SYSTEM" ) 07710328 |
| 90008 FORMAT (" ",21X,"VERSION 2.1" ) 07720328 |
| 90010 FORMAT (" ",8X,"FOR OFFICIAL USE ONLY - COPYRIGHT 1978" ) 07730328 |
| 90012 FORMAT (" ",5X,"TEST",5X,"PASS/FAIL",5X,"COMPUTED",8X,"CORRECT") 07740328 |
| 90014 FORMAT (" ",5X,"----------------------------------------------" ) 07750328 |
| 90016 FORMAT (" ",18X,"SUBSET LEVEL TEST" ) 07760328 |
| C 07770328 |
| C FORMAT STATEMENTS FOR RUN SUMMARY 07780328 |
| C 07790328 |
| 90020 FORMAT (" ",19X,I5," TESTS FAILED" ) 07800328 |
| 90022 FORMAT (" ",19X,I5," TESTS PASSED" ) 07810328 |
| 90024 FORMAT (" ",19X,I5," TESTS DELETED" ) 07820328 |
| END 07830328 |
| |
| SUBROUTINE FS329(IDON01, RDON01, LDON01) 00010329 |
| C THIS SUBROUTINE IS USED BY VARIOUS TESTS IN THE MAIN PROGRAM 00020329 |
| C FM328 TO TEST THE DIFFERENT FORMS OF INTEGER, REAL AND LOGICAL 00030329 |
| C ACTUAL ARGUMENTS THAT CAN BE ASSOCIATED WITH INTEGER, REAL AND 00040329 |
| C LOGICAL DUMMY ARGUMENTS. THIS ROUTINE INCREMENTS THE INTEGER 00050329 |
| C AND REAL ARGUMENTS BY ONE AND NEGATES THE LOGICAL ARGUMENT. ALL 00060329 |
| C RESULTS ARE THEN RETURNED TO FM328 VIA VARIABLES IN NAMED COMMON. 00070329 |
| IMPLICIT LOGICAL (L) 00080329 |
| COMMON /BLK1/ IVCN01, RVCN01, LVCN01 00090329 |
| IVCN01 = IDON01 + 1 00100329 |
| RVCN01 = RDON01 + 1.0 00110329 |
| LVCN01 = .NOT. LDON01 00120329 |
| RETURN 00130329 |
| END 00140329 |
| |
| INTEGER FUNCTION FF330(IDON02) 00010330 |
| C THIS FUNCTION IS USED BY TEST 011 OF THE MAIN PROGRAM FM328 TO00020330 |
| C TEST THE USE OF AN EXTERNAL FUNCTION REFERENCE AS AN ACTUAL 00030330 |
| C ARGUMENT WHEN THE ASSOCIATED DUMMY ARGUMENT IS A VARIABLE NAME. 00040330 |
| C THIS FUNCTION IS ALSO REFERENCED FROM SUBROUTINE FS333 VIA A 00050330 |
| C DUMMY PROCEDURE NAME REFERENCE. THIS FUNCTION INCREMENTS THE 00060330 |
| C ARGUMENT VALUE BY ONE AND RETURNS THE RESULT AS THE FUNCTION 00070330 |
| C VALUE. 00080330 |
| FF330 = IDON02 + 1 00090330 |
| RETURN 00100330 |
| END 00110330 |
| |
| SUBROUTINE FS331(IDDN11) 00010331 |
| C THIS SUBROUTINE IS USED BY VARIOUS TESTS IN THE MAIN PROGRAM 00020331 |
| C FM328 TO TEST THE USE OF AN ARRAY NAME AS AN ACTUAL ARGUMENT WHEN 00030331 |
| C THE ASSOCIATED DUMMY ARGUMENT IS AN ARRAY NAME. THIS ROUTINE 00040331 |
| C ADDS TOGETHER THE FOUR ELEMENTS IN THE DUMMY ARGUMENT ARRAY AND 00050331 |
| C RETURNS THE RESULTS VIA A VARIABLE IN NAMED COMMON. 00060331 |
| LOGICAL LVCN01 00070331 |
| DIMENSION IDDN11(4) 00080331 |
| COMMON /BLK1/IVCN01, RVCN01, LVCN01 00090331 |
| IVCN01 = IDDN11(1) + IDDN11(2) + IDDN11(3) + IDDN11(4) 00100331 |
| RETURN 00110331 |
| END 00120331 |
| |
| SUBROUTINE FS332(RDTN21) 00010332 |
| C THIS SUBROUTINE IS USED BY VARIOUS TESTS IN THE MAIN PROGRAM 00020332 |
| C FM328 TO TEST THE USE OF AN ARRAY ELEMENT NAME AS AN ACTUAL 00030332 |
| C ARGUMENT WHEN THE ASSOCIATED DUMMY ARGUMENT IS AN ARRAY NAME. 00040332 |
| C THIS ROUTINE ADDS TOGETHER THE FOUR ELEMENTS IN THE DUMMY 00050332 |
| C ARGUMENT ARRAY AND RETURNS THE RESULT VIA A VARIABLE IN NAMED 00060332 |
| C COMMON. 00070332 |
| IMPLICIT LOGICAL (L) 00080332 |
| REAL RDTN21(2,2) 00090332 |
| COMMON /BLK1/IVCN01, RVCN01, LVCN01 00100332 |
| RVCN01 = RDTN21(1,1) + RDTN21(2,1) + RDTN21(1,2) + RDTN21(2,2) 00110332 |
| RETURN 00120332 |
| END 00130332 |
| |
| SUBROUTINE FS333(NINT, IDON03) 00010333 |
| C THIS SUBROUTINE IS USED BY TESTS 020 AND 021 OF THE MAIN 00020333 |
| C PROGRAM FM328 TO TEST THE USE OF EXTERNAL AND INTRINSIC FUNCTION 00030333 |
| C NAMES AS ACTUAL ARGUMENTS WHEN THE ASSOCIATED DUMMY ARGUMENT IS A 00040333 |
| C PROCEDURE NAME. THIS SUBROUTINE REFERENCES THE EXTERNAL FUNCTION 00050333 |
| C FF330 OR THE INTRINSIC FUNCTION IABS DEPENDING ON THE ACTUAL 00060333 |
| C ARGUMENT PASSED TO IT. THE RESULT OF THIS FUNCTION REFERENCE IS 00070333 |
| C THEN INCREMENTED BY ONE AND THE RESULT IS RETURNED TO FS328 VIA 00080333 |
| C A VARIABLE IN NAMED COMMON. 00090333 |
| IMPLICIT LOGICAL (L) 00100333 |
| COMMON /BLK1/IVCN01, RVCN01, LVCN01 00110333 |
| IVCN01 = NINT(IDON03) + 1 00120333 |
| C **** THE NAME NINT IS A DUMMY ARGUMENT NAME 00130333 |
| C AND NOT AN INTRINSIC FUNCTION REFERENCE **** 00140333 |
| RETURN 00150333 |
| END 00160333 |
| |
| SUBROUTINE FS334(IDON06, RDON03) 00010334 |
| C THIS SUBROUTINE IS USED BY TEST 022 OF THE MAIN PROGRAM 00020334 |
| C FM328 TO TEST THE USE OF A SUBROUTINE NAME AS AN ACTUAL ARGUMENT 00030334 |
| C WHEN THE ASSOCIATED DUMMY ARGUMENT IS A PROCEDURE NAME. THIS 00040334 |
| C SUBROUTINE CALLS THE SUBROUTINE FS335 VIA A DUMMY PROCEDURE NAME 00050334 |
| C REFERENCE. THE ARGUMENT VALUE WHICH IS RETURNED FROM THE FS335 00060334 |
| C REFERENCE IS THEN INCREMENTED BY ONE AND RETURNED TO FM328 VIA 00070334 |
| C A VARIABLE IN NAMED COMMON. 00080334 |
| IMPLICIT LOGICAL (L) 00090334 |
| COMMON /BLK1/IVCN01, RVCN01, LVCN01 00100334 |
| CALL IDON06(RDON03) 00110334 |
| RVCN01 = RDON03 + 1.0 00120334 |
| RETURN 00130334 |
| END 00140334 |
| |
| SUBROUTINE FS335(RDON04) 00010335 |
| C THIS SUBROUITNE IS USED BY TEST 022 OF THE MAIN PROGRAM FM32800020335 |
| C TO TEST THE USE OF A SUBROUTINE NAME AS AN ACTUAL ARGUMENT WHEN 00030335 |
| C THE ASSOCIATED DUMMY ARGUMENT IS A PROCEDURE NAME. FS335 IS 00040335 |
| C CALLED FROM SUBROUTINE FS334 VIA A DUMMY PROCEDURE NAME REFERENCE.00050335 |
| C THIS ROUTINE INCREMENTS THE ARGUMENT VALUE BY ONE. 00060335 |
| RDON04 = RDON04 + 1.0 00070335 |
| RETURN 00080335 |
| END 00090335 |
