Context Navigation

← Previous Revision
Latest Revision
Next Revision →
Blame
Revision Log

convert.f90 @ 4233

Last change on this file since 4233 was 4203, checked in by dubos, 6 years ago
simple_physics : cleanup Mellor & Yamada
File size: 58.3 KB

Line
1	! Copyright CERN, Geneva 1991, 1997 - Copyright and any other
2	! appropriate legal protection of these computer programs
3	! and associated documentation reserved in all countries
4	! of the world.
5	! Author: Michael Metcalf (MichaelMetcalf@compuserve.com)
6	!
7	! Requires the option -qcharlen=14400 with IBM's xlf.
8	!
9	! Version 1.5. Differs from previous versions in that:
10	! (19/12/96)
11	! Code modified to be Fortran 95 and ELF
12	! compatible (no functional changes).
13	!
14	!***********************************************************************
15	! *
16	! *
17	! A program to convert FORTRAN 77 source form to Fortran 90 source *
18	! form. It also formats the code by indenting the bodies of DO-loops *
19	! and IF-blocks by ISHIFT columns. Statement keywords are *
20	! followed if necessary by a blank, and blanks within tokens are *
21	! are suppressed; this handling of blanks is optional. *
22	! If a CONTINUE statement terminates a single DO loop, it is *
23	! replaced by END DO. *
24	! Procedure END statements have the procedure name added, if *
25	! blanks are handled. *
26	! Statements like INTEGER2 are converted to INTEGER(2), if blanks
27	! are handled. Depending on the target processor, a further global *
28	! edit might be required (e.g. where 2 bytes correspond to KIND=1). *
29	! Typed functions and assumed-length character specifications are *
30	! treated similarly. The length specification 4 is removed for all
31	! data types except CHARACTER, as is 8 for COMPLEX. This
32	! treatment of non-standard type declarations includes any *
33	! non-standard IMPLICIT statements. *
34	! Optionally, interface blocks only may be produced; this requires *
35	! blanks processing to be requested. The interface blocks are *
36	! compatible with both the old and new source forms. *
37	! *
38	! Usage: the program reads one data record in free format from the *
39	! default input unit. This contains: *
40	! *
41	! name of file *
42	! indentation depth *
43	! maximum indentation level *
44	! whether significant blanks should be handled *
45	! whether interface blocks only are required *
46	! *
47	! The default values in the absence of this record are: *
48	! name 3 10 T F *
49	! To do nothing but change the source form of a file prog.f type *
50	! prog 0 0 F F *
51	! or simply *
52	! prog / *
53	! For more extensive processing type, say, *
54	! prog 3 10 t f *
55	! and for interface blocks only type *
56	! prog 0 0 t t *
57	! The input is read from prog.f, the output is written to prog.f90; *
58	! there should be no tabs in the input. *
59	! *
60	! Restrictions: The program does not indent FORMAT statements or *
61	! any statement containing a character string with an *
62	! embedded multiple blank. *
63	! The order of comment lines and Fortran statements *
64	! is slightly modified if there are sequences of *
65	! more than KKLIM (=200) comment lines. *
66	! If there are syntax errors, continued lines do not *
67	! have a trailing &. *
68	! When producing interface blocks, a check is required*
69	! that any dummy argument that is a procedure has a *
70	! corresponding EXTERNAL statement. Also, since no *
71	! COMMON blocks or PARAMETER statements are copied, *
72	! part of an assumed-size array declaration may be *
73	! missing. Similarly, parts of an assumed-length *
74	! character symbolic constant might be copied and have *
75	! to be deleted. BLOCK DATA statements are copied and *
76	! must be deleted. These problems would normally be *
77	! detected by a compiler and are trivially corrected. *
78	! Within a given keyword, the case must be all upper *
79	! or all lower, and lower case programs require *
80	! blank handling for correct indenting. *
81	! *
82	!***********************************************************************
83	!
84	MODULE STRUCTURE
85	!
86	!***********************************************************************
87	! Define maximum level of DO-loop nesting, and maximum length of *
88	! a Fortran statement. LEN may be reduced for *
89	! compilers accepting a maximum character *
90	! length below 2640 and this will cause any excess *
91	! continuation lines and all following lines to be copied unchanged. *
92	! KKLIM defines the length of the comment line buffer. If this *
93	! length is exceeded, the statement preceding the comments will *
94	! appear after them. *
95	!***********************************************************************
96	implicit none
97	public
98	INTEGER, PARAMETER :: NEST = 32 , LEN = 2640 , KKLIM = 200, &
99	KLEN = 72*KKLIM
100	!
101	INTEGER :: KNTDO , KNTIF , KNTCOM , LABEL , LENST , LABLNO, NOARG
102	INTEGER, DIMENSION(NEST) :: LABLDO
103	!
104	LOGICAL :: SYNERR, BLNKFL, INTFL
105	!
106	CHARACTER(LEN=LEN) :: STAMNT
107	CHARACTER(LEN=KLEN):: CBUF
108	CHARACTER(LEN=42) :: NAME
109	!
110	END MODULE STRUCTURE
111	MODULE DATA
112	implicit none
113	public
114	!
115	INTEGER, SAVE :: ISHIFT , MXDPTH , NIN , NOUT, TIME0
116	LOGICAL, SAVE :: BLANKS, INTBFL
117	!
118	END MODULE DATA
119	MODULE STATISTICS
120	implicit none
121	public
122	!
123	INTEGER, SAVE :: MXDO , MXIF , KARD , KNTPU
124	!
125	LOGICAL, SAVE :: SYNTAX, OVFLW, NONSTD
126	!
127	END MODULE STATISTICS
128	MODULE ALL_PROCEDURES
129	private
130	public :: start, program_units, terminate
131	CONTAINS
132	!***********************************************************************
133	SUBROUTINE ARGUMENT(ARGNAM, LENARG, STAMNT, LENST, NOARG)
134	implicit none
135	!
136	! To store the argument names and function name, if any, for later
137	! use in checking whether a specification statement is relevant to an
138	! interface block.
139	CHARACTER(LEN=*), INTENT(IN OUT), dimension(:) :: ARGNAM
140	CHARACTER(LEN=*), INTENT(IN) :: STAMNT
141	INTEGER, INTENT(OUT), dimension(:) :: LENARG
142	INTEGER, INTENT(IN OUT) :: NOARG
143	INTEGER, INTENT(IN) :: LENST
144	!
145	integer :: ind1, ind2, newind
146	!
147	! Correct length of function name
148	IF (NOARG == 1) LENARG(1) = LEN_TRIM(ARGNAM(1))
149	!
150	! Get any other arguments
151	IND1 = index(STAMNT(:LENST), '(') + 1
152	IF (IND1 /= 1 .AND. STAMNT(IND1:IND1) /= ')') THEN
153	NEWIND = index(STAMNT(IND1+1:LENST), '(')
154	IF (NEWIND /= 0) IND1 = NEWIND + 1 + IND1
155	3 IND2 = index(STAMNT(IND1:LENST), ',') - 1
156	IF (IND2 == -1) IND2 = index(STAMNT(IND1:LENST), ')') - 1
157	IND2 = IND2 + IND1 - 1
158	IF (STAMNT(IND1+1:IND1+1) /= '*' ) THEN
159	NOARG = NOARG +1
160	ARGNAM(NOARG) = STAMNT(IND1:IND2)
161	LENARG(NOARG) = IND2 - IND1 +1
162	END IF
163	IF (STAMNT(IND2+1:IND2+1) == ')') GO TO 4
164	IND1 = IND2 + 3
165	GO TO 3
166	END IF
167	4 LENARG(:NOARG) = MIN(LENARG(:NOARG), 6)
168	!
169	RETURN
170	END SUBROUTINE ARGUMENT
171	SUBROUTINE BLANK( )
172	!
173	! To suppress all blanks in the statement, and then to place
174	! a blank on each side of =, +, -, * and / (but not ** or //), a
175	! blank after each ) and , and a blank before each (.
176	! No changes are made within character strings or FORMAT statememts.
177	!
178	USE DATA
179	!
180	USE STATISTICS
181	!
182	USE STRUCTURE
183	implicit none
184	!
185	CHARACTER(LEN=LEN) :: BUFFER
186	integer :: l1, l2, lchar, napost, lenold
187	!
188	! Reduce length to that of significant characters
189	BLNKFL = .FALSE.
190	LENST = LEN_TRIM(STAMNT(1:LENST))
191	IF (.NOT.BLANKS) THEN
192	IF (LEN-LENST >= 2) STAMNT(LENST+1:LENST+2) = ' '
193	LENST = MIN(LENST+2, LEN)
194	GO TO 99
195	END IF
196	BLNKFL = .TRUE.
197	!
198	! Suppress blanks (add 2 to catch
199	! odd number of apostrophes on a line in REFORM).
200	LCHAR = 0
201	NAPOST = 0
202	DO L1 = 1, LENST
203	IF (STAMNT(L1:L1) == "'") NAPOST = 1-NAPOST
204	IF (NAPOST == 0 .AND. STAMNT(L1:L1) == ' ') CYCLE
205	LCHAR = LCHAR+1
206	BUFFER(LCHAR:LCHAR) = STAMNT(L1:L1)
207	END DO
208	IF (LEN-LCHAR >= 2) BUFFER(LCHAR+1:LCHAR+2) = ' '
209	LCHAR = MIN(LCHAR+2, LEN)
210	!
211	! Eliminate FORMATS
212	IF( LABEL /= 0 .AND. &
213	& LCHAR >= 11 .AND.(BUFFER(:7) == 'FORMAT(' .OR. &
214	& BUFFER(:7) == 'format(') .AND. &
215	& BUFFER(LCHAR-2:LCHAR-2) == ')') THEN
216	IF (LEN-LENST >= 2) STAMNT(LENST+1:LENST+2) = ' '
217	LENST = MIN(LENST+2, LEN)
218	GO TO 99
219	END IF
220	!
221	! Insert blanks
222	LENOLD = LENST
223	LENST = 0
224	NAPOST = 0
225	DO L2 = 1, LCHAR
226	!
227	! Check size of statement
228	IF(LENST+3 > LEN) THEN
229	LENST = LCHAR
230	STAMNT(:LENST) = BUFFER(:LENST)
231	OVFLW = .TRUE.
232	GO TO 99
233	END IF
234	!
235	! Whether inside character string
236	IF (BUFFER(L2:L2) == "'") NAPOST = 1-NAPOST
237	IF (NAPOST == 1) GO TO 3
238	!
239	! Add blank padding according to character
240	SELECT CASE (BUFFER(L2:L2))
241	CASE ( ')' )
242	STAMNT(LENST+1:LENST+2) = ') '
243	LENST = LENST+2
244	CASE ( '(' )
245	STAMNT(LENST+1:LENST+2) = ' ('
246	LENST = LENST + 2
247	CASE ( ',' )
248	STAMNT(LENST+1:LENST+2) = ', '
249	LENST = LENST + 2
250	CASE ( '=' )
251	STAMNT(LENST+1:LENST+3) = ' = '
252	LENST = LENST + 3
253	CASE ( '*' )
254	IF (BUFFER(L2-1:L2-1) /= '*' .AND. BUFFER(L2+1:L2+1) &
255	/= '*') THEN
256	STAMNT(LENST+1:LENST+3) = ' * '
257	LENST = LENST + 3
258	ELSE
259	GO TO 3
260	END IF
261	CASE ( '/' )
262	IF (BUFFER(L2-1:L2-1) /= '/' .AND. BUFFER(L2+1:L2+1) &
263	/= '/') THEN
264	STAMNT(LENST+1:LENST+3) = ' / '
265	LENST = LENST + 3
266	ELSE
267	GO TO 3
268	END IF
269	CASE ('+')
270	IF (BUFFER(L2-1:L2-1) /= 'E' .AND. &
271	BUFFER(L2-1:L2-1) /= 'e' .AND. &
272	BUFFER(L2-1:L2-1) /= 'D' .AND. &
273	BUFFER(L2-1:L2-1) /= 'd' .OR. &
274	LLT(BUFFER(L2+1:L2+1), '0') .AND. LGT(BUFFER(L2+1:L2+1), '9')&
275	) THEN
276	STAMNT(LENST+1:LENST+3) = ' + '
277	LENST = LENST + 3
278	ELSE
279	GO TO 3
280	END IF
281	CASE ('-')
282	IF (BUFFER(L2-1:L2-1) /= 'E' .AND. &
283	BUFFER(L2-1:L2-1) /= 'e' .AND. &
284	BUFFER(L2-1:L2-1) /= 'D' .AND. &
285	BUFFER(L2-1:L2-1) /= 'd' .OR. &
286	LLT(BUFFER(L2+1:L2+1), '0') .AND. LGT(BUFFER(L2+1:L2+1), '9')&
287	) THEN
288	STAMNT(LENST+1:LENST+3) = ' - '
289	LENST = LENST + 3
290	ELSE
291	GO TO 3
292	END IF
293	CASE DEFAULT
294	GO TO 3
295	END SELECT
296	CYCLE
297	3 STAMNT(LENST+1:LENST+1) = BUFFER(L2:L2)
298	LENST = LENST +1
299	END DO
300	!
301	! Blank out end of statement
302	IF (LENOLD > LENST) STAMNT(LENST+1:LENOLD) = ' '
303	IF (LENST < LEN .AND. MOD(LENST, 66) /= 0) &
304	STAMNT(LENST+1: LENST+66-MOD(LENST, 66)) = ' '
305	!
306	99 RETURN
307	END SUBROUTINE BLANK
308	SUBROUTINE IDENTIFY (IRET)
309	!
310	!***********************************************************************
311	! To identify statement as beginning or end of DO-loop or *
312	! IF-block, or as probable FORMAT. *
313	! Attempt to scan as few of the input characters as possible. *
314	!***********************************************************************
315	!
316	USE STRUCTURE
317	USE DATA
318	implicit none
319	!
320	CHARACTER(LEN=5), PARAMETER :: ENDIF='ENDIF' , THEN='NEHT)', &
321	THENLC='neht)'
322	CHARACTER(LEN=3), PARAMETER :: BIF='IF('
323	CHARACTER(LEN=2), PARAMETER :: DO='DO'
324	CHARACTER(LEN=7), PARAMETER :: FORMAT='FORMAT('
325	CHARACTER(LEN=4), PARAMETER :: ELSE='ELSE'
326	CHARACTER(LEN=5) :: INTFIL
327	INTEGER, INTENT(OUT) :: IRET
328	!
329	integer :: l1, l2, l3, l4, l5, l6, l7, l8, l9, l10, l11, l12, &
330	k1, k2, k3, k5, k6, k7, k8, lparen, kntch, napos
331	!
332	IRET = 0
333	!
334	! Check whether end of DO-loop
335	IF (KNTDO /= 0) THEN
336	IF (LABEL == LABLDO(KNTDO)) THEN
337	IRET = 2
338	GO TO 99
339	END IF
340	END IF
341	!
342	! Check whether any of remaining possibilities
343	DO L7 = 1 , LENST
344	IF (STAMNT(L7:L7) == ' ') CYCLE
345	IF (STAMNT(L7:L7) == 'E') THEN
346	DO L11 = L7+1 , LENST
347	IF (STAMNT(L11:L11) == ' ') CYCLE
348	IF (STAMNT(L11:L11) == ENDIF(2:2)) GO TO 6
349	IF (STAMNT(L11:L11) == ELSE(2:2)) GO TO 3
350	GO TO 99
351	END DO
352	END IF
353	IF (STAMNT(L7:L7) == BIF(:1)) GO TO 9
354	IF (STAMNT(L7:L7) == DO(:1)) GO TO 15
355	IF (STAMNT(L7:L7) == FORMAT(:1)) GO TO 31
356	GO TO 99
357	END DO
358	GO TO 99
359	!
360	! Check whether ELSE or ELSEIF
361	3 K8 = 3
362	DO L12 = L11+1 , LENST
363	IF (STAMNT(L12:L12) == ' ') CYCLE
364	IF (STAMNT(L12:L12) /= ELSE(K8:K8)) GO TO 99
365	IF (K8 == 4) GO TO 5
366	K8 = K8+1
367	END DO
368	GO TO 99
369	5 IF (L12 >= LENST) THEN
370	IRET = 6
371	GO TO 99
372	END IF
373	IF (STAMNT(L12+1:LENST) == ' ') THEN
374	IRET = 6
375	GO TO 99
376	END IF
377	K2 = 1
378	IRET = 6
379	L7 = L12
380	GO TO 10
381	!
382	! Check whether end of IF-block
383	6 K1 = 3
384	DO L1 = L11+1 , LENST
385	IF (STAMNT(L1:L1) == ' ') CYCLE
386	IF (STAMNT(L1:L1) /= ENDIF(K1:K1)) GO TO 99
387	IF (K1 == 5) EXIT
388	K1 = K1+1
389	END DO
390	IF (L1 >= LENST) THEN
391	IRET = 4
392	GO TO 99
393	END IF
394	IF (STAMNT(L1+1:LENST) == ' ') IRET = 4
395	GO TO 99
396	!
397	! Check whether beginning of IF-block
398	9 K2 = 2
399	IRET = 3
400	10 DO L2 = L7+1 , LENST
401	IF (STAMNT(L2:L2) == ' ') CYCLE
402	IF (STAMNT(L2:L2) /= BIF(K2:K2)) THEN
403	IRET = 0
404	GO TO 99
405	END IF
406	IF (K2 == 3) GO TO 12
407	K2 = K2+1
408	END DO
409	IRET = 0
410	GO TO 99
411	!
412	! Backward search for )THEN at end of IF statement (to save
413	! scanning the condition).
414	12 K3 = 1
415	DO L3 = LENST , L2+1 , -1
416	IF (STAMNT(L3:L3) == ' ') CYCLE
417	IF (STAMNT(L3:L3) /= THEN(K3:K3) .AND. &
418	STAMNT(L3:L3) /= THENLC(K3:K3)) THEN
419	IRET = 0
420	GO TO 99
421	END IF
422	IF (K3 == 5) GO TO 99
423	K3 = K3+1
424	END DO
425	IRET = 0
426	GO TO 99
427	!
428	! Check whether beginning of DO-loop
429	15 DO L4 = L7+1 , LENST
430	IF (STAMNT(L4:L4) == ' ') CYCLE
431	IF (STAMNT(L4:L4) == DO(2:2)) GO TO 17
432	GO TO 99
433	END DO
434	GO TO 99
435	!
436	! Have DO - check label
437	17 K5 = 0
438	INTFIL = ' '
439	DO L5 = L4+1 , LENST
440	IF (STAMNT(L5:L5) == ' ') CYCLE
441	IF (LLT(STAMNT(L5:L5) , '0') .OR. LGT(STAMNT(L5:L5) , '9')) &
442	EXIT
443	K5 = K5+1
444	IF (K5 > 5) GO TO 20
445	INTFIL(K5:K5) = STAMNT(L5:L5)
446	END DO
447	IF (K5 == 0) GO TO 99
448	20 READ (INTFIL , '(BN , I5)') LABLNO
449	IF (LABLNO == 0) GO TO 99
450	!
451	! Have label - check comma
452	DO L8 = L5, LENST
453	IF (STAMNT(L8:L8) == ' ') CYCLE
454	IF (STAMNT(L8:L8) == ',') EXIT
455	GO TO 23
456	END DO
457	IRET = 1
458	GO TO 99
459	!
460	! Have a DO and label with no comma.
461	! Check for variable whose first of maximum of six
462	! characters is alphabetic, followed by an equals sign,
463	! followed by a character string containing a comma which is
464	! not enclosed in parentheses.
465	23 K6 = 0
466	DO L9 = L8 , LENST
467	IF (STAMNT(L9:L9) == ' ') CYCLE
468	IF (K6 == 0) THEN
469	IF ((LLT(STAMNT(L9:L9), 'A') .OR. LGT(STAMNT(L9:L9), 'Z')) &
470	.AND.(LLT(STAMNT(L9:L9), 'a') .OR. LGT(STAMNT(L9:L9), 'z')))&
471	GO TO 99
472	K6 = 1
473	ELSE IF (LGE(STAMNT(L9:L9) , 'A') .AND. LLE(STAMNT(L9:L9),'Z')&
474	.OR. LGE(STAMNT(L9:L9) , 'a') .AND. LLE(STAMNT(L9:L9) ,'z')&
475	.OR. LGE(STAMNT(L9:L9) , '0') .AND. LLE(STAMNT(L9:L9) , '9')) &
476	THEN
477	K6 = K6+1
478	IF (K6 == 6) GO TO 26
479	ELSE
480	IF (K6 == 0) GO TO 99
481	GO TO 25
482	END IF
483	END DO
484	GO TO 99
485	!
486	! Expect an equals sign
487	25 L9=L9-1
488	26 DO L10 = L9+1 , LENST
489	IF (STAMNT(L10:L10) == ' ') CYCLE
490	IF (STAMNT(L10:L10) == '=') GO TO 28
491	GO TO 99
492	END DO
493	GO TO 99
494	!
495	! Search for bare comma
496	28 LPAREN = 0
497	KNTCH = 0
498	NAPOS = 0
499	DO L6 = L10+1 , LENST
500	IF (STAMNT(L6:L6) == ' ') CYCLE
501	IF (STAMNT(L6:L6) == "'") NAPOS = 1 - NAPOS
502	IF (NAPOS == 1) CYCLE
503	IF (STAMNT(L6:L6) == ',') THEN
504	IF (KNTCH /= 0) THEN
505	IF (LPAREN == 0) GO TO 30
506	CYCLE
507	ELSE
508	GO TO 99
509	END IF
510	ELSE IF (STAMNT(L6:L6) == '(') THEN
511	LPAREN = LPAREN+1
512	ELSE IF (STAMNT(L6:L6) == ')') THEN
513	LPAREN = LPAREN-1
514	END IF
515	KNTCH = 1
516	END DO
517	GO TO 99
518	30 IRET = 1
519	!
520	! Insert blank after label
521	IF (.NOT.BLANKS .OR. LENST >= LEN) GO TO 99
522	DO L10 = LENST, L5, -1
523	STAMNT(L10+1:L10+1) = STAMNT(L10:L10)
524	END DO
525	STAMNT(L5:L5) = ' '
526	LENST = LENST + 1
527	GO TO 99
528	!
529	! Identify FORMAT statement
530	31 IF (LABEL == 0) GO TO 99
531	K7 = 2
532	DO L11 = L7+1 , LENST
533	IF (STAMNT(L11:L11) == ' ') CYCLE
534	IF (STAMNT(L11:L11) /= FORMAT(K7:K7)) GO TO 99
535	IF (K7 == 7) GO TO 33
536	K7 = K7+1
537	END DO
538	GO TO 99
539	33 IRET = 5
540	!
541	99 RETURN
542	END SUBROUTINE IDENTIFY
543	SUBROUTINE KEYWORD(ASSIGN, SKIP)
544	!
545	! To check whether those initial keywords of the statement which
546	! require it are followed by a blank, to add one if necessary, and
547	! to suppress any embedded blanks.
548	!
549	USE STATISTICS
550	!
551	USE STRUCTURE
552	implicit none
553	!
554	LOGICAL, INTENT(OUT) :: ASSIGN, SKIP
555	!
556	INTEGER, PARAMETER :: NKEY = 42, MAXLEN = 15
557	CHARACTER(LEN=MAXLEN) :: BEGIN
558	CHARACTER(LEN=LEN) :: BUFFER
559	CHARACTER(LEN=3) :: THREE
560	CHARACTER(LEN=32) :: NAMEOF
561	CHARACTER(LEN=6), SAVE :: ARGNAM(445)
562	LOGICAL :: IFASS
563	INTEGER, SAVE :: LENARG(445)
564	!
565	CHARACTER(LEN=MAXLEN), PARAMETER, dimension(nkey) :: KEYS = (/ &
566	'ASSIGN ', 'BACKSPACE ', 'BLOCKDATA ', &
567	'CALL ', 'CHARACTER ', 'CLOSE ', &
568	'COMMON ', 'COMPLEX ', 'CONTINUE ', &
569	'DATA ', 'DIMENSION ', 'DOUBLEPRECISION', &
570	'DO ', 'ELSEIF ', 'ELSE ', &
571	'ENDFILE ', 'ENDIF ', 'ENTRY ', &
572	'EXTERNAL ', 'EQUIVALENCE ', 'FORMAT ', &
573	'FUNCTION ', 'GOTO ', 'IF ', &
574	'IMPLICIT ', 'INQUIRE ', 'INTEGER ', &
575	'INTRINSIC ', 'LOGICAL ', 'OPEN ', &
576	'PARAMETER ', 'PAUSE ', 'PRINT ', &
577	'PROGRAM ', 'READ ', 'REAL ', &
578	'RETURN ', 'REWIND ', 'SAVE ', &
579	'STOP ', 'SUBROUTINE ', 'WRITE '/)
580	INTEGER, PARAMETER, dimension(nkey) :: LK = &
581	(/6, 9, 9, 4, &
582	9, 5, 6, 7, 8, 4, &
583	9,15, 2, 6, 4, &
584	7, 5, 5, 8,11, &
585	6, 8, 4, 2, 8, 7, &
586	7, 9, 7, 4, 9, &
587	5, 5, 7, 4, 4, 6, &
588	6, 4, 4,10, 5 /)
589	LOGICAL, PARAMETER, dimension(nkey) :: BLANK = &
590	(/.TRUE., .TRUE., .TRUE., .TRUE., &
591	.TRUE., .FALSE., .TRUE., .TRUE., .FALSE., .TRUE., &
592	.TRUE., .TRUE., .TRUE., .FALSE., .FALSE., &
593	.TRUE., .FALSE., .TRUE., .TRUE., .FALSE., &
594	.FALSE., .TRUE., .TRUE., .FALSE., .TRUE., .FALSE., &
595	.TRUE., .TRUE., .TRUE., .FALSE., .TRUE., &
596	.TRUE., .TRUE., .TRUE., .TRUE., .TRUE., .TRUE., &
597	.TRUE., .TRUE., .TRUE., .TRUE., .FALSE./)
598	LOGICAL, PARAMETER, dimension(nkey) :: FOLLOW = &
599	(/.TRUE., .TRUE., .FALSE., .TRUE., &
600	.FALSE., .FALSE., .FALSE., .FALSE., .FALSE., .FALSE., &
601	.FALSE., .FALSE., .FALSE., .FALSE., .FALSE., &
602	.TRUE., .FALSE., .FALSE., .FALSE., .FALSE., &
603	.FALSE., .FALSE., .TRUE., .FALSE., .FALSE., .FALSE., &
604	.FALSE., .FALSE., .FALSE., .FALSE., .FALSE., &
605	.TRUE., .TRUE., .FALSE., .TRUE., .FALSE., .TRUE., &
606	.TRUE., .FALSE., .TRUE., .FALSE., .FALSE./)
607	!
608	CHARACTER(LEN=MAXLEN), PARAMETER, dimension(nkey) :: KEYSLC = (/ &
609	'assign ', 'backspace ', 'blockdata ', &
610	'call ', 'character ', 'close ', &
611	'common ', 'complex ', 'continue ', &
612	'data ', 'dimension ', 'doubleprecision', &
613	'do ', 'elseif ', 'else ', &
614	'endfile ', 'endif ', 'entry ', &
615	'external ', 'equivalence ', 'format ', &
616	'function ', 'goto ', 'if ', &
617	'implicit ', 'inquire ', 'integer ', &
618	'intrinsic ', 'logical ', 'open ', &
619	'parameter ', 'pause ', 'print ', &
620	'program ', 'read ', 'real ', &
621	'return ', 'rewind ', 'save ', &
622	'stop ', 'subroutine ', 'write '/)
623	!
624	integer :: l1, l2, l3, l4, l5, l6, l7, l20, lparen, kntap, kntch,&
625	lc, lcc, l33, next, l8, napos, lsave, name_length
626	!
627	! Test for statement function statement or assignment statement
628	SKIP = INTFL
629	ASSIGN = .FALSE.
630	IFASS = .FALSE.
631	THREE = ' '
632	LPAREN = 0
633	KNTAP = 0
634	KNTCH = 0
635	DO L1 = 1, LENST
636	IF (STAMNT(L1:L1)==' ') CYCLE
637	IF (STAMNT(L1:L1)=='=') THEN
638	IF (KNTCH==0) SYNERR = .TRUE.
639	IF (LPAREN==0 .AND. KNTAP==0) THEN
640	ASSIGN = .TRUE.
641	GO TO 9
642	ELSE
643	EXIT
644	END IF
645	ELSE IF (STAMNT(L1:L1)=='(') THEN
646	LPAREN = LPAREN+1
647	ELSE IF (STAMNT(L1:L1)==')') THEN
648	LPAREN = LPAREN-1
649	ELSE IF (STAMNT(L1:L1)=="'") THEN
650	KNTAP = 1-KNTAP
651	END IF
652	KNTCH = KNTCH+1
653	IF (KNTCH<=3) THREE(KNTCH:KNTCH) = STAMNT(L1:L1)
654	END DO
655	!
656	! Suppress blanks in first 15 non-blank characters
657	10 BEGIN = ' '
658	LC = 0
659	DO L2 = 1, LENST
660	IF (STAMNT(L2:L2)==' ') CYCLE
661	LC = LC+1
662	BEGIN(LC:LC) = STAMNT(L2:L2)
663	IF (LC==MAXLEN) GO TO 3
664	END DO
665	L2 = L2-1
666	!
667	! Is this a keyword? Failure of this test is not fatal, in order to
668	! allow for non-standard syntax extensions.
669	3 DO L3 = 1, NKEY
670	IF (BEGIN(:LK(L3)) == KEYS(L3)(:LK(L3))) THEN
671	GO TO 5
672	ELSE IF (BEGIN(:LK(L3)) == KEYSLC(L3)(:LK(L3))) THEN
673	LCC = 0
674	DO L33 = 1, L2
675	IF (STAMNT(L33:L33) == ' ') CYCLE
676	LCC = LCC + 1
677	IF (LCC == LK(L3)) EXIT
678	END DO
679	STAMNT(:L33) = KEYS(L3)(:LK(L3))
680	GO TO 5
681	END IF
682	END DO
683	NONSTD = .TRUE.
684	GO TO 98
685	!
686	! Test for embedded blanks in keyword
687	5 IF (L2 /= LC) THEN
688	LC = 0
689	DO L4 =1, LENST
690	IF (STAMNT(L4:L4)==' ') CYCLE
691	LC = LC+1
692	IF (LC==LK(L3)) GO TO 7
693	END DO
694	GO TO 8
695	7 IF (L4==LC) GO TO 8
696	STAMNT(:L4) = KEYS(L3)(:LC)
697	GO TO 99
698	END IF
699	!
700	! Keyword has no blanks - is it followed by a blank if it needs one?
701	8 IF (.NOT.BLANK(L3)) GO TO 99
702	NEXT = 0
703	DO L8 = 1, LK(L3)
704	17 NEXT = NEXT+1
705	IF (STAMNT(NEXT:NEXT)==' ') GO TO 17
706	END DO
707	NEXT = NEXT+1
708	IF (STAMNT(NEXT:NEXT)==' ') GO TO 99
709	!
710	! Sometimes a delimiter may be present
711	IF (L3==2.OR.L3==16.OR.L3==23.OR.L3==35.OR.L3==38) THEN
712	IF (STAMNT(NEXT:NEXT)=='(') GO TO 99
713	ELSE IF (L3==5) THEN
714	IF (STAMNT(NEXT:NEXT)=='*') GO TO 99
715	ELSE IF (L3==7.OR.L3==39) THEN
716	IF (STAMNT(NEXT:NEXT)=='/') GO TO 99
717	END IF
718	IF (LENST==LEN) THEN
719	OVFLW = .TRUE.
720	GO TO 99
721	END IF
722	!
723	! Insert the blank
724	BUFFER(NEXT:LENST) = STAMNT(NEXT:LENST)
725	LENST = LENST+1
726	STAMNT(NEXT:NEXT) = ' '
727	STAMNT(NEXT+1:LENST) = BUFFER(NEXT:LENST-1)
728	BLNKFL = .TRUE.
729	GO TO 99
730	!
731	! Check whether, in fact, a DO-loop
732	9 IF (THREE(:2) /= 'DO' .AND. THREE(:2) /= 'do') GO TO 12
733	LPAREN = 0
734	NAPOS = 0
735	DO L5 = L1+2, LENST
736	IF (STAMNT(L5:L5)==' ') CYCLE
737	IF (STAMNT(L5:L5) == "'") NAPOS = 1 - NAPOS
738	IF (NAPOS == 1) CYCLE
739	IF (STAMNT(L5:L5)==',') THEN
740	IF (LPAREN==0) THEN
741	ASSIGN = .FALSE.
742	GO TO 10
743	END IF
744	ELSE IF (STAMNT(L5:L5)=='(') THEN
745	LPAREN = LPAREN+1
746	ELSE IF (STAMNT(L5:L5)==')') THEN
747	LPAREN = LPAREN-1
748	END IF
749	END DO
750	GO TO 99
751	!
752	! Check whether, in fact, a logical IF followed by an assignment
753	12 IF (THREE /= 'IF(' .AND. THREE /= 'if(') GO TO 99
754	IFASS = .TRUE.
755	DO L6 = L1-1, 1, -1
756	IF (STAMNT(L6:L6)==' ') CYCLE
757	IF (STAMNT(L6:L6)==')') THEN
758	!
759	! Is there a second pair of first-level parentheses
760	IF (index(STAMNT(:L6), ')')==0) GO TO 99
761	LPAREN = 1
762	DO L7 = L6-1, 4, -1
763	IF (STAMNT(L7:L7)==' ') CYCLE
764	IF (STAMNT(L7:L7)==')') THEN
765	IF (LPAREN==0) THEN
766	GO TO 14
767	ELSE
768	LPAREN = LPAREN+1
769	END IF
770	ELSE IF (STAMNT(L7:L7)=='(') THEN
771	LPAREN = LPAREN-1
772	END IF
773	END DO
774	GO TO 99
775	14 ASSIGN = .FALSE.
776	GO TO 10
777	ELSE
778	ASSIGN = .FALSE.
779	GO TO 10
780	END IF
781	END DO
782	!
783	! Test for non-executable statement keyword
784	99 IF (ASSIGN) GO TO 98
785	IF (.NOT.INTFL) GO TO 97
786	SKIP = L3 == 3.OR.L3 == 5.OR.L3 == 8 &
787	.OR.L3 == 11.OR.L3 == 12.OR.L3 == 19.OR.L3 == 22 &
788	.OR.L3 == 25.OR.L3 == 27.OR.L3 == 29 &
789	.OR.L3 == 34.OR.L3 == 36.OR.L3 == 41
790	SKIP = .NOT.SKIP
791	IF (SKIP) GO TO 98
792	!
793	! Check whether this statement refers to an argument or a function
794	! name
795	IF (L3 == 3 .OR. L3 == 22 .OR. L3 == 25 .OR. &
796	L3 == 34 .OR. L3 == 41) GO TO 97
797	IF(index(STAMNT(LK(L3)+1:LENST), 'FUNCTION')/= .0 .OR. &
798	index(STAMNT(LK(L3)+1:LENST), 'function') /= 0) GO TO 97
799	DO L20 = 1, NOARG
800	IF(index(STAMNT(LK(L3)+1:LENST), ARGNAM(L20)(:LENARG(L20))) &
801	/= 0) GO TO 97
802	END DO
803	SKIP = .TRUE.
804	GO TO 98
805	!
806	! Keep procedure name for END statement
807	97 call name_of(nameof, stamnt(lk(l3)+2:lenst), name_length)
808	IF(L3 == 3.OR.L3 == 22.OR.L3 == 34.OR. &
809	L3 == 41) NAME = KEYS(L3)(:LK(L3))//NAMEOF(:name_length)
810	!
811	! Get argument names for later use in skipping unnecessary
812	! specifications
813	21 IF (INTFL) THEN
814	IF (L3 == 22) THEN
815	ARGNAM(1) = NAME(10:15)
816	NOARG = 1
817	END IF
818	IF (L3 == 22 .OR. L3 == 41) &
819	CALL ARGUMENT(ARGNAM, LENARG, STAMNT, LENST, NOARG)
820	END IF
821	!
822	! Deal with awkward cases
823	LSAVE = L3
824	IF(L3 == 1.OR.L3 == 5.OR.L3 == 8.OR.L3 == 12 .OR. L3 == 13 &
825	.OR. L3 == 25 &
826	.OR.L3 == 24.AND..NOT.IFASS.OR.L3 == 27.OR.L3 == 29.OR.L3 == 36) &
827	CALL SPECIAL(L3, NEXT, BUFFER, NKEY, KEYS, KEYSLC, LK, FOLLOW)
828	!
829	! Was, in fact, a function
830	IF (INTFL.AND.L3 == 22.AND.LSAVE /= 22) THEN
831	SKIP = .FALSE.
832	GO TO 21
833	END IF
834	!
835	! Print procedure name
836	98 IF(.NOT.ASSIGN.AND.(L3 == 3.OR.L3 == 22.OR.L3 == 34.OR.L3 == 41))&
837	WRITE (*, '('' Starting '', A)') NAME
838	RETURN
839	END SUBROUTINE KEYWORD
840	subroutine NAME_OF(nameof, HEADER, name_length)
841	!
842	implicit none
843	! Pick out name of procedure
844	CHARACTER(LEN=*), INTENT(IN) :: HEADER
845	CHARACTER(LEN=*), INTENT(out):: nameof
846	integer, intent(out) :: name_length
847	integer :: ind, indast
848	!
849	NAMEOF = ' '
850	!
851	! Is there a left parenthesis or an asterisk?
852	IND = index(HEADER, '(' )
853	INDAST = index(HEADER, '*')
854	IF (IND /= 0 .AND. INDAST /= 0) IND = MIN(IND, INDAST)
855	IF (IND <= LEN(NAMEOF)) THEN
856	IF (IND == 0) THEN
857	NAMEOF(2:) = HEADER(:LEN(HEADER))
858	name_length = min(len(header)+1, len(nameof))
859	ELSE
860	NAMEOF(2:IND) = HEADER(:IND-1)
861	name_length = ind
862	END IF
863	END IF
864	RETURN
865	END subroutine NAME_OF
866	SUBROUTINE PROGRAM_UNITS( )
867	!
868	!***********************************************************************
869	! The principal subroutine of CONVERT processes the *
870	! input stream, which is assumed to contain syntactically correct *
871	! Fortran program units. To protect itself from bad data, failure *
872	! to pass a primitive syntax check will cause the program to copy *
873	! the input stream to the output unit unchanged, until an END line is*
874	! encountered. *
875	!***********************************************************************
876	!
877	USE DATA
878	!
879	USE STATISTICS
880	!
881	USE STRUCTURE
882	implicit none
883	!
884	!***********************************************************************
885	! USER is a character which may be defined to identify lines *
886	! in the input stream which are to be treated as *
887	! comment lines ( + in this example). *
888	!***********************************************************************
889	!
890	CHARACTER(LEN=1) :: CONTIN
891	CHARACTER(LEN=3), PARAMETER :: FIN='END', FINLC='end'
892	CHARACTER(LEN=66) :: FIELD
893	CHARACTER(LEN=72) :: LINE
894	CHARACTER(LEN=72), PARAMETER :: BLANKV=' '
895	!
896	LOGICAL :: NEWDO , NEWIF , FORM , ELSEBL , ASSIGN
897	!
898	CHARACTER(LEN=*), PARAMETER :: USER = '+'
899	LOGICAL :: STAT = .FALSE. , SKIP = .FALSE.
900	!
901	integer :: l1, l5, l22, kntcon, napo, lab, l9, k1, &
902	irtcod, nend
903	!
904	! Start processing program units
905	MXDO = 0
906	MXIF = 0
907	KARD = 0
908	KNTPU = 0
909	SYNTAX = .FALSE.
910	SYNERR = .FALSE.
911	OVFLW = .FALSE.
912	NONSTD = .FALSE.
913	KNTDO = 0
914	KNTIF = 0
915	KNTCOM = 0
916	NAME = ' '
917	NOARG = 0
918	INTFL = INTBFL
919	!
920	! Set continuation line counter
921	1 KNTCON = 0
922	!
923	! Set statement length counter
924	LENST = 0
925	!
926	! Read one line into an internal file,
927	! columns 73-80 of all lines are ignored.
928	2 READ (NIN , '(A)' , END = 100 , ERR = 100) LINE
929	KARD = KARD+1
930	!
931	! Check whether a comment line and if so copy to buffer.
932	IF (LINE(:1) == 'C' .OR. LINE(:1) == '*' .OR. LINE(:1) == &
933	USER .OR. LINE == ' ' .OR. LINE(:1) == 'c' &
934	.OR. LINE(:1) == '!') THEN
935	IF (INTFL) GO TO 2
936	IF (LINE(:1) == 'C' .OR. LINE(:1) == '*' &
937	.OR. LINE(:1) == 'c') LINE(:1) = '!'
938	IF (KNTCOM == KKLIM) THEN
939	WRITE (NOUT , '(A72)') (CBUF(72L5-71:72L5) , L5 = 1 , &
940	KNTCOM) , LINE
941	KNTCOM = 0
942	ELSE IF (SYNERR .OR. .NOT.STAT) THEN
943	WRITE (NOUT , '(A72)') LINE
944	ELSE
945	KNTCOM = KNTCOM+1
946	CBUF(72KNTCOM-71:72KNTCOM) = LINE
947	END IF
948	GO TO 2
949	END IF
950	!
951	! Some form of embedded comment?
952	NAPO = 0
953	DO L22 = 2, 72
954	IF (LINE(L22:L22) == '''') NAPO = 1 - NAPO
955	IF (L22 == 6) CYCLE
956	IF (LINE(L22:L22) /= '!') CYCLE
957	IF (NAPO /= 0) CYCLE
958	IF (.NOT. INTFL) THEN
959	IF (KNTCOM < KKLIM) THEN
960	KNTCOM = KNTCOM +1
961	CBUF(72KNTCOM-71:72KNTCOM) = &
962	BLANKV(:L22-1)//LINE(L22:72)
963	ELSE
964	WRITE (NOUT, '(A)') BLANKV(:L22-1)//LINE(L22:72)
965	END IF
966	END IF
967	LINE(L22:72) = ' '
968	IF (LINE == ' ') GO TO 2
969	EXIT
970	END DO
971	!
972	! Line is some form of statement; re-read.
973	READ (LINE , '(BN , I5 , A1 , A66)') LAB , CONTIN , FIELD
974	STAT = .TRUE.
975	!
976	! Check on syntax and copy to statement buffer
977	3 IF (CONTIN == '0') CONTIN = ' '
978	IF (CONTIN /= ' ') THEN
979	CONTIN = '&'
980	IF (SYNERR) THEN
981	GO TO 6
982	ELSE IF (LENST == 0 .OR. LENST+66 > LEN .OR. LAB /= 0) THEN
983	SYNERR = .TRUE.
984	IF (LENST > 0) THEN
985	IF (LABEL /= 0) THEN
986	WRITE (NOUT , '(I5, 1X, A66:"&"/(5X, "&", A66: &
987	& "&"))') LABEL , &
988	(STAMNT(66L9-65:66L9) , L9 = 1 , (LENST+65)/66)
989	ELSE
990	WRITE (NOUT , '(6X, A66:"&"/(5X, "&", A66:"&" &
991	& ))') (STAMNT(66L9-65:66L9) , L9 = 1 , (LENST+65)/66)
992	END IF
993	END IF
994	IF (LAB /= 0) THEN
995	WRITE (NOUT , 1000) LAB , CONTIN , FIELD
996	ELSE
997	WRITE (NOUT , 1006) CONTIN , FIELD
998	END IF
999	GO TO 1
1000	ELSE
1001	KNTCON = KNTCON+1
1002	STAMNT(LENST+1:LENST+66) = FIELD
1003	LENST = LENST+66
1004	GO TO 2
1005	END IF
1006	ELSE IF (KNTCON == 0) THEN
1007	IF (LENST /= 0) GO TO 4
1008	STAMNT(1:66) = FIELD
1009	LENST = 66
1010	LABEL = LAB
1011	IF (SYNERR) GO TO 4
1012	GO TO 2
1013	END IF
1014	IF (KNTCON > 0) GO TO 6
1015	!
1016	! Have a complete statement ready for processing (the last line
1017	! read is still waiting in LINE). The statement now needs to be
1018	! identified.
1019	! The END statement is a special case - if found it will be copied
1020	! and the next program unit processed.
1021	4 K1 = 1
1022	DO L1 = 1 , LENST
1023	IF (STAMNT(L1:L1) == ' ') CYCLE
1024	IF (STAMNT(L1:L1) /= FIN(K1:K1) .AND. &
1025	STAMNT(L1:L1) /= FINLC(K1:K1)) THEN
1026	EXIT
1027	ELSE
1028	K1 = K1+1
1029	IF (K1 > 3 .AND. (L1 >= LENST .OR. STAMNT(L1+1:LENST) &
1030	== ' ')) THEN
1031	IF (.NOT.SYNERR) THEN
1032	KNTPU=KNTPU+1
1033	IF (LABEL == 0) THEN
1034	WRITE (NOUT , 1001) FIN, NAME
1035	ELSE
1036	WRITE (NOUT , 1002) LABEL , FIN, NAME
1037	END IF
1038	END IF
1039	!
1040	! Set counters for new program unit
1041	SYNTAX = SYNTAX .OR. SYNERR
1042	KNTDO = 0
1043	KNTIF = 0
1044	SYNERR = .FALSE.
1045	KNTCON = 0
1046	LENST = 0
1047	IF (KNTCOM /= 0) WRITE (NOUT , '(A72)') (CBUF(72*L5-71: &
1048	72*L5) , L5 = 1 , KNTCOM)
1049	KNTCOM = 0
1050	NAME = ' '
1051	NOARG = 0
1052	GO TO 3
1053	ELSE
1054	IF (K1 > 3) EXIT
1055	END IF
1056	END IF
1057	END DO
1058	!
1059	! If syntax error flag set, copy and take next statement
1060	6 IF (SYNERR) THEN
1061	IF (LAB /= 0) THEN
1062	WRITE (NOUT , 1000) LAB , CONTIN , FIELD
1063	ELSE
1064	WRITE (NOUT , 1006) CONTIN , FIELD
1065	END IF
1066	LENST = 0
1067	GO TO 2
1068	END IF
1069	!
1070	! Compress blanks and insert blanks around special characters
1071	CALL BLANK( )
1072	!
1073	! Handle Fortran keywords
1074	NEWDO = .FALSE.
1075	NEWIF = .FALSE.
1076	FORM = .FALSE.
1077	ELSEBL = .FALSE.
1078	ASSIGN = .FALSE.
1079	IF (BLANKS) CALL KEYWORD(ASSIGN, SKIP)
1080	IF (SKIP) GO TO 16
1081	IF (SYNERR) GO TO 6
1082	IF (BLANKS .AND. ASSIGN .AND. LABEL == 0) GO TO 14
1083	!
1084	! Have a valid statement which is not an END line or assignment
1085	! Identify statement as DO
1086	! IF ( ) THEN
1087	! DO terminator
1088	! END IF
1089	! FORMAT
1090	! ELSE or ELSEIF
1091	! none of these.
1092	CALL IDENTIFY(IRTCOD)
1093	SELECT CASE (IRTCOD)
1094	CASE (0)
1095	GO TO 14
1096	!
1097	! New DO-loop
1098	CASE (1)
1099	IF (KNTDO == NEST) GO TO 14
1100	NEWDO = .TRUE.
1101	LABLDO(KNTDO+1) = LABLNO
1102	!
1103	! End of DO-loop(s)
1104	CASE (2)
1105	NEND = 0
1106	DO L5 = KNTDO , 1 , -1
1107	IF (LABLDO(L5) /= LABEL) EXIT
1108	NEND = NEND + 1
1109	END DO
1110	!
1111	! Replace CONTINUE by END DO
1112	KNTDO = KNTDO - NEND
1113	IF (NEND == 1 .AND. LENST == 10 .AND. STAMNT(:LENST) == &
1114	'CONTINUE ') THEN
1115	STAMNT(:8) = 'END DO '
1116	LENST = 6
1117	END IF
1118	!
1119	! Beginning of IF-block
1120	CASE (3)
1121	NEWIF = .TRUE.
1122	!
1123	! End of IF-block
1124	CASE (4)
1125	KNTIF = KNTIF-1
1126	IF (KNTIF < 0) THEN
1127	SYNERR = .TRUE.
1128	KNTIF = 0
1129	END IF
1130	!
1131	! FORMAT statement
1132	CASE (5)
1133	FORM =.TRUE.
1134	!
1135	! Beginning of ELSE-block
1136	CASE (6)
1137	IF (KNTIF > 0) THEN
1138	ELSEBL = .TRUE.
1139	ELSE
1140	SYNERR = .TRUE.
1141	END IF
1142	END SELECT
1143	!
1144	! Reformat statements and write
1145	14 CALL REFORM (FORM , ELSEBL)
1146	!
1147	! Set variables for next statement
1148	IF (NEWDO) KNTDO = KNTDO+1
1149	IF (NEWIF) KNTIF = KNTIF+1
1150	MXDO = MAX(MXDO , KNTDO)
1151	MXIF = MAX(MXIF , KNTIF)
1152	16 KNTCON = 0
1153	LENST = 0
1154	GO TO 3
1155	!
1156	! End of data. Last line must be an END.
1157	100 IF (LABEL == 0) WRITE (NOUT , 1001) FIN, NAME
1158	IF (LABEL /= 0) WRITE (NOUT , 1002) LABEL , FIN, NAME
1159	KNTPU=KNTPU+1
1160	IF (INTFL) WRITE (NOUT, '(6X, ''END INTERFACE'')')
1161	!
1162	! Note: if there is a syntax error, continued
1163	! statements do not have a trailing &
1164	1000 FORMAT(I5 , A1 , A)
1165	1001 FORMAT(TR6 , A3 ,TR1, A)
1166	1002 FORMAT(I5 , TR1 , A3 ,TR1, A)
1167	1006 FORMAT(TR5 , A1 , A66)
1168	!
1169	RETURN
1170	END SUBROUTINE PROGRAM_UNITS
1171	SUBROUTINE REFORM (FORM , ELSEBL)
1172	!
1173	! Performs reformatting and output of accepted statements
1174	!
1175	USE DATA
1176	!
1177	USE STRUCTURE
1178	implicit none
1179	!
1180	INTEGER, PARAMETER :: LLIMIT = LEN-(LEN/66-1)*6
1181	CHARACTER(LEN=LEN) :: OUT
1182	CHARACTER(LEN = 1) :: AMP
1183	!
1184	LOGICAL, INTENT(IN) :: FORM , ELSEBL
1185	!
1186	integer :: ind, ipnt, l6, l2, l3, l4, lout, idepth, kntap, kadd, &
1187	l5, jpnt
1188	!
1189	! If FORMAT statement, do not indent
1190	IF (FORM) GO TO 9
1191	!
1192	! Remove the blanks before commas if no character string
1193	IF (BLNKFL .AND. INDEX(STAMNT(:LENST), "'") == 0) THEN
1194	IPNT = 1
1195	DO
1196	IND = INDEX(STAMNT(IPNT:LENST), ' , ')
1197	IF (IND == 0) EXIT
1198	IND = IPNT + IND - 1
1199	STAMNT(IND:IND+2) = ', '
1200	IPNT = IND + 3
1201	END DO
1202	END IF
1203	!
1204	! Reformat indented statement and write. If reformatting causes it
1205	! to exceed LEN characters, it will be copied unchanged.
1206	IDEPTH = MIN(KNTDO+KNTIF , MXDPTH)
1207	IF (IDEPTH == 0 .AND. .NOT.BLNKFL) GO TO 9
1208	IF (ELSEBL) IDEPTH = IDEPTH-1
1209	IPNT = 1
1210	JPNT = 1
1211	1 IF (MOD(IPNT , 66) == 1) THEN
1212	IF (IPNT+65 > LEN) GO TO 9
1213	OUT(IPNT:IPNT+65) = ' '
1214	IPNT = IPNT+IDEPTH*ISHIFT
1215	END IF
1216	!
1217	! Find first non-blank character
1218	DO L2 = JPNT , LENST
1219	IF (STAMNT(L2:L2) /= ' ') GO TO 3
1220	END DO
1221	IF (JPNT == 1) THEN
1222	SYNERR = .TRUE.
1223	GO TO 9
1224	ELSE
1225	GO TO 10
1226	END IF
1227	!
1228	! Find first multiple blank (but not in a character string)
1229	3 KNTAP = 0
1230	DO L3 = L2, LENST-1
1231	IF (STAMNT(L3:L3) == "'") KNTAP = 1-KNTAP
1232	IF (STAMNT(L3:L3+1) == ' ') THEN
1233	IF (KNTAP == 0) GO TO 5
1234	GO TO 9
1235	END IF
1236	END DO
1237	L3 = LENST
1238	!
1239	! Have section with no multiple blanks. This can be copied to OUT
1240	! if there is room on the current line. Otherwise cut the
1241	! section after the non-alphanumeric character nearest to the end of
1242	! the line, if one exists.
1243	! An apostrophe and period are considered to be alphanumeric
1244	! characters, in order to hold character strings,
1245	! and real and logical constants together;
1246	! underscores and dollars are so treated to handle common extensions,
1247	! and the ** and // operators and real literal constants are treated.
1248	5 KADD = 0
1249	IF (L3-L2 <= 66-MOD(IPNT , 66)) GO TO 8
1250	DO L4 = 66+L2-MOD(IPNT , 66) , L2 , -1
1251	IF (STAMNT(L4:L4) == ' ') GO TO 7
1252	IF (LGE(STAMNT(L4:L4) , 'A') .AND. LLE(STAMNT(L4:L4) , 'Z')) &
1253	CYCLE
1254	IF(LGE(STAMNT(L4:L4), '0') .AND. &
1255	LLE(STAMNT(L4:L4), '9')) CYCLE
1256	IF (STAMNT(L4:L4) == "'" .OR. &
1257	STAMNT(L4:L4) == '_' .OR. STAMNT(L4:L4) == '$' .OR. &
1258	STAMNT(L4:L4) == '.') CYCLE
1259	IF (L4 /= LENST) THEN
1260	IF (STAMNT(L4:L4+1) == '**' .OR. &
1261	STAMNT(L4:L4+1) == '//' ) CYCLE
1262	IF (L4 /= L2) THEN
1263	IF(LGE(STAMNT(L4+1:L4+1), '0') .AND. &
1264	LLE(STAMNT(L4+1:L4+1), '9')) THEN
1265	IF (STAMNT(L4-1:L4) == 'E+' .OR. &
1266	STAMNT(L4-1:L4) == 'e+' .OR. &
1267	STAMNT(L4-1:L4) == 'E-' .OR. &
1268	STAMNT(L4-1:L4) == 'e-' .OR. &
1269	STAMNT(L4-1:L4) == 'D+' .OR. &
1270	STAMNT(L4-1:L4) == 'd+' .OR. &
1271	STAMNT(L4-1:L4) == 'D-' .OR. &
1272	STAMNT(L4-1:L4) == 'd-' ) CYCLE
1273	END IF
1274	END IF
1275	END IF
1276	IF (LGE(STAMNT(L4:L4) , 'a') .AND. LLE(STAMNT(L4:L4) , 'z')) &
1277	CYCLE
1278	GO TO 7
1279	END DO
1280	!
1281	! No break character found
1282	IF (BLNKFL) GO TO 9
1283	L4 = 66-MOD(IPNT , 66)+L2
1284	!
1285	! Cut here
1286	7 L3 = L4
1287	KADD = 1
1288	8 LOUT = IPNT+L3-L2
1289	IF (LOUT > LEN) GO TO 9
1290	OUT(IPNT:LOUT) = STAMNT(L2:L3)
1291	IF (L3 == LENST) GO TO 10
1292	!
1293	! Set pointers for next section of statement
1294	IPNT = LOUT+1
1295	IF (KADD == 1 .AND. MOD(IPNT , 66) /= 1 .OR. MOD(IPNT , 66) &
1296	>= 60) IPNT = ((IPNT+65)/66)*66+1
1297	IF (MOD(IPNT , 66) == 0) IPNT = IPNT+1
1298	JPNT = L3+1
1299	IF (KADD == 0) JPNT = JPNT+1
1300	GO TO 1
1301	!
1302	! Copied statement (if adding 6 cols. to initial line would cause
1303	! total length to exceed 2640, must start it in col.1)
1304	9 LENST = LEN_TRIM(STAMNT(:LENST))
1305	IF (LENST > 66) THEN
1306	AMP = '&'
1307	ELSE
1308	AMP = ' '
1309	END IF
1310	IF (LABEL /= 0) THEN
1311	WRITE (NOUT , 1003) LABEL , STAMNT(:MIN(LENST, 66)), AMP
1312	ELSE
1313	IF (LENST < LEN-6) THEN
1314	WRITE (NOUT , 1004) STAMNT(:MIN(LENST,66)), AMP
1315	ELSE
1316	WRITE (NOUT , '(A,A1)') STAMNT(:MIN(LENST, 66)), AMP
1317	END IF
1318	END IF
1319	IF (LENST > 66) WRITE (NOUT , 1005) &
1320	&('&', STAMNT(66L6-65:66L6) , L6 = 2 , (LENST+65)/66)
1321	GO TO 11
1322	!
1323	! Write OUT to output unit
1324	10 LOUT = LEN_TRIM(OUT(:LOUT))
1325	IF (LOUT > 66) THEN
1326	AMP = '&'
1327	ELSE
1328	AMP =' '
1329	END IF
1330	IF (LABEL /= 0) THEN
1331	WRITE (NOUT , 1003) LABEL , OUT(:MIN(LOUT, 66)), AMP
1332	ELSE
1333	WRITE (NOUT , 1004) OUT(:MIN(LOUT, 66)), AMP
1334	END IF
1335	!
1336	! An & is required in col. 6 if statement has more than 2412
1337	! characters, otherwise total length including cols. 1-6 will
1338	! exceed 2640. Also if making interface blocks, in order to be
1339	! compatible with both old and new source forms.
1340	IF (LOUT > 66) THEN
1341	IF (LOUT > LLIMIT .OR. INTFL) THEN
1342	AMP = '&'
1343	ELSE
1344	AMP = ' '
1345	END IF
1346	WRITE (NOUT , 1005) (AMP , OUT(66L5-65:66L5) , L5 = 2 , ( &
1347	LOUT+65)/66)
1348	END IF
1349	!
1350	! Write any comments following statement
1351	11 IF (KNTCOM /= 0) THEN
1352	WRITE (NOUT ,'(A72)') (CBUF(72L5-71:72L5) , L5 = 1 , KNTCOM)
1353	KNTCOM = 0
1354	END IF
1355	!
1356	1003 FORMAT(I5 , TR1, A, A)
1357	1004 FORMAT(TR6, A, A)
1358	1005 FORMAT(TR5 , A , A:'&' )
1359	!
1360	RETURN
1361	END SUBROUTINE REFORM
1362	SUBROUTINE SPECIAL(L3, NEXT, BUFFER, NKEY, KEYS, KEYSLC, &
1363	LK, FOLLOW)
1364	!
1365	! Special treatment for peculiar Fortran syntax
1366	!
1367	USE STRUCTURE
1368	!
1369	USE STATISTICS
1370	implicit none
1371	!
1372	INTEGER, PARAMETER :: NUMLEN = 5
1373	!
1374	CHARACTER(LEN=*), INTENT(OUT) :: BUFFER
1375	INTEGER, INTENT(IN) :: NKEY
1376	INTEGER, INTENT(IN), dimension(:) :: LK
1377	CHARACTER(LEN=*), INTENT(IN), dimension(:) :: KEYS, KEYSLC
1378	CHARACTER(LEN=32) :: NAMEOF
1379	CHARACTER(LEN=NUMLEN) :: NUMBER
1380	!
1381	INTEGER, INTENT(IN OUT) :: L3, NEXT
1382	LOGICAL, INTENT(IN), dimension(:) :: FOLLOW
1383	LOGICAL :: IFASSIGN
1384	integer :: ind, l20, istar, lparen, napos, ndigit,&
1385	nparen, l10, ilp, isss, limit, name_length
1386	!
1387	IFASSIGN = .FALSE.
1388	!
1389	! Deal with labelled DO WHILE
1390	IF (L3 == 13) THEN
1391	IND = index(STAMNT(:LENST), 'WHILE')
1392	IF (IND == 0) IND = index(STAMNT(:LENST), 'while')
1393	IF (IND /= 0) THEN
1394	IF(LGE(STAMNT(IND-1:IND-1), '0') .AND. &
1395	LLE(STAMNT(IND-1:IND-1), '9')) &
1396	STAMNT(IND:IND+5) = ' WHILE'
1397	END IF
1398	GO TO 99
1399	END IF
1400	!
1401	! Deal with IMPLICIT with non-standard length specifiers
1402	IF (L3 == 25) THEN
1403	IF (index(STAMNT(:LENST), '*') /= 0) THEN
1404	!
1405	! first, CHARACTER*(len)
1406	11 IND = index(STAMNT(:LENST), 'CHARACTER * (')
1407	IF (IND == 0) IND = index(STAMNT(:LENST),'character * (')
1408	IF (IND /= 0) THEN
1409	STAMNT(IND+10:IND+10) = ' '
1410	GO TO 11
1411	END IF
1412	!
1413	! then, type*nn
1414	NPAREN = 0
1415	NAPOS = 0
1416	DO L10 = 15, LENST
1417	IF (STAMNT(L10:L10) == "'") THEN
1418	NAPOS = 1 - NAPOS
1419	ELSE IF (STAMNT(L10:L10) == '(') THEN
1420	IF (NAPOS == 0) NPAREN = NPAREN + 1
1421	ELSE IF (STAMNT(L10:L10) == ')') THEN
1422	IF (NAPOS == 0) NPAREN = NPAREN - 1
1423	ELSE IF (STAMNT(L10:L10) == '*') THEN
1424	IF (NPAREN == 0) THEN
1425	STAMNT(L10:L10+1) = ' ('
1426	ILP = index(STAMNT(L10+2:LENST), '(')
1427	IF (ILP == 0) THEN
1428	SYNERR = .TRUE.
1429	GO TO 99
1430	ELSE
1431	STAMNT(L10+ILP:L10+ILP) = ')'
1432	END IF
1433	IF (STAMNT(L10+1:L10+3) == '(4)') THEN
1434	IF (STAMNT(L10-5:L10-5) /= 'C' .AND. &
1435	STAMNT(L10-5:L10-5) /= 'c') &
1436	STAMNT(L10+1:L10+3) = ' '
1437	ELSE IF (STAMNT(L10-2:L10+3) == 'X (8)' .OR. &
1438	STAMNT(L10-2:L10+3) == 'x (8)')THEN
1439	STAMNT(L10+1:L10+3) = ' '
1440	END IF
1441
1442	END IF
1443	END IF
1444	END DO
1445	END IF
1446	GO TO 99
1447	END IF
1448	!
1449	! An ASSIGN label must be followed by a blank and a * specifier
1450	! converted to (...)
1451	IF(L3 == 1 .AND. STAMNT(:7 ) == 'ASSIGN ' .OR. &
1452	L3 == 5 .AND. STAMNT(:11) == 'CHARACTER *' .OR. &
1453	L3 == 8 .AND. STAMNT(:9 ) == 'COMPLEX *' .OR. &
1454	L3 == 27.AND. STAMNT(:9 ) == 'INTEGER *' .OR. &
1455	L3 == 29.AND. STAMNT(:9 ) == 'LOGICAL *' .OR. &
1456	L3 == 36.AND. STAMNT(:6 ) == 'REAL *' ) THEN
1457	IF (L3 < 8) THEN
1458	ISSS = L3+7
1459	ELSE IF (L3 < 30) THEN
1460	ISSS = 10
1461	ELSE
1462	ISSS = 7
1463	END IF
1464	!
1465	! Extract the length parameter
1466	NDIGIT = 1
1467	NUMBER = ' '
1468	DO L20 = ISSS, LENST
1469	IF(STAMNT(L20:L20) == ' ') CYCLE
1470	NUMBER(:1) = STAMNT(L20:L20)
1471	IF(LGE(STAMNT(L20:L20),'0') .AND. LLE(STAMNT(L20:L20),'9') &
1472	) GO TO 21
1473	GO TO 1
1474	END DO
1475	SYNERR = .TRUE.
1476	GO TO 99
1477	21 DO NEXT = L20+1, LENST
1478	IF(STAMNT(NEXT:NEXT) == ' ') CYCLE
1479	IF(LLT(STAMNT(NEXT:NEXT), '0') .OR. LGT(STAMNT(NEXT:NEXT), &
1480	'9')) GO TO 19
1481	NDIGIT = NDIGIT + 1
1482	IF (NDIGIT > NUMLEN) THEN
1483	SYNERR = .TRUE.
1484	GO TO 99
1485	END IF
1486	NUMBER(NDIGIT:NDIGIT) = STAMNT(NEXT:NEXT)
1487	END DO
1488	SYNERR = .TRUE.
1489	GO TO 99
1490	END IF
1491	GO TO 1
1492	!
1493	! Insert the blank or parentheses
1494	19 IF (LENST >= LEN-1) THEN
1495	OVFLW = .TRUE.
1496	GO TO 99
1497	END IF
1498	BUFFER(NEXT:LENST) = STAMNT(NEXT:LENST)
1499	IF (L3 == 1) THEN
1500	LENST = LENST+2
1501	STAMNT(NEXT:NEXT+3) = ' TO '
1502	STAMNT(NEXT+4:LENST) = BUFFER(NEXT+2:LENST-2)
1503	ELSE
1504	LENST = LENST+1
1505	STAMNT(NEXT:NEXT) = ' '
1506	STAMNT(NEXT+1:LENST) = BUFFER(NEXT:LENST-1)
1507	IF (L3 /= 5.AND. NDIGIT == 1 .AND. NUMBER(:1) == '4') THEN
1508	STAMNT(NEXT-4:NEXT-1) = ' '
1509	ELSE IF (L3 == 8.AND.NDIGIT == 1 .AND. NUMBER(:1) == '8') &
1510	THEN
1511	STAMNT(NEXT-4:NEXT-1) = ' '
1512	ELSE
1513	STAMNT(NEXT-3-NDIGIT:NEXT-1) = '('//NUMBER(:NDIGIT)//')'
1514	END IF
1515	END IF
1516	GO TO 2
1517	!
1518	! Handle (*) case
1519	1 IF(L3 == 5 .AND. STAMNT(:18) == 'CHARACTER * ( * )') THEN
1520	NEXT = 19
1521	STAMNT(11:11) = ' '
1522	END IF
1523	!
1524	! IF statement may be followed by a keyword
1525	2 IF (L3 == 24 ) THEN
1526	LPAREN = 1
1527	NAPOS = 0
1528	DO NEXT = 5, LENST
1529	IF (STAMNT(NEXT:NEXT) == "'") NAPOS = 1 - NAPOS
1530	IF (NAPOS == 1) CYCLE
1531	IF (STAMNT(NEXT:NEXT) == '(' ) LPAREN = LPAREN+1
1532	IF (STAMNT(NEXT:NEXT) == ')' ) LPAREN = LPAREN-1
1533	IF (LPAREN == 0) GO TO 5
1534	END DO
1535	GO TO 99
1536	5 NEXT = NEXT+1
1537	DO L3 = 1, NKEY
1538	IF (FOLLOW(L3) .AND.(STAMNT(NEXT+1:NEXT+LK(L3)) == KEYS(L3)&
1539	.OR. STAMNT(NEXT+1:NEXT+LK(L3)) == KEYSLC(L3)&
1540	)) THEN
1541	NEXT = NEXT+LK(L3)+1
1542	IF(L3 == 1) IFASSIGN = .TRUE.
1543	GO TO 9
1544	END IF
1545	END DO
1546	ELSE
1547	!
1548	! Typed function
1549	IF(STAMNT(NEXT+1:NEXT+8) == 'FUNCTION' .OR. &
1550	STAMNT(NEXT+1:NEXT+8) == 'function') THEN
1551	NEXT = NEXT+9
1552	call name_of(nameof, stamnt(next:lenst), name_length)
1553	NAME = 'FUNCTION'//NAMEOF(:name_length)
1554	L3 = 22
1555	!
1556	! Deal with any *
1557	LIMIT = index(STAMNT(:LENST), '(')
1558	IF (LIMIT /= 0) THEN
1559	ISTAR = index(STAMNT(:LIMIT), '*')
1560	IF (ISTAR /= 0) THEN
1561	NDIGIT = LIMIT - ISTAR -3
1562	IF (NDIGIT > NUMLEN) THEN
1563	SYNERR = .TRUE.
1564	GO TO 99
1565	END IF
1566	NUMBER(:NDIGIT) = STAMNT(ISTAR+2:LIMIT-2)
1567	STAMNT(NEXT-5+NDIGIT:LIMIT-2) = &
1568	'FUNCTION'//NAME(10:ISTAR-NEXT+8)
1569	STAMNT(NEXT-8:NEXT-6+NDIGIT) = &
1570	'('//NUMBER(:NDIGIT)//') '
1571	IF (NDIGIT == 1 .AND. NUMBER(:1) == '4') THEN
1572	STAMNT(NEXT-8:NEXT-5) = ' '
1573	ELSE IF (NDIGIT == 1 .AND. NUMBER(:1) == '8'.AND.&
1574	(STAMNT(7:7) == 'X'.OR.STAMNT(7:7) == 'x')) THEN
1575	STAMNT(NEXT-8:NEXT-5) = ' '
1576	END IF
1577	NEXT = NEXT + 3 + NDIGIT
1578	END IF
1579	ELSE
1580	SYNERR = .TRUE.
1581	GO TO 99
1582	END IF
1583	GO TO 9
1584	END IF
1585	END IF
1586	GO TO 99
1587	!
1588	! Insert the blank
1589	9 IF (LENST >= LEN-2) THEN
1590	OVFLW = .TRUE.
1591	GO TO 99
1592	END IF
1593	BUFFER(NEXT:LENST) = STAMNT(NEXT:LENST)
1594	LENST = LENST+1
1595	STAMNT(NEXT:NEXT) = ' '
1596	STAMNT(NEXT+1:LENST) = BUFFER(NEXT:LENST-1)
1597	!
1598	! ASSIGN may follow IF
1599	IF(.NOT.IFASSIGN) GO TO 99
1600	NEXT = index(STAMNT(:LENST), 'TO')
1601	IF (NEXT == 0) NEXT = index(STAMNT(:LENST), 'to')
1602	IF(NEXT == 0) THEN
1603	SYNERR = .TRUE.
1604	GO TO 99
1605	ELSE
1606	LENST = LENST+2
1607	STAMNT(NEXT:NEXT+3) = ' TO '
1608	STAMNT(NEXT+4:LENST) = BUFFER(NEXT+1:LENST-3)
1609	END IF
1610	99 RETURN
1611	END SUBROUTINE SPECIAL
1612	SUBROUTINE START( )
1613	!
1614	! To prepare for PROGRAM_UNITS
1615	!
1616	USE DATA
1617	implicit none
1618	CHARACTER(LEN=16) :: NAME
1619	!
1620	! Prompt for interactive use
1621	WRITE (*,'(" Type name of file, shift, max. indent level, T or F &
1622	&for blank treatment,",/ " T or F for interface blocks only.")')
1623	WRITE (*,'(" For simple use type only the name of the file ", &
1624	&"followed by a slash (/) and RETURN.",/ &
1625	&" Note that the name should be given WITHOUT extension!")')
1626	!
1627	! Does standard input unit contain an input record
1628	NIN = 11
1629	NOUT = 12
1630	ISHIFT = 0
1631	MXDPTH = 0
1632	BLANKS = .FALSE.
1633	INTBFL = .FALSE.
1634	READ (* , * , END = 1 , ERR = 1) NAME, ISHIFT , MXDPTH , &
1635	BLANKS, INTBFL
1636	!
1637	! If record present, check input values are reasonable
1638	ISHIFT = MIN(MAX(ISHIFT , 0) , 10)
1639	MXDPTH = MIN(MAX(MXDPTH , 0) , 36/MAX(ISHIFT,1))
1640	IF (INTBFL.AND..NOT.BLANKS) WRITE (*, '('' Interface block proces&
1641	&sing cancelled as blank processing not requested'')')
1642	INTBFL = BLANKS.AND.INTBFL
1643	GO TO 2
1644	!
1645	! Set default values
1646	1 ISHIFT = 3
1647	MXDPTH = 10
1648	BLANKS = .TRUE.
1649	INTBFL = .FALSE.
1650	NAME = 'name'
1651	2 OPEN (UNIT=NIN, FILE=TRIM(NAME)//'.f', ACTION='READ')
1652	OPEN (UNIT=NOUT, FILE=TRIM(NAME)//'.f90', ACTION='WRITE')
1653	!
1654	! Print values to be used
1655	Write (*,'(" Loop bodies will be indented by",I3/ &
1656	& " Maximum indenting level is ",I3)') &
1657	ISHIFT , MXDPTH
1658	IF (BLANKS) WRITE (*, &
1659	'(" Significant blank proccessing requested")')
1660	IF (INTBFL) WRITE (*, &
1661	'('' Only interface blocks will be produced'')')
1662	IF (INTBFL) WRITE (NOUT, '(6X, ''INTERFACE'')')
1663	!
1664	CALL SYSTEM_CLOCK(TIME0)
1665	RETURN
1666	END SUBROUTINE START
1667	SUBROUTINE TERMINATE( )
1668	!
1669	! To print the final summary
1670	!
1671	USE STATISTICS
1672	USE DATA
1673	implicit none
1674	!
1675	integer :: itick, itime
1676	!
1677	CALL SYSTEM_CLOCK(ITIME, ITICK)
1678	IF (ITICK /= 0) &
1679	WRITE (*,'(" Processing complete in ", F7.3, " seconds")') &
1680	REAL(ITIME-TIME0)/REAL(ITICK)
1681	WRITE (*,'(" Maximum depth of DO-loop nesting ",I3/ &
1682	& " Maximum depth of IF-block nesting",I3/ &
1683	&" No. of lines read ",I17/" No. of program units read ",I8/ &
1684	& " Global syntax error flag",L12)') &
1685	MXDO , MXIF , KARD , KNTPU , SYNTAX
1686	!
1687	IF (OVFLW) WRITE(*, '(" At least one statement was too long to h&
1688	&ave a necessary blank added")')
1689	IF (NONSTD) WRITE (*, '(" At least one statement began with a no&
1690	&n-standard keyword")')
1691	!
1692	RETURN
1693	END SUBROUTINE TERMINATE
1694	END MODULE ALL_PROCEDURES
1695	PROGRAM CONVERT
1696	USE ALL_PROCEDURES
1697	implicit none
1698	!
1699	! Initialize
1700	CALL START( )
1701	!
1702	! Process the lines of program units
1703	CALL PROGRAM_UNITS( )
1704	!
1705	! Print some statistics
1706	CALL TERMINATE( )
1707	STOP
1708	END PROGRAM CONVERT

Note: See TracBrowser for help on using the repository browser.

Download in other formats:

Original Format