![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to FM328.f CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [Power 6/32 Unix Tahoe 4.2BSD] / cci / usr / src / usr.bin / f77 / testf77 / tests|
Return to FM328.f CVS log | Up to [Power 6/32 Unix Tahoe 4.2BSD] / cci / usr / src / usr.bin / f77 / testf77 / tests |
1.1 ! root 1: PROGRAM FM328 00010328 ! 2: C DATE***82/08/02*18.33.46 ! 3: C OWNER PRE/850703/TC-85- -410/ /FSTC/278FCVS*F78UBP20/ ! 4: C AUDIT FCVS78 V2.0 ! 5: C 00020328 ! 6: C 00030328 ! 7: C THIS ROUTINE TEST SUBSET LEVEL FEATURES OF 00040328 ! 8: C SUBROUTINE SUBPROGRAMS. TESTS ARE DESIGNED TO CHECK THE 00050328 ! 9: C ASSOCIATION OF ALL PERMISSIBLE FORMS OF ACTUAL ARGUMENTS WITH 00060328 ! 10: C VARIABLE, ARRAY AND PROCEDURE NAME DUMMY ARGUMENTS. THESE 00070328 ! 11: C INCLUDE, 00080328 ! 12: C 00090328 ! 13: C 1) ACTUAL ARGUMENTS ASSOCIATED TO VARIABLE NAME DUMMY 00100328 ! 14: C ARGUMENT INCLUDE, 00110328 ! 15: C 00120328 ! 16: C A) CONSTANT 00130328 ! 17: C B) VARIABLE NAME 00140328 ! 18: C C) ARRAY ELEMENT NAME 00150328 ! 19: C D) EXPRESSION INVOLVING OPERATORS 00160328 ! 20: C E) EXPRESSION ENCLOSED IN PARENTHESES 00170328 ! 21: C F) INTRINSIC FUNCTION REFERENCE 00180328 ! 22: C G) EXTERNAL FUNCTION REFERENCE 00190328 ! 23: C H) STATEMENT FUNCTION REFERENCE 00200328 ! 24: C I) ACTUAL ARGUMENT NAME SAME AS DUMMY ARGUMENT NAME 00210328 ! 25: C 00220328 ! 26: C 2) ACTUAL ARGUMENTS ASSOCIATED TO ARRAY NAME DUMMY 00230328 ! 27: C ARGUMENT INCLUDE, 00240328 ! 28: C 00250328 ! 29: C A) ARRAY NAME 00260328 ! 30: C B) ARRAY ELEMENT NAME 00270328 ! 31: C 00280328 ! 32: C 3) ACTUAL ARGUMENTS ASSOCIATED TO PROCEDURE NAME DUMMY 00290328 ! 33: C ARGUMENT INCLUDE, 00300328 ! 34: C 00310328 ! 35: C A) EXTERNAL FUNCTION NAME 00320328 ! 36: C B) INTRINSIC FUNCTION NAME 00330328 ! 37: C C) SUBROUTINE NAME 00340328 ! 38: C 00350328 ! 39: C ALL DATA PASSED TO THE REFERENCED SUBPROGRAMS ARE PASSED VIA 00360328 ! 40: C ARGUMENT VALUES, WHILE ALL RESULTS RETURNED TO FM328 ARE 00370328 ! 41: C RETURNED VIA VARIABLES IN NAMED COMMON. SUBSET LEVEL ROUTINES 00380328 ! 42: C FM026, FM050 AND FM056 ALSO TEST THE USE OF SUBROUTINES. 00390328 ! 43: C 00400328 ! 44: C REFERENCES. 00410328 ! 45: C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN, 00420328 ! 46: C X3.9-1978 00430328 ! 47: C 00440328 ! 48: C SECTION 2.8, DUMMY ARGUMENTS 00450328 ! 49: C SECTION 5.1.2.2, DUMMY ARRAY DECLARATOR 00460328 ! 50: C SECTION 5.5, DUMMY AND ACTUAL ARRAYS 00470328 ! 51: C SECTION 8.1, DIMENSION STATEMENT 00480328 ! 52: C SECTION 8.3, COMMON STATEMENT 00490328 ! 53: C SECTION 8.4, TYPE-STATEMENT 00500328 ! 54: C SECTION 8.7, EXTERNAL STATEMENT 00510328 ! 55: C SECTION 8.8, INTRINSIC STATEMENT 00520328 ! 56: C SECTION 15.2, REFERENCING A FUNCTION 00530328 ! 57: C SECTION 15.3, INTRINSIC FUNCTIONS 00540328 ! 58: C SECTION 15.5, EXTERNAL FUNCTIONS 00550328 ! 59: C SECTION 15.6, SUBROUTINES 00560328 ! 60: C SECTION 15.9, ARGUMENTS AND COMMON BLOCKS 00570328 ! 61: C 00580328 ! 62: C 00590328 ! 63: C ******************************************************************00600328 ! 64: C A COMPILER VALIDATION SYSTEM FOR THE FORTRAN LANGUAGE 00610328 ! 65: C BASED ON SPECIFICATIONS AS DEFINED IN AMERICAN STANDARD FORTRAN 00620328 ! 66: C X3.9-1978, HAS BEEN DEVELOPED BY THE DEPARTMENT OF THE NAVY. THE 00630328 ! 67: C FORTRAN COMPILER VALIDATION SYSTEM (FCVS) CONSISTS OF AUDIT 00640328 ! 68: C ROUTINES, THEIR RELATED DATA, AND AN EXECUTIVE SYSTEM. EACH AUDIT00650328 ! 69: C ROUTINE IS A FORTRAN PROGRAM OR SUBPROGRAM WHICH INCLUDES TESTS 00660328 ! 70: C OF SPECIFIC LANGUAGE ELEMENTS AND SUPPORTING PROCEDURES INDICATING00670328 ! 71: C THE RESULT OF EXECUTING THESE TESTS. 00680328 ! 72: C 00690328 ! 73: C THIS PARTICULAR PROGRAM OR SUBPROGRAM CONTAINS ONLY FEATURES 00700328 ! 74: C FOUND IN THE SUBSET LEVEL OF THE STANDARD. 00710328 ! 75: C 00720328 ! 76: C SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO 00730328 ! 77: C DEPARTMENT OF THE NAVY 00740328 ! 78: C FEDERAL COBOL COMPILER TESTING SERVICE 00750328 ! 79: C WASHINGTON, D.C. 20376 00760328 ! 80: C 00770328 ! 81: C ******************************************************************00780328 ! 82: C 00790328 ! 83: C 00800328 ! 84: IMPLICIT LOGICAL (L) 00810328 ! 85: IMPLICIT CHARACTER*14 (C) 00820328 ! 86: C 00830328 ! 87: INTEGER IATN11(2,3) 00840328 ! 88: REAL RATN11(3,4) 00850328 ! 89: INTEGER FF330 00860328 ! 90: DIMENSION IADN11(4), IADN12(4) 00870328 ! 91: DIMENSION RADN11(4), RADN12(4) 00880328 ! 92: DIMENSION LADN11(4) 00890328 ! 93: COMMON /BLK1/IVCN01, RVCN01, LVCN01 00900328 ! 94: COMMON IACN11(6), RACN11(10) 00910328 ! 95: EXTERNAL FF330, FS335 00920328 ! 96: INTRINSIC ABS, IABS, NINT 00930328 ! 97: IFOS01(IDON04) = IDON04 + 1 00940328 ! 98: RFOS01(RDON04) = RDON04 + 1.0 00950328 ! 99: LFOS01(LDON04) = .NOT. LDON04 00960328 ! 100: C 00970328 ! 101: C 00980328 ! 102: C 00990328 ! 103: C INITIALIZATION SECTION. 01000328 ! 104: C 01010328 ! 105: C INITIALIZE CONSTANTS 01020328 ! 106: C ******************** 01030328 ! 107: C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER 01040328 ! 108: I01 = 5 01050328 ! 109: C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER 01060328 ! 110: I02 = 6 01070328 ! 111: C SYSTEM ENVIRONMENT SECTION 01080328 ! 112: C 01090328 ! 113: I01 = 5 01100328 ! 114: C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 01110328 ! 115: C (UNIT NUMBER FOR CARD READER). 01120328 ! 116: CX011 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-011 CONTROL CARD01130328 ! 117: C THE CX011 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 01140328 ! 118: C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX010 ABOVE. 01150328 ! 119: C 01160328 ! 120: I02 = 6 01170328 ! 121: C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02 = 6 01180328 ! 122: C (UNIT NUMBER FOR PRINTER). 01190328 ! 123: CX021 THIS CARD IS PEPLACED BY CONTENTS OF FEXEC X-021 CONTROL CARD.01200328 ! 124: C THE CX021 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 01210328 ! 125: C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX020 ABOVE. 01220328 ! 126: C 01230328 ! 127: IVPASS = 0 01240328 ! 128: IVFAIL = 0 01250328 ! 129: IVDELE = 0 01260328 ! 130: ICZERO = 0 01270328 ! 131: C 01280328 ! 132: C WRITE OUT PAGE HEADERS 01290328 ! 133: C 01300328 ! 134: WRITE (I02,90002) 01310328 ! 135: WRITE (I02,90006) 01320328 ! 136: WRITE (I02,90008) 01330328 ! 137: WRITE (I02,90004) 01340328 ! 138: WRITE (I02,90010) 01350328 ! 139: WRITE (I02,90004) 01360328 ! 140: WRITE (I02,90016) 01370328 ! 141: WRITE (I02,90001) 01380328 ! 142: WRITE (I02,90004) 01390328 ! 143: WRITE (I02,90012) 01400328 ! 144: WRITE (I02,90014) 01410328 ! 145: WRITE (I02,90004) 01420328 ! 146: C 01430328 ! 147: C 01440328 ! 148: C TEST 001 THROUGH TEST 013 ARE DESIGNED TO ASSOCIATE VARIOUS FORMS 01450328 ! 149: C OF ACTUAL ARGUMENTS TO VARIABLE NAMES USED AS SUBROUTINE 01460328 ! 150: C DUMMY ARGUMENTS. INTEGER, REAL AND LOGICAL DUMMY ARGUMENTS ARE 01470328 ! 151: C TESTED. 01480328 ! 152: C 01490328 ! 153: C 01500328 ! 154: C **** FCVS PROGRAM 328 - TEST 001 **** 01510328 ! 155: C 01520328 ! 156: C USE INTEGER, REAL AND LOGICAL CONSTANTS AS ACTUAL ARGUMENTS. 01530328 ! 157: C 01540328 ! 158: IVTNUM = 1 01550328 ! 159: IF (ICZERO) 30010, 0010, 30010 01560328 ! 160: 0010 CONTINUE 01570328 ! 161: CALL FS329(3, 3.0, .FALSE.) 01580328 ! 162: IVCOMP = 1 01590328 ! 163: IF (IVCN01 .EQ. 4) IVCOMP = IVCOMP * 2 01600328 ! 164: IF (RVCN01 .GE. 3.9995 .AND. RVCN01 .LE. 4.0005) IVCOMP = IVCOMP*301610328 ! 165: IF (LVCN01) IVCOMP = IVCOMP * 5 01620328 ! 166: IVCORR = 30 01630328 ! 167: 40010 IF (IVCOMP - 30) 20010, 10010, 20010 01640328 ! 168: 30010 IVDELE = IVDELE + 1 01650328 ! 169: WRITE (I02,80000) IVTNUM 01660328 ! 170: IF (ICZERO) 10010, 0021, 20010 01670328 ! 171: 10010 IVPASS = IVPASS + 1 01680328 ! 172: WRITE (I02,80002) IVTNUM 01690328 ! 173: GO TO 0021 01700328 ! 174: 20010 IVFAIL = IVFAIL + 1 01710328 ! 175: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 01720328 ! 176: 0021 CONTINUE 01730328 ! 177: C 01740328 ! 178: C **** FCVS PROGRAM 328 - TEST 002 **** 01750328 ! 179: C 01760328 ! 180: C USE INTEGER, REAL AND LOGICAL VARIABLES AS ACTUAL ARGUMENTS. 01770328 ! 181: C 01780328 ! 182: IVTNUM = 2 01790328 ! 183: IF (ICZERO) 30020, 0020, 30020 01800328 ! 184: 0020 CONTINUE 01810328 ! 185: IVON01 = 7 01820328 ! 186: RVON01 = 7.0 01830328 ! 187: LVON01 = .TRUE. 01840328 ! 188: CALL FS329(IVON01, RVON01, LVON01) 01850328 ! 189: IVCOMP = 1 01860328 ! 190: IF (IVCN01 .EQ. 8) IVCOMP =IVCOMP * 2 01870328 ! 191: IF (RVCN01 .GE. 7.9995 .AND. RVCN01 .LE. 8.0005) IVCOMP = IVCOMP*301880328 ! 192: IF (.NOT. LVCN01) IVCOMP = IVCOMP * 5 01890328 ! 193: IVCORR = 30 01900328 ! 194: 40020 IF (IVCOMP - 30) 20020, 10020, 20020 01910328 ! 195: 30020 IVDELE = IVDELE + 1 01920328 ! 196: WRITE (I02,80000) IVTNUM 01930328 ! 197: IF (ICZERO) 10020, 0031, 20020 01940328 ! 198: 10020 IVPASS = IVPASS + 1 01950328 ! 199: WRITE (I02,80002) IVTNUM 01960328 ! 200: GO TO 0031 01970328 ! 201: 20020 IVFAIL = IVFAIL + 1 01980328 ! 202: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 01990328 ! 203: 0031 CONTINUE 02000328 ! 204: C 02010328 ! 205: C **** FCVS PROGRAM 328 - TEST 003 **** 02020328 ! 206: C 02030328 ! 207: C USE INTEGER, REAL AND LOGICAL ARRAY ELEMENT NAMES AS ACTUAL 02040328 ! 208: C ARGUMENTS. 02050328 ! 209: C 02060328 ! 210: IVTNUM = 3 02070328 ! 211: IF (ICZERO) 30030, 0030, 30030 02080328 ! 212: 0030 CONTINUE 02090328 ! 213: IADN11(2) = 2 02100328 ! 214: RADN11(4) = 4.0 02110328 ! 215: LADN11(1) = .FALSE. 02120328 ! 216: CALL FS329(IADN11(2), RADN11(4), LADN11(1)) 02130328 ! 217: IVCOMP = 1 02140328 ! 218: IF (IVCN01 .EQ. 3) IVCOMP = IVCOMP * 2 02150328 ! 219: IF (RVCN01 .GE. 4.9995 .AND. RVCN01 .LE. 5.0005) IVCOMP = IVCOMP*302160328 ! 220: IF (LVCN01) IVCOMP = IVCOMP * 5 02170328 ! 221: IVCORR = 30 02180328 ! 222: 40030 IF (IVCOMP - 30) 20030, 10030, 20030 02190328 ! 223: 30030 IVDELE = IVDELE + 1 02200328 ! 224: WRITE (I02,80000) IVTNUM 02210328 ! 225: IF (ICZERO) 10030, 0041, 20030 02220328 ! 226: 10030 IVPASS = IVPASS + 1 02230328 ! 227: WRITE (I02,80002) IVTNUM 02240328 ! 228: GO TO 0041 02250328 ! 229: 20030 IVFAIL = IVFAIL + 1 02260328 ! 230: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 02270328 ! 231: 0041 CONTINUE 02280328 ! 232: C 02290328 ! 233: C **** FCVS PROGRAM 328 - TEST 004 **** 02300328 ! 234: C 02310328 ! 235: C INTEGER AND REAL EXPRESSIONS INVOLVING OPERATORS AS ACTUAL 02320328 ! 236: C ARGUMENTS. 02330328 ! 237: C 02340328 ! 238: IVTNUM = 4 02350328 ! 239: IF (ICZERO) 30040, 0040, 30040 02360328 ! 240: 0040 CONTINUE 02370328 ! 241: IVON02 = 2 02380328 ! 242: IVON03 = 3 02390328 ! 243: RVON02 = 2. 02400328 ! 244: RVON03 = 1.2 02410328 ! 245: CALL FS329(IVON02 + 3 * IVON03 - 7, RVON02 *RVON03 / .6, .TRUE.) 02420328 ! 246: IVCOMP = 1 02430328 ! 247: IF (IVCN01 .EQ. 5) IVCOMP = IVCOMP * 2 02440328 ! 248: IF (RVCN01 .GE. 4.9995 .AND. RVCN01 .LE. 5.0005) IVCOMP = IVCOMP*302450328 ! 249: IVCORR = 6 02460328 ! 250: 40040 IF (IVCOMP - 6) 20040, 10040, 20040 02470328 ! 251: 30040 IVDELE = IVDELE + 1 02480328 ! 252: WRITE (I02,80000) IVTNUM 02490328 ! 253: IF (ICZERO) 10040, 0051, 20040 02500328 ! 254: 10040 IVPASS = IVPASS + 1 02510328 ! 255: WRITE (I02,80002) IVTNUM 02520328 ! 256: GO TO 0051 02530328 ! 257: 20040 IVFAIL = IVFAIL + 1 02540328 ! 258: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 02550328 ! 259: 0051 CONTINUE 02560328 ! 260: C 02570328 ! 261: C **** FCVS PROGRAM 328 - TEST 005 **** 02580328 ! 262: C 02590328 ! 263: C REAL EXPRESSION INVOLVING INTEGER AND REAL PRIMARIES AND OPERATORS02600328 ! 264: C AS ACTUAL ARGUMENT. 02610328 ! 265: C 02620328 ! 266: IVTNUM = 5 02630328 ! 267: IF (ICZERO) 30050, 0050, 30050 02640328 ! 268: 0050 CONTINUE 02650328 ! 269: RVCOMP = 0.0 02660328 ! 270: IVON01 = 2 02670328 ! 271: RADN11(2) = 2.5 02680328 ! 272: CALL FS329(1, IVON01**3 * (RADN11(2) - 1) + 2.0, .TRUE.) 02690328 ! 273: RVCOMP = RVCN01 02700328 ! 274: RVCORR = 15.0 02710328 ! 275: 40050 IF (RVCOMP - 14.995) 20050, 10050, 40051 02720328 ! 276: 40051 IF (RVCOMP - 15.005) 10050, 10050, 20050 02730328 ! 277: 30050 IVDELE = IVDELE + 1 02740328 ! 278: WRITE (I02,80000) IVTNUM 02750328 ! 279: IF (ICZERO) 10050, 0061, 20050 02760328 ! 280: 10050 IVPASS = IVPASS + 1 02770328 ! 281: WRITE (I02,80002) IVTNUM 02780328 ! 282: GO TO 0061 02790328 ! 283: 20050 IVFAIL = IVFAIL + 1 02800328 ! 284: WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 02810328 ! 285: 0061 CONTINUE 02820328 ! 286: C 02830328 ! 287: C **** FCVS PROGRAM 328 - TEST 006 **** 02840328 ! 288: C 02850328 ! 289: C LOGICAL EXPRESSION INVOLVING LOGICAL OPERATOR (.NOT.) AS ACTUAL 02860328 ! 290: C ARGUMENT. 02870328 ! 291: C 02880328 ! 292: IVTNUM = 6 02890328 ! 293: IF (ICZERO) 30060, 0060, 30060 02900328 ! 294: 0060 CONTINUE 02910328 ! 295: LVON01 = .TRUE. 02920328 ! 296: CALL FS329(1, 1.0, .NOT. LVON01) 02930328 ! 297: IVCOMP = 0 02940328 ! 298: IF (LVCN01) IVCOMP = 1 02950328 ! 299: IVCORR = 1 02960328 ! 300: 40060 IF (IVCOMP - 1) 20060, 10060, 20060 02970328 ! 301: 30060 IVDELE = IVDELE + 1 02980328 ! 302: WRITE (I02,80000) IVTNUM 02990328 ! 303: IF (ICZERO) 10060, 0071, 20060 03000328 ! 304: 10060 IVPASS = IVPASS + 1 03010328 ! 305: WRITE (I02,80002) IVTNUM 03020328 ! 306: GO TO 0071 03030328 ! 307: 20060 IVFAIL = IVFAIL + 1 03040328 ! 308: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 03050328 ! 309: 0071 CONTINUE 03060328 ! 310: C 03070328 ! 311: C **** FCVS PROGRAM 328 - TEST 007 **** 03080328 ! 312: C 03090328 ! 313: C LOGICAL EXPRESSION INVOLVING LOGICAL OPERATOR (.OR.) AS ACTIVE 03100328 ! 314: C ARGUMENT. 03110328 ! 315: C 03120328 ! 316: IVTNUM = 7 03130328 ! 317: IF (ICZERO) 30070, 0070, 30070 03140328 ! 318: 0070 CONTINUE 03150328 ! 319: LVON01 = .TRUE. 03160328 ! 320: LVON02 = .FALSE. 03170328 ! 321: CALL FS329(1, 1.0, LVON01 .OR. LVON02) 03180328 ! 322: IVCOMP = 0 03190328 ! 323: IF (.NOT. LVCN01) IVCOMP = 1 03200328 ! 324: IVCORR = 1 03210328 ! 325: 40070 IF (IVCOMP - 1) 20070, 10070, 20070 03220328 ! 326: 30070 IVDELE = IVDELE + 1 03230328 ! 327: WRITE (I02,80000) IVTNUM 03240328 ! 328: IF (ICZERO) 10070, 0081, 20070 03250328 ! 329: 10070 IVPASS = IVPASS + 1 03260328 ! 330: WRITE (I02,80002) IVTNUM 03270328 ! 331: GO TO 0081 03280328 ! 332: 20070 IVFAIL = IVFAIL + 1 03290328 ! 333: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 03300328 ! 334: 0081 CONTINUE 03310328 ! 335: C 03320328 ! 336: C **** FCVS PROGRAM 328 - TEST 008 **** 03330328 ! 337: C 03340328 ! 338: C LOGICAL EXPRESSION INVOLVING LOGICAL OPERATOR (.AND.) AS ACTUAL 03350328 ! 339: C ARGUMENT. 03360328 ! 340: C 03370328 ! 341: IVTNUM = 8 03380328 ! 342: IF (ICZERO) 30080, 0080, 30080 03390328 ! 343: 0080 CONTINUE 03400328 ! 344: LVON01 = .FALSE. 03410328 ! 345: LVON02 = .TRUE. 03420328 ! 346: CALL FS329(1, 1.0, LVON01 .AND. LVON02) 03430328 ! 347: IVCOMP = 0 03440328 ! 348: IF (LVCN01) IVCOMP = 1 03450328 ! 349: IVCORR = 1 03460328 ! 350: 40080 IF (IVCOMP - 1) 20080, 10080, 20080 03470328 ! 351: 30080 IVDELE = IVDELE + 1 03480328 ! 352: WRITE (I02,80000) IVTNUM 03490328 ! 353: IF (ICZERO) 10080, 0091, 20080 03500328 ! 354: 10080 IVPASS = IVPASS + 1 03510328 ! 355: WRITE (I02,80002) IVTNUM 03520328 ! 356: GO TO 0091 03530328 ! 357: 20080 IVFAIL = IVFAIL + 1 03540328 ! 358: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 03550328 ! 359: 0091 CONTINUE 03560328 ! 360: C 03570328 ! 361: C **** FCVS PROGRAM 328 - TEST 009 **** 03580328 ! 362: C 03590328 ! 363: C EXPRESSION ENCLOSED IN PARENTHESES AS ACTUAL ARGUMENT. 03600328 ! 364: C 03610328 ! 365: IVTNUM = 9 03620328 ! 366: IF (ICZERO) 30090, 0090, 30090 03630328 ! 367: 0090 CONTINUE 03640328 ! 368: IVCOMP = 0 03650328 ! 369: IVON01 = 6 03660328 ! 370: CALL FS329((IVON01 + 3), 1.0, .TRUE.) 03670328 ! 371: IVCOMP = IVCN01 03680328 ! 372: IVCORR = 10 03690328 ! 373: 40090 IF (IVCOMP - 10) 20090, 10090, 20090 03700328 ! 374: 30090 IVDELE = IVDELE + 1 03710328 ! 375: WRITE (I02,80000) IVTNUM 03720328 ! 376: IF (ICZERO) 10090, 0101, 20090 03730328 ! 377: 10090 IVPASS = IVPASS + 1 03740328 ! 378: WRITE (I02,80002) IVTNUM 03750328 ! 379: GO TO 0101 03760328 ! 380: 20090 IVFAIL = IVFAIL + 1 03770328 ! 381: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 03780328 ! 382: 0101 CONTINUE 03790328 ! 383: C 03800328 ! 384: C **** FCVS PROGRAM 328 - TEST 010 **** 03810328 ! 385: C 03820328 ! 386: C INTEGER AND REAL INTRINSIC FUNCTION REFERENCES AS ACTUAL ARGUMENTS03830328 ! 387: C 03840328 ! 388: IVTNUM = 10 03850328 ! 389: IF (ICZERO) 30100, 0100, 30100 03860328 ! 390: 0100 CONTINUE 03870328 ! 391: RVON01 = 4.7 03880328 ! 392: RVON02 = -5.2 03890328 ! 393: CALL FS329(NINT(RVON01), ABS(RVON02), .TRUE.) 03900328 ! 394: IVCOMP = 1 03910328 ! 395: IF (IVCN01 .EQ. 6) IVCOMP = IVCOMP * 2 03920328 ! 396: IF (RVCN01 .GE. 6.1995 .AND. RVCN01 .LE. 6.2005) IVCOMP = IVCOMP*303930328 ! 397: IVCORR = 6 03940328 ! 398: 40100 IF (IVCOMP - 6) 20100, 10100, 20100 03950328 ! 399: 30100 IVDELE = IVDELE + 1 03960328 ! 400: WRITE (I02,80000) IVTNUM 03970328 ! 401: IF (ICZERO) 10100, 0111, 20100 03980328 ! 402: 10100 IVPASS = IVPASS + 1 03990328 ! 403: WRITE (I02,80002) IVTNUM 04000328 ! 404: GO TO 0111 04010328 ! 405: 20100 IVFAIL = IVFAIL + 1 04020328 ! 406: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 04030328 ! 407: 0111 CONTINUE 04040328 ! 408: C 04050328 ! 409: C **** FCVS PROGRAM 328 - TEST 011 **** 04060328 ! 410: C 04070328 ! 411: C EXTERNAL FUNCTION REFERENCE AS ACTUAL ARGUMENT. 04080328 ! 412: C 04090328 ! 413: IVTNUM = 11 04100328 ! 414: IF (ICZERO) 30110, 0110, 30110 04110328 ! 415: 0110 CONTINUE 04120328 ! 416: IVCOMP = 0 04130328 ! 417: IVON01 = 4 04140328 ! 418: CALL FS329(FF330(IVON01), 1.0, .TRUE.) 04150328 ! 419: IVCOMP = IVCN01 04160328 ! 420: IVCORR = 6 04170328 ! 421: 40110 IF (IVCOMP - 6) 20110, 10110, 20110 04180328 ! 422: 30110 IVDELE = IVDELE + 1 04190328 ! 423: WRITE (I02,80000) IVTNUM 04200328 ! 424: IF (ICZERO) 10110, 0121, 20110 04210328 ! 425: 10110 IVPASS = IVPASS + 1 04220328 ! 426: WRITE (I02,80002) IVTNUM 04230328 ! 427: GO TO 0121 04240328 ! 428: 20110 IVFAIL = IVFAIL + 1 04250328 ! 429: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 04260328 ! 430: 0121 CONTINUE 04270328 ! 431: C 04280328 ! 432: C **** FCVS PROGRAM 328 - TEST 012 **** 04290328 ! 433: C 04300328 ! 434: C USE ACTUAL ARGUMENT NAMES WHICH ARE IDENTICAL TO THE DUMMY 04310328 ! 435: C ARGUMENT NAMES. 04320328 ! 436: C 04330328 ! 437: IVTNUM = 12 04340328 ! 438: IF (ICZERO) 30120, 0120, 30120 04350328 ! 439: 0120 CONTINUE 04360328 ! 440: IDON01 = 10 04370328 ! 441: RDON01 = 10.0 04380328 ! 442: LDON01 = .FALSE. 04390328 ! 443: CALL FS329(IDON01, RDON01, LDON01) 04400328 ! 444: IVCOMP = 1 04410328 ! 445: IF (IVCN01 .EQ. 11) IVCOMP = IVCOMP * 2 04420328 ! 446: IF (RVCN01 .GE. 10.995 .AND. RVCN01 .LE. 11.005) IVCOMP = IVCOMP*304430328 ! 447: IF (LVCN01) IVCOMP = IVCOMP * 5 04440328 ! 448: IVCORR = 30 04450328 ! 449: 40120 IF (IVCOMP - 30) 20120, 10120, 20120 04460328 ! 450: 30120 IVDELE = IVDELE + 1 04470328 ! 451: WRITE (I02,80000) IVTNUM 04480328 ! 452: IF (ICZERO) 10120, 0131, 20120 04490328 ! 453: 10120 IVPASS = IVPASS + 1 04500328 ! 454: WRITE (I02,80002) IVTNUM 04510328 ! 455: GO TO 0131 04520328 ! 456: 20120 IVFAIL = IVFAIL + 1 04530328 ! 457: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 04540328 ! 458: 0131 CONTINUE 04550328 ! 459: C 04560328 ! 460: C **** FCVS PROGRAM 328 - TEST 013 **** 04570328 ! 461: C 04580328 ! 462: C USE INTEGER, REAL AND LOGICAL STATEMENT FUNCTION REFERENCES AS 04590328 ! 463: C ARGUMENT NAMES. 04600328 ! 464: C 04610328 ! 465: IVTNUM = 13 04620328 ! 466: IF (ICZERO) 30130, 0130, 30130 04630328 ! 467: 0130 CONTINUE 04640328 ! 468: RVON01 = 5.0 04650328 ! 469: CALL FS329(IFOS01(4), RFOS01(RVON01), LFOS01(.TRUE.)) 04660328 ! 470: IVCOMP = 1 04670328 ! 471: IF (IVCN01 .EQ. 6) IVCOMP = IVCOMP * 2 04680328 ! 472: IF (RVCN01 .GE. 6.9995 .AND. RVCN01 .LE. 7.0005) IVCOMP = IVCOMP*304690328 ! 473: IF (LVCN01) IVCOMP = IVCOMP * 5 04700328 ! 474: IVCORR = 30 04710328 ! 475: 40130 IF (IVCOMP - 30) 20130, 10130, 20130 04720328 ! 476: 30130 IVDELE = IVDELE + 1 04730328 ! 477: WRITE (I02,80000) IVTNUM 04740328 ! 478: IF (ICZERO) 10130, 0141, 20130 04750328 ! 479: 10130 IVPASS = IVPASS + 1 04760328 ! 480: WRITE (I02,80002) IVTNUM 04770328 ! 481: GO TO 0141 04780328 ! 482: 20130 IVFAIL = IVFAIL + 1 04790328 ! 483: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 04800328 ! 484: 0141 CONTINUE 04810328 ! 485: C 04820328 ! 486: C TEST 014 THROUGH TEST 019 ARE DESIGNED TO ASSOCIATE VARIOUS FORMS 04830328 ! 487: C OF ACTUAL ARGUMENTS TO ARRAY NAMES USED AS SUBROUTINE DUMMY 04840328 ! 488: C ARGUMENTS. 04850328 ! 489: C 04860328 ! 490: C 04870328 ! 491: C **** FCVS PROGRAM 328 - TEST 014 **** 04880328 ! 492: C 04890328 ! 493: C USE AN ARRAY NAME AS AN ACTUAL ARGUMENT IN WHICH THE ACTUAL 04900328 ! 494: C ARGUMENT ARRAY DECLARATOR IS IDENTICAL TO THE ASSOCIATED DUMMY 04910328 ! 495: C ARGUMENT ARRAY DECLARATOR. 04920328 ! 496: C 04930328 ! 497: IVTNUM = 14 04940328 ! 498: IF (ICZERO) 30140, 0140, 30140 04950328 ! 499: 0140 CONTINUE 04960328 ! 500: IVCOMP = 0 04970328 ! 501: IADN12(1) = 1 04980328 ! 502: IADN12(2) = 10 04990328 ! 503: IADN12(3) = 100 05000328 ! 504: IADN12(4) = 1000 05010328 ! 505: CALL FS331(IADN12) 05020328 ! 506: IVCOMP = IVCN01 05030328 ! 507: IVCORR = 1111 05040328 ! 508: 40140 IF (IVCOMP - 1111) 20140, 10140, 20140 05050328 ! 509: 30140 IVDELE = IVDELE + 1 05060328 ! 510: WRITE (I02,80000) IVTNUM 05070328 ! 511: IF (ICZERO) 10140, 0151, 20140 05080328 ! 512: 10140 IVPASS = IVPASS + 1 05090328 ! 513: WRITE (I02,80002) IVTNUM 05100328 ! 514: GO TO 0151 05110328 ! 515: 20140 IVFAIL = IVFAIL + 1 05120328 ! 516: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 05130328 ! 517: 0151 CONTINUE 05140328 ! 518: C 05150328 ! 519: C **** FCVS PROGRAM 328 - TEST 015 **** 05160328 ! 520: C 05170328 ! 521: C USE AN ARRAY NAME AS AN ACTUAL ARGUMENT IN WHICH THE SIZE OF THE 05180328 ! 522: C ACTUAL ARGUMENT ARRAY IS LARGER THAN THE SIZE OF THE ASSOCIATED 05190328 ! 523: C DUMMY ARGUMENT ARRAY. 05200328 ! 524: C 05210328 ! 525: IVTNUM = 15 05220328 ! 526: IF (ICZERO) 30150, 0150, 30150 05230328 ! 527: 0150 CONTINUE 05240328 ! 528: IVCOMP = 0 05250328 ! 529: IACN11(1) = 1 05260328 ! 530: IACN11(2) = 10 05270328 ! 531: IACN11(3) = 100 05280328 ! 532: IACN11(4) = 1000 05290328 ! 533: IACN11(5) = 10000 05300328 ! 534: CALL FS331(IACN11) 05310328 ! 535: IVCOMP = IVCN01 05320328 ! 536: IVCORR = 1111 05330328 ! 537: 40150 IF (IVCOMP - 1111) 20150, 10150, 20150 05340328 ! 538: 30150 IVDELE = IVDELE + 1 05350328 ! 539: WRITE (I02,80000) IVTNUM 05360328 ! 540: IF (ICZERO) 10150, 0161, 20150 05370328 ! 541: 10150 IVPASS = IVPASS + 1 05380328 ! 542: WRITE (I02,80002) IVTNUM 05390328 ! 543: GO TO 0161 05400328 ! 544: 20150 IVFAIL = IVFAIL + 1 05410328 ! 545: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 05420328 ! 546: 0161 CONTINUE 05430328 ! 547: C 05440328 ! 548: C **** FCVS PROGRAM 328 - TEST 016 **** 05450328 ! 549: C 05460328 ! 550: C USE AN ARRAY NAME AS AN ACTUAL ARGUMENT IN WHICH THE ACTUAL 05470328 ! 551: C ARGUMENT ARRAY DECLARATOR IS LARGER AND HAS MORE SUBSCRIPT 05480328 ! 552: C EXPRESSIONS THAN THE ASSOCIATED DUMMY ARGUMENT ARRAY DECLARATOR. 05490328 ! 553: C 05500328 ! 554: IVTNUM = 16 05510328 ! 555: IF (ICZERO) 30160, 0160, 30160 05520328 ! 556: 0160 CONTINUE 05530328 ! 557: IVCOMP = 0 05540328 ! 558: IATN11(1,1) = 1 05550328 ! 559: IATN11(2,1) = 10 05560328 ! 560: IATN11(1,2) = 100 05570328 ! 561: IATN11(2,2) = 1000 05580328 ! 562: IATN11(1,3) = 10000 05590328 ! 563: CALL FS331(IATN11) 05600328 ! 564: IVCOMP = IVCN01 05610328 ! 565: IVCORR = 1111 05620328 ! 566: 40160 IF (IVCOMP - 1111) 20160, 10160, 20160 05630328 ! 567: 30160 IVDELE = IVDELE + 1 05640328 ! 568: WRITE (I02,80000) IVTNUM 05650328 ! 569: IF (ICZERO) 10160, 0171, 20160 05660328 ! 570: 10160 IVPASS = IVPASS + 1 05670328 ! 571: WRITE (I02,80002) IVTNUM 05680328 ! 572: GO TO 0171 05690328 ! 573: 20160 IVFAIL = IVFAIL + 1 05700328 ! 574: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 05710328 ! 575: 0171 CONTINUE 05720328 ! 576: C 05730328 ! 577: C **** FCVS PROGRAM 328 - TEST 017 **** 05740328 ! 578: C 05750328 ! 579: C USE AN ARRAY ELEMENT NAME AS AN ACTUAL ARGUMENT IN WHICH THE 05760328 ! 580: C ASSOCIATED ACTUAL AND DUMMY ARRAY DECLARATORS ARE IDENTICAL. ALL 05770328 ! 581: C ARRAY ELEMENTS OF THE ACTUAL ARRAY SHOULD BE PASSED TO THE 05780328 ! 582: C DUMMY ARRAY OF THE SUBROUTINE. 05790328 ! 583: C 05800328 ! 584: IVTNUM = 17 05810328 ! 585: IF (ICZERO) 30170, 0170, 30170 05820328 ! 586: 0170 CONTINUE 05830328 ! 587: RVCOMP = 0.0 05840328 ! 588: RADN12(1) = 1. 05850328 ! 589: RADN12(2) = 10. 05860328 ! 590: RADN12(3) = 100. 05870328 ! 591: RADN12(4) = 1000. 05880328 ! 592: CALL FS332(RADN12(1)) 05890328 ! 593: RVCOMP = RVCN01 05900328 ! 594: RVCORR = 1111. 05910328 ! 595: 40170 IF (RVCOMP - 1110.5) 20170, 10170, 40171 05920328 ! 596: 40171 IF (RVCOMP - 1111.5) 10170, 10170, 20170 05930328 ! 597: 30170 IVDELE = IVDELE + 1 05940328 ! 598: WRITE (I02,80000) IVTNUM 05950328 ! 599: IF (ICZERO) 10170, 0181, 20170 05960328 ! 600: 10170 IVPASS = IVPASS + 1 05970328 ! 601: WRITE (I02,80002) IVTNUM 05980328 ! 602: GO TO 0181 05990328 ! 603: 20170 IVFAIL = IVFAIL + 1 06000328 ! 604: WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 06010328 ! 605: 0181 CONTINUE 06020328 ! 606: C 06030328 ! 607: C **** FCVS PROGRAM 328 - TEST 018 **** 06040328 ! 608: C 06050328 ! 609: C USE AN ARRAY ELEMENT NAME AS AN ACTUAL ARGUMENT IN WHICH THE SIZE 06060328 ! 610: C OF THE ACTUAL ARGUMENT ARRAY IS LARGER AND HAS FEWER SUBSCRIPT 06070328 ! 611: C EXPRESSIONS THAN THE ASSOCIATED DUMMY ARRAY. ONLY ACTUAL ARRAY 06080328 ! 612: C ELEMENTS WITH SUBSCRIPT VALUES OF 5, 6, 7 AND 8 ( OUT OF A 06090328 ! 613: C POSSIBLE 10 ELEMENTS) SHOULD BE PASSED TO THE DUMMY ARRAY OF 06100328 ! 614: C THE SUBROUTINE. 06110328 ! 615: C 06120328 ! 616: IVTNUM = 18 06130328 ! 617: IF (ICZERO) 30180, 0180, 30180 06140328 ! 618: 0180 CONTINUE 06150328 ! 619: RVCOMP = 0.0 06160328 ! 620: RACN11(4) = 1. 06170328 ! 621: RACN11(5) = 10. 06180328 ! 622: RACN11(6) = 100. 06190328 ! 623: RACN11(7) = 1000. 06200328 ! 624: RACN11(8) = 10000. 06210328 ! 625: RACN11(9) = 100000. 06220328 ! 626: CALL FS332(RACN11(5)) 06230328 ! 627: RVCOMP = RVCN01 06240328 ! 628: RVCORR = 11110. 06250328 ! 629: 40180 IF (RVCOMP - 11105.) 20180, 10180, 40181 06260328 ! 630: 40181 IF (RVCOMP - 11115.) 10180, 10180, 20180 06270328 ! 631: 30180 IVDELE = IVDELE + 1 06280328 ! 632: WRITE (I02,80000) IVTNUM 06290328 ! 633: IF (ICZERO) 10180, 0191, 20180 06300328 ! 634: 10180 IVPASS = IVPASS + 1 06310328 ! 635: WRITE (I02,80002) IVTNUM 06320328 ! 636: GO TO 0191 06330328 ! 637: 20180 IVFAIL = IVFAIL + 1 06340328 ! 638: WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 06350328 ! 639: 0191 CONTINUE 06360328 ! 640: C 06370328 ! 641: C **** FCVS PROGRAM 328 - TEST 019 **** 06380328 ! 642: C 06390328 ! 643: C USE AN ARRAY ELEMENT NAME AS AN ACTUAL ARGUMENT IN WHICH THE SIZE 06400328 ! 644: C OF THE ACTUAL ARGUMENT ARRAY IS LARGE THAN THE SIZE OF THE 06410328 ! 645: C ASSOCIATED DUMMY ARGUMENT ARRAY. ONLY ACTUAL ARRAY ELEMENTS WITH 06420328 ! 646: C SUBSCRIPT VALUES OF 9, 10, 11 AND 12 (OUT OF A POSSIBLE 12 06430328 ! 647: C ELEMENTS) SHOULD BE PASSED TO THE DUMMY ARRAY OF THE SUBROUTINE. 06440328 ! 648: C 06450328 ! 649: IVTNUM = 19 06460328 ! 650: IF (ICZERO) 30190, 0190, 30190 06470328 ! 651: 0190 CONTINUE 06480328 ! 652: RVCOMP = 0.0 06490328 ! 653: RATN11(2,3) = 1. 06500328 ! 654: RATN11(3,3) = 10. 06510328 ! 655: RATN11(1,4) = 100. 06520328 ! 656: RATN11(2,4) = 1000. 06530328 ! 657: RATN11(3,4) = 10000. 06540328 ! 658: CALL FS332(RATN11(3,3)) 06550328 ! 659: RVCOMP = RVCN01 06560328 ! 660: RVCORR = 11110. 06570328 ! 661: 40190 IF (RVCOMP - 11105.) 20190, 10190, 40191 06580328 ! 662: 40191 IF (RVCOMP - 11115.) 10190, 10190, 20190 06590328 ! 663: 30190 IVDELE = IVDELE + 1 06600328 ! 664: WRITE (I02,80000) IVTNUM 06610328 ! 665: IF (ICZERO) 10190, 0201, 20190 06620328 ! 666: 10190 IVPASS = IVPASS + 1 06630328 ! 667: WRITE (I02,80002) IVTNUM 06640328 ! 668: GO TO 0201 06650328 ! 669: 20190 IVFAIL = IVFAIL + 1 06660328 ! 670: WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 06670328 ! 671: 0201 CONTINUE 06680328 ! 672: C 06690328 ! 673: C TEST 020 THROUGH TEST 022 ARE DESIGNED TO ASSOCIATE VARIOUS FORMS 06700328 ! 674: C OF ACTUAL ARGUMENTS TO PROCEDURES USED AS SUBROUTINE DUMMY 06710328 ! 675: C ARGUMENTS. ACTUAL ARGUMENTS TESTED INCLUDE THE NAMES OF AN 06720328 ! 676: C EXTERNAL FUNCTION, AN INTRINSIC FUNCTION AND A SUBROUTINE. 06730328 ! 677: C 06740328 ! 678: C 06750328 ! 679: C **** FCVS PROGRAM 328 - TEST 020 **** 06760328 ! 680: C 06770328 ! 681: C USE AN EXTERNAL FUNCTION NAME AS AN ACTUAL ARGUMENT. 06780328 ! 682: C 06790328 ! 683: IVTNUM = 20 06800328 ! 684: IF (ICZERO) 30200, 0200, 30200 06810328 ! 685: 0200 CONTINUE 06820328 ! 686: IVCOMP = 0 06830328 ! 687: CALL FS333(FF330, 5) 06840328 ! 688: IVCOMP = IVCN01 06850328 ! 689: IVCORR = 7 06860328 ! 690: 40200 IF (IVCOMP - 7) 20200, 10200, 20200 06870328 ! 691: 30200 IVDELE = IVDELE + 1 06880328 ! 692: WRITE (I02,80000) IVTNUM 06890328 ! 693: IF (ICZERO) 10200, 0211, 20200 06900328 ! 694: 10200 IVPASS = IVPASS + 1 06910328 ! 695: WRITE (I02,80002) IVTNUM 06920328 ! 696: GO TO 0211 06930328 ! 697: 20200 IVFAIL = IVFAIL + 1 06940328 ! 698: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 06950328 ! 699: 0211 CONTINUE 06960328 ! 700: C 06970328 ! 701: C **** FCVS PROGRAM 328 - TEST 021 **** 06980328 ! 702: C 06990328 ! 703: C USE AN INTRINSIC FUNCTION NAME AS AN ACTUAL ARGUMENT. 07000328 ! 704: C 07010328 ! 705: IVTNUM = 21 07020328 ! 706: IF (ICZERO) 30210, 0210, 30210 07030328 ! 707: 0210 CONTINUE 07040328 ! 708: IVCOMP = 0 07050328 ! 709: CALL FS333(IABS, -7) 07060328 ! 710: IVCOMP = IVCN01 07070328 ! 711: IVCORR = 8 07080328 ! 712: 40210 IF (IVCOMP - 8) 20210, 10210, 20210 07090328 ! 713: 30210 IVDELE = IVDELE + 1 07100328 ! 714: WRITE (I02,80000) IVTNUM 07110328 ! 715: IF (ICZERO) 10210, 0221, 20210 07120328 ! 716: 10210 IVPASS = IVPASS + 1 07130328 ! 717: WRITE (I02,80002) IVTNUM 07140328 ! 718: GO TO 0221 07150328 ! 719: 20210 IVFAIL = IVFAIL + 1 07160328 ! 720: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 07170328 ! 721: 0221 CONTINUE 07180328 ! 722: C 07190328 ! 723: C **** FCVS PROGRAM 328 - TEST 022 **** 07200328 ! 724: C 07210328 ! 725: C USE A SUBROUTINE NAME AS AN ACTUAL ARGUMENT. 07220328 ! 726: C 07230328 ! 727: IVTNUM = 22 07240328 ! 728: IF (ICZERO) 30220, 0220, 30220 07250328 ! 729: 0220 CONTINUE 07260328 ! 730: RVCOMP = 0.0 07270328 ! 731: RVON01 = 3.5 07280328 ! 732: CALL FS334(FS335, RVON01) 07290328 ! 733: RVCOMP = RVCN01 07300328 ! 734: RVCORR = 5.5 07310328 ! 735: 40220 IF (RVCOMP - 5.4995) 20220, 10220, 40221 07320328 ! 736: 40221 IF (RVCOMP - 5.5005) 10220, 10220, 20220 07330328 ! 737: 30220 IVDELE = IVDELE + 1 07340328 ! 738: WRITE (I02,80000) IVTNUM 07350328 ! 739: IF (ICZERO) 10220, 0231, 20220 07360328 ! 740: 10220 IVPASS = IVPASS + 1 07370328 ! 741: WRITE (I02,80002) IVTNUM 07380328 ! 742: GO TO 0231 07390328 ! 743: 20220 IVFAIL = IVFAIL + 1 07400328 ! 744: WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 07410328 ! 745: 0231 CONTINUE 07420328 ! 746: C 07430328 ! 747: C 07440328 ! 748: C WRITE OUT TEST SUMMARY 07450328 ! 749: C 07460328 ! 750: WRITE (I02,90004) 07470328 ! 751: WRITE (I02,90014) 07480328 ! 752: WRITE (I02,90004) 07490328 ! 753: WRITE (I02,90000) 07500328 ! 754: WRITE (I02,90004) 07510328 ! 755: WRITE (I02,90020) IVFAIL 07520328 ! 756: WRITE (I02,90022) IVPASS 07530328 ! 757: WRITE (I02,90024) IVDELE 07540328 ! 758: STOP 07550328 ! 759: 90001 FORMAT (1H ,24X,5HFM328) 07560328 ! 760: 90000 FORMAT (1H ,20X,20HEND OF PROGRAM FM328) 07570328 ! 761: C 07580328 ! 762: C FORMATS FOR TEST DETAIL LINES 07590328 ! 763: C 07600328 ! 764: 80000 FORMAT (1H ,4X,I5,6X,7HDELETED) 07610328 ! 765: 80002 FORMAT (1H ,4X,I5,7X,4HPASS) 07620328 ! 766: 80010 FORMAT (1H ,4X,I5,7X,4HFAIL,10X,I6,9X,I6) 07630328 ! 767: 80012 FORMAT (1H ,4X,I5,7X,4HFAIL,4X,E12.5,3X,E12.5) 07640328 ! 768: 80018 FORMAT (1H ,4X,I5,7X,4HFAIL,2X,A14,1X,A14) 07650328 ! 769: C 07660328 ! 770: C FORMAT STATEMENTS FOR PAGE HEADERS 07670328 ! 771: C 07680328 ! 772: 90002 FORMAT (1H1) 07690328 ! 773: 90004 FORMAT (1H ) 07700328 ! 774: 90006 FORMAT (1H ,10X,34HFORTRAN COMPILER VALIDATION SYSTEM) 07710328 ! 775: 90008 FORMAT (1H ,21X,11HVERSION 1.0) 07720328 ! 776: 90010 FORMAT (1H ,8X,38HFOR OFFICIAL USE ONLY - COPYRIGHT 1978) 07730328 ! 777: 90012 FORMAT (1H ,5X,4HTEST,5X,9HPASS/FAIL,5X,8HCOMPUTED,8X,7HCORRECT) 07740328 ! 778: 90014 FORMAT (1H ,5X,46H----------------------------------------------) 07750328 ! 779: 90016 FORMAT (1H ,18X,17HSUBSET LEVEL TEST) 07760328 ! 780: C 07770328 ! 781: C FORMAT STATEMENTS FOR RUN SUMMARY 07780328 ! 782: C 07790328 ! 783: 90020 FORMAT (1H ,19X,I5,13H TESTS FAILED) 07800328 ! 784: 90022 FORMAT (1H ,19X,I5,13H TESTS PASSED) 07810328 ! 785: 90024 FORMAT (1H ,19X,I5,14H TESTS DELETED) 07820328 ! 786: END 07830328 ! 787: SUBROUTINE FS329(IDON01, RDON01, LDON01) 00010329 ! 788: C DATE***82/08/02*18.33.46 ! 789: C OWNER PRE/850703/TC-85- -410/ /FSTC/278FCVS*F78UBP20/ ! 790: C AUDIT FCVS78 V2.0 ! 791: C THIS SUBROUTINE IS USED BY VARIOUS TESTS IN THE MAIN PROGRAM 00020329 ! 792: C FM328 TO TEST THE DIFFERENT FORMS OF INTEGER, REAL AND LOGICAL 00030329 ! 793: C ACTUAL ARGUMENTS THAT CAN BE ASSOCIATED WITH INTEGER, REAL AND 00040329 ! 794: C LOGICAL DUMMY ARGUMENTS. THIS ROUTINE INCREMENTS THE INTEGER 00050329 ! 795: C AND REAL ARGUMENTS BY ONE AND NEGATES THE LOGICAL ARGUMENT. ALL 00060329 ! 796: C RESULTS ARE THEN RETURNED TO FM328 VIA VARIABLES IN NAMED COMMON. 00070329 ! 797: IMPLICIT LOGICAL (L) 00080329 ! 798: COMMON /BLK1/ IVCN01, RVCN01, LVCN01 00090329 ! 799: IVCN01 = IDON01 + 1 00100329 ! 800: RVCN01 = RDON01 + 1.0 00110329 ! 801: LVCN01 = .NOT. LDON01 00120329 ! 802: RETURN 00130329 ! 803: END 00140329 ! 804: INTEGER FUNCTION FF330(IDON02) 00010330 ! 805: C DATE***82/08/02*18.33.46 ! 806: C OWNER PRE/850703/TC-85- -410/ /FSTC/278FCVS*F78UBP20/ ! 807: C AUDIT FCVS78 V2.0 ! 808: C THIS FUNCTION IS USED BY TEST 011 OF THE MAIN PROGRAM FM328 TO00020330 ! 809: C TEST THE USE OF AN EXTERNAL FUNCTION REFERENCE AS AN ACTUAL 00030330 ! 810: C ARGUMENT WHEN THE ASSOCIATED DUMMY ARGUMENT IS A VARIABLE NAME. 00040330 ! 811: C THIS FUNCTION IS ALSO REFERENCED FROM SUBROUTINE FS333 VIA A 00050330 ! 812: C DUMMY PROCEDURE NAME REFERENCE. THIS FUNCTION INCREMENTS THE 00060330 ! 813: C ARGUMENT VALUE BY ONE AND RETURNS THE RESULT AS THE FUNCTION 00070330 ! 814: C VALUE. 00080330 ! 815: FF330 = IDON02 + 1 00090330 ! 816: RETURN 00100330 ! 817: END 00110330 ! 818: SUBROUTINE FS331(IDDN11) 00010331 ! 819: C DATE***82/08/02*18.33.46 ! 820: C OWNER PRE/850703/TC-85- -410/ /FSTC/278FCVS*F78UBP20/ ! 821: C AUDIT FCVS78 V2.0 ! 822: C THIS SUBROUTINE IS USED BY VARIOUS TESTS IN THE MAIN PROGRAM 00020331 ! 823: C FM328 TO TEST THE USE OF AN ARRAY NAME AS AN ACTUAL ARGUMENT WHEN 00030331 ! 824: C THE ASSOCIATED DUMMY ARGUMENT IS AN ARRAY NAME. THIS ROUTINE 00040331 ! 825: C ADDS TOGETHER THE FOUR ELEMENTS IN THE DUMMY ARGUMENT ARRAY AND 00050331 ! 826: C RETURNS THE RESULTS VIA A VARIABLE IN NAMED COMMON. 00060331 ! 827: LOGICAL LVCN01 00070331 ! 828: DIMENSION IDDN11(4) 00080331 ! 829: COMMON /BLK1/IVCN01, RVCN01, LVCN01 00090331 ! 830: IVCN01 = IDDN11(1) + IDDN11(2) + IDDN11(3) + IDDN11(4) 00100331 ! 831: RETURN 00110331 ! 832: END 00120331 ! 833: SUBROUTINE FS332(RDTN21) 00010332 ! 834: C DATE***82/08/02*18.33.46 ! 835: C OWNER PRE/850703/TC-85- -410/ /FSTC/278FCVS*F78UBP20/ ! 836: C AUDIT FCVS78 V2.0 ! 837: C THIS SUBROUTINE IS USED BY VARIOUS TESTS IN THE MAIN PROGRAM 00020332 ! 838: C FM328 TO TEST THE USE OF AN ARRAY ELEMENT NAME AS AN ACTUAL 00030332 ! 839: C ARGUMENT WHEN THE ASSOCIATED DUMMY ARGUMENT IS AN ARRAY NAME. 00040332 ! 840: C THIS ROUTINE ADDS TOGETHER THE FOUR ELEMENTS IN THE DUMMY 00050332 ! 841: C ARGUMENT ARRAY AND RETURNS THE RESULT VIA A VARIABLE IN NAMED 00060332 ! 842: C COMMON. 00070332 ! 843: IMPLICIT LOGICAL (L) 00080332 ! 844: REAL RDTN21(2,2) 00090332 ! 845: COMMON /BLK1/IVCN01, RVCN01, LVCN01 00100332 ! 846: RVCN01 = RDTN21(1,1) + RDTN21(2,1) + RDTN21(1,2) + RDTN21(2,2) 00110332 ! 847: RETURN 00120332 ! 848: END 00130332 ! 849: SUBROUTINE FS333(NINT, IDON03) 00010333 ! 850: C DATE***82/08/02*18.33.46 ! 851: C OWNER PRE/850703/TC-85- -410/ /FSTC/278FCVS*F78UBP20/ ! 852: C AUDIT FCVS78 V2.0 ! 853: C THIS SUBROUTINE IS USED BY TESTS 020 AND 021 OF THE MAIN 00020333 ! 854: C PROGRAM FM328 TO TEST THE USE OF EXTERNAL AND INTRINSIC FUNCTION 00030333 ! 855: C NAMES AS ACTUAL ARGUMENTS WHEN THE ASSOCIATED DUMMY ARGUMENT IS A 00040333 ! 856: C PROCEDURE NAME. THIS SUBROUTINE REFERENCES THE EXTERNAL FUNCTION 00050333 ! 857: C FF330 OR THE INTRINSIC FUNCTION IABS DEPENDING ON THE ACTUAL 00060333 ! 858: C ARGUMENT PASSED TO IT. THE RESULT OF THIS FUNCTION REFERENCE IS 00070333 ! 859: C THEN INCREMENTED BY ONE AND THE RESULT IS RETURNED TO FS328 VIA 00080333 ! 860: C A VARIABLE IN NAMED COMMON. 00090333 ! 861: IMPLICIT LOGICAL (L) 00100333 ! 862: COMMON /BLK1/IVCN01, RVCN01, LVCN01 00110333 ! 863: IVCN01 = NINT(IDON03) + 1 00120333 ! 864: C **** THE NAME NINT IS A DUMMY ARGUMENT NAME 00130333 ! 865: C AND NOT AN INTRINSIC FUNCTION REFERENCE **** 00140333 ! 866: RETURN 00150333 ! 867: END 00160333 ! 868: SUBROUTINE FS334(IDON06, RDON03) 00010334 ! 869: C DATE***82/08/02*18.33.46 ! 870: C OWNER PRE/850703/TC-85- -410/ /FSTC/278FCVS*F78UBP20/ ! 871: C AUDIT FCVS78 V2.0 ! 872: C THIS SUBROUTINE IS USED BY TEST 022 OF THE MAIN PROGRAM 00020334 ! 873: C FM328 TO TEST THE USE OF A SUBROUTINE NAME AS AN ACTUAL ARGUMENT 00030334 ! 874: C WHEN THE ASSOCIATED DUMMY ARGUMENT IS A PROCEDURE NAME. THIS 00040334 ! 875: C SUBROUTINE CALLS THE SUBROUTINE FS335 VIA A DUMMY PROCEDURE NAME 00050334 ! 876: C REFERENCE. THE ARGUMENT VALUE WHICH IS RETURNED FROM THE FS335 00060334 ! 877: C REFERENCE IS THEN INCREMENTED BY ONE AND RETURNED TO FM328 VIA 00070334 ! 878: C A VARIABLE IN NAMED COMMON. 00080334 ! 879: IMPLICIT LOGICAL (L) 00090334 ! 880: COMMON /BLK1/IVCN01, RVCN01, LVCN01 00100334 ! 881: CALL IDON06(RDON03) 00110334 ! 882: RVCN01 = RDON03 + 1.0 00120334 ! 883: RETURN 00130334 ! 884: END 00140334 ! 885: SUBROUTINE FS335(RDON04) 00010335 ! 886: C DATE***82/08/02*18.33.46 ! 887: C OWNER PRE/850703/TC-85- -410/ /FSTC/278FCVS*F78UBP20/ ! 888: C AUDIT FCVS78 V2.0 ! 889: C THIS SUBROUITNE IS USED BY TEST 022 OF THE MAIN PROGRAM FM32800020335 ! 890: C TO TEST THE USE OF A SUBROUTINE NAME AS AN ACTUAL ARGUMENT WHEN 00030335 ! 891: C THE ASSOCIATED DUMMY ARGUMENT IS A PROCEDURE NAME. FS335 IS 00040335 ! 892: C CALLED FROM SUBROUTINE FS334 VIA A DUMMY PROCEDURE NAME REFERENCE.00050335 ! 893: C THIS ROUTINE INCREMENTS THE ARGUMENT VALUE BY ONE. 00060335 ! 894: RDON04 = RDON04 + 1.0 00070335 ! 895: RETURN 00080335 ! 896: END 00090335
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.