![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to fm050.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 fm050.f CVS log | Up to [CSRG BSD Unix] / 43BSDTahoe / usr.bin / f77 / testf77 / tests |
1.1 ! root 1: c ! 2: c comment section ! 3: c ! 4: c fm050 ! 5: c ! 6: c this routine contains basic subroutine and function reference ! 7: c tests. four subroutines and one function are called or ! 8: c referenced. fs051 is called to test the calling and passing of ! 9: c arguments through unlabeled common. no arguments are specified ! 10: c in the call line. fs052 is identical to fs051 except that several ! 11: c returns are used. fs053 utilizes many arguments on the call ! 12: c statement and many return statements in the subroutine body. ! 13: c ff054 is a function subroutine in which many arguments and return ! 14: c statements are used. and finally fs055 passes a one dimenional ! 15: c array back to fm050. ! 16: c ! 17: c references ! 18: c american national standard programming language fortran, ! 19: c x3.9-1978 ! 20: c ! 21: c section 15.5.2, referencing an external function ! 22: c section 15.6.2, subroutine reference ! 23: c ! 24: common rvcn01,ivcn01,ivcn02,iacn11(20) ! 25: integer ff054 ! 26: c ! 27: c ********************************************************** ! 28: c ! 29: c a compiler validation system for the fortran language ! 30: c based on specifications as defined in american national standard ! 31: c programming language fortran x3.9-1978, has been developed by the ! 32: c federal cobol compiler testing service. the fortran compiler ! 33: c validation system (fcvs) consists of audit routines, their related ! 34: c data, and an executive system. each audit routine is a fortran ! 35: c program, subprogram or function which includes tests of specific ! 36: c language elements and supporting procedures indicating the result ! 37: c of executing these tests. ! 38: c ! 39: c this particular program/subprogram/function contains features ! 40: c found only in the subset as defined in x3.9-1978. ! 41: c ! 42: c suggestions and comments should be forwarded to - ! 43: c ! 44: c department of the navy ! 45: c federal cobol compiler testing service ! 46: c washington, d.c. 20376 ! 47: c ! 48: c ********************************************************** ! 49: c ! 50: c ! 51: c ! 52: c initialization section ! 53: c ! 54: c initialize constants ! 55: c ************** ! 56: c i01 contains the logical unit number for the card reader. ! 57: i01 = 5 ! 58: c i02 contains the logical unit number for the printer. ! 59: i02 = 6 ! 60: c system environment section ! 61: c ! 62: cx010 this card is replaced by contents of fexec x-010 control card. ! 63: c the cx010 card is for overriding the program default i01 = 5 ! 64: c (unit number for card reader). ! 65: cx011 this card is replaced by contents of fexec x-011 control card. ! 66: c the cx011 card is for systems which require additional ! 67: c fortran statements for files associated with cx010 above. ! 68: c ! 69: cx020 this card is replaced by contents of fexec x-020 control card. ! 70: c the cx020 card is for overriding the program default i02 = 6 ! 71: c (unit number for printer). ! 72: cx021 this card is replaced by contents of fexec x-021 control card. ! 73: c the cx021 card is for systems which require additional ! 74: c fortran statements for files associated with cx020 above. ! 75: c ! 76: ivpass=0 ! 77: ivfail=0 ! 78: ivdele=0 ! 79: iczero=0 ! 80: c ! 81: c write page headers ! 82: write (i02,90000) ! 83: write (i02,90001) ! 84: write (i02,90002) ! 85: write (i02, 90002) ! 86: write (i02,90003) ! 87: write (i02,90002) ! 88: write (i02,90004) ! 89: write (i02,90002) ! 90: write (i02,90011) ! 91: write (i02,90002) ! 92: write (i02,90002) ! 93: write (i02,90005) ! 94: write (i02,90006) ! 95: write (i02,90002) ! 96: c test section ! 97: c ! 98: c subroutine and function subprograms ! 99: c ! 100: 4001 continue ! 101: ivtnum = 400 ! 102: c ! 103: c **** test 400 **** ! 104: c test 400 tests the call to a subroutine containing no arguments. ! 105: c all parameters are passed through unlabeled common. ! 106: c ! 107: if (iczero) 34000, 4000, 34000 ! 108: 4000 continue ! 109: rvcn01 = 2.1654 ! 110: call fs051 ! 111: rvcomp = rvcn01 ! 112: go to 44000 ! 113: 34000 ivdele = ivdele + 1 ! 114: write (i02,80003) ivtnum ! 115: if (iczero) 44000, 4011, 44000 ! 116: 44000 if (rvcomp - 3.1649) 24000,14000,44001 ! 117: 44001 if (rvcomp - 3.1659) 14000,14000,24000 ! 118: 14000 ivpass = ivpass + 1 ! 119: write (i02,80001) ivtnum ! 120: go to 4011 ! 121: 24000 ivfail = ivfail + 1 ! 122: rvcorr = 3.1654 ! 123: write (i02,80005) ivtnum, rvcomp, rvcorr ! 124: 4011 continue ! 125: c ! 126: c test 401 through test 403 test the call to subroutine fs052 which ! 127: c contains no arguments. all parameters are passed through ! 128: c unlabeled common. subroutine fs052 contain several return ! 129: c statements. ! 130: c ! 131: ivtnum = 401 ! 132: c ! 133: c **** test 401 **** ! 134: c ! 135: if (iczero) 34010, 4010, 34010 ! 136: 4010 continue ! 137: ivcn01 = 5 ! 138: ivcn02 = 1 ! 139: call fs052 ! 140: ivcomp = ivcn01 ! 141: go to 44010 ! 142: 34010 ivdele = ivdele + 1 ! 143: write (i02,80003) ivtnum ! 144: if (iczero) 44010, 4021, 44010 ! 145: 44010 if (ivcomp - 6) 24010,14010,24010 ! 146: 14010 ivpass = ivpass + 1 ! 147: write (i02,80001) ivtnum ! 148: go to 4021 ! 149: 24010 ivfail = ivfail + 1 ! 150: ivcorr = 6 ! 151: write (i02,80004) ivtnum, ivcomp ,ivcorr ! 152: 4021 continue ! 153: ivtnum = 402 ! 154: c ! 155: c **** test 402 **** ! 156: c ! 157: if (iczero) 34020, 4020, 34020 ! 158: 4020 continue ! 159: ivcn01 = 10 ! 160: ivcn02 = 5 ! 161: call fs052 ! 162: ivcomp = ivcn01 ! 163: go to 44020 ! 164: 34020 ivdele = ivdele + 1 ! 165: write (i02,80003) ivtnum ! 166: if (iczero) 44020, 4031, 44020 ! 167: 44020 if (ivcomp - 15) 24020,14020,24020 ! 168: 14020 ivpass = ivpass + 1 ! 169: write (i02,80001) ivtnum ! 170: go to 4031 ! 171: 24020 ivfail = ivfail + 1 ! 172: ivcorr = 15 ! 173: write (i02,80004) ivtnum, ivcomp ,ivcorr ! 174: 4031 continue ! 175: ivtnum = 403 ! 176: c ! 177: c **** test 403 **** ! 178: c ! 179: if (iczero) 34030, 4030, 34030 ! 180: 4030 continue ! 181: ivcn01 = 30 ! 182: ivcn02 = 3 ! 183: call fs052 ! 184: ivcomp = ivcn01 ! 185: go to 44030 ! 186: 34030 ivdele = ivdele + 1 ! 187: write (i02,80003) ivtnum ! 188: if (iczero) 44030, 4041, 44030 ! 189: 44030 if (ivcomp - 33) 24030,14030,24030 ! 190: 14030 ivpass = ivpass + 1 ! 191: write (i02,80001) ivtnum ! 192: go to 4041 ! 193: 24030 ivfail = ivfail + 1 ! 194: ivcorr = 33 ! 195: write (i02,80004) ivtnum, ivcomp ,ivcorr ! 196: 4041 continue ! 197: c ! 198: c test 404 through test 406 test the call to subroutine fs053 which ! 199: c contains several arguments and several return statements. ! 200: c ! 201: ivtnum = 404 ! 202: c ! 203: c **** test 404 **** ! 204: c ! 205: if (iczero) 34040, 4040, 34040 ! 206: 4040 continue ! 207: call fs053 (6,10,11,ivon04,1) ! 208: ivcomp = ivon04 ! 209: go to 44040 ! 210: 34040 ivdele = ivdele + 1 ! 211: write (i02,80003) ivtnum ! 212: if (iczero) 44040, 4051, 44040 ! 213: 44040 if (ivcomp - 6) 24040,14040,24040 ! 214: 14040 ivpass = ivpass + 1 ! 215: write (i02,80001) ivtnum ! 216: go to 4051 ! 217: 24040 ivfail = ivfail + 1 ! 218: ivcorr = 6 ! 219: write (i02,80004) ivtnum, ivcomp ,ivcorr ! 220: 4051 continue ! 221: ivtnum = 405 ! 222: c ! 223: c **** test 405 **** ! 224: c ! 225: if (iczero) 34050, 4050, 34050 ! 226: 4050 continue ! 227: ivcn01 = 10 ! 228: call fs053 (6,ivcn01,11,ivon04,2) ! 229: ivcomp = ivon04 ! 230: go to 44050 ! 231: 34050 ivdele = ivdele + 1 ! 232: write (i02,80003) ivtnum ! 233: if (iczero) 44050, 4061, 44050 ! 234: 44050 if (ivcomp - 16) 24050,14050,24050 ! 235: 14050 ivpass = ivpass + 1 ! 236: write (i02,80001) ivtnum ! 237: go to 4061 ! 238: 24050 ivfail = ivfail + 1 ! 239: ivcorr = 16 ! 240: write (i02,80004) ivtnum, ivcomp ,ivcorr ! 241: 4061 continue ! 242: ivtnum = 406 ! 243: c ! 244: c **** test 406 **** ! 245: c ! 246: if (iczero) 34060, 4060, 34060 ! 247: 4060 continue ! 248: ivon01 = 6 ! 249: ivon02 = 10 ! 250: ivon03 = 11 ! 251: ivon05 = 3 ! 252: call fs053 (ivon01,ivon02,ivon03,ivon04,ivon05) ! 253: ivcomp = ivon04 ! 254: go to 44060 ! 255: 34060 ivdele = ivdele + 1 ! 256: write (i02,80003) ivtnum ! 257: if (iczero) 44060, 4071, 44060 ! 258: 44060 if (ivcomp - 27) 24060,14060,24060 ! 259: 14060 ivpass = ivpass + 1 ! 260: write (i02,80001) ivtnum ! 261: go to 4071 ! 262: 24060 ivfail = ivfail + 1 ! 263: ivcorr = 27 ! 264: write (i02,80004) ivtnum, ivcomp ,ivcorr ! 265: 4071 continue ! 266: c ! 267: c test 407 through 409 test the reference to function ff054 which ! 268: c contains several arguments and several return statements ! 269: c ! 270: ivtnum = 407 ! 271: c ! 272: c **** test 407 **** ! 273: c ! 274: if (iczero) 34070, 4070, 34070 ! 275: 4070 continue ! 276: ivcomp = ff054 (300,1,21,1) ! 277: go to 44070 ! 278: 34070 ivdele = ivdele + 1 ! 279: write (i02,80003) ivtnum ! 280: if (iczero) 44070, 4081, 44070 ! 281: 44070 if (ivcomp - 300) 24070,14070,24070 ! 282: 14070 ivpass = ivpass + 1 ! 283: write (i02,80001) ivtnum ! 284: go to 4081 ! 285: 24070 ivfail = ivfail + 1 ! 286: ivcorr = 300 ! 287: write (i02,80004) ivtnum, ivcomp ,ivcorr ! 288: 4081 continue ! 289: ivtnum = 408 ! 290: c ! 291: c **** test 408 **** ! 292: c ! 293: if (iczero) 34080, 4080, 34080 ! 294: 4080 continue ! 295: ivon01 = 300 ! 296: ivon04 = 2 ! 297: ivcomp = ff054 (ivon01,77,5,ivon04) ! 298: go to 44080 ! 299: 34080 ivdele = ivdele + 1 ! 300: write (i02,80003) ivtnum ! 301: if (iczero) 44080, 4091, 44080 ! 302: 44080 if (ivcomp - 377) 24080,14080,24080 ! 303: 14080 ivpass = ivpass + 1 ! 304: write (i02,80001) ivtnum ! 305: go to 4091 ! 306: 24080 ivfail = ivfail + 1 ! 307: ivcorr = 377 ! 308: write (i02,80004) ivtnum, ivcomp ,ivcorr ! 309: 4091 continue ! 310: ivtnum = 409 ! 311: c ! 312: c **** test 409 **** ! 313: c ! 314: if (iczero) 34090, 4090, 34090 ! 315: 4090 continue ! 316: ivon01 = 71 ! 317: ivon02 = 21 ! 318: ivon03 = 17 ! 319: ivon04 = 3 ! 320: ivcomp = ff054 (ivon01,ivon02,ivon03,ivon04) ! 321: go to 44090 ! 322: 34090 ivdele = ivdele + 1 ! 323: write (i02,80003) ivtnum ! 324: if (iczero) 44090, 4101, 44090 ! 325: 44090 if (ivcomp - 109) 24090,14090,24090 ! 326: 14090 ivpass = ivpass + 1 ! 327: write (i02,80001) ivtnum ! 328: go to 4101 ! 329: 24090 ivfail = ivfail + 1 ! 330: ivcorr = 109 ! 331: write (i02,80004) ivtnum, ivcomp ,ivcorr ! 332: 4101 continue ! 333: c ! 334: c test 410 through 429 test the call to subroutine fs055 which ! 335: c contains no arguments. the parameters are passed through an ! 336: c integer array variable in unlabeled common. ! 337: c ! 338: call fs055 ! 339: do 20 i = 1,20 ! 340: if (iczero) 34100, 4100, 34100 ! 341: 4100 continue ! 342: ivtnum = 409 + i ! 343: ivcomp = iacn11(i) ! 344: go to 44100 ! 345: 34100 ivdele = ivdele + 1 ! 346: write (i02,80003) ivtnum ! 347: if (iczero) 44100, 4111, 44100 ! 348: 44100 if (ivcomp - i) 24100,14100,24100 ! 349: 14100 ivpass = ivpass + 1 ! 350: write (i02,80001) ivtnum ! 351: go to 4111 ! 352: 24100 ivfail = ivfail + 1 ! 353: ivcorr = i ! 354: write (i02,80004) ivtnum, ivcomp ,ivcorr ! 355: 4111 continue ! 356: 20 continue ! 357: c ! 358: c write page footings and run summaries ! 359: 99999 continue ! 360: write (i02,90002) ! 361: write (i02,90006) ! 362: write (i02,90002) ! 363: write (i02,90002) ! 364: write (i02,90007) ! 365: write (i02,90002) ! 366: write (i02,90008) ivfail ! 367: write (i02,90009) ivpass ! 368: write (i02,90010) ivdele ! 369: c ! 370: c ! 371: c terminate routine execution ! 372: stop ! 373: c ! 374: c format statements for page headers ! 375: 90000 format (1h1) ! 376: 90002 format (1h ) ! 377: 90001 format (1h ,10x,34hfortran compiler validation system) ! 378: 90003 format (1h ,21x,11hversion 1.0) ! 379: 90004 format (1h ,10x,38hfor official use only - copyright 1978) ! 380: 90005 format (1h ,5x,4htest,5x,9hpass/fail, 5x,8hcomputed,8x,7hcorrect) ! 381: 90006 format (1h ,5x,46h----------------------------------------------) ! 382: 90011 format (1h ,18x,17hsubset level test) ! 383: c ! 384: c format statements for run summaries ! 385: 90008 format (1h ,15x,i5,19h errors encountered) ! 386: 90009 format (1h ,15x,i5,13h tests passed) ! 387: 90010 format (1h ,15x,i5,14h tests deleted) ! 388: c ! 389: c format statements for test results ! 390: 80001 format (1h ,4x,i5,7x,4hpass) ! 391: 80002 format (1h ,4x,i5,7x,4hfail) ! 392: 80003 format (1h ,4x,i5,7x,7hdeleted) ! 393: 80004 format (1h ,4x,i5,7x,4hfail,10x,i6,9x,i6) ! 394: 80005 format (1h ,4x,i5,7x,4hfail,4x,e12.5,3x,e12.5) ! 395: c ! 396: 90007 format (1h ,20x,20hend of program fm050) ! 397: end
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.