![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to FM302.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 FM302.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 FM302 00010302 ! 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 00020302 ! 6: C 00030302 ! 7: C THIS ROUTINE TESTS THE SUBSET LEVEL FEATURES OF THE COMMON 00040302 ! 8: C SPECIFICATION STATEMENT. INTEGER, REAL AND LOGICAL VARIABLES AND 00050302 ! 9: C ARRAYS ARE PASSED BACK-AND-FORTH BETWEEN THE MAIN PROGRAM,EXTERNAL00060302 ! 10: C FUNCTIONS AND SUBROUTINES. BOTH NAMED AND UNNAMED (BLANK) COMMON 00070302 ! 11: C ARE TESTED. SPECIFIC TESTS ARE INCLUDED FOR RENAMING ENTITIES IN 00080302 ! 12: C COMMON BETWEEN PROGRAM UNITS, THE PASSING OF DATA THROUGH COMMON 00090302 ! 13: C BY EQUIVALENCE ASSOCIATION, AND THE SPECIFYING OF BLANK COMMON OF 00100302 ! 14: C DIFFERENT LENGTHS IN DIFFERENT PROGRAM UNITS. THE SUBSET LEVEL 00110302 ! 15: C FEATURES OF THE COMMON STATEMENT ARE ALSO TESTED IN FM022 THROUGH 00120302 ! 16: C FM025, FM050 AND FM056. 00130302 ! 17: C 00140302 ! 18: C REFERENCES. 00150302 ! 19: C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN, 00160302 ! 20: C X3.9-1978 00170302 ! 21: C 00180302 ! 22: C SECTION 8.2, EQUIVALENCE STATEMENT 00190302 ! 23: C SECTION 8.3, COMMON STATEMENT 00200302 ! 24: C SECTION 15.5, EXTERNAL FUNCTIONS 00210302 ! 25: C SECTION 15.6, SUBROUTINES 00220302 ! 26: C SECTION 15.9.4, COMMON BLOCKS 00230302 ! 27: C 00240302 ! 28: C 00250302 ! 29: C ******************************************************************00260302 ! 30: C A COMPILER VALIDATION SYSTEM FOR THE FORTRAN LANGUAGE 00270302 ! 31: C BASED ON SPECIFICATIONS AS DEFINED IN AMERICAN STANDARD FORTRAN 00280302 ! 32: C X3.9-1978, HAS BEEN DEVELOPED BY THE DEPARTMENT OF THE NAVY. THE 00290302 ! 33: C FORTRAN COMPILER VALIDATION SYSTEM (FCVS) CONSISTS OF AUDIT 00300302 ! 34: C ROUTINES, THEIR RELATED DATA, AND AN EXECUTIVE SYSTEM. EACH AUDIT00310302 ! 35: C ROUTINE IS A FORTRAN PROGRAM OR SUBPROGRAM WHICH INCLUDES TESTS 00320302 ! 36: C OF SPECIFIC LANGUAGE ELEMENTS AND SUPPORTING PROCEDURES INDICATING00330302 ! 37: C THE RESULT OF EXECUTING THESE TESTS. 00340302 ! 38: C 00350302 ! 39: C THIS PARTICULAR PROGRAM OR SUBPROGRAM CONTAINS ONLY FEATURES 00360302 ! 40: C FOUND IN THE SUBSET LEVEL OF THE STANDARD. 00370302 ! 41: C 00380302 ! 42: C SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO 00390302 ! 43: C DEPARTMENT OF THE NAVY 00400302 ! 44: C FEDERAL COBOL COMPILER TESTING SERVICE 00410302 ! 45: C WASHINGTON, D.C. 20376 00420302 ! 46: C 00430302 ! 47: C ******************************************************************00440302 ! 48: C 00450302 ! 49: C 00460302 ! 50: IMPLICIT LOGICAL (L) 00470302 ! 51: IMPLICIT CHARACTER*14 (C) 00480302 ! 52: C 00490302 ! 53: 00500302 ! 54: C 00510302 ! 55: C *** SPECIFICATION STATEMENT FOR TEST 001 *** 00520302 ! 56: C 00530302 ! 57: COMMON IVCN01 00540302 ! 58: C 00550302 ! 59: C *** SPECIFICATION STATEMENT FOR TEST 002 *** 00560302 ! 60: C 00570302 ! 61: COMMON //IVCN02,LVCN01 00580302 ! 62: C 00590302 ! 63: C *** SPECIFICATION STATEMENT FOR TEST 003 *** 00600302 ! 64: C 00610302 ! 65: COMMON RVCN01//IVCN03 00620302 ! 66: C 00630302 ! 67: C *** SPECIFICATION STATEMENT FOR TEST 004 *** 00640302 ! 68: C 00650302 ! 69: COMMON IVCN04, IVCN05, // IACN11(4) 00660302 ! 70: C 00670302 ! 71: C *** SPECIFICATION STATEMENT FOR TEST 005 *** 00680302 ! 72: C 00690302 ! 73: COMMON /BLK1/ IVCNA1 00700302 ! 74: C 00710302 ! 75: C *** SPECIFICATION STATEMENT FOR TEST 006 *** 00720302 ! 76: C 00730302 ! 77: COMMON /BLK2/IVCNB1,RVCNB1, /BLK2/IVCNB2 00740302 ! 78: C 00750302 ! 79: C *** SPECIFICATION STATEMENT FOR TEST 007 *** 00760302 ! 80: C 00770302 ! 81: DIMENSION RACN11(10) 00780302 ! 82: COMMON /BLK3/LVCNC1,IVCNC1/BLK4/RACN11,IACN21(2,3) 00790302 ! 83: C 00800302 ! 84: C *** SPECIFICATION STATEMENT FOR TEST 008 *** 00810302 ! 85: C 00820302 ! 86: COMMON /BLK5/IVCND1, IVCND2 00830302 ! 87: C 00840302 ! 88: C *** SPECIFICATION STATEMENT FOR TEST 009 *** 00850302 ! 89: C 00860302 ! 90: COMMON IVCN06/BLK5/RVCND1,LVCND1//IVCN07,IVCN08/BLK6/RVCNE1 00870302 ! 91: C 00880302 ! 92: C *** SPECIFICATION STATEMENT FOR TEST 010 *** 00890302 ! 93: C 00900302 ! 94: DIMENSION IACN1F(3) 00910302 ! 95: COMMON /BLK7/IVCNF1,IVCNF2,IVCNF3,IACN1F 00920302 ! 96: C 00930302 ! 97: C *** SPECIFICATION STATEMENT FOR TEST 011 *** 00940302 ! 98: C 00950302 ! 99: EQUIVALENCE (IVCEH1,IVCEH2) 00960302 ! 100: COMMON /BLK8/IVCEH1 00970302 ! 101: C 00980302 ! 102: C *** SPECIFICATION STATEMENT FOR TEST 012 00990302 ! 103: EQUIVALENCE (IVCE09,IVCE10) 01000302 ! 104: COMMON IVCE09 01010302 ! 105: C 01020302 ! 106: C *** SPECIFICATION STATEMENT FOR TEST 013 01030302 ! 107: C 01040302 ! 108: EQUIVALENCE (IVCEI1,IACE1I) 01050302 ! 109: DIMENSION IACE1I(3) 01060302 ! 110: COMMON /BLK9/IVCEI1 01070302 ! 111: C 01080302 ! 112: C *** SPECIFICATION STATEMENT FOR TEST 014 *** 01090302 ! 113: C 01100302 ! 114: COMMON IVCN12 01110302 ! 115: C 01120302 ! 116: C *** SPECIFICATION STATEMENT FOR TEST 015 *** 01130302 ! 117: C 01140302 ! 118: COMMON /BLK10/IVCNJ1 01150302 ! 119: C 01160302 ! 120: C *** SPECIFICATION STATEMENT FOR TEST 016 *** 01170302 ! 121: C 01180302 ! 122: COMMON /BLKCHR/CVTN01,CVTN02,CATN11 01190302 ! 123: CHARACTER CVTN01*2, CVTN02*3, CATN11(3)*5 01200302 ! 124: INTEGER FF304 01210302 ! 125: C 01220302 ! 126: C 01230302 ! 127: C 01240302 ! 128: C INITIALIZATION SECTION. 01250302 ! 129: C 01260302 ! 130: C INITIALIZE CONSTANTS 01270302 ! 131: C ******************** 01280302 ! 132: C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER 01290302 ! 133: I01 = 5 01300302 ! 134: C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER 01310302 ! 135: I02 = 6 01320302 ! 136: C SYSTEM ENVIRONMENT SECTION 01330302 ! 137: C 01340302 ! 138: I01 = 5 01350302 ! 139: C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 01360302 ! 140: C (UNIT NUMBER FOR CARD READER). 01370302 ! 141: CX011 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-011 CONTROL CARD01380302 ! 142: C THE CX011 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 01390302 ! 143: C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX010 ABOVE. 01400302 ! 144: C 01410302 ! 145: I02 = 6 01420302 ! 146: C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02 = 6 01430302 ! 147: C (UNIT NUMBER FOR PRINTER). 01440302 ! 148: CX021 THIS CARD IS PEPLACED BY CONTENTS OF FEXEC X-021 CONTROL CARD.01450302 ! 149: C THE CX021 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 01460302 ! 150: C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX020 ABOVE. 01470302 ! 151: C 01480302 ! 152: IVPASS = 0 01490302 ! 153: IVFAIL = 0 01500302 ! 154: IVDELE = 0 01510302 ! 155: ICZERO = 0 01520302 ! 156: C 01530302 ! 157: C WRITE OUT PAGE HEADERS 01540302 ! 158: C 01550302 ! 159: WRITE (I02,90002) 01560302 ! 160: WRITE (I02,90006) 01570302 ! 161: WRITE (I02,90008) 01580302 ! 162: WRITE (I02,90004) 01590302 ! 163: WRITE (I02,90010) 01600302 ! 164: WRITE (I02,90004) 01610302 ! 165: WRITE (I02,90016) 01620302 ! 166: WRITE (I02,90001) 01630302 ! 167: WRITE (I02,90004) 01640302 ! 168: WRITE (I02,90012) 01650302 ! 169: WRITE (I02,90014) 01660302 ! 170: WRITE (I02,90004) 01670302 ! 171: C 01680302 ! 172: C 01690302 ! 173: C THE FOLLOWING ASSIGNMENT STATEMENTS INITIALIZE THE DATA 01700302 ! 174: C ENTITIES BEING PASSED THROUGH COMMON TO SUBROUTINE FS303. ONLY 01710302 ! 175: C ONE REFERENCE TO THIS SUBPROGRAM IS MADE FROM THIS PROGRAM. THE 01720302 ! 176: C CONTENTS OF THE DATA ENTITIES BEING RETURNED THROUGH COMMON ARE 01730302 ! 177: C THEN CHECKED IN THIS PROGRAM. 01740302 ! 178: C 01750302 ! 179: C 01760302 ! 180: IVCN01 = 3 01770302 ! 181: IVCN02 = 2 01780302 ! 182: LVCN01 = .FALSE. 01790302 ! 183: IVCNA1 = 25 01800302 ! 184: IVCNB1 = 3 01810302 ! 185: RVCNB1 = 4.0 01820302 ! 186: IVCNB2 = 5 01830302 ! 187: LVCNC1 = .TRUE. 01840302 ! 188: IVCNC1 = 13 01850302 ! 189: RACN11(1) = 1. 01860302 ! 190: RACN11(10) = 10.0 01870302 ! 191: IACN21(1,1) = 11 01880302 ! 192: IACN21(2,3) = 23 01890302 ! 193: IVCNF1 = 41 01900302 ! 194: IVCNF3 = 43 01910302 ! 195: IACN1F(1) = 141 01920302 ! 196: IACN1F(2) = 142 01930302 ! 197: IVCEH1 = 1 01940302 ! 198: IVCEH2 = 5 01950302 ! 199: CVTN01 = 'AB' 01960302 ! 200: CVTN02 = 'CDE' 01970302 ! 201: CATN11(1) = 'FGHIJ' 01980302 ! 202: CATN11(2) = 'KLMNO' 01990302 ! 203: CATN11(3) = 'PQRST' 02000302 ! 204: CALL FS303 02010302 ! 205: C 02020302 ! 206: C THE FOLLOWING ASSIGNMENT STATEMENTS INITIALIZE THE DATA 02030302 ! 207: C ENTITIES BEING PASSED THROUGH COMMON TO EXTERNAL FUNCTION FF304. 02040302 ! 208: C ONLY ONE REFERENCE TO THIS SUBPROGRAM IS MADE FROM THIS PROGRAM. 02050302 ! 209: C THE CONTENTS OF THE DATA ENTITIES BEING RETURNED THROUGH COMMON 02060302 ! 210: C ARE THEN CHECKED IN THIS PROGRAM. 02070302 ! 211: C 02080302 ! 212: RVCN01 = 6.4 02090302 ! 213: IVCN03 = 11 02100302 ! 214: IVCN03 = IVCN03*2 02110302 ! 215: IVCN04 = 16 02120302 ! 216: IVCN05 = 16 02130302 ! 217: IACN11(1) = 1 02140302 ! 218: IACN11(2) = 2 02150302 ! 219: IACN11(3) = 3 02160302 ! 220: IACN11(4) = 4 02170302 ! 221: IVCND1 = +33 02180302 ! 222: IVCND2 = 10 02190302 ! 223: IVCN06 = 6 02200302 ! 224: IVCN07 = 7 02210302 ! 225: IVCN08 = 8 02220302 ! 226: RVCND1 = 1.3 02230302 ! 227: LVCND1 = .FALSE. 02240302 ! 228: RVCNE1 = +3.5 02250302 ! 229: IVCE09 = 9 02260302 ! 230: IVCE10 = 10 02270302 ! 231: IVCEI1 = 5 02280302 ! 232: IACE1I(1) = 10 02290302 ! 233: IACE1I(2) = 15 02300302 ! 234: IACE1I(3) = 20 02310302 ! 235: IVCNJ1 = 1 02320302 ! 236: IVON99 = FF304 ( ) 02330302 ! 237: C 02340302 ! 238: C TESTS 001 THROUGH 009 ARE DESIGNED TO TEST VARIOUS 02350302 ! 239: C SYNTACTICAL CONSTRUCTS OF THE COMMON STATEMENT USING NAMED AND 02360302 ! 240: C UNNAMED (BLANK) COMMON IN THE MAIN PROGRAM, A SUBROUTINE AND AN 02370302 ! 241: C EXTERNAL FUNCTION. DATA ENTITIES CONSIST OF INTEGER, REAL AND 02380302 ! 242: C LOGICAL VARIABLES AND INTEGER AND REAL ARRAYS. 02390302 ! 243: C 02400302 ! 244: C **** FCVS PROGRAM 302 - TEST 001 **** 02410302 ! 245: C 02420302 ! 246: C TESTS 001 AND 002 TEST THE USE OF UNNAMED COMMON IN A MAIN 02430302 ! 247: C PROGRAM AND A SUBROUTINE. 02440302 ! 248: C 02450302 ! 249: IVTNUM = 1 02460302 ! 250: IF (ICZERO) 30010, 0010, 30010 02470302 ! 251: 0010 CONTINUE 02480302 ! 252: IVCOMP = 0 02490302 ! 253: IVCOMP = IVCN01 02500302 ! 254: IVCORR = 4 02510302 ! 255: 40010 IF (IVCOMP - 4) 20010, 10010, 20010 02520302 ! 256: 30010 IVDELE = IVDELE + 1 02530302 ! 257: WRITE (I02,80000) IVTNUM 02540302 ! 258: IF (ICZERO) 10010, 0021, 20010 02550302 ! 259: 10010 IVPASS = IVPASS + 1 02560302 ! 260: WRITE (I02,80002) IVTNUM 02570302 ! 261: GO TO 0021 02580302 ! 262: 20010 IVFAIL = IVFAIL + 1 02590302 ! 263: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 02600302 ! 264: 0021 CONTINUE 02610302 ! 265: C 02620302 ! 266: C **** FCVS PROGRAM 302 - TEST 002 **** 02630302 ! 267: C 02640302 ! 268: C 02650302 ! 269: IVTNUM = 2 02660302 ! 270: IF (ICZERO) 30020, 0020, 30020 02670302 ! 271: 0020 CONTINUE 02680302 ! 272: IVCOMP = 1 02690302 ! 273: IF (IVCN02 .EQ. 7) IVCOMP = IVCOMP * 2 02700302 ! 274: IF (LVCN01) IVCOMP = IVCOMP * 3 02710302 ! 275: IVCORR = 6 02720302 ! 276: C 6 = 2 * 3 02730302 ! 277: 40020 IF (IVCOMP - 6) 20020, 10020, 20020 02740302 ! 278: 30020 IVDELE = IVDELE + 1 02750302 ! 279: WRITE (I02,80000) IVTNUM 02760302 ! 280: IF (ICZERO) 10020, 0031, 20020 02770302 ! 281: 10020 IVPASS = IVPASS + 1 02780302 ! 282: WRITE (I02,80002) IVTNUM 02790302 ! 283: GO TO 0031 02800302 ! 284: 20020 IVFAIL = IVFAIL + 1 02810302 ! 285: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 02820302 ! 286: 0031 CONTINUE 02830302 ! 287: C 02840302 ! 288: C **** FCVS PROGRAM 302 - TEST 003 **** 02850302 ! 289: C 02860302 ! 290: C TESTS 003 AND 004 TEST THE USE OF UNNAMED COMMON IN A MAIN 02870302 ! 291: C PROGRAM AND AN EXTERNAL FUNCTION. 02880302 ! 292: C 02890302 ! 293: IVTNUM = 3 02900302 ! 294: IF (ICZERO) 30030, 0030, 30030 02910302 ! 295: 0030 CONTINUE 02920302 ! 296: IVCOMP = 1 02930302 ! 297: IF (RVCN01 .GE. 4.1995 .AND. RVCN01 .LE. 4.2005) IVCOMP=IVCOMP*2 02940302 ! 298: IF (IVCN03 .EQ. 23) IVCOMP = IVCOMP * 3 02950302 ! 299: IVCORR = 6 02960302 ! 300: C 6 = 2 * 3 02970302 ! 301: 40030 IF (IVCOMP - 6) 20030, 10030, 20030 02980302 ! 302: 30030 IVDELE = IVDELE + 1 02990302 ! 303: WRITE (I02,80000) IVTNUM 03000302 ! 304: IF (ICZERO) 10030, 0041, 20030 03010302 ! 305: 10030 IVPASS = IVPASS + 1 03020302 ! 306: WRITE (I02,80002) IVTNUM 03030302 ! 307: GO TO 0041 03040302 ! 308: 20030 IVFAIL = IVFAIL + 1 03050302 ! 309: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 03060302 ! 310: 0041 CONTINUE 03070302 ! 311: C 03080302 ! 312: C **** FCVS PROGRAM 302 - TEST 004 **** 03090302 ! 313: C 03100302 ! 314: C 03110302 ! 315: IVTNUM = 4 03120302 ! 316: IF (ICZERO) 30040, 0040, 30040 03130302 ! 317: 0040 CONTINUE 03140302 ! 318: IVCOMP = 1 03150302 ! 319: IF (IVCN04 .EQ. 8) IVCOMP = IVCOMP * 2 03160302 ! 320: IF (IVCN05 .EQ. 16) IVCOMP = IVCOMP * 3 03170302 ! 321: IF (IACN11(1) .EQ. 5) IVCOMP = IVCOMP * 5 03180302 ! 322: IF (IACN11(2) .EQ. 5) IVCOMP = IVCOMP * 7 03190302 ! 323: IF (IACN11(3) .EQ. 5) IVCOMP = IVCOMP * 11 03200302 ! 324: IF (IACN11(4) .EQ. 5) IVCOMP = IVCOMP * 13 03210302 ! 325: IVCORR = 30030 03220302 ! 326: C 30030 = 2 * 3 * 5 * 7 * 11 * 13 03230302 ! 327: 40040 IF (IVCOMP - 30030) 20040, 10040, 20040 03240302 ! 328: 30040 IVDELE = IVDELE + 1 03250302 ! 329: WRITE (I02,80000) IVTNUM 03260302 ! 330: IF (ICZERO) 10040, 0051, 20040 03270302 ! 331: 10040 IVPASS = IVPASS + 1 03280302 ! 332: WRITE (I02,80002) IVTNUM 03290302 ! 333: GO TO 0051 03300302 ! 334: 20040 IVFAIL = IVFAIL + 1 03310302 ! 335: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 03320302 ! 336: 0051 CONTINUE 03330302 ! 337: C 03340302 ! 338: C **** FCVS PROGRAM 302 - TEST 005 **** 03350302 ! 339: C 03360302 ! 340: C TESTS 005 THROUGH 007 TEST THE USE OF NAMED COMMON BLOCKS 03370302 ! 341: C IN A MAIN PROGRAM AND A SUBROUTINE. 03380302 ! 342: C 03390302 ! 343: IVTNUM = 5 03400302 ! 344: IF (ICZERO) 30050, 0050, 30050 03410302 ! 345: 0050 CONTINUE 03420302 ! 346: IVCOMP = 0 03430302 ! 347: IVCOMP = IVCNA1 03440302 ! 348: IVCORR = 5 03450302 ! 349: 40050 IF (IVCOMP - 5) 20050, 10050, 20050 03460302 ! 350: 30050 IVDELE = IVDELE + 1 03470302 ! 351: WRITE (I02,80000) IVTNUM 03480302 ! 352: IF (ICZERO) 10050, 0061, 20050 03490302 ! 353: 10050 IVPASS = IVPASS + 1 03500302 ! 354: WRITE (I02,80002) IVTNUM 03510302 ! 355: GO TO 0061 03520302 ! 356: 20050 IVFAIL = IVFAIL + 1 03530302 ! 357: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 03540302 ! 358: 0061 CONTINUE 03550302 ! 359: C 03560302 ! 360: C **** FCVS PROGRAM 302 - TEST 006 **** 03570302 ! 361: C 03580302 ! 362: C 03590302 ! 363: IVTNUM = 6 03600302 ! 364: IF (ICZERO) 30060, 0060, 30060 03610302 ! 365: 0060 CONTINUE 03620302 ! 366: IVCOMP = 1 03630302 ! 367: IF (IVCNB1 .EQ. 8) IVCOMP = IVCOMP * 2 03640302 ! 368: IF (RVCNB1 .GE. 3.4995 .AND. RVCNB1 .LE. 3.5005) IVCOMP=IVCOMP*3 03650302 ! 369: IF (IVCNB2 .EQ. 5) IVCOMP = IVCOMP * 5 03660302 ! 370: IVCORR = 30 03670302 ! 371: C 30 = 2 * 3 * 5 03680302 ! 372: 40060 IF (IVCOMP - 30) 20060, 10060, 20060 03690302 ! 373: 30060 IVDELE = IVDELE + 1 03700302 ! 374: WRITE (I02,80000) IVTNUM 03710302 ! 375: IF (ICZERO) 10060, 0071, 20060 03720302 ! 376: 10060 IVPASS = IVPASS + 1 03730302 ! 377: WRITE (I02,80002) IVTNUM 03740302 ! 378: GO TO 0071 03750302 ! 379: 20060 IVFAIL = IVFAIL + 1 03760302 ! 380: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 03770302 ! 381: 0071 CONTINUE 03780302 ! 382: C 03790302 ! 383: C **** FCVS PROGRAM 302 - TEST 007 **** 03800302 ! 384: C 03810302 ! 385: C 03820302 ! 386: IVTNUM = 7 03830302 ! 387: IF (ICZERO) 30070, 0070, 30070 03840302 ! 388: 0070 CONTINUE 03850302 ! 389: IVCOMP = 1 03860302 ! 390: IF (.NOT. LVCNC1) IVCOMP = IVCOMP * 2 03870302 ! 391: IF (IVCNC1 .EQ. 12) IVCOMP = IVCOMP * 3 03880302 ! 392: IF (RACN11(1).GE.110.95 .AND. RACN11(1).LE.111.05) IVCOMP=IVCOMP*503890302 ! 393: IF (RACN11(10).GE.109.95.AND.RACN11(10).LE.110.05)IVCOMP=IVCOMP*7 03900302 ! 394: IF (IACN21(1,1) .EQ. 12) IVCOMP = IVCOMP * 11 03910302 ! 395: IF (IACN21 (2,3) .EQ. 24) IVCOMP = IVCOMP * 13 03920302 ! 396: IVCORR = 30030 03930302 ! 397: C 30030 = 2* 3 * 5 * 7 * 11 * 13 03940302 ! 398: 40070 IF (IVCOMP - 30030) 20070, 10070, 20070 03950302 ! 399: 30070 IVDELE = IVDELE + 1 03960302 ! 400: WRITE (I02,80000) IVTNUM 03970302 ! 401: IF (ICZERO) 10070, 0081, 20070 03980302 ! 402: 10070 IVPASS = IVPASS + 1 03990302 ! 403: WRITE (I02,80002) IVTNUM 04000302 ! 404: GO TO 0081 04010302 ! 405: 20070 IVFAIL = IVFAIL + 1 04020302 ! 406: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 04030302 ! 407: 0081 CONTINUE 04040302 ! 408: C 04050302 ! 409: C **** FCVS PROGRAM 302 - TEST 008 **** 04060302 ! 410: C 04070302 ! 411: C TESTS 008 AND 009 TEST THE USE OF NAMED COMMON BLOCKS IN A 04080302 ! 412: C MAIN PROGRAM AND AN EXTERNAL FUNCTION. 04090302 ! 413: C 04100302 ! 414: IVTNUM = 8 04110302 ! 415: IF (ICZERO) 30080, 0080, 30080 04120302 ! 416: 0080 CONTINUE 04130302 ! 417: IVCOMP = 1 04140302 ! 418: IF (IVCND1 .EQ. 34) IVCOMP = IVCOMP * 2 04150302 ! 419: IF (IVCND2 .EQ. 11) IVCOMP = IVCOMP * 3 04160302 ! 420: IVCORR = 6 04170302 ! 421: C 6 = 2 * 3 04180302 ! 422: 40080 IF (IVCOMP - 6) 20080, 10080, 20080 04190302 ! 423: 30080 IVDELE = IVDELE + 1 04200302 ! 424: WRITE (I02,80000) IVTNUM 04210302 ! 425: IF (ICZERO) 10080, 0091, 20080 04220302 ! 426: 10080 IVPASS = IVPASS + 1 04230302 ! 427: WRITE (I02,80002) IVTNUM 04240302 ! 428: GO TO 0091 04250302 ! 429: 20080 IVFAIL = IVFAIL + 1 04260302 ! 430: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 04270302 ! 431: 0091 CONTINUE 04280302 ! 432: C 04290302 ! 433: C **** FCVS PROGRAM 302 - TEST 009 **** 04300302 ! 434: C 04310302 ! 435: C 04320302 ! 436: IVTNUM = 9 04330302 ! 437: IF (ICZERO) 30090, 0090, 30090 04340302 ! 438: 0090 CONTINUE 04350302 ! 439: IVCOMP = 1 04360302 ! 440: IF (IVCN06 .EQ. 7) IVCOMP = IVCOMP * 2 04370302 ! 441: IF (RVCND1 .GE. 4.4995 .AND. RVCND1 .LE. 4.5005) IVCOMP = IVCOMP*304380302 ! 442: IF (LVCND1) IVCOMP = IVCOMP * 5 04390302 ! 443: IF (IVCN07 .EQ. -7) IVCOMP = IVCOMP * 7 04400302 ! 444: IF (IVCN08 .EQ. -3) IVCOMP = IVCOMP * 11 04410302 ! 445: IF (RVCNE1.GE.-6.7005.AND.RVCNE1.LE.-6.6995) IVCOMP=IVCOMP*13 04420302 ! 446: IVCORR = 30030 04430302 ! 447: C 30030 = 2 * 3 * 5 * 7 * 11 * 13 04440302 ! 448: 40090 IF (IVCOMP - 30030) 20090, 10090, 20090 04450302 ! 449: 30090 IVDELE = IVDELE + 1 04460302 ! 450: WRITE (I02,80000) IVTNUM 04470302 ! 451: IF (ICZERO) 10090, 0101, 20090 04480302 ! 452: 10090 IVPASS = IVPASS + 1 04490302 ! 453: WRITE (I02,80002) IVTNUM 04500302 ! 454: GO TO 0101 04510302 ! 455: 20090 IVFAIL = IVFAIL + 1 04520302 ! 456: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 04530302 ! 457: 0101 CONTINUE 04540302 ! 458: C 04550302 ! 459: C **** FCVS PROGRAM 302 - TEST 010 **** 04560302 ! 460: C 04570302 ! 461: C TEST 010 IS DESIGNED TO TEST THE ABILITY TO RENAME ENTITIES 04580302 ! 462: C IN NAMED COMMON BETWEEN A MAIN PROGRAM AND A SUBROUTINE. 04590302 ! 463: C 04600302 ! 464: IVTNUM = 10 04610302 ! 465: IF (ICZERO) 30100, 0100, 30100 04620302 ! 466: 0100 CONTINUE 04630302 ! 467: IVCOMP = 1 04640302 ! 468: IF (IVCNF1 .EQ. 42) IVCOMP = IVCOMP * 2 04650302 ! 469: IF (IVCNF2 .EQ. 43) IVCOMP = IVCOMP * 3 04660302 ! 470: IF (IVCNF3 .EQ. 44) IVCOMP = IVCOMP * 5 04670302 ! 471: IF (IACN1F(1) .EQ. 142) IVCOMP = IVCOMP * 7 04680302 ! 472: IF (IACN1F(2) .EQ. 143) IVCOMP = IVCOMP * 11 04690302 ! 473: IF (IACN1F(3) .EQ. 144) IVCOMP = IVCOMP * 13 04700302 ! 474: IVCORR = 30030 04710302 ! 475: C 30030 = 2 * 3 * 5 * 7 * 11 * 13 04720302 ! 476: 40100 IF (IVCOMP - 30030) 20100, 10100, 20100 04730302 ! 477: 30100 IVDELE = IVDELE + 1 04740302 ! 478: WRITE (I02,80000) IVTNUM 04750302 ! 479: IF (ICZERO) 10100, 0111, 20100 04760302 ! 480: 10100 IVPASS = IVPASS + 1 04770302 ! 481: WRITE (I02,80002) IVTNUM 04780302 ! 482: GO TO 0111 04790302 ! 483: 20100 IVFAIL = IVFAIL + 1 04800302 ! 484: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 04810302 ! 485: 0111 CONTINUE 04820302 ! 486: C 04830302 ! 487: C **** FCVS PROGRAM 302 - TEST 011 **** 04840302 ! 488: C 04850302 ! 489: C TEST 011 IS DESIGNED TO TEST THE STORAGE OF A VARIABLE IN 04860302 ! 490: C NAMED COMMON BY EQUIVALENCE ASSOCIATION. 04870302 ! 491: C 04880302 ! 492: IVTNUM = 11 04890302 ! 493: IF (ICZERO) 30110, 0110, 30110 04900302 ! 494: 0110 CONTINUE 04910302 ! 495: IVCOMP = 0 04920302 ! 496: IVCOMP = IVCEH2 04930302 ! 497: IVCORR = 6 04940302 ! 498: 40110 IF (IVCOMP - 6) 20110, 10110, 20110 04950302 ! 499: 30110 IVDELE = IVDELE + 1 04960302 ! 500: WRITE (I02,80000) IVTNUM 04970302 ! 501: IF (ICZERO) 10110, 0121, 20110 04980302 ! 502: 10110 IVPASS = IVPASS + 1 04990302 ! 503: WRITE (I02,80002) IVTNUM 05000302 ! 504: GO TO 0121 05010302 ! 505: 20110 IVFAIL = IVFAIL + 1 05020302 ! 506: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 05030302 ! 507: 0121 CONTINUE 05040302 ! 508: C 05050302 ! 509: C **** FCVS PROGRAM 302 - TEST 012 **** 05060302 ! 510: C 05070302 ! 511: C TEST 012 IS DESIGNED TO TEST THE STORAGE OF A VARIABLE IN 05080302 ! 512: C UNNAMED COMMON BY EQUIVALENCE ASSOCIATION. 05090302 ! 513: C 05100302 ! 514: IVTNUM = 12 05110302 ! 515: IF (ICZERO) 30120, 0120, 30120 05120302 ! 516: 0120 CONTINUE 05130302 ! 517: IVCOMP = 1 05140302 ! 518: IF (IVCE09 .EQ. 100) IVCOMP = IVCOMP * 2 05150302 ! 519: IF (IVCE10 .EQ. 100) IVCOMP = IVCOMP * 3 05160302 ! 520: IVCORR = 6 05170302 ! 521: C 6 = 2 * 3 05180302 ! 522: 40120 IF (IVCOMP - 6) 20120, 10120, 20120 05190302 ! 523: 30120 IVDELE = IVDELE + 1 05200302 ! 524: WRITE (I02,80000) IVTNUM 05210302 ! 525: IF (ICZERO) 10120, 0131, 20120 05220302 ! 526: 10120 IVPASS = IVPASS + 1 05230302 ! 527: WRITE (I02,80002) IVTNUM 05240302 ! 528: GO TO 0131 05250302 ! 529: 20120 IVFAIL = IVFAIL + 1 05260302 ! 530: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 05270302 ! 531: 0131 CONTINUE 05280302 ! 532: C 05290302 ! 533: C **** FCVS PROGRAM 302 - TEST 013 **** 05300302 ! 534: C 05310302 ! 535: C TEST 013 IS DESIGNED TO TEST THE EXTENSION OF NAMED COMMON 05320302 ! 536: C BLOCK STORAGE BY EQUIVALENCE ASSOCIATION OF A VARIABLE AND AN 05330302 ! 537: C ARRAY. 05340302 ! 538: C 05350302 ! 539: IVTNUM = 13 05360302 ! 540: IF (ICZERO) 30130, 0130, 30130 05370302 ! 541: 0130 CONTINUE 05380302 ! 542: IVCOMP = 1 05390302 ! 543: IF (IVCEI1 .EQ. 11) IVCOMP = IVCOMP * 2 05400302 ! 544: IF (IACE1I(1) .EQ. 11) IVCOMP = IVCOMP * 3 05410302 ! 545: IF (IACE1I(2) .EQ. 16) IVCOMP = IVCOMP * 5 05420302 ! 546: IF (IACE1I(3) .EQ. 21) IVCOMP = IVCOMP * 7 05430302 ! 547: IVCORR = 210 05440302 ! 548: C 210 = 2 * 3 * 5 * 7 05450302 ! 549: 40130 IF (IVCOMP - 210) 20130, 10130, 20130 05460302 ! 550: 30130 IVDELE = IVDELE + 1 05470302 ! 551: WRITE (I02,80000) IVTNUM 05480302 ! 552: IF (ICZERO) 10130, 0141, 20130 05490302 ! 553: 10130 IVPASS = IVPASS + 1 05500302 ! 554: WRITE (I02,80002) IVTNUM 05510302 ! 555: GO TO 0141 05520302 ! 556: 20130 IVFAIL = IVFAIL + 1 05530302 ! 557: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 05540302 ! 558: 0141 CONTINUE 05550302 ! 559: C 05560302 ! 560: C **** FCVS PROGRAM 302 - TEST 014 **** 05570302 ! 561: C 05580302 ! 562: C TEST 014 IS DESIGNED TO TEST THE ABILITY OF PASSING DATA 05590302 ! 563: C THROUGH UNNAMED COMMON FROM EXTERNAL FUNCTIONS WHICH HAVE MORE 05600302 ! 564: C ENTITIES IN UNNAMED COMMON THAN THE MAIN PROGRAM. 05610302 ! 565: C 05620302 ! 566: IVTNUM = 14 05630302 ! 567: IF (ICZERO) 30140, 0140, 30140 05640302 ! 568: 0140 CONTINUE 05650302 ! 569: IVCOMP = 0 05660302 ! 570: IVCOMP = IVCN12 05670302 ! 571: IVCORR = 11 05680302 ! 572: 40140 IF (IVCOMP - 11) 20140, 10140, 20140 05690302 ! 573: 30140 IVDELE = IVDELE + 1 05700302 ! 574: WRITE (I02,80000) IVTNUM 05710302 ! 575: IF (ICZERO) 10140, 0151, 20140 05720302 ! 576: 10140 IVPASS = IVPASS + 1 05730302 ! 577: WRITE (I02,80002) IVTNUM 05740302 ! 578: GO TO 0151 05750302 ! 579: 20140 IVFAIL = IVFAIL + 1 05760302 ! 580: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 05770302 ! 581: 0151 CONTINUE 05780302 ! 582: C 05790302 ! 583: C **** FCVS PROGRAM 302 - TEST 015 **** 05800302 ! 584: C 05810302 ! 585: C TEST 015 IS DESIGNED TO TEST THE ABILITY OF PASSING DATA 05820302 ! 586: C THROUGH NAMED COMMON BETWEEN EXTERNAL FUNCTIONS WHERE THE NAMED 05830302 ! 587: C COMMON BLOCK IS NOT SPECIFIED IN THE MAIN PROGRAM. 05840302 ! 588: C 05850302 ! 589: IVTNUM = 15 05860302 ! 590: IF (ICZERO) 30150, 0150, 30150 05870302 ! 591: 0150 CONTINUE 05880302 ! 592: IVCOMP = 0 05890302 ! 593: IVCOMP = IVCNJ1 05900302 ! 594: IVCORR = 5 05910302 ! 595: 40150 IF (IVCOMP - 5) 20150, 10150, 20150 05920302 ! 596: 30150 IVDELE = IVDELE + 1 05930302 ! 597: WRITE (I02,80000) IVTNUM 05940302 ! 598: IF (ICZERO) 10150, 0161, 20150 05950302 ! 599: 10150 IVPASS = IVPASS + 1 05960302 ! 600: WRITE (I02,80002) IVTNUM 05970302 ! 601: GO TO 0161 05980302 ! 602: 20150 IVFAIL = IVFAIL + 1 05990302 ! 603: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 06000302 ! 604: 0161 CONTINUE 06010302 ! 605: C 06020302 ! 606: C **** FCVS PROGRAM 302 - TEST 016 **** 06030302 ! 607: C 06040302 ! 608: C TEST 016 IS DESIGNED TO TEST THE PASSING OF CHARACTER DATA 06050302 ! 609: C IN NAMED COMMON BETWEEN THE MAIN PROGRAM AND A SUBROUTINE. 06060302 ! 610: C 06070302 ! 611: IVTNUM = 16 06080302 ! 612: IF (ICZERO) 30160, 0160, 30160 06090302 ! 613: 0160 CONTINUE 06100302 ! 614: IVCOMP = 1 06110302 ! 615: IF (CVTN01 .EQ. 'YZ') IVCOMP = IVCOMP * 2 06120302 ! 616: IF (CVTN02 .EQ. 'UVW') IVCOMP = IVCOMP * 3 06130302 ! 617: IF (CATN11(1) .EQ. 'VWXYZ') IVCOMP = IVCOMP * 5 06140302 ! 618: IF (CATN11(2) .EQ. 'KLMNO') IVCOMP = IVCOMP * 7 06150302 ! 619: IF (CATN11(3) .EQ. 'ABCDE') IVCOMP = IVCOMP * 11 06160302 ! 620: IVCORR = 2310 06170302 ! 621: C 2310 = 2 * 3 * 5 * 7 * 11 06180302 ! 622: 40160 IF (IVCOMP - 2310) 20160, 10160, 20160 06190302 ! 623: 30160 IVDELE = IVDELE + 1 06200302 ! 624: WRITE (I02,80000) IVTNUM 06210302 ! 625: IF (ICZERO) 10160, 0171, 20160 06220302 ! 626: 10160 IVPASS = IVPASS + 1 06230302 ! 627: WRITE (I02,80002) IVTNUM 06240302 ! 628: GO TO 0171 06250302 ! 629: 20160 IVFAIL = IVFAIL + 1 06260302 ! 630: WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 06270302 ! 631: 0171 CONTINUE 06280302 ! 632: C 06290302 ! 633: C 06300302 ! 634: C WRITE OUT TEST SUMMARY 06310302 ! 635: C 06320302 ! 636: WRITE (I02,90004) 06330302 ! 637: WRITE (I02,90014) 06340302 ! 638: WRITE (I02,90004) 06350302 ! 639: WRITE (I02,90000) 06360302 ! 640: WRITE (I02,90004) 06370302 ! 641: WRITE (I02,90020) IVFAIL 06380302 ! 642: WRITE (I02,90022) IVPASS 06390302 ! 643: WRITE (I02,90024) IVDELE 06400302 ! 644: STOP 06410302 ! 645: 90001 FORMAT (1H ,24X,5HFM302) 06420302 ! 646: 90000 FORMAT (1H ,20X,20HEND OF PROGRAM FM302) 06430302 ! 647: C 06440302 ! 648: C FORMATS FOR TEST DETAIL LINES 06450302 ! 649: C 06460302 ! 650: 80000 FORMAT (1H ,4X,I5,6X,7HDELETED) 06470302 ! 651: 80002 FORMAT (1H ,4X,I5,7X,4HPASS) 06480302 ! 652: 80010 FORMAT (1H ,4X,I5,7X,4HFAIL,10X,I6,9X,I6) 06490302 ! 653: 80012 FORMAT (1H ,4X,I5,7X,4HFAIL,4X,E12.5,3X,E12.5) 06500302 ! 654: 80018 FORMAT (1H ,4X,I5,7X,4HFAIL,2X,A14,1X,A14) 06510302 ! 655: C 06520302 ! 656: C FORMAT STATEMENTS FOR PAGE HEADERS 06530302 ! 657: C 06540302 ! 658: 90002 FORMAT (1H1) 06550302 ! 659: 90004 FORMAT (1H ) 06560302 ! 660: 90006 FORMAT (1H ,10X,34HFORTRAN COMPILER VALIDATION SYSTEM) 06570302 ! 661: 90008 FORMAT (1H ,21X,11HVERSION 1.0) 06580302 ! 662: 90010 FORMAT (1H ,8X,38HFOR OFFICIAL USE ONLY - COPYRIGHT 1978) 06590302 ! 663: 90012 FORMAT (1H ,5X,4HTEST,5X,9HPASS/FAIL,5X,8HCOMPUTED,8X,7HCORRECT) 06600302 ! 664: 90014 FORMAT (1H ,5X,46H----------------------------------------------) 06610302 ! 665: 90016 FORMAT (1H ,18X,17HSUBSET LEVEL TEST) 06620302 ! 666: C 06630302 ! 667: C FORMAT STATEMENTS FOR RUN SUMMARY 06640302 ! 668: C 06650302 ! 669: 90020 FORMAT (1H ,19X,I5,13H TESTS FAILED) 06660302 ! 670: 90022 FORMAT (1H ,19X,I5,13H TESTS PASSED) 06670302 ! 671: 90024 FORMAT (1H ,19X,I5,14H TESTS DELETED) 06680302 ! 672: END 06690302 ! 673: SUBROUTINE FS303 00010303 ! 674: C DATE***82/08/02*18.33.46 ! 675: C OWNER PRE/850703/TC-85- -410/ /FSTC/278FCVS*F78UBP20/ ! 676: C AUDIT FCVS78 V2.0 ! 677: C 00020303 ! 678: C FS303 IS A SUBROUTINE WHICH IS CALLED ONCE FROM PROGRAM FM302. 00030303 ! 679: C IT IS USED TO MODIFY VARIABLES AND ARRAY PASSED THROUGH NAMED AND 00040303 ! 680: C UNNAMED COMMON FROM FM302. AFTER THE DATA ENTITIES ARE MODIFIED 00050303 ! 681: C CONTROL IS RETURNED TO FM302 WHERE EACH ENTITY IS TESTED. 00060303 ! 682: C 00070303 ! 683: IMPLICIT LOGICAL (L) 00080303 ! 684: DIMENSION RACN11(10) 00090303 ! 685: COMMON IVCN01 00100303 ! 686: COMMON //IVCN02, LVCN01 00110303 ! 687: COMMON RVCN01//IVCN03 00120303 ! 688: COMMON IVCN04,IVCN05, //IACN11(4) 00130303 ! 689: COMMON /BLK1/IVCNA1 00140303 ! 690: COMMON /BLK2/IVCNB1,RVCNB1,/BLK2/IVCNB2 00150303 ! 691: COMMON /BLK3/LVCNC1,IVCNC1/BLK4/RACN11,IACN21(2,3) 00160303 ! 692: COMMON /BLK7/IACN1G(5),IVCNG1 00170303 ! 693: COMMON /BLK8/IVCNH1 00180303 ! 694: COMMON /BLKCHR/CVTN01,CVTN02,CATN11 00190303 ! 695: CHARACTER CVTN01*2, CVTN02*3, CATN11(3)*5 00200303 ! 696: C TEST 001 00210303 ! 697: IVCN01 = IVCN01 + 1 00220303 ! 698: C TEST 002 00230303 ! 699: IVCN02 = IVCN02 + 5 00240303 ! 700: LVCN01 = .NOT. LVCN01 00250303 ! 701: C TEST 005 00260303 ! 702: IVCNA1 = IVCNA1 / 5 00270303 ! 703: C TEST 006 00280303 ! 704: IVCNB1 = IVCNB1 + IVCNB2 00290303 ! 705: RVCNB1 = 3.5 00300303 ! 706: C TEST 007 00310303 ! 707: LVCNC1 = .FALSE. 00320303 ! 708: IVCNC1 = IVCNC1 - 1 00330303 ! 709: RACN11(1) = 111. 00340303 ! 710: RACN11(10) = 110. 00350303 ! 711: IACN21(1,1) = IACN21(1,1) + 1 00360303 ! 712: IACN21(2,3) = IACN21(2,3) + 1 00370303 ! 713: C TEST 010 00380303 ! 714: IACN1G(1) = IACN1G(1) + 1 00390303 ! 715: IACN1G(2) = 43 00400303 ! 716: IACN1G(3) = IACN1G(3) + 1 00410303 ! 717: IACN1G(4) = IACN1G(4) + 1 00420303 ! 718: IACN1G(5) = IACN1G(5) + 1 00430303 ! 719: IVCNG1 = 144 00440303 ! 720: C TEST 011 00450303 ! 721: IVCNH1 = IVCNH1 + 1 00460303 ! 722: C TEST 017 00470303 ! 723: CVTN01 = 'YZ' 00480303 ! 724: CVTN02 = 'UVW' 00490303 ! 725: CATN11(1) = 'VWXYZ' 00500303 ! 726: CATN11(3) = 'ABCDE' 00510303 ! 727: RETURN 00520303 ! 728: END 00530303 ! 729: INTEGER FUNCTION FF304 () 00010304 ! 730: C DATE***82/08/02*18.33.46 ! 731: C OWNER PRE/850703/TC-85- -410/ /FSTC/278FCVS*F78UBP20/ ! 732: C AUDIT FCVS78 V2.0 ! 733: C 00020304 ! 734: C FF304 IS AN EXTERNAL FUNCTION WHICH IS REFERENCED ONCE FROM 00030304 ! 735: C PROGRAM FM302. IT IS USED TO MODIFY VARIABLES AND ARRAYS PASSED 00040304 ! 736: C THROUGH NAMED AND UNNAMED COMMON FROM FM302. AFTER THE DATA 00050304 ! 737: C ENTITIES ARE MODIFIED CONTROL IS RETURNED TO FM302 WHERE EACH 00060304 ! 738: C ENTITY IS TESTED. A FUNCTION VALUE OF 999 IS RETURNED BUT IT IS 00070304 ! 739: C NOT SIGNIFICANT NOR IS IT TESTED BY FM302. 00080304 ! 740: C 00090304 ! 741: IMPLICIT LOGICAL (L) 00100304 ! 742: DIMENSION IACN11(4) 00110304 ! 743: COMMON IVCN01 00120304 ! 744: COMMON IVCN02, LVCN01 00130304 ! 745: COMMON RVCN01, IVCN03 00140304 ! 746: COMMON IVCN04,IVCN05,IACN11 00150304 ! 747: COMMON /BLK5/IVCND1,IVCND2 00160304 ! 748: COMMON IVCN06 00170304 ! 749: COMMON /BLK5/RVCND1,LVCND1 00180304 ! 750: COMMON IVCN07, IVCN08 00190304 ! 751: COMMON /BLK6/RVCNE1 00200304 ! 752: COMMON IVCN10 00210304 ! 753: COMMON /BLK9/IVCNI1, IVCNI2, IVCNI3 00220304 ! 754: COMMON IVCN12, IVCN13 00230304 ! 755: COMMON /BLK10/IVCNJ1 00240304 ! 756: COMMON /BLK11/IVCNK1 00250304 ! 757: INTEGER FF305 00260304 ! 758: C TEST 003 00270304 ! 759: RVCN01 = 4.2 00280304 ! 760: IVCN03 = IVCN03 + 1 00290304 ! 761: C TEST 004 00300304 ! 762: IVCN04 = 32 00310304 ! 763: IVCN04 = IVCN04 / 4 00320304 ! 764: IVCN05 = IVCN05 00330304 ! 765: IACN11(1) = IACN11(1) + 4 00340304 ! 766: IACN11(2) = IACN11(2) + 3 00350304 ! 767: IACN11(3) = IACN11(3) + 2 00360304 ! 768: IACN11(4) = IACN11(4) + 1 00370304 ! 769: C TEST 008 00380304 ! 770: IVCND1 = IVCND1 + 1 00390304 ! 771: IVCND2 = IVCND2 + 1 00400304 ! 772: C TEST 009 00410304 ! 773: IVCN06 = IVCN06 + 1 00420304 ! 774: RVCND1 = 4.5 00430304 ! 775: LVCND1 = .TRUE. 00440304 ! 776: IVCN07 = -IVCN07 00450304 ! 777: IVCN08 = -3 00460304 ! 778: RVCNE1 = -6.7 00470304 ! 779: C TEST 012 00480304 ! 780: IVCN10 = IVCN10 * IVCN10 00490304 ! 781: C TEST 013 00500304 ! 782: IVCNI1 = IVCNI1 + 1 00510304 ! 783: IVCNI2 = IVCNI2 + 1 00520304 ! 784: IVCNI3 = IVCNI3 + 1 00530304 ! 785: C TEST 014 00540304 ! 786: IVCN13 = 5 00550304 ! 787: C TEST 015 00560304 ! 788: IVCNK1 = 3 00570304 ! 789: C 00580304 ! 790: C FOR TESTS 014 AND 015 EXTERNAL FUNCTION FF305 IS REFERENCED 00590304 ! 791: C 00600304 ! 792: IVON99 = FF305 () 00610304 ! 793: C TEST 014 00620304 ! 794: IVCN12 = IVCN13 00630304 ! 795: C TEST 015 00640304 ! 796: IVCNJ1 = IVCNK1 00650304 ! 797: FF304 = 999 00660304 ! 798: RETURN 00670304 ! 799: END 00680304 ! 800: INTEGER FUNCTION FF305 () 00010305 ! 801: C DATE***82/08/02*18.33.46 ! 802: C OWNER PRE/850703/TC-85- -410/ /FSTC/278FCVS*F78UBP20/ ! 803: C AUDIT FCVS78 V2.0 ! 804: C 00020305 ! 805: C FF305 IS AN EXTERNAL FUNCTION WHICH IS USED IN TEST 014 AND 00030305 ! 806: C 015 OF PROGRAM FM302. THIS SUBPROGRAM IS REFERENCED FROM EXTERNAL 00040305 ! 807: C FUNCTION FF304. 00050305 ! 808: C 00060305 ! 809: COMMON IACN11(15) 00070305 ! 810: COMMON IVCN12, IVCN13, IVCN14 00080305 ! 811: COMMON /BLK10/IVCNJ1, /BLK11/IVCNK1 00090305 ! 812: C TEST 014 00100305 ! 813: IVCN14 = 11 00110305 ! 814: IVCN13 = IVCN14 00120305 ! 815: C TEST 015 00130305 ! 816: IVCNK1 = 5 00140305 ! 817: FF305 = 999 00150305 ! 818: RETURN 00160305 ! 819: END 00170305
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.