![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to fm023.f CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [CSRG BSD Unix] / 43BSDTahoe / usr.bin / f77 / testf77 / tests|
Return to fm023.f CVS log | Up to [CSRG BSD Unix] / 43BSDTahoe / usr.bin / f77 / testf77 / tests |
1.1 ! root 1: c comment section. ! 2: c ! 3: c fm023 ! 4: c ! 5: c two dimensioned arrays are used in this routine. ! 6: c this routine tests arrays with fixed dimension and size limits ! 7: c set either in a blank common or dimension statement. the values ! 8: c of the array elements are set in various ways such as simple ! 9: c assignment statements, set to the values of other array elements ! 10: c (either positive or negative), set by integer to real or real to ! 11: c integer conversion, set by arithmetic expressions, or set by ! 12: c use of the equivalence statement. ! 13: c ! 14: c ! 15: c references ! 16: c american national standard programming language fortran, ! 17: c x3.9-1978 ! 18: c ! 19: c section 8, specification statements ! 20: c section 8.1, dimension statement ! 21: c section 8.2, equivalence statement ! 22: c section 8.3, common statement ! 23: c section 8.4, type-statements ! 24: c section 9, data statement ! 25: c ! 26: common iadn22(2,2), radn22(2,2), icoe01, rcoe01 ! 27: dimension iadn21(2,2), radn21(2,2) ! 28: dimension iade23(2,2), iade24(2,2), rade23(2,2), rade24(2,2) ! 29: equivalence (iade23(2,2),iadn22(2,2),iade24(2,2)) ! 30: equivalence (rade23(2,2),radn22(2,2),rade24(2,2)) ! 31: equivalence (icoe01,icoe02,icoe03,icoe04), (rcoe01,rcoe02,rcoe03) ! 32: integer radn11(2), radn25(2,2) ! 33: logical ladn21(2,2) ! 34: data radn21(2,2)/-512./ ! 35: data ladn21/4*.true./ ! 36: c ! 37: c ********************************************************** ! 38: c ! 39: c a compiler validation system for the fortran language ! 40: c based on specifications as defined in american national standard ! 41: c programming language fortran x3.9-1978, has been developed by the ! 42: c federal cobol compiler testing service. the fortran compiler ! 43: c validation system (fcvs) consists of audit routines, their related ! 44: c data, and an executive system. each audit routine is a fortran ! 45: c program, subprogram or function which includes tests of specific ! 46: c language elements and supporting procedures indicating the result ! 47: c of executing these tests. ! 48: c ! 49: c this particular program/subprogram/function contains features ! 50: c found only in the subset as defined in x3.9-1978. ! 51: c ! 52: c suggestions and comments should be forwarded to - ! 53: c ! 54: c department of the navy ! 55: c federal cobol compiler testing service ! 56: c washington, d.c. 20376 ! 57: c ! 58: c ********************************************************** ! 59: c ! 60: c ! 61: c ! 62: c initialization section ! 63: c ! 64: c initialize constants ! 65: c ************** ! 66: c i01 contains the logical unit number for the card reader. ! 67: i01 = 5 ! 68: c i02 contains the logical unit number for the printer. ! 69: i02 = 6 ! 70: c system environment section ! 71: c ! 72: cx010 this card is replaced by contents of fexec x-010 control card. ! 73: c the cx010 card is for overriding the program default i01 = 5 ! 74: c (unit number for card reader). ! 75: cx011 this card is replaced by contents of fexec x-011 control card. ! 76: c the cx011 card is for systems which require additional ! 77: c fortran statements for files associated with cx010 above. ! 78: c ! 79: cx020 this card is replaced by contents of fexec x-020 control card. ! 80: c the cx020 card is for overriding the program default i02 = 6 ! 81: c (unit number for printer). ! 82: cx021 this card is replaced by contents of fexec x-021 control card. ! 83: c the cx021 card is for systems which require additional ! 84: c fortran statements for files associated with cx020 above. ! 85: c ! 86: ivpass=0 ! 87: ivfail=0 ! 88: ivdele=0 ! 89: iczero=0 ! 90: c ! 91: c write page headers ! 92: write (i02,90000) ! 93: write (i02,90001) ! 94: write (i02,90002) ! 95: write (i02, 90002) ! 96: write (i02,90003) ! 97: write (i02,90002) ! 98: write (i02,90004) ! 99: write (i02,90002) ! 100: write (i02,90011) ! 101: write (i02,90002) ! 102: write (i02,90002) ! 103: write (i02,90005) ! 104: write (i02,90006) ! 105: write (i02,90002) ! 106: ivtnum = 632 ! 107: c ! 108: c **** test 632 **** ! 109: c test 632 - tests setting an integer array element by a ! 110: c simple assignment statement to the value 9999. ! 111: c ! 112: if (iczero) 36320, 6320, 36320 ! 113: 6320 continue ! 114: iadn21(1,1) = 9999 ! 115: ivcomp = iadn21(1,1) ! 116: go to 46320 ! 117: 36320 ivdele = ivdele + 1 ! 118: write (i02,80003) ivtnum ! 119: if (iczero) 46320, 6331, 46320 ! 120: 46320 if ( ivcomp - 9999 ) 26320, 16320, 26320 ! 121: 16320 ivpass = ivpass + 1 ! 122: write (i02,80001) ivtnum ! 123: go to 6331 ! 124: 26320 ivfail = ivfail + 1 ! 125: ivcorr = 9999 ! 126: write (i02,80004) ivtnum, ivcomp ,ivcorr ! 127: 6331 continue ! 128: ivtnum = 633 ! 129: c ! 130: c **** test 633 **** ! 131: c test 633 - tests setting a real array element by a simple ! 132: c assignment statement to the value -32766. ! 133: c ! 134: if (iczero) 36330, 6330, 36330 ! 135: 6330 continue ! 136: radn21(1,2) = -32766. ! 137: ivcomp = radn21(1,2) ! 138: go to 46330 ! 139: 36330 ivdele = ivdele + 1 ! 140: write (i02,80003) ivtnum ! 141: if (iczero) 46330, 6341, 46330 ! 142: 46330 if ( ivcomp + 32766 ) 26330, 16330, 26330 ! 143: 16330 ivpass = ivpass + 1 ! 144: write (i02,80001) ivtnum ! 145: go to 6341 ! 146: 26330 ivfail = ivfail + 1 ! 147: ivcorr = -32766 ! 148: write (i02,80004) ivtnum, ivcomp ,ivcorr ! 149: 6341 continue ! 150: ivtnum = 634 ! 151: c ! 152: c **** test 634 **** ! 153: c test 634 - test of the data initialization statement and setting ! 154: c an integer array element equal to the value of a real array ! 155: c element. the value used is -512. ! 156: c ! 157: if (iczero) 36340, 6340, 36340 ! 158: 6340 continue ! 159: iadn21(2,2) = radn21(2,2) ! 160: ivcomp = iadn21(2,2) ! 161: go to 46340 ! 162: 36340 ivdele = ivdele + 1 ! 163: write (i02,80003) ivtnum ! 164: if (iczero) 46340, 6351, 46340 ! 165: 46340 if ( ivcomp + 512 ) 26340, 16340, 26340 ! 166: 16340 ivpass = ivpass + 1 ! 167: write (i02,80001) ivtnum ! 168: go to 6351 ! 169: 26340 ivfail = ivfail + 1 ! 170: ivcorr = -512 ! 171: write (i02,80004) ivtnum, ivcomp ,ivcorr ! 172: 6351 continue ! 173: ivtnum = 635 ! 174: c ! 175: c **** test 635 **** ! 176: c test 635 - test of setting a two dimensioned array element ! 177: c equal to the value of a one dimensioned array element. ! 178: c both arrays are set integer by the type statement and the two ! 179: c dimensioned array element is minus the value of the one dimension ! 180: c element. the value used is 3. ! 181: c ! 182: if (iczero) 36350, 6350, 36350 ! 183: 6350 continue ! 184: radn11(1) = 3 ! 185: radn25(2,2) = - radn11(1) ! 186: ivcomp = radn25(2,2) ! 187: go to 46350 ! 188: 36350 ivdele = ivdele + 1 ! 189: write (i02,80003) ivtnum ! 190: if (iczero) 46350, 6361, 46350 ! 191: 46350 if ( ivcomp + 3 ) 26350, 16350, 26350 ! 192: 16350 ivpass = ivpass + 1 ! 193: write (i02,80001) ivtnum ! 194: go to 6361 ! 195: 26350 ivfail = ivfail + 1 ! 196: ivcorr = -3 ! 197: write (i02,80004) ivtnum, ivcomp ,ivcorr ! 198: 6361 continue ! 199: ivtnum = 636 ! 200: c ! 201: c **** test 636 **** ! 202: c test 636 - test of logical array elements set by data statements ! 203: c ! 204: if (iczero) 36360, 6360, 36360 ! 205: 6360 continue ! 206: icon01 = 0 ! 207: if ( ladn21(2,1) ) icon01 = 1 ! 208: go to 46360 ! 209: 36360 ivdele = ivdele + 1 ! 210: write (i02,80003) ivtnum ! 211: if (iczero) 46360, 6371, 46360 ! 212: 46360 if ( icon01 - 1 ) 26360, 16360, 26360 ! 213: 16360 ivpass = ivpass + 1 ! 214: write (i02,80001) ivtnum ! 215: go to 6371 ! 216: 26360 ivfail = ivfail + 1 ! 217: ivcomp = icon01 ! 218: ivcorr = 1 ! 219: write (i02,80004) ivtnum, ivcomp ,ivcorr ! 220: 6371 continue ! 221: ivtnum = 637 ! 222: c ! 223: c **** test 637 **** ! 224: c test 637 - test of real to integer conversion and setting ! 225: c integer array elements to the value obtained in an arithmetic ! 226: c expression using real array elements. .5 + .5 = 1 ! 227: c ! 228: if (iczero) 36370, 6370, 36370 ! 229: 6370 continue ! 230: radn21(1,2) = 00000.5 ! 231: radn21(2,1) = .500000 ! 232: iadn21(2,1) = radn21(1,2) + radn21(2,1) ! 233: ivcomp = iadn21(2,1) ! 234: go to 46370 ! 235: 36370 ivdele = ivdele + 1 ! 236: write (i02,80003) ivtnum ! 237: if (iczero) 46370, 6381, 46370 ! 238: 46370 if ( ivcomp - 1 ) 26370, 16370, 26370 ! 239: 16370 ivpass = ivpass + 1 ! 240: write (i02,80001) ivtnum ! 241: go to 6381 ! 242: 26370 ivfail = ivfail + 1 ! 243: ivcorr = 1 ! 244: write (i02,80004) ivtnum, ivcomp ,ivcorr ! 245: 6381 continue ! 246: ivtnum = 638 ! 247: c ! 248: c **** test 638 **** ! 249: c test 638 - test of equivalence of three integer arrays one of ! 250: c which is in common. ! 251: c ! 252: if (iczero) 36380, 6380, 36380 ! 253: 6380 continue ! 254: iadn22(2,1) = -9999 ! 255: ivcomp = iade23(2,1) ! 256: go to 46380 ! 257: 36380 ivdele = ivdele + 1 ! 258: write (i02,80003) ivtnum ! 259: if (iczero) 46380, 6391, 46380 ! 260: 46380 if ( ivcomp + 9999 ) 26380, 16380, 26380 ! 261: 16380 ivpass = ivpass + 1 ! 262: write (i02,80001) ivtnum ! 263: go to 6391 ! 264: 26380 ivfail = ivfail + 1 ! 265: ivcorr = -9999 ! 266: write (i02,80004) ivtnum, ivcomp ,ivcorr ! 267: 6391 continue ! 268: ivtnum = 639 ! 269: c ! 270: c **** test 639 **** ! 271: c test 639 - like test 638 only the other equivalenced array is ! 272: c tested for the value -9999. ! 273: c ! 274: if (iczero) 36390, 6390, 36390 ! 275: 6390 continue ! 276: iade23(2,1) = -9999 ! 277: ivcomp = iade24(2,1) ! 278: go to 46390 ! 279: 36390 ivdele = ivdele + 1 ! 280: write (i02,80003) ivtnum ! 281: if (iczero) 46390, 6401, 46390 ! 282: 46390 if ( ivcomp + 9999 ) 26390, 16390, 26390 ! 283: 16390 ivpass = ivpass + 1 ! 284: write (i02,80001) ivtnum ! 285: go to 6401 ! 286: 26390 ivfail = ivfail + 1 ! 287: ivcorr = -9999 ! 288: write (i02,80004) ivtnum, ivcomp ,ivcorr ! 289: 6401 continue ! 290: ivtnum = 640 ! 291: c ! 292: c **** test 640 **** ! 293: c test 640 - test of three real arrays that are equivalenced. ! 294: c one of the arrays is in common. the value 512 is set into one of ! 295: c the dimensioned array elements by an integer to real conversion ! 296: c assignment statement. ! 297: c ! 298: if (iczero) 36400, 6400, 36400 ! 299: 6400 continue ! 300: rade24(2,2) = 512 ! 301: ivcomp = radn22(2,2) ! 302: go to 46400 ! 303: 36400 ivdele = ivdele + 1 ! 304: write (i02,80003) ivtnum ! 305: if (iczero) 46400, 6411, 46400 ! 306: 46400 if ( ivcomp - 512 ) 26400, 16400, 26400 ! 307: 16400 ivpass = ivpass + 1 ! 308: write (i02,80001) ivtnum ! 309: go to 6411 ! 310: 26400 ivfail = ivfail + 1 ! 311: ivcorr = 512 ! 312: write (i02,80004) ivtnum, ivcomp ,ivcorr ! 313: 6411 continue ! 314: ivtnum = 641 ! 315: c ! 316: c **** test 641 **** ! 317: c test 641 - like test 640 only the other equivalenced array is ! 318: c tested for the value 512. ! 319: c ! 320: if (iczero) 36410, 6410, 36410 ! 321: 6410 continue ! 322: radn22(2,2) = 512 ! 323: ivcomp = rade23(2,2) ! 324: go to 46410 ! 325: 36410 ivdele = ivdele + 1 ! 326: write (i02,80003) ivtnum ! 327: if (iczero) 46410, 6421, 46410 ! 328: 46410 if ( ivcomp - 512 ) 26410, 16410, 26410 ! 329: 16410 ivpass = ivpass + 1 ! 330: write (i02,80001) ivtnum ! 331: go to 6421 ! 332: 26410 ivfail = ivfail + 1 ! 333: ivcorr = 512 ! 334: write (i02,80004) ivtnum, ivcomp ,ivcorr ! 335: 6421 continue ! 336: ivtnum = 642 ! 337: c ! 338: c **** test 642 **** ! 339: c test 642 - test of four integer variables that are equivalenced. ! 340: c one of the integer variables is in blank common. the value used ! 341: c is 3 set by an assignment statement. ! 342: c ! 343: if (iczero) 36420, 6420, 36420 ! 344: 6420 continue ! 345: icoe03 = 3 ! 346: ivcomp = icoe01 ! 347: go to 46420 ! 348: 36420 ivdele = ivdele + 1 ! 349: write (i02,80003) ivtnum ! 350: if (iczero) 46420, 6431, 46420 ! 351: 46420 if ( ivcomp - 3 ) 26420, 16420, 26420 ! 352: 16420 ivpass = ivpass + 1 ! 353: write (i02,80001) ivtnum ! 354: go to 6431 ! 355: 26420 ivfail = ivfail + 1 ! 356: ivcorr = 3 ! 357: write (i02,80004) ivtnum, ivcomp ,ivcorr ! 358: 6431 continue ! 359: ivtnum = 643 ! 360: c ! 361: c **** test 643 **** ! 362: c test 643 - like test 642 but another of the elements is tested ! 363: c by an arithmetic expression using the equivalenced elements. ! 364: c the value of all of the elements should inititially be 3 since ! 365: c they all should share the same storage location. icoe04 = 3+3+3+3 ! 366: c icoe04 = 12 then the element icoe02 is tested for the value 12. ! 367: c ! 368: if (iczero) 36430, 6430, 36430 ! 369: 6430 continue ! 370: icoe01 = 3 ! 371: icoe04 = icoe01 + icoe02 + icoe03 + icoe04 ! 372: ivcomp = icoe02 ! 373: go to 46430 ! 374: 36430 ivdele = ivdele + 1 ! 375: write (i02,80003) ivtnum ! 376: if (iczero) 46430, 6441, 46430 ! 377: 46430 if ( ivcomp - 12 ) 26430, 16430, 26430 ! 378: 16430 ivpass = ivpass + 1 ! 379: write (i02,80001) ivtnum ! 380: go to 6441 ! 381: 26430 ivfail = ivfail + 1 ! 382: ivcorr = 12 ! 383: write (i02,80004) ivtnum, ivcomp ,ivcorr ! 384: 6441 continue ! 385: ivtnum = 644 ! 386: c ! 387: c **** test 644 **** ! 388: c test 644 - test of equivalence with three real variables one ! 389: c of which is in blank common. the elements are set initially to .5 ! 390: c then all of the elements are used in an arithmetic expression ! 391: c rcoe01 =(.5 + .5 + .5) * 2. so rcoe01 = 3. element rcoe02 ! 392: c is tested for the value 3. ! 393: c ! 394: if (iczero) 36440, 6440, 36440 ! 395: 6440 continue ! 396: rcoe02 = 0.5 ! 397: rcoe01 = ( rcoe01 + rcoe02 + rcoe03 ) * 2. ! 398: ivcomp = rcoe02 ! 399: go to 46440 ! 400: 36440 ivdele = ivdele + 1 ! 401: write (i02,80003) ivtnum ! 402: if (iczero) 46440, 6451, 46440 ! 403: 46440 if ( ivcomp - 3 ) 26440, 16440, 26440 ! 404: 16440 ivpass = ivpass + 1 ! 405: write (i02,80001) ivtnum ! 406: go to 6451 ! 407: 26440 ivfail = ivfail + 1 ! 408: ivcorr = 3 ! 409: write (i02,80004) ivtnum, ivcomp ,ivcorr ! 410: 6451 continue ! 411: c ! 412: c write page footings and run summaries ! 413: 99999 continue ! 414: write (i02,90002) ! 415: write (i02,90006) ! 416: write (i02,90002) ! 417: write (i02,90002) ! 418: write (i02,90007) ! 419: write (i02,90002) ! 420: write (i02,90008) ivfail ! 421: write (i02,90009) ivpass ! 422: write (i02,90010) ivdele ! 423: c ! 424: c ! 425: c terminate routine execution ! 426: stop ! 427: c ! 428: c format statements for page headers ! 429: 90000 format (1h1) ! 430: 90002 format (1h ) ! 431: 90001 format (1h ,10x,34hfortran compiler validation system) ! 432: 90003 format (1h ,21x,11hversion 1.0) ! 433: 90004 format (1h ,10x,38hfor official use only - copyright 1978) ! 434: 90005 format (1h ,5x,4htest,5x,9hpass/fail, 5x,8hcomputed,8x,7hcorrect) ! 435: 90006 format (1h ,5x,46h----------------------------------------------) ! 436: 90011 format (1h ,18x,17hsubset level test) ! 437: c ! 438: c format statements for run summaries ! 439: 90008 format (1h ,15x,i5,19h errors encountered) ! 440: 90009 format (1h ,15x,i5,13h tests passed) ! 441: 90010 format (1h ,15x,i5,14h tests deleted) ! 442: c ! 443: c format statements for test results ! 444: 80001 format (1h ,4x,i5,7x,4hpass) ! 445: 80002 format (1h ,4x,i5,7x,4hfail) ! 446: 80003 format (1h ,4x,i5,7x,7hdeleted) ! 447: 80004 format (1h ,4x,i5,7x,4hfail,10x,i6,9x,i6) ! 448: 80005 format (1h ,4x,i5,7x,4hfail,4x,e12.5,3x,e12.5) ! 449: c ! 450: 90007 format (1h ,20x,20hend of program fm023) ! 451: end
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.