![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to fm011.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 fm011.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 fm011 ! 4: c ! 5: c this routine is a test of blank characters (section 3.1.6) ! 6: c which should have no meaning when embedded in fortran reserved ! 7: c words. ! 8: c references ! 9: c american national standard programming language fortran, ! 10: c x3.9-1978 ! 11: c ! 12: c section 3.1.6, blank character ! 13: dim en sion iadn11(3),iadn12(3) ! 14: in teger rvtni1 ! 15: rea l ivtnr1 ! 16: log ical lvtnl1,lvtnl2 ! 17: com mon iace11(3) ! 18: equ ival ence (iace11(1),iadn11(1)) ! 19: d a t a iadn12/3*3/ ! 20: c ! 21: c ********************************************************** ! 22: c ! 23: c a compiler validation system for the fortran language ! 24: c based on specifications as defined in american national standard ! 25: c programming language fortran x3.9-1978, has been developed by the ! 26: c federal cobol compiler testing service. the fortran compiler ! 27: c validation system (fcvs) consists of audit routines, their related ! 28: c data, and an executive system. each audit routine is a fortran ! 29: c program, subprogram or function which includes tests of specific ! 30: c language elements and supporting procedures indicating the result ! 31: c of executing these tests. ! 32: c ! 33: c this particular program/subprogram/function contains features ! 34: c found only in the subset as defined in x3.9-1978. ! 35: c ! 36: c suggestions and comments should be forwarded to - ! 37: c ! 38: c department of the navy ! 39: c federal cobol compiler testing service ! 40: c washington, d.c. 20376 ! 41: c ! 42: c ********************************************************** ! 43: c ! 44: c ! 45: c ! 46: c initialization section ! 47: c ! 48: c initialize constants ! 49: c ************** ! 50: c i01 contains the logical unit number for the card reader. ! 51: i01 = 5 ! 52: c i02 contains the logical unit number for the printer. ! 53: i02 = 6 ! 54: c system environment section ! 55: c ! 56: cx010 this card is replaced by contents of fexec x-010 control card. ! 57: c the cx010 card is for overriding the program default i01 = 5 ! 58: c (unit number for card reader). ! 59: cx011 this card is replaced by contents of fexec x-011 control card. ! 60: c the cx011 card is for systems which require additional ! 61: c fortran statements for files associated with cx010 above. ! 62: c ! 63: cx020 this card is replaced by contents of fexec x-020 control card. ! 64: c the cx020 card is for overriding the program default i02 = 6 ! 65: c (unit number for printer). ! 66: cx021 this card is replaced by contents of fexec x-021 control card. ! 67: c the cx021 card is for systems which require additional ! 68: c fortran statements for files associated with cx020 above. ! 69: c ! 70: ivpass=0 ! 71: ivfail=0 ! 72: ivdele=0 ! 73: iczero=0 ! 74: c ! 75: c write page headers ! 76: write (i02,90000) ! 77: write (i02,90001) ! 78: write (i02,90002) ! 79: write (i02, 90002) ! 80: write (i02,90003) ! 81: write (i02,90002) ! 82: write (i02,90004) ! 83: write (i02,90002) ! 84: write (i02,90011) ! 85: write (i02,90002) ! 86: write (i02,90002) ! 87: write (i02,90005) ! 88: write (i02,90006) ! 89: write (i02,90002) ! 90: ivtnum = 103 ! 91: c ! 92: c **** test 103 **** ! 93: c test 103 - this test has blanks embedded in a dimension ! 94: c statement. also the do statement with an embedded blank ! 95: c will be tested to initialize values in an array. the ! 96: c continue and if statements have embedded blanks as well. ! 97: c ! 98: if (iczero) 31030, 1030, 31030 ! 99: 1030 continue ! 100: d o 1 ivon01 =1 , 3 , 1 ! 101: iadn11(ivon01) = ivon01 ! 102: 1 c on t in ue ! 103: go to 41030 ! 104: 31030 ivdele = ivdele + 1 ! 105: write (i02,80003) ivtnum ! 106: if (iczero) 41030, 1041, 41030 ! 107: 41030 i f (iadn11(2) - 2) 21030,11030,21030 ! 108: 11030 ivpass = ivpass + 1 ! 109: write (i02,80001) ivtnum ! 110: go to 1041 ! 111: 21030 ivfail = ivfail + 1 ! 112: ivcomp = iadn11(2) ! 113: ivcorr = 2 ! 114: write (i02,80004) ivtnum, ivcomp ,ivcorr ! 115: 1041 continue ! 116: ivtnum = 104 ! 117: c ! 118: c **** test 104 **** ! 119: c test 104 - this tests embedded blanks in an integer type ! 120: c statement. fraction 1/2 should become 0 as an integer. ! 121: c integer to real * 2. back to integer conversion should be 0. ! 122: c ! 123: if (iczero) 31040, 1040, 31040 ! 124: 1040 continue ! 125: rvtni1 = 2 ! 126: rvon01 = 1/rvtni1 ! 127: ivon02 = rvon01 * 2. ! 128: go to 41040 ! 129: 31040 ivdele = ivdele + 1 ! 130: write (i02,80003) ivtnum ! 131: if (iczero) 41040, 1051, 41040 ! 132: 41040 if( ivon02 - 0 ) 21040,11040,21040 ! 133: 11040 ivpass = ivpass + 1 ! 134: write (i02,80001) ivtnum ! 135: go to 1051 ! 136: 21040 ivfail = ivfail + 1 ! 137: ivcomp = ivon02 ! 138: ivcorr = 0 ! 139: write (i02,80004) ivtnum, ivcomp ,ivcorr ! 140: 1051 continue ! 141: ivtnum = 105 ! 142: c ! 143: c **** test 105 **** ! 144: c test 105 - test of embedded blanks in a real type statement. ! 145: c real to real*2. to integer conversion is performed. result ! 146: c is 1 if the type of the test variable(ivtnr1) was real. ! 147: c ! 148: if (iczero) 31050, 1050, 31050 ! 149: 1050 continue ! 150: ivtnr1 = .5 ! 151: rvon03 = ivtnr1*2. ! 152: ivon03 = rvon03 +.3 ! 153: go to 41050 ! 154: 31050 ivdele = ivdele + 1 ! 155: write (i02,80003) ivtnum ! 156: if (iczero) 41050, 1061, 41050 ! 157: 41050 if(ivon03 - 1) 21050, 11050, 21050 ! 158: 11050 ivpass = ivpass + 1 ! 159: write (i02,80001) ivtnum ! 160: go to 1061 ! 161: 21050 ivfail = ivfail + 1 ! 162: ivcomp = ivon03 ! 163: ivcorr = 1 ! 164: write (i02,80004) ivtnum, ivcomp ,ivcorr ! 165: 1061 continue ! 166: ivtnum = 106 ! 167: c ! 168: c **** test 106 **** ! 169: c test 106 - test the logical type with embedded blanks by a ! 170: c logic assignment (v = .true.) section 4.7.1 and 10.2 ! 171: c ! 172: if (iczero) 31060, 1060, 31060 ! 173: 1060 continue ! 174: lvtnl1 = .true. ! 175: go to 41060 ! 176: 31060 ivdele = ivdele + 1 ! 177: write (i02,80003) ivtnum ! 178: if (iczero) 41060, 1071, 41060 ! 179: 41060 if(iczero) 21060,11060,21060 ! 180: 11060 ivpass = ivpass + 1 ! 181: write (i02,80001) ivtnum ! 182: go to 1071 ! 183: 21060 ivfail = ivfail + 1 ! 184: write (i02,80002) ivtnum, ivcomp ,ivcorr ! 185: 1071 continue ! 186: ivtnum = 107 ! 187: c ! 188: c **** test 107 **** ! 189: c test 107 - a second test of the logical type statement with ! 190: c embedded blanks. the test is again made by a logical ! 191: c assignment (section 4.7.1 and 10.2). ! 192: c ! 193: if (iczero) 31070, 1070, 31070 ! 194: 1070 continue ! 195: lvtnl2 = .false. ! 196: go to 41070 ! 197: 31070 ivdele = ivdele + 1 ! 198: write (i02,80003) ivtnum ! 199: if (iczero) 41070, 1081, 41070 ! 200: 41070 if(iczero) 21070,11070,21070 ! 201: 11070 ivpass = ivpass + 1 ! 202: write (i02,80001) ivtnum ! 203: go to 1081 ! 204: 21070 ivfail = ivfail + 1 ! 205: write (i02,80002) ivtnum, ivcomp ,ivcorr ! 206: 1081 continue ! 207: ivtnum = 108 ! 208: c ! 209: c **** test 108 **** ! 210: c test 108 - this is a test of blanks embedded in the common, ! 211: c dimension and equivalence statements (section 8.1, ! 212: c 8.3. and 8.2.). ! 213: c ! 214: if (iczero) 31080, 1080, 31080 ! 215: 1080 continue ! 216: iadn11(3) = 4 ! 217: go to 41080 ! 218: 31080 ivdele = ivdele + 1 ! 219: write (i02,80003) ivtnum ! 220: if (iczero) 41080, 1091, 41080 ! 221: 41080 if(iace11(3) - 4) 21080,11080,21080 ! 222: 11080 ivpass = ivpass + 1 ! 223: write (i02,80001) ivtnum ! 224: go to 1091 ! 225: 21080 ivfail = ivfail + 1 ! 226: ivcomp = iace11(3) ! 227: ivcorr = 4 ! 228: write (i02,80004) ivtnum, ivcomp ,ivcorr ! 229: 1091 continue ! 230: ivtnum = 109 ! 231: c ! 232: c **** test 109 **** ! 233: c test 109 - this tests the effect of blanks embedded in the ! 234: c data statement by checking the initialization of array ! 235: c element values (section 9). ! 236: c ! 237: if (iczero) 31090, 1090, 31090 ! 238: 1090 continue ! 239: ivon04 = iadn12(1) + iadn12(2) + iadn12(3) ! 240: go to 41090 ! 241: 31090 ivdele = ivdele + 1 ! 242: write (i02,80003) ivtnum ! 243: if (iczero) 41090, 1101, 41090 ! 244: 41090 if(ivon04 - 9) 21090,11090,21090 ! 245: 11090 ivpass = ivpass + 1 ! 246: write (i02,80001) ivtnum ! 247: go to 1101 ! 248: 21090 ivfail = ivfail + 1 ! 249: ivcomp = ivon04 ! 250: ivcorr = 9 ! 251: write (i02,80004) ivtnum, ivcomp ,ivcorr ! 252: 1101 continue ! 253: c ! 254: c write page footings and run summaries ! 255: 99999 continue ! 256: write (i02,90002) ! 257: write (i02,90006) ! 258: write (i02,90002) ! 259: write (i02,90002) ! 260: write (i02,90007) ! 261: write (i02,90002) ! 262: write (i02,90008) ivfail ! 263: write (i02,90009) ivpass ! 264: write (i02,90010) ivdele ! 265: c ! 266: c ! 267: c terminate routine execution ! 268: stop ! 269: c ! 270: c format statements for page headers ! 271: 90000 format (1h1) ! 272: 90002 format (1h ) ! 273: 90001 format (1h ,10x,34hfortran compiler validation system) ! 274: 90003 format (1h ,21x,11hversion 1.0) ! 275: 90004 format (1h ,10x,38hfor official use only - copyright 1978) ! 276: 90005 format (1h ,5x,4htest,5x,9hpass/fail, 5x,8hcomputed,8x,7hcorrect) ! 277: 90006 format (1h ,5x,46h----------------------------------------------) ! 278: 90011 format (1h ,18x,17hsubset level test) ! 279: c ! 280: c format statements for run summaries ! 281: 90008 format (1h ,15x,i5,19h errors encountered) ! 282: 90009 format (1h ,15x,i5,13h tests passed) ! 283: 90010 format (1h ,15x,i5,14h tests deleted) ! 284: c ! 285: c format statements for test results ! 286: 80001 format (1h ,4x,i5,7x,4hpass) ! 287: 80002 format (1h ,4x,i5,7x,4hfail) ! 288: 80003 format (1h ,4x,i5,7x,7hdeleted) ! 289: 80004 format (1h ,4x,i5,7x,4hfail,10x,i6,9x,i6) ! 290: 80005 format (1h ,4x,i5,7x,4hfail,4x,e12.5,3x,e12.5) ! 291: c ! 292: 90007 format (1h ,20x,20hend of program fm011) ! 293: end
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.