1 2FTNCHEK Version 3.3 November 2004 3 4File include.f: 5 6 1 C Derived from Brian Downing's WC program, replacing common decls by INCLUDEs 7 2 C 8 3 C main(){ Get a file, open it, read and determine semi-useful 9 4 C statistics, print them to screen, and exit quietly. 10 5 C }; 11 6 C 12 7 C This program is an example word counter that makes use of several 13 8 C Fortran intrinsic functions and data structures, such as; 14 9 C common, sub-routines, functions, inplied do loops, and much, much more. 15 10 C 16 11 Program WC 17 12 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 18 13 C Program: Word_Count_And_Other_Stuff C 19 14 C Written_By: Brian Downing C 20 15 C Fordham University C 21 16 C Date: October 1st-16th, 1990 C 22 17 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 23 18 Character Fname*80 24 19 25 20 Call Initialize 26 21 Call GetFileName(Fname) 27 22 Call GetStats(Fname) 28 23 Call PrintStats 29 24 End 30 31Module WC: prog 32 33External subprograms referenced: 34 35GETFILENAME: subr GETSTATS: subr INITIALIZE: subr PRINTSTATS: subr 36 37Variables: 38 39 Name Type Dims Name Type Dims Name Type Dims Name Type Dims 40 FNAME char80 41 42 43 44 45Warning in module WC: Names longer than 6 chars (nonstandard): 46 GETFILENAME referenced at line 21 47 GETSTATS referenced at line 22 48 INITIALIZE referenced at line 20 49 PRINTSTATS referenced at line 23 50 25 C 51 26 C SubRoutine to get all kinds of neat statistics. 52 27 C 53 28 SubRoutine GetStats(Fname) 54 29 Include 'stats.h' 55 ^ 56Warning near line 29 col 7: Nonstandard syntax 57Including file ./Include/stats.h: 58 1 Common /Stats/ACPW,AWPS,NW,NP,NL,NC,NEC(255) 59Resuming file include.f: 60 30 Character Inline*82, Fname*80, Ch 61 31 62 32 Open (Unit=8,File=Fname,Err=999) 63 33 Do While (.TRUE.) 64 ^ 65Warning near line 33 col 7: Nonstandard syntax 66 34 Read(8,10,End=888)InLine 67 35 NL = NL + 1 68 36 LastPos = INDEX(InLine,' ') 69 37 Do J = 1,LastPos 70 ^ 71Warning near line 37 col 11: Nonstandard syntax 72 38 Ch = InLine(J:J) 73 39 L = IntUpCase(ICHAR(Ch)) 74 40 NEC(L) = NEC(L) + 1 75 41 If ((Ch.NE.' ').AND.(Ch.NE.'.')) Then 76 42 NC = NC + 1 77 43 ElseIf (Ch.EQ.'.') Then 78 44 NP = NP + 1 79 45 Else 80 46 NW = NW + 1 81 47 EndIf 82 48 EndDo 83 ^ 84Warning near line 48 col 11: Nonstandard syntax 85 49 EndDo 86 ^ 87Warning near line 49 col 7: Nonstandard syntax 88 50 888 Continue 89 51 ACPW = REAL(NC)/REAL(NW) 90 52 AWPS = REAL(NW)/REAL(NP) 91 53 Return 92 54 10 Format(a) 93 55 999 Print*,'Error opening file, please verify filename and try again.' 94 56 C 95 57 C In the event of improper filename exit abruptly. 96 58 C 97 59 STOP 98 60 End 99 100Module GETSTATS: subr 101 102External subprograms referenced: 103 104 ICHAR: intrns INDEX: intrns INTUPCASE: intg* REAL: intrns 105 106Common blocks referenced: 107 108 STATS 109 110Variables: 111 112 Name Type Dims Name Type Dims Name Type Dims Name Type Dims 113 ACPW real* AWPS real* CH char FNAME char80 114 INLINE char82 J intg* L intg* LASTPOS intg* 115 NC intg* NEC intg* 1 NL intg* NP intg* 116 NW intg* 117 118* Variable not declared. Type has been implicitly defined. 119 120 121 122Warning in module GETSTATS: Names longer than 6 chars (nonstandard): 123 GETSTATS declared at line 28 124 INTUPCASE referenced at line 39 125 LASTPOS first occurrence at line 36 126I/O Operations: 127 128 Unit ID Unit No. Access Form Operation Line 129 8 SEQ FMTD OPEN 32 130 8 SEQ FMTD READ 34 131 * SEQ FMTD PRINT 55 132 133Statement labels defined: 134 135 Label Line StmtType Label Line StmtType Label Line StmtType 136 <10> 54 format <888> 50 exec <999> 55 exec 137 138 61 C 139 62 C SubRoutine to print to terminal all of these neat statistics. 140 63 C 141 64 SubRoutine PrintStats 142 65 Include 'stats.h' 143 ^ 144Warning near line 65 col 7: Nonstandard syntax 145Including file ./Include/stats.h: 146 1 Common /Stats/ACPW,AWPS,NW,NP,NL,NC,NEC(255) 147Resuming file include.f: 148 66 149 67 Write(5,10)ACPW,AWPS,NW,NP,NL,NC 150 68 Write(5,20) 151 69 Do J = 65,90 152 ^ 153Warning near line 69 col 7: Nonstandard syntax 154 70 Write(5,40)(CHAR(J),NEC(J),('@',K=1,(NEC(J)/10)), 155 71 1 ('*',K=1,MOD(NEC(J),10))) 156 ^ 157Error near line 71 col 43: syntax error, unexpected ')', expecting ',' 158 72 EndDo 159 ^ 160Warning near line 72 col 7: Nonstandard syntax 161 73 Write(5,50) 162 74 10 Format('1'30X'Word Statistics'/1x,80('*')/ 163 75 1 1X'Average characters per word = 'F6.2/ 164 76 2 1X'Average words per sentence = 'F6.2/ 165 77 3 1X'Total number of words = 'I5/ 166 78 4 1X'Total number of sentences = 'I5/ 167 79 5 1X'Total number of lines = 'I5/ 168 80 6 1X'Total number of characters = 'I5/) 169 81 20 Format(29x'Character Statistics'/1x,80('*')/) 170 82 30 Format(1X,A) 171 83 40 Format(1X,A','I3,1x,125(A)) 172 84 50 Format(1X'Legend:'/9x'@ equals ten characters', 173 85 1 ', * equals one character.') 174 86 Return 175 87 End 176 177Module PRINTSTATS: subr 178 179External subprograms referenced: 180 181 CHAR: intrns MOD: intrns 182 183Common blocks referenced: 184 185 STATS 186 187Variables: 188 189 Name Type Dims Name Type Dims Name Type Dims Name Type Dims 190 ACPW real* AWPS real* J intg* K intg* 191 NC intg* NEC intg* 1 NL intg* NP intg* 192 NW intg* 193 194* Variable not declared. Type has been implicitly defined. 195 196 197 198Warning in module PRINTSTATS: Names longer than 6 chars (nonstandard): 199 PRINTSTATS declared at line 64 200I/O Operations: 201 202 Unit ID Unit No. Access Form Operation Line 203 5 SEQ FMTD WRITE 67 68 73 204 205Statement labels defined: 206 207 Label Line StmtType Label Line StmtType Label Line StmtType 208 <10> 74 format <20> 81 format <30> 82 format 209 <40> 83 format <50> 84 format 210 211 212Warning in module PRINTSTATS: Labels defined but not used: 213 <30> defined at line 82 214 88 C 215 89 C SubRoutine to prompt for and return a filename. 216 90 C 217 91 SubRoutine GetFileName(Fname) 218 92 Character Fname*80, Prompt*7 219 93 220 94 Prompt = '_File: ' 221 95 Write(5,10)Prompt 222 96 Read(5,20)Fname 223 97 10 Format(1XA$) 224 ^ 225Warning near line 97 col 17: Nonstandard syntax 226 98 20 Format(A) 227 99 Return 228 100 End 229 230Module GETFILENAME: subr 231 232Variables: 233 234 Name Type Dims Name Type Dims Name Type Dims Name Type Dims 235 FNAME char80 PROMPT char7 236 237 238 239 240Warning in module GETFILENAME: Names longer than 6 chars (nonstandard): 241 GETFILENAME declared at line 91 242I/O Operations: 243 244 Unit ID Unit No. Access Form Operation Line 245 5 SEQ FMTD READ 96 246 5 SEQ FMTD WRITE 95 247 248Statement labels defined: 249 250 Label Line StmtType Label Line StmtType 251 <10> 97 format <20> 98 format 252 253 101 C 254 102 C SubRoutine to initailize globally used variables. 255 103 C 256 104 SubRoutine Initialize 257 105 Common /Stats/A,B,J,K,L,M,N(26) 258 106 Do O = 1,26 259 ^ 260Warning near line 106 col 10: DO index is not integer 261 ^ 262Warning near line 106 col 7: Nonstandard syntax 263 107 N(O) = 0 264 ^ 265Warning near line 107 col 11: subscript is not integer 266 108 EndDo 267 ^ 268Warning near line 108 col 7: Nonstandard syntax 269 109 A = 0.0 270 110 B = 0.0 271 111 J = 0 272 112 K = 0 273 113 L = 0 274 114 M = 0 275 115 Return 276 116 End 277 278Module INITIALIZE: subr 279 280Common blocks referenced: 281 282 STATS 283 284Variables: 285 286 Name Type Dims Name Type Dims Name Type Dims Name Type Dims 287 A real* B real* J intg* K intg* 288 L intg* M intg* N intg* 1 O real* 289 290* Variable not declared. Type has been implicitly defined. 291 292 293 294Warning in module INITIALIZE: Names longer than 6 chars (nonstandard): 295 INITIALIZE declared at line 104 296 117 C 297 118 C Function to return integer value of a character in range of uppercase. 298 119 C 299 120 Function IntUpCase (I) 300 121 301 122 If ((I.LE.ICHAR('z')).AND.(I.GE.ICHAR('a'))) Then 302 123 IntUpCase = I - ICHAR(' ') 303 124 Else 304 125 IntUpCase = I 305 126 EndIf 306 127 Return 307 128 End 308 309Module INTUPCASE: func: intg* 310 311External subprograms referenced: 312 313 ICHAR: intrns 314 315Variables: 316 317 Name Type Dims Name Type Dims Name Type Dims Name Type Dims 318 I intg* INTUPCASE intg* 319 320* Variable not declared. Type has been implicitly defined. 321 322 323 324Warning in module INTUPCASE: Names longer than 6 chars (nonstandard): 325 INTUPCASE declared at line 120 326 327 1 syntax error detected in file include.f 328 24 warnings issued in file include.f 329 330Warning: Common block STATS array dimen/size mismatch at position 7: 331 Variable NEC in module GETSTATS line 1 file ./Include/stats.h (included at 332 line 29 in include.f) has size 255 333 Variable N in module INITIALIZE line 105 file include.f has size 26 334