Revision Log

f77toM.pl

Revision 495 (checked in by cbc, 12 years ago)	Initial import of Stark code.

Line
1	#!/usr/local/bin/perl5 -w
2
3	# f77toM is a Perl 5 script to convert one or more F77 or F90
4	# files to Matlab M-files.
5	# If you have any questions, please contact Chris Cornuelle at
6	# bob@math.umn.edu, Minnesota Center for Industrial Mathematics
7	# at the University of Minnesota.
8	# Dr. C. Cornuelle
9	# School of Mathematics/MCIM
10	# 206 Church Street SE
11	# Minneapolis, MN 55455 USA
12
13	# WARNING: This program is not up to version 1.0 as of July 1998.
14	# There are a number of shortcomings and it is not fully tested.
15	# RSVP to bob@math.umn.edu with all bug reports.
16	# However, don't tell me about how it will not handle GO TOs in
17	# your Fortran code. :^)
18	# Note also the location of your perl binary may differ from what
19	# is on line number 1 here. Adjust as necessary.
20	# All development and testing done on a Pentium II with Linux 2.0.34.
21	# Your mileage may vary.
22
23	# Development Diary (incomplete):
24	# 01.03.96csc: This will take one string and replace it with
25	# another for all local files ending in .htm or .html.
26	# 04.28.98csc: Formerly edit_local_files. Now attempts a rude
27	# conversion of F77 code into M-files.
28	# 05.07.98csc: The way to handle file IDs. Since we cannot just
29	# fopen a file with the same fid as its F77 counterpart,
30	# an array is required, fid_index. This must be global.
31	# 05.19.98csc: This is version 0.11, and may it be the last. It
32	# will parse all of B Cockburn;s conservation laws code.
33	# 05.19.98csc: Input from J Treadway, improvements. V 0.16 now.
34	# 06.16.98csc: Routine expand_implied_do_loop does just that, up
35	# to 3 indices deep.
36	# 06.17.98csc: Horrible realization that each variable needs to
37	# be tracked in value to handle implied do loops. Joy.
38	# 07.09.98csc: Now handles open and close. V 0.26 now.
39	# 07.10.98csc: Make fid_index a hash to handle variables.
40	# 07.13.98csc: Apparent need to find and modify any array or
41	# subroutine names that mirror Matlab M-files. An example
42	# is the routine name "input."
43	# 07.16.98csc: Oh. Need print, and also formats w/out the format
44	# statement. This means ed_read, ed_print, and ed_write.
45	# 07.20.98ccs: V 0.33 now. This pretty much does everything, or
46	# at least takes a stab at it.
47	#####################################################################
48
49	# Typical usage stuff here.
50	if ( 0 > $#ARGV ) { # Should be one arg, at least.
51	usage();
52	} # endif
53
54	###################################################################
55	# Basic plan is to open files one at a time, parse, edit, generate
56	# lines of output, print to M-file, close. Rinse, repeat.
57
58	for ( $ifl=0;$ifl<=$#ARGV;$ifl++ ) { # Loop over arg list files.
59
60	$fname = $ARGV[ $ifl ];
61
62	# Check it out ...
63	stat( $fname );
64	if ( !(-f _) \|\| (-z _) \|\| !(-r _) \|\| !(-T _) ) {
65
66	print "$fname has problems for editing, skipping.\n";
67
68	}
69	else {
70
71	# Copy Fortran file to backup, open file with original name for input.
72	$file_bkp = "";$file_bkp .= $fname."\.bkp";
73	system("cp -f $fname $file_bkp");
74	print "file: $fname ->\n backup file: $file_bkp ->\n";
75	$m_file = $fname;
76	# Will this name be a problem?
77	$m_name = $m_file;
78	$m_name =~ s/\.f$//;
79	$is_trouble = mfile_test( $m_name );
80	# Rename.
81	if ( $is_trouble ) {
82	$m_file = $m_name."ff.m";
83	print "*** File renamed: was $fname, now $m_file\n";
84	}
85	elsif ( $m_file =~ m/\.f$/ ) { $m_file =~ s/f$/m/; }
86	else { $m_file .= ".m"; }
87
88	###################################################################
89	# Read file in, scanning for labels, managing continuations, etc.
90	# This is an initial parsing.
91	open( F77FL, "<$file_bkp" );
92	$label_num = $do_num = 0;
93	$lineno = 0;
94	foreach ( <F77FL> ) {
95
96	# The first step has to be to lowercase everything except comments.
97	if (!(/^\S+/) && !(/format/)) {
98	$dataline = $_;
99	$_ = lc( $dataline );
100	} # endif
101
102	# Find and modify dangerous mirrors of Matlab M-files.
103	if ( !(/^\S+/) &&
104	(/(call)\s+(\w+)($.+$)?/ \|\|
105	/(function)\s+(\w+)($.+$)?/ \|\|
106	/(subroutine)\s+(\w+)($.+$)?/) ) {
107
108	# So far look just at routines.
109	$dummy = $_;
110	$is_trouble = mfile_test( $2 );
111	if ($is_trouble) {
112	$text_array[ $lineno ] =
113	"*** Routine renamed: was $2, now ".$2."ff\n";
114	print $text_array[ $lineno ];
115	$lineno++;
116	$_ = " ".$1." ".$2."ff".$3."\n";
117	}
118	else {
119	$_ = $dummy;
120	} # endif
121
122	} # endif
123
124	if ( /^\s+include/ ) { print "INCLUDE: $_"; }
125	if ( /^\s{5}\S{1}/ ) { # Continuations.
126	$text_array[ $lineno-1 ] =
127	ed_asterix( $text_array[ $lineno-1 ], $_ );
128	}
129	# Look for other interesting tidbits.
130	elsif (/^\s+(else)?\s+if\s*$.+$\s+(\S+)/) {
131	# elsif (/^\s+(else)?\s+if\s*$.+$\s+(.+)$/) {
132
133	# An anti-continuation caused by a one-line if clause. Need to
134	# break the clause out into a new line and tag on an "end" so that
135	# it will be in a "standard" form. Motivation same as for continuation
136	# handling here. See ed_if below.
137	# Special case where we are seeing the end of a long single-line if clause.
138
139	if ( $2 ne "then" ) {
140
141	$tmpif = $_;
142	$tmpif =~ s/\(\s+/\(/g;
143	$tmpif =~ s/\s+\)/\)/g;
144	$tmpif =~ s/\.\s+/\./g;
145	$tmpif =~ s/\s+\./\./g;
146	$tmpif =~ s/\s+/ /g;
147	@tmparray = split(' ',$tmpif);
148	# The if line.
149	$text_array[ $lineno++ ] = " ".shift(@tmparray)." ".shift(@tmparray)." then\n";
150	# The statement.
151	$tmpif = join(' ',@tmparray);
152	$text_array[ $lineno++ ] = " ".$tmpif."\n";
153	# The endif.
154	$text_array[ $lineno++ ] = " endif\n";
155
156	}
157	else {
158	$text_array[ $lineno++ ] = $_;
159	} # endif
160	}
161	elsif ( 0 == $ifl && !(/^\S+/) &&
162	( /\w+\s{1}function\s{1}\w+/ \|\|
163	/\s+subroutine\s{1}\w+/ ) ) { # First file should be main.
164	print "\nERROR - First file in argument list should be the \'main\' program.\n$_\n\n";
165	usage();
166	exit;
167	}
168	elsif (/^\s+do (\d+) /) { # Pull the labels from doloops.
169
170	# Note this label needs to match another one somewhere ...
171	$do_vals[ $do_num ] = $1;
172	$do_list{ $do_vals[ $do_num ] } = $_;
173	$do_num++;
174	$text_array[ $lineno++ ] = $_;
175
176	}
177	else { # We can move on.
178	$text_array[ $lineno++ ] = $_;
179	} # endif
180
181	} # end of foreach
182	close( F77FL );
183	$lineno--;
184
185	###################################################################
186	# 05.07.98csc: Add a search to map file names-IDs.
187	$fid_index{5} = "screen";
188	$fid_index{6} = "screen";
189	for ( $i=0;$i<=$lineno;$i++ ) {
190
191	# Find and collect the labels.
192	if ( $text_array[ $i ] =~ m/^\s{1,4}(\d{1,4})\s+(.+)/ ) {
193
194	# Get the label.
195	$label_vals[ $label_num ] = $1;
196	$tmplabel = $2;
197	$tmplabel =~ s/\s+/ /g;
198	@tmparray = split(' ',$tmplabel);
199
200	# IMHO all labels must be to continue, go to, or format.
201	if ( !($tmparray[0] =~ m/continue/) &&
202	!($tmparray[0] =~ m/go/ && $tmparray[1] =~ m/to/) &&
203	!($tmparray[0] =~ m/goto/) &&
204	!($tmparray[0] =~ m/format/) ) {
205
206	# Strip off the label.
207	$text_array[ $i ] =~ s/^\s+\d+/ /;
208	# Then insert a comment to help track gotos.
209	$commentary = "% GOTO ALERT, original F77 nearly: ";
210	$commentary .= $label_vals[ $label_num ]." ".$tmplabel."\n";
211	# Should be done above ...
212	for ( $j=$lineno+1;$j>$i;$j-- ) {
213	$text_array[ $j ] = $text_array[ $j-1 ];
214	} # end for on j
215	$lineno++;
216	$text_array[ $i ] = $commentary;
217	$i++;
218	}
219	else {
220	# The hash of labelled lines will be global.
221	$label_list{ $label_vals[ $label_num ] } = join(' ',@tmparray);
222	} # endif
223	$label_num++;
224
225	}
226	elsif ($text_array[$i]=~ m/^\s+((else)?\s+if\s$.+?$)\s+(.+?)\s$/ &&
227	$3 ne "then" ) {
228
229	# Extra-long one-line if continuations missed above.
230	for ( $j=$lineno+2;$j>$i;$j-- ) {
231	$text_array[ $j ] = $text_array[ $j-1 ];
232	$text_array[ $j-1 ] = $text_array[ $j-2 ];
233	} # end for on j
234	$lineno += 2;
235	$text_array[$i] = " ".$1." then\n";
236	$text_array[$i+1] = " ".$3."\n";
237	$text_array[$i+2] = " endif\n";
238	$i += 2;
239
240	} # endif
241
242	} # end for on i
243	$label_num--;
244
245	###################################################################
246	# Now that we have the text, let's parse.
247	open( MFL, ">$m_file" );
248
249	for ( $lines=0;$lines<=$lineno;$lines++ ) { # This is where the work is done.
250
251	$dataline = "\n";
252	$_ = $text_array[ $lines ];
253
254	# Now we have buckets-o-if clauses.
255	SWITCH: {
256
257	# Handle empty line, of course.
258	if (/^\s+$/) { $dataline = $_; last SWITCH; }
259
260	# Comment line trumps all else.
261	if (/^\S+/) { ($dataline = $_) =~ s/^\S{1}/\%/; last SWITCH; }
262
263	# Must match read/write to I/O fid and to format label (global).
264	if (/^\s+read/) { $dataline = ed_read( $_ ); last SWITCH; }
265	if (/^\s+write/) { $dataline = ed_write( $_ ); last SWITCH; }
266	if (/^\s+print/) { $dataline = ed_print( $_ ); last SWITCH; }
267
268	# Subprograms.
269	if (/^\s+.+\s+function\s+\w+/) { $dataline = ed_function( $_ ); last SWITCH; }
270	if (/^\s+subroutine\s+\w+/) { $dataline = ed_subroutine( $_ ); last SWITCH; }
271	if (/^\s+call\s+\w+/) { $dataline = ed_call( $_ ); last SWITCH; }
272
273	# Declarations.
274	if (/^\s+integer \w+/) { $dataline = ed_integer( $_ ); last SWITCH; }
275	if (/^\s+real(\*8)? \w+/) { $dataline = ed_real( $_ ); last SWITCH; }
276	if (/^\s+dimension/) { $dataline = ed_dimension( $_ ); last SWITCH; }
277	if (/^\s+parameter/) { $dataline = ed_parameter( $_ ); last SWITCH; }
278	if (/^\s+data/) { $dataline = ed_data( $_ ); last SWITCH; }
279	if (/^\s+common/) { $dataline = ed_common( $_ ); last SWITCH; }
280
281	# Conditionals.
282	if (/^\s+if/ \|\| /^\s+else/ \|\| /^\s+endif/) { $dataline = ed_if( $_ ); last SWITCH; }
283	if (/^\s+endif/) { $dataline = ed_endif( $_ ); last SWITCH; }
284
285	# Loops.
286	if (/^\s+do \d+ /) { $dataline = ed_doloop( $_ ); last SWITCH; }
287
288	# File management.
289	if (/^\s+open/) { $dataline = ed_open( $_ ); last SWITCH; }
290	if (/^\s+close/) { $dataline = ed_close( $_ ); last SWITCH; }
291	if (/^\s+inquire/) { $dataline = ed_inquire( $_ ); last SWITCH; }
292
293	# Miscellaneous constructs.
294	if (/^\s+include/) { $dataline = ed_include( $_ ); last SWITCH; }
295	if (/^\s+return/) { $dataline = ed_return( $_ ); last SWITCH; }
296	if (/^\s+go to \d+/ \|\|
297	/^\s+goto \d+/) { $dataline = ed_goto( $_ ); last SWITCH; }
298
299	# Stuff without much meaning in a Matlab world.
300	if (/^\s+implicit/) { $dataline = "\n"; last SWITCH; }
301	if (/^\s+end/) { $dataline = "\n"; last SWITCH; }
302	# Comment out the stray format lines.
303	if (/^\s+\d+\s+format\s*\(/) { $dataline = "% Would be: $_"; last SWITCH; }
304
305	# Parse near end as it occurs in other contexts.
306	if (/=/) { $dataline = ed_assignment( $_ ); last SWITCH; }
307	if (/^\s+stop\s*\n/) { $dataline = ed_stop( $_ ); last SWITCH; }
308	if (/^\s+(\d+)?\s+continue/) { $dataline = ed_continue( $_ ); last SWITCH; }
309
310	# Handle the wacky stuff ungracefully.
311	# die "\nERROR: f77toM will not handle this >$_";
312	# $dataline = minedit( $_ ); last SWITCH;
313	$dataline = commentout( $_ ); last SWITCH;
314
315	} # end switch block
316
317	# Header stuff.
318	if ( 0 == $lines ) {
319	$headline = "% Generated by f77toM v0.34 [(c) 1998] from original F77 file: $fname\n\n";
320	$dataline = $headline.$dataline;
321	} # endif
322
323	# Output - note that we need to catch the first line regardless.
324	if ( $dataline =~ /\S+/ \|\| 0 == $lines ) { print( MFL $dataline ); }
325	# if ( $dataline =~ /\S+/ \|\| 0 == $lines ) { print $dataline; }
326
327	} # end for on lines.
328
329	# Get the last line.
330	print( MFL $dataline );
331	# print $dataline;
332
333	close( MFL );
334	print " M-file: $m_file\n";
335
336	} # endif
337
338	} # end for over arg list
339
340	print "Done.\n";
341
342
343	######################################################################
344	# The routine subs ...
345
346	#++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
347	# 07.16.98csc: Initially a clone of ed_write.
348	sub ed_print {
349
350	my($f77_line) = @_;
351	my($outline) = "";
352	my($do_flag) = 0;
353	my($implied_do) = "";
354	my(@arglist) = "";
355	my(@fmt_matlab) = "";
356	my(@fmt_matvar) = "";
357	my(@listidl) = "";
358	my(@make_loops) = "";
359	my(@mloop) = "";
360	my(@array_parenclose,@array_parenopen);
361	my(@f77_array,@fmt_array,@fmtpar,@fmtstr);
362	my(@idl_inc,@idl_init,@idl_lim,@idl_ndx);
363	my(@var_array,@var_type);
364	my($Mfid);
365	my($argnum,$arr_var,$dummy,$eqflag,$f77fid,$f77fmt,$f77label,$f77vars);
366	my($fclose_string,$fmt_edited,$fopen_string,$wr_string,$printfilename);
367	my($idl_var,$idum,$ifmt,$ilups,$imat,$inum,$ivar);
368	my($jidl,$jmat,$jpar,$lim,$listnum,$n_indices,$nargs,$nchars,$nlines,$npar,$nidl,$nstr);
369	my($parencount,$pflag,$space_str);
370
371	# Begin.
372
373	# Is this a * format or not?
374	# Could be a string, could be a string variable, or could be *.
375	if ( $f77_line =~ m/^\s+print\s+[\"\|\']$(.+?)$[\"\|\']\s*\,(.+)$/ ) {
376	$f77fmt = $1;
377	$f77vars = $2;
378	}
379	elsif ( $f77_line =~ m/^\s+print\s+(\w+)\s*\,(.+)$/ ) {
380	# Darned if I know what to do here!
381	$warning = "ed_print(): WARNING, this print formatting not supported\n $f77_line Please rewrite with the character variable ".$1." expanded.\n\n";
382	print $warning;
383	$outline = "% ".$warning.$2."\n";
384	return $outline;
385	}
386	elsif ( $f77_line =~ m/^\s+print\s+\\s\,(.+)$/ ) {
387	$f77fmt = "";
388	$f77vars = $1;
389	}
390	else { # Houston, we have a problem.
391	die("ed_print(): ERROR - Format wrong in $f77_line");
392	} # endif
393
394	# Holdovers.
395	$f77fid = "6";
396	$Mfid = 1; # Matlab screen output.
397
398	# The rest is variables.
399	$f77vars =~ s/\s+//g;
400
401	# Extract strings from the format and tag them.
402	$fmt_edited = $f77fmt;
403	$nstr = 0;
404	while ( $fmt_edited =~ m/\'(.*?)\'/ ) {
405	$fmtstr[ $nstr ] = $1;
406	# Need to escape as needed by Matlab.
407	$fmtstr[ $nstr ] =~ s/(\\)/$1$1/g;
408	$fmtstr[ $nstr ] =~ s/(%)/$1$1/g;
409	$fmt_edited =~ s/(\'.*?\')(\')?/X$nstr$2/;
410	if ( $2 ) { $fmt_edited =~ s/(X$nstr)($2)/$1\,$2/; }
411	$nstr++;
412	} # end while
413
414	# Extract and label paren'd format bits.
415	$npar = 0;
416	$fmt_edited =~ s/format$(.+)$$/$1/; # Extract formats only.
417	while ( $fmt_edited =~ m/$(.+?)$/ ) {
418	$fmtpar[ $npar ] = $1;
419	$fmt_edited =~ s/($.+?$)/Y$npar/;
420	$npar++;
421	} # end while
422	# Replace label with expanded format.
423	for ( $jpar=0;$jpar<$npar;$jpar++ ) {
424	$dummy = "";
425	$fmt_edited =~ m/(\d+)?Y$jpar/;
426	if ( !$1 ) { $lim = 1; }
427	else { $lim = $1; }
428	for ( $idum=0;$idum<$lim;$idum++ ) { $dummy .= $fmtpar[$jpar].","; }
429	chop $dummy;
430	$fmt_edited =~ s/(\d+)?Y$jpar/$dummy/;
431	} # end for
432
433	# Now tidy up and tag a few remaining things ...
434	$fmt_edited =~ s/\s+//g;
435	$fmt_edited =~ s/\//N/g;
436	$fmt_edited =~ s/N([^\,\|^\)])/N\,$1/g;
437	$fmt_edited =~ s/N([^\,\|^\)])/N\,$1/g;
438	$fmt_edited =~ s/([^\,\|^\(])N/$1\,N/g;
439	$fmt_edited =~ s/([^\,\|^\(])N/$1\,N/g;
440
441	# Place each output line in an array element and process.
442	@fmt_array = split(',',$fmt_edited);
443	$imat = 0;
444	$fmt_matlab[ $imat ] = $space_str = "";
445	$nchars = 0; # Absolute chars.
446	if ( !$f77vars && !f77fmt ) { # Really ought not to happen.
447	die ("ed_print(): ERROR, must have vars with * format here");
448	}
449	elsif ( $f77vars && !f77fmt ) {
450	@var_array = split(',',$f77vars);
451	for ( $ivar=0;$ivar<=$#var_array;$ivar++ ) {
452	# Assumes the F77 convention, and no chars at all. Poor policy.
453	if ( $var_array[$ivar] =~ m/^[a-ho-z]{1}/ ) { $var_type[$ivar] = "real"; }
454	elsif ( $var_array[$ivar] =~ m/^[i-n]{1}/ ) { $var_type[$ivar] = "int"; }
455	else { $var_type[$ivar] = "error"; }
456	} # end for on ivar
457	}
458	else {
459	$var_type[0] = "";
460	} # endif
461
462	for ( $ifmt=0;$ifmt<=$#fmt_array;$ifmt++ ) {
463
464	($space_str,$nchars,$imat,\@fmt_matlab,\@fmt_matvar) =
465	parse_write_fmt($space_str,$nchars,$ifmt,$imat,\@fmt_array,\@fmt_matlab,\@fmt_matvar,\@fmtstr,\@var_type);
466
467	} # end for on ifmt
468	# Need a \n at end.
469	$fmt_matlab[$imat] .= "\\n";
470
471	####################################################################
472	# Based on the nature of the output variable string, we will make up
473	# an fprintf for matlab to use, one per line.
474
475	# Loop over each line in the output format.
476	for ( $jmat=0;$jmat<=$imat;$jmat++ ) {
477
478	$dummy = "fprintf(".$Mfid.",\'".$fmt_matlab[ $jmat ]."\'";
479	if ( $fmt_matvar[ $jmat ] ) {
480	$dummy .= ",".$fmt_matvar[ $jmat ].");\n";
481	}
482	else { $dummy .= ");\n"; } # endif
483	$outline .= $dummy;
484
485	} # end for on jmat
486
487	# Characterize the variables, if any. This involves moving along the
488	# print line, parsing as we go, usually by parentheses and commas.
489	if ( $f77vars ) { # We got 'em.
490
491	$nargs = 0;
492	# How many?
493	@var_array = split(',',$f77vars);
494	for ( $ivar=0;$ivar<=$#var_array;$ivar++ ) {
495
496	if ( $var_array[$ivar] =~ m/^\(/ ) {
497	# This means we have something special, and we need to paste it
498	# back together again. Probably an implied do loop.
499	$idl_var = "";
500	$parencount = 0;
501	$pflag = 1;
502	$eqflag = 0;
503	# Run to the end, gathering all between the parens.
504	while ( $var_array[$ivar] =~ m/[$\|$]+/ \|\| $pflag ) {
505	@array_parenopen = split('\(',$var_array[$ivar]);
506	@array_parenclose = split('\)',$var_array[$ivar]);
507	if ( $var_array[$ivar] =~ m/\)$/ ) { $#array_parenclose++; }
508	$parencount += $#array_parenclose - $#array_parenopen;
509	# print "$parencount += $#array_parenclose - $#array_parenopen\n";
510	if ( 0 <= $parencount ) { $pflag = 0; }
511	# Paste together ...
512	if ( $var_array[$ivar] =~ m/\)$/ ) { # Not array args.
513	$idl_var .= $var_array[$ivar]."\|";
514	}
515	elsif ( $eqflag \|\| $var_array[$ivar] =~ m/\=/ ) {
516	$idl_var .= $var_array[$ivar]."\|";
517	$eqflag = 1;
518	}
519	elsif ( !$eqflag && (-1 > $parencount) ) { # Non-robust ...
520	$idl_var .= $var_array[$ivar].",";
521	}
522	else {
523	$idl_var .= $var_array[$ivar]."\|";
524	# print "HOW DID I GET HERE? -> $var_array[$ivar]\n";
525	}
526	if ( $ivar > $#var_array ) { die "ERROR: paren mismatch in $f77vars"; }
527	$ivar++;
528	} # endwhile
529	$idl_var .= $var_array[$ivar];
530	$idl_var =~ s/[\\|\|\,]$//;
531	$arglist[ $nargs++ ] = $idl_var;
532
533	}
534	elsif ( $var_array[$ivar] =~ m/^\w+$.+?$$/ ) { # Array/function.
535	$arglist[ $nargs++ ] = $var_array[$ivar];
536	}
537	elsif ( $var_array[$ivar] =~ m/^\w+\(.+?$/ ) { # Ditto ...
538	$arr_var = "";
539	$parencount = 0;
540	$pflag = 1;
541	# Run to the end, gathering all between the parens.
542	while ( $var_array[$ivar] =~ m/[$\|$]+/ \|\| $pflag ) {
543	@array_parenopen = split('\(',$var_array[$ivar]);
544	@array_parenclose = split('\)',$var_array[$ivar]);
545	if ( $var_array[$ivar] =~ m/\)$/ ) { $#array_parenclose++; }
546	$parencount += $#array_parenclose - $#array_parenopen;
547	if ( 0 == $parencount ) { $pflag = 0; }
548	$arr_var .= $var_array[$ivar];
549	if ( $ivar > $#var_array ) { die "ERROR: paren mismatch in $f77vars"; }
550	$ivar++;
551	} # endwhile
552	$arr_var .= $var_array[$ivar];
553	$arglist[ $nargs++ ] = $arr_var[$ivar];
554	}
555	elsif ( $var_array[$ivar] =~ m/^\w+$/ ) { # Simple variable.
556	$arglist[ $nargs++ ] = $var_array[$ivar];
557	}
558	elsif ( $var_array[$ivar] =~ m/[\*\|\+\|\-\|\/]/ ) { # Statement.
559	$arglist[ $nargs++ ] = $var_array[$ivar];
560	}
561	else { # Dull stuff.
562	$arglist[ $nargs++ ] = $var_array[$ivar];
563	} # endif
564
565	} # end for on ivar
566
567	# At this stage the args are space-delimited, array indices are comma-
568	# delimited, and implied do bits are pipe-delimited.
569
570	} # endif
571
572	# Now compare the arglist to the outline to see where the variables,
573	# if any, need to go.
574	$argnum = 0;
575	$listnum = 0;
576	while ( $outline =~ m/[\,\|X\|\'\|$]X[X\|(\,\')\|$]/ ) {
577
578	if ( $arglist[ $argnum ] =~ m/\\|/ ) { # Implied do land.
579
580	$nidl = 0;
581	$arglist[ $argnum ] =~ s/^\(//;
582	$arglist[ $argnum ] =~ s/\)$//;
583	@listidl = split('\\|',$arglist[ $argnum ]);
584	$n_indices = 0;
585	for ( $jdl=0;$jdl<=$#listidl;$jdl++ ) {
586
587	if ( $listidl[$jdl] =~ m/(\w+)\=(\S+)/ ) { # An index variable.
588
589	$idl_ndx[$n_indices] = $1;
590	$idl_init[$n_indices] = $2;
591	$jdl++;
592	$idl_lim[$n_indices] = $listidl[$jdl];
593	if ( $listidl[$jdl+1] !=~ m/(\w+)\=(\S+)/ ) { # Increment.
594	$idl_inc[$n_indices] = $listidl[$jdl+1];
595	$jdl++;
596	} # endif
597	# Construct the necessary Matlab loop(s).
598	$mloop[$n_indices] = " for ".$idl_ndx[$n_indices].
599	" = ".$idl_init[$n_indices];
600	if ( $idl_inc[$n_indices] ) { $mloop[$n_indices] .= ":".$idl_inc[$n_indices]; }
601	$mloop[$n_indices] .= ":".$idl_lim[$n_indices]."\n";
602	$n_indices++;
603
604	}
605	else { # It had better be an output variable name ...
606	$outline =~ s/([\'\|$]?)X{1}([(\,\')\|$]?)/$1\,$listidl[ $jdl ]$2/;
607	$arglist[ $argnum ] = $listidl[ $jdl ];
608	$nidl++;
609	$argnum++;
610	} # endif
611
612	} # end for on jdl
613
614	# Now insert the loop(s) into the string of commands.
615	@make_loops = split(';\n',$outline);
616	$outline = "";
617	for ( $nlines=0;$nlines<=$#make_loops;$nlines++ ) {
618	if ( $make_loops[$nlines] =~ m/$$idl_ndx[0]$/ ) {
619	# Note that here we decrement as the IDL reads right-to-left.
620	for ( $ilups=$n_indices-1;$ilups>=0;$ilups-- ) {
621	if ( 0 < $nlines ) { $make_loops[$nlines-1] .= ";\n"; }
622	$make_loops[$nlines] = $mloop[ $ilups ]." ".$make_loops[$nlines];
623	$make_loops[$nlines] .= ";\n end;\n";
624	} # end for ilups
625	} # endif
626	$outline .= $make_loops[$nlines]."\n";
627	} # end for on nlines
628
629	}
630	else { # Reality.
631	$outline =~ s/([\'\|$]?\,?)X{1}([(\,\')\|$]?)/$1$arglist[$argnum]$2/;
632	$outline =~ s/\,(\,$arglist[$argnum])/$1/;
633	$argnum++;
634	} # endif
635
636	# Limit here is arbitrary.
637	if ( $argnum > 7 ) { die "ERROR: $argnum > 7"; }
638
639	} # endwhile
640
641	# Open file for appending/creation.
642	if ( 1 != $Mfid ) {
643	$fopen_string = $Mfid." = fopen(".$printfilename.",\'a\');\n";
644	$fclose_string = "fclose(".$Mfid.");\n";
645	}
646	else {
647	$fopen_string = "";
648	$fclose_string = "";
649	} # endif
650	$outline = join('',$fopen_string,$outline,$fclose_string);
651
652	return $outline;
653	} # end of ed_print
654
655
656	#++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
657	# 07.15.98csc: Silly.
658	sub ed_return {
659
660
661	my($f77_line) = @_;
662	my($outline) = "ed_return(): ERROR in f77toM\n";
663
664	# Begin.
665
666	$outline = "\n return;\n";
667
668	return $outline;
669	} # end of ed_return
670
671
672	#++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
673	# 07.15.98csc: Comment out the string and also print to screen.
674	sub commentout {
675
676	my($f77_line) = @_;
677	my($outline) = "commentout(): ERROR in f77toM\n";
678
679	# Begin.
680	$commentline = "% ".$f77_line;
681	$f77_line =~ s/\n//g;
682	$f77_line =~ s/\'//g;
683	$f77_line =~ s/\"//g;
684	$displine = "disp(\'*** What is this (quotes deleted)? ".$f77_line."\');\n";
685
686	$outline = $commentline.$displine;
687
688	return $outline;
689	} # end of commentout
690
691
692	#++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
693	# 07.13.98csc: If string is a Matlab command, return a 1, else
694	# a 0. List is not complete.
695	sub mfile_test {
696
697	my($testword) = @_;
698	my($istrouble) = 0; # Assume no problems.
699
700	# Begin.
701	$_ = $testword;
702
703	MSWITCH: {
704
705	if (/^addpath$/) { $istrouble = 1; last MSWITCH; }
706	if (/^cd$/) { $istrouble = 1; last MSWITCH; }
707	if (/^clear$/) { $istrouble = 1; last MSWITCH; }
708	if (/^dbclear$/) { $istrouble = 1; last MSWITCH; }
709	if (/^dbcont$/) { $istrouble = 1; last MSWITCH; }
710	if (/^dbdown$/) { $istrouble = 1; last MSWITCH; }
711	if (/^dbmex$/) { $istrouble = 1; last MSWITCH; }
712	if (/^dbquit$/) { $istrouble = 1; last MSWITCH; }
713	if (/^dbstack$/) { $istrouble = 1; last MSWITCH; }
714	if (/^dbstatus$/) { $istrouble = 1; last MSWITCH; }
715	if (/^dbstep$/) { $istrouble = 1; last MSWITCH; }
716	if (/^dbstop$/) { $istrouble = 1; last MSWITCH; }
717	if (/^dbtype$/) { $istrouble = 1; last MSWITCH; }
718	if (/^dbup$/) { $istrouble = 1; last MSWITCH; }
719	if (/^debug$/) { $istrouble = 1; last MSWITCH; }
720	if (/^demo$/) { $istrouble = 1; last MSWITCH; }
721	if (/^diary$/) { $istrouble = 1; last MSWITCH; }
722	if (/^disp$/) { $istrouble = 1; last MSWITCH; }
723	if (/^edit$/) { $istrouble = 1; last MSWITCH; }
724	if (/^getenv$/) { $istrouble = 1; last MSWITCH; }
725	if (/^help$/) { $istrouble = 1; last MSWITCH; }
726	if (/^inmem$/) { $istrouble = 1; last MSWITCH; }
727	if (/^input$/) { $istrouble = 1; last MSWITCH; }
728	if (/^load$/) { $istrouble = 1; last MSWITCH; }
729	if (/^lookfor$/) { $istrouble = 1; last MSWITCH; }
730	if (/^more$/) { $istrouble = 1; last MSWITCH; }
731	if (/^path$/) { $istrouble = 1; last MSWITCH; }
732	if (/^plot$/) { $istrouble = 1; last MSWITCH; }
733	if (/^profile$/) { $istrouble = 1; last MSWITCH; }
734	if (/^rmpath$/) { $istrouble = 1; last MSWITCH; }
735	if (/^quit$/) { $istrouble = 1; last MSWITCH; }
736	if (/^save$/) { $istrouble = 1; last MSWITCH; }
737	if (/^title$/) { $istrouble = 1; last MSWITCH; }
738	if (/^type$/) { $istrouble = 1; last MSWITCH; }
739	if (/^unix$/) { $istrouble = 1; last MSWITCH; }
740	if (/^ver$/) { $istrouble = 1; last MSWITCH; }
741	if (/^what$/) { $istrouble = 1; last MSWITCH; }
742	if (/^which$/) { $istrouble = 1; last MSWITCH; }
743	if (/^who$/) { $istrouble = 1; last MSWITCH; }
744
745	} # end of MSWITCH
746
747	return $istrouble;
748	} # end of mfile_test
749
750
751	#++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
752	# 07.09.98csc: Note of course that the inquire statement is ever
753	# used by _real_ Fortran programmers ...
754	# In Matlab we will use exist to simulate this.
755	sub ed_inquire {
756
757	my($f77_line) = @_;
758	my($outline) = "ed_inquire(): ERROR in f77toM\n";
759	my($file_access) = "sequential";
760	my($file_action) = "readwrite";
761	my($file_blank) = "null";
762	my($file_delim) = "delim";
763	my($file_exist) = 0;
764	my($file_form) = "";
765	my($file_formatted) = "";
766	my($file_id) = 0;
767	my($file_iolength) = 0;
768	my($file_iostat) = 0;
769	my($file_name) = "";
770	my($file_named) = "";
771	my($file_nextrc) = 0;
772	my($file_number) = 0;
773	my($file_opened) = "";
774	my($file_pad) = "";
775	my($file_position) = "asis";
776	my($file_read) = "";
777	my($file_readwrite) = "";
778	my($file_recl) = 0;
779	my($file_sequential) = "";
780	my($file_unformatted) = "";
781	my($file_write) = "";
782	my(@specifiers);
783	my($Mfid,$ispec);
784
785	# Begin.
786	$f77_line =~ s/\s+//g;
787
788	# Let's return the original for safety.
789	$orig_line = "% Originally: ".$f77_line;
790	$f77_line =~ s/inquire\(//;
791	$f77_line =~ s/\)\s*$//;
792	# These might be dangerous ...
793	$f77_line =~ s/\'//g;
794	$f77_line =~ s/\"//g;
795
796	# Parse for the specifiers. Note that we do here F77 and F90 ...
797	@specifiers = split(',',$f77_line);
798	for ( $ispec=0;$ispec<=$#specifiers;$ispec++ ) {
799
800	$_ = $specifiers[$ispec];
801
802	QSWITCH: {
803
804	# File ID. Note there are two ways to get this. Ordering important.
805	if (/unit=(\w+)/) { $file_id = $1; last QSWITCH; }
806	if ( 0 == $ispec && /[^\=]/ && /(\w+)/) { $file_id = $1; last QSWITCH; }
807	# File nom.
808	if (/file=(\S+)/) { $file_name = $1; last QSWITCH; }
809
810	# Less interesting stuff.
811	if (/access=(\S+)/) { $file_access = $1; last QSWITCH; }
812	if (/action=(\S+)/) { $file_action = $1; last QSWITCH; }
813	if (/blank=(\S+)/) { $file_blank = $1; last QSWITCH; }
814	if (/delim=(\S+)/) { $file_delim = $1; last QSWITCH; }
815	if (/exist=(\S+)/) { $file_exist = $1; last QSWITCH; }
816	if (/form=(\S+)/) { $file_form = $1; last QSWITCH; }
817	if (/formatted=(\S+)/) { $file_formatted = $1; last QSWITCH; }
818	if (/iolength=(\S+)/) { $file_iolength = $1; last QSWITCH; }
819	if (/iostat=(\S+)/) { $file_iostat = $1; last QSWITCH; }
820	if (/name=(\S+)/) { $file_name = $1; last QSWITCH; }
821	if (/named=(\S+)/) { $file_named = $1; last QSWITCH; }
822	if (/nextrc=(\S+)/) { $file_nextrc = $1; last QSWITCH; }
823	if (/number=(\S+)/) { $file_number = $1; last QSWITCH; }
824	if (/opened=(\S+)/) { $file_opened = $1; last QSWITCH; }
825	if (/pad=(\S+)/) { $file_pad = $1; last QSWITCH; }
826	if (/position=(\S+)/) { $file_position = $1; last QSWITCH; }
827	if (/read=(\S+)/) { $file_read = $1; last QSWITCH; }
828	if (/readwrite=(\S+)/) { $file_readwrite = $1; last QSWITCH; }
829	if (/recl=(\S+)/) { $file_recl = $1; last QSWITCH; }
830	if (/sequential=(\S+)/) { $file_sequential = $1; last QSWITCH; }
831	if (/unformatted=(\S+)/) { $file_unformatted = $1; last QSWITCH; }
832	if (/write=(\S+)/) { $file_write = $1; last QSWITCH; }
833
834	} # end of QSWITCH
835
836	} # end for on ispec
837
838	# Now create the corresponding Matlab code.
839	if ( !$file_name ) { $file_name = $fid_index{ $file_id }; }
840	$outline = $orig_line." inquiry = exist(\'".$file_name."\',\'file\'); exist = inquiry; name = \'".$file_name."\';\n";
841
842	return $outline;
843	} # end of ed_inquire
844
845
846	#++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
847	# 07.09.98csc: File close.
848	sub ed_close {
849
850	my($f77_line) = @_;
851	my($outline) = "ed_close(): ERROR in f77toM\n";
852	my($file_id) = 0;
853	my($file_iostat) = 0;
854	my($file_status) = "keep";
855	my($error_string, $fclose_string) = "";
856	my($Mfid,$ispec);
857
858	# Begin.
859	$f77_line =~ s/\s+//g;
860	$f77_line =~ s/close\(//;
861	$f77_line =~ s/\)\s*$//;
862
863	# Parse for the specifiers. Note that we do here F77 and F90 ...
864	@specifiers = split(',',$f77_line);
865	for ( $ispec=0;$ispec<=$#specifiers;$ispec++ ) {
866
867	$_ = $specifiers[$ispec];
868
869	SWITCHRU: {
870
871	# File ID. Note there are two ways to get this. Ordering important.
872	if (/unit=(\w+)/) { $file_id = $1; last SWITCHRU; }
873	if ( 0 == $ispec && /[^\=]/ && /(\w+)/) { $file_id = $1; last SWITCHRU; }
874	# Less interesting stuff.
875	if (/iostat=(\S+)/) { $file_iostat = $1; last SWITCHRU; }
876	if (/status=(\S+)/) { $file_status = $1; last SWITCHRU; }
877
878	} # end of SWITCHRU
879
880	} # end for on ispec
881
882	# Apply Matlab to infected area.
883	$file_name = $fid_index{ $file_id };
884	if ( $file_status eq "delete" ) { # Well, that's different.
885	$outline = " delete(\'".$file_name."\');\n";
886	}
887	else {
888	$Mfid = "fid".$file_id;
889	$fclose_string = " rstatus = fclose(".$Mfid.");\n";
890	$error_string = " if ( 0 > rstatus )\n error(\'fclose failed with file=".$file_name.", fid=".$Mfid."\');\n end;\n\n";
891	$outline = $fclose_string.$error_string;
892	} # endif
893
894	return $outline;
895	} # end of ed_close
896
897
898	#++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
899	# 07.08.98csc: File open. Should be straightforward ...
900	# open([unit=],iostat=,err=,file=,status=,access=,form=,recl=,blank=)
901	sub ed_open {
902
903	my($f77_line) = @_;
904	my($outline) = "ed_open(): ERROR in f77toM\n";
905	my($file_access) = "sequential";
906	my($file_action) = "readwrite";
907	my($file_blank) = "null";
908	my($file_delim) = "delim";
909	my($file_err) = 0;
910	my($file_form) = "";
911	my($file_id) = 0;
912	my($file_iostat) = 0;
913	my($file_name) = "";
914	my($file_pad) = "yes";
915	my($file_position) = "asis";
916	my($file_recl) = 0;
917	my($file_status) = "unknown";
918	my($error_string, $fopen_string, $orig_line, $permission) = "";
919	my(@specifiers);
920	my($Mfid,$ispec);
921
922	# Begin.
923	$f77_line =~ s/\s+//g;
924
925	# Let's return the original for safety.
926	$orig_line = "% Originally: ".$f77_line;
927	$f77_line =~ s/open\(//;
928	$f77_line =~ s/\)\s*$//;
929	# These might be dangerous ...
930	$f77_line =~ s/\'//g;
931	$f77_line =~ s/\"//g;
932
933	# Parse for the specifiers. Note that we do here F77 and F90 ...
934	@specifiers = split(',',$f77_line);
935	for ( $ispec=0;$ispec<=$#specifiers;$ispec++ ) {
936
937	$_ = $specifiers[$ispec];
938
939	IPSWITCH: {
940
941	# File ID. Note there are two ways to get this. Ordering important.
942	if (/unit=(\w+)/) { $file_id = $1; last IPSWITCH; }
943	if ( 0 == $ispec && /[^\=]/ && /(\w+)/) { $file_id = $1; last IPSWITCH; }
944	# File nom.
945	if (/file=(\S+)/) { $file_name = $1; last IPSWITCH; }
946
947	# Less interesting stuff.
948	if (/iostat=(\S+)/) { $file_iostat = $1; last IPSWITCH; }
949	if (/status=(\S+)/) { $file_status = $1; last IPSWITCH; }
950	if (/access=(\S+)/) { $file_access = $1; last IPSWITCH; }
951	if (/form=(\S+)/) { $file_form = $1; last IPSWITCH; }
952	if (/recl=(\S+)/) { $file_recl = $1; last IPSWITCH; }
953	if (/blank=(\S+)/) { $file_blank = $1; last IPSWITCH; }
954	if (/position=(\S+)/) { $file_position = $1; last IPSWITCH; }
955	if (/action=(\S+)/) { $file_action = $1; last IPSWITCH; }
956	if (/delim=(\S+)/) { $file_delim = $1; last IPSWITCH; }
957	if (/pad=(\S+)/) { $file_pad = $1; last IPSWITCH; }
958	if (/err=(\S+)/) { $file_err = $1; last IPSWITCH; }
959
960	} # end of IPSWITCH
961
962	} # end for on ispec
963
964	# Consistency check.
965	if ( !$file_recl && $file_access eq "direct" ) {
966	die "ed_open(): ERROR RECL=$file_recl and ACCESS=$file_access inconsistent";
967	} # endif
968	if ( ($file_position eq "rewind" \|\| $file_position eq "append") &&
969	$file_access eq "direct" ) {
970	die "ed_open(): ERROR POSITION=$file_recl and ACCESS=$file_access inconsistent";
971	} # endif
972
973	#######################################################################
974	# Convert some of the above to generate something that makes sense in
975	# Matlab.
976	$Mfid = "fid".$file_id;
977	if ( !$file_form ) { # Set defaults.
978	if ( $file_access eq "direct" ) { $file_form = "unformatted"; }
979	else { $file_form = "formatted"; }
980	} # endif
981	if ( $file_position eq "rewind" ) {
982	$outline = " frewind(".$Mfid.");\n";
983	return $outline;
984	}
985
986	if ( $file_status eq "old" ) {
987	if ( $file_action eq "readwrite" ) { $permission = "r+"; }
988	elsif ( $file_action eq "read" ) { $permission = "r"; }
989	elsif ( $file_action eq "write" ) { $permission = "w"; }
990	}
991	elsif ( $file_status eq "new" ) {
992	if ( $file_status eq "write" ) { $permission = "w"; }
993	else { $permission = "w+"; }
994	}
995	elsif ( $file_status eq "replace" ) {
996	$permission = "w+"
997	}
998	elsif ( $file_status eq "scratch" ) {
999	# These will have no name.
1000	}
1001	elsif ( $file_status eq "unknown" ) {
1002	if ( $file_action eq "readwrite" ) { $permission = "r+"; }
1003	elsif ( $file_action eq "read" ) { $permission = "r"; }
1004	elsif ( $file_action eq "write" ) { $permission = "w"; }
1005	} # endif
1006
1007	if ( $file_position eq "append" ) { # Supersedes the above.
1008	if ( $file_status eq "old" ) {
1009	if ( $file_action eq "write" ) { $permission = "a"; }
1010	else { $permission = "a+"; }
1011	}
1012	else {
1013	$permission = "a+";
1014	} # endif
1015	} # endif
1016
1017	# Store the file ID and name for later. How to handle integer
1018	# statements here? Global here.
1019	if ( $fid_index{ $file_id } =~ m/\S+/ ) { # Extant.
1020	}
1021	else { # New.
1022	$fid_index{ $file_id } = $file_name;
1023	} # endif
1024
1025	# Brain dead error checking.
1026	if ( !$permission ) { # Whoops.
1027	die "ed_open(): ERROR Matlab file permission somehow never set";
1028	} # endif
1029
1030	# Now create the corresponding Matlab code.
1031	$fopen_string = "\n [".$Mfid.",message] = fopen(\'".$file_name."\',\'".$permission."\');\n";
1032	$error_string = " if ( 0 > ".$Mfid." )\n disp(message);\n error(\'fopen failed with file=".$file_name.", fid=".$Mfid."\');\n end;\n\n";
1033
1034	$outline = $orig_line.$fopen_string.$error_string;
1035
1036	return $outline;
1037	} # end of ed_open
1038
1039
1040	#++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
1041	# 07.07.98csc: Parses the specially modified F77 format statement
1042	# and places results into useful arrays for later work. Used
1043	# in ed_read. Call as in
1044	# ( $space_str, $nchars, $imat, fmt_matlab, fmt_matvar ) = parse_read_fmt( $space_str, $nchars, $ifmt, $imat, fmt_array, fmtstr, *var_type );
1045	# $imat is the external loop variable.
1046	sub parse_read_fmt {
1047
1048	my($space_str,$nchars,$ifmt,$imat,$fmt_array,$fmt_matlab,$fmt_matvar,$fmtstr,$var_type) = @_;
1049	my($inum,$isp,$lim);
1050
1051	# Begin.
1052
1053	if ( $fmt_array->[$ifmt] eq "N" ) { # New line.
1054	$fmt_matlab->[$imat] .= "\\n";
1055	$imat++; # New line, new fscanf wanted.
1056	$fmt_matlab->[$imat] = "";
1057	$nchars = 0;
1058	}
1059	elsif ( $fmt_array->[$ifmt] =~ /^X(\d+)/ ) { # Strings.
1060	$fmt_matlab->[$imat] .= "%s";
1061	if ( $fmt_matvar->[$imat] ) { $fmt_matvar->[$imat] .= ","; }
1062	$fmt_matvar->[$imat] .= "\'".$fmtstr->[$1]."\'";
1063	$nchars += length( $fmtstr->[$1] );
1064	}
1065	elsif ( $fmt_array->[$ifmt] =~ /^(\d+)x/ \|\|
1066	$fmt_array->[$ifmt] =~ /tr(\d+)/ ) { # Space insertion.
1067	$space_str = "";
1068	for ( $isp=0;$isp<$1;$isp++ ) { $space_str .= " "; }
1069	$fmt_matlab->[$imat] .= "%s";
1070	if ( $fmt_matvar->[$imat] ) { $fmt_matvar->[$imat] .= ","; }
1071	$fmt_matvar->[$imat] .= "\'".$space_str."\'";
1072	$space_str = "";
1073	$nchars += $isp-1;
1074	}
1075	elsif ( $fmt_array->[$ifmt] =~ /^tl(\d+)/ ) { # Space deletion.
1076	# Not supported.
1077	}
1078	elsif ( $fmt_array->[$ifmt] =~ /^t(\d+)/ ) { # Space by absolutes.
1079	$nspaces = $1 - $nchars;
1080	$space_str = "";
1081	for ( $isp=0;$isp<$nspaces;$isp++ ) { $space_str .= " "; }
1082	$fmt_matlab->[$imat] .= "%s";
1083	if ( $fmt_matvar->[$imat] ) { $fmt_matvar->[ $imat ] .= ","; }
1084	$fmt_matvar->[$imat] .= "\'".$space_str."\'";
1085	$space_str = "";
1086	$nchars += $nspaces;
1087	}
1088	elsif ( $fmt_array->[$ifmt] =~ /^(\d+)?i(\d+)(\.\d+)?/ ) { # Integers.
1089	if ( !$1 ) { $lim = 1; }
1090	else { $lim = $1; }
1091	for ( $inum=0;$inum<$lim;$inum++ ) {
1092	$fmt_matlab->[$imat] .= "%$2$3i";
1093	$fmt_matvar->[$imat] .= "X";
1094	} # endif
1095	# $fmt_matvar->[$imat] .= "X";
1096	$nchars += $lim * $2;
1097	}
1098	elsif ( $fmt_array->[$ifmt] =~ /^(\d+)?([d\|e\|f\|g])(\d+)(\.\d+)?/ ) {
1099	# Floating point formats.
1100	if ( !$1 ) { $lim = 1; }
1101	else { $lim = $1; }
1102	# Note that 1->1 mapping of formats may NOT be valid.
1103	for ( $inum=0;$inum<$lim;$inum++ ) {
1104	$fmt_matlab->[$imat] .= "%$3$4$2";
1105	$fmt_matvar->[$imat] .= "X";
1106	} # endif
1107	$nchars += $lim * $3;
1108	}
1109	elsif ( $fmt_array->[$ifmt] =~ /^a(\d+)/ ) { # Characters.
1110	$fmt_matlab->[$imat] .= "%$1s";
1111	$fmt_matvar->[$imat] .= "X";
1112	$nchars += $1;
1113	}
1114	elsif ( $var_type->[0] ) { # * format ...
1115	if ( "real" eq $var_type->[$ifmt] ) {
1116	}
1117	}
1118	else { # Que?
1119	print "ERROR: $fmt_array->[$ifmt] unrecognized.\n";
1120	} # endif
1121
1122	return($space_str,$nchars,$imat,$fmt_matlab,$fmt_matvar);
1123
1124	} # end of parse_read_fmt
1125
1126
1127	#++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
1128	# 07.06.98csc: Parses the specially modified F77 format statement
1129	# and places results into useful arrays for later work. Used
1130	# in ed_write. Call as in
1131	# ( $space_str, $nchars, $imat, \@fmt_matlab, \@fmt_matvar ) = parse_write_fmt( $space_str, $nchars, $ifmt, $imat, \@fmt_array, \@fmtstr, \@var_type );
1132	# $imat is the external loop variable.
1133	sub parse_write_fmt {
1134
1135	my($space_str,$nchars,$ifmt,$imat,$fmt_array,$fmt_matlab,$fmt_matvar,$fmtstr,$var_type) = @_;
1136	my($inum,$isp,$lim);
1137
1138	# Begin.
1139
1140	if ( $fmt_array->[$ifmt] eq "N" ) { # New line.
1141	$fmt_matlab->[$imat] .= "\\n";
1142	$imat++; # New line, new fprintf wanted.
1143	$fmt_matlab->[$imat] = "";
1144	$nchars = 0;
1145	}
1146	elsif ( $fmt_array->[$ifmt] =~ /^X(\d+)/ ) { # Strings.
1147	$fmt_matlab->[$imat] .= "%s";
1148	if ( $fmt_matvar->[$imat] ) { $fmt_matvar->[$imat] .= ","; }
1149	$fmt_matvar->[$imat] .= "\'".$fmtstr->[$1]."\'";
1150	$nchars += length( $fmtstr->[$1] );
1151	}
1152	elsif ( $fmt_array->[$ifmt] =~ /^(\d+)x/ \|\|
1153	$fmt_array->[$ifmt] =~ /tr(\d+)/ ) { # Space insertion.
1154	$space_str = "";
1155	for ( $isp=0;$isp<$1;$isp++ ) { $space_str .= " "; }
1156	$fmt_matlab->[$imat] .= "%s";
1157	if ( $fmt_matvar->[$imat] ) { $fmt_matvar->[$imat] .= ","; }
1158	$fmt_matvar->[$imat] .= "\'".$space_str."\'";
1159	$space_str = "";
1160	$nchars += $isp-1;
1161	}
1162	elsif ( $fmt_array->[$ifmt] =~ /^tl(\d+)/ ) { # Space deletion.
1163	# Not supported.
1164	}
1165	elsif ( $fmt_array->[$ifmt] =~ /^t(\d+)/ ) { # Space by absolutes.
1166	$nspaces = $1 - $nchars;
1167	$space_str = "";
1168	for ( $isp=0;$isp<$nspaces;$isp++ ) { $space_str .= " "; }
1169	$fmt_matlab->[$imat] .= "%s";
1170	if ( $fmt_matvar->[$imat] ) { $fmt_matvar->[ $imat ] .= ","; }
1171	$fmt_matvar->[$imat] .= "\'".$space_str."\'";
1172	$space_str = "";
1173	$nchars += $nspaces;
1174	}
1175	elsif ( $fmt_array->[$ifmt] =~ /^(\d+)?i(\d+)(\.\d+)?/ ) { # Integers.
1176	if ( !$1 ) { $lim = 1; }
1177	else { $lim = $1; }
1178	for ( $inum=0;$inum<$lim;$inum++ ) {
1179	$fmt_matlab->[$imat] .= "%$2$3i";
1180	$fmt_matvar->[$imat] .= "X";
1181	} # endif
1182	# $fmt_matvar->[$imat] .= "X";
1183	$nchars += $lim * $2;
1184	}
1185	elsif ( $fmt_array->[$ifmt] =~ /^(\d+)?([d\|e\|f\|g])(\d+)(\.\d+)?/ ) {
1186	# Floating point formats.
1187	if ( !$1 ) { $lim = 1; }
1188	else { $lim = $1; }
1189	# Note that 1->1 mapping of formats may NOT be valid.
1190	for ( $inum=0;$inum<$lim;$inum++ ) {
1191	$fmt_matlab->[$imat] .= "%$3$4$2";
1192	$fmt_matvar->[$imat] .= "X";
1193	} # endif
1194	$nchars += $lim * $3;
1195	}
1196	elsif ( $fmt_array->[$ifmt] =~ /^a(\d+)/ ) { # Characters.
1197	$fmt_matlab->[$imat] .= "%$1s";
1198	$fmt_matvar->[$imat] .= "X";
1199	$nchars += $1;
1200	}
1201	elsif ( $var_type->[0] ) { # * format ...
1202	if ( "real" eq $var_type->[$ifmt] ) {
1203	}
1204	}
1205	else { # Que?
1206	print "parse_write_fmt(): ERROR; This >$fmt_array->[$ifmt]< unrecognized.\n";
1207	} # endif
1208
1209	return($space_str,$nchars,$imat,$fmt_matlab,$fmt_matvar);
1210
1211	} # end of parse_write_fmt
1212
1213
1214	#++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
1215	# 06.16.98csc: Input an implied do loop, output the expanded
1216	# form. Only does up to 3 indices, and has other problems.
1217	sub expand_implied_do_loop {
1218
1219	my($input_line) = @_;
1220	my($outline) = "ERROR: in expand_implied_do_loop in f77toM\n;";
1221	my(@do_init) = (1,1,1);
1222	my(@do_lim) = (0,0,0);
1223	my(@do_inc) = (1,1,1);
1224	my($gstring) = "\n";
1225	my(@do_var,$i0,$i1,$i2,$init_list,$init_statement,$ndx,$nlst);
1226	my(@var_args,@var_list,@var_name);
1227
1228	# Begin.
1229
1230	if ( $input_line =~ m/^$(.+\=+.+)$/ ) {
1231
1232	$init_statement = $1;
1233	# From right to left, remove the loops recursively.
1234	$init_list = $init_statement;
1235	$ndx = 0;
1236	while ( $init_list =~ m/(\w+)\=(\w+)\,(\w+)(\,\w+)?$/ ) {
1237
1238	$do_var[$ndx] = $1;
1239	if ( $3 ) { $do_init[$ndx] = $do_ndx[$ndx] = $2; }
1240	else { $do_init[$ndx] = $do_ndx[$ndx] = 1; }
1241	if ( $3 ) { $do_lim[$ndx] = $3; }
1242	else { $do_lim[$ndx] = 0; }
1243	if ( $4 ) { $do_inc[$ndx] = $4; }
1244	else { $do_inc[$ndx] = 1; }
1245	$ndx++;
1246	$init_list =~ s/\,\w+\=\w+\,\w+(\,\w+)?$//;
1247	if ( $init_list =~ m/^$(.+\=+.+)$/ ) { $init_list = $1; }
1248
1249	} # end while
1250
1251	# List contents - variables, arrays, etc.
1252	$nlst = 0;
1253	while ( $init_list ) {
1254
1255	if ( $init_list =~ m/^(\w+$.+?$)[\,\|^\)\|^\w+]?/ ) { # Array.
1256	$var_list[$nlst] = $1;
1257	$var_list_id[$nlst] = "array";
1258	$var_name[$nlst] = $var_list[$nlst];
1259	$var_name[$nlst] =~ s/$[\w\|\,]+$//;
1260	$gstring .= "global ".$var_name[$nlst].";\n";
1261	$var_args[$nlst] = $var_list[$nlst];
1262	$var_args[$nlst] =~ s/\w+$(.+)$/$1/;
1263	$init_list =~ s/^(\w+$.+?$)/$2/;
1264	$init_list =~ s/^\,//;
1265	}
1266	elsif ( $init_list =~ m/^(\w+)\,?/ ) { # Scalar.
1267	# Is this ever really going to get here?
1268	$var_list[$nlst] = $1;
1269	$var_list_id[$nlst] = "scalar";
1270	$init_list =~ s/^(\w+)(\,)?/$2/;
1271	}
1272	else { # Probably another implied do loop.
1273	die "do_data(): WARNING, $init_list has unusual list.";
1274	} # endif
1275	$init_list =~ s/^\,//;
1276	$nlst++;
1277
1278	} # end while
1279
1280	# Now deconvolve. Here we will for now assume no more than three
1281	# array indices are used.
1282	if ( 3 < $ndx ) { print "ed_data(): WARNING, $ndx indices, more than 3 ...\n"; }
1283	$outline = "";
1284	for ( $i0=$do_init[0];$i0<=$do_lim[0];$i0 += $do_inc[0] ) {
1285	if ( 1 == $ndx ) {
1286	$outline .= idl_index_match($nlst,\@do_var,$i0,-1,-1,
1287	\@var_list_id,\@var_list,\@var_name);
1288	}
1289	else {
1290	for ( $i1=$do_init[1];$i1<=$do_lim[1];$i1 += $do_inc[1] ) {
1291	if ( 2 == $ndx ) {
1292	$outline .= idl_index_match($nlst,\@do_var,$i0,$i1,-1,
1293	\@var_list_id,\@var_list,\@var_name);
1294	}
1295	else {
1296	for ( $i2=$do_init[2];$i2<=$do_lim[2];$i2 += $do_inc[2] ) {
1297	$outline .= idl_index_match($nlst,\@do_var,$i0,$i1,$i2,
1298	\@var_list_id,\@var_list,\@var_name);
1299	} # end for on i2
1300	} # endif
1301	} # end for on i1
1302	} # endif
1303	} # end for on i0
1304
1305	# Tidy it up.
1306	$outline =~ s/\\|$//;
1307
1308	}
1309	else { # Not an implied do loop.
1310	print "expand_implied_do_loop(): WARNING, $input_line is not an implied do loop.\n";
1311	} # endif
1312
1313	return $outline;
1314	} # end of expand_implied_do_loop
1315
1316
1317	#++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
1318	# 06.15.98csc: Lots of globals, used to match indices in an
1319	# implied do loop. Passed referenced arrays.
1320	sub idl_index_match {
1321
1322	my(@input_line) = @_;
1323	my($avar_list_id,$avar_list,$avar_name,$do_var_str); # Pointers.
1324	my($do_val0,$do_val1,$do_val2);
1325	my($idx,$ilst,$nindices,$nlst,$one_cell);
1326	my($outline) = "";
1327
1328	# Begin.
1329
1330	($nlst,$do_var_str,$do_val0,$do_val1,$do_val2,$avar_list_id,$avar_list,$avar_name) = @input_line;
1331
1332	# Determine number of indices.
1333	if ( 0 > $do_val1 ) { $nindices = 1; }
1334	elsif ( 0 > $do_val2 ) { $nindices = 2; }
1335	else { $nindices = 3; }
1336
1337	# Loop over the implied do loop variables list.
1338	for ( $ilst=0;$ilst<$nlst;$ilst++ ) {
1339	if ( $avar_list_id->[$ilst] eq "array" ) { # Tricky ...
1340	$one_cell = $avar_list->[$ilst];
1341	$one_cell =~ s/^\w+$(.+)$/$1/; # Get args.
1342	# Loop over the indices and replace.
1343	for ( $idx=0;$idx<$nindices;$idx++ ) {
1344
1345	if ( $one_cell =~ m/[$\|\,]?($do_var_str->[$idx])[$\|\,]?/ ) {
1346	if ( 0 == $idx ) { $do_var_val = $do_val0; }
1347	elsif ( 1 == $idx ) { $do_var_val = $do_val1; }
1348	else { $do_var_val = $do_val2; }
1349	$one_cell =~ s/$do_var_str->[$idx]/$do_var_val/;
1350	if ( 0 == $idx ) { $one_cell = $avar_name->[$ilst]."(".$one_cell.")"; }
1351	} # endif
1352
1353	} # end for on idx
1354
1355	$outline .= $one_cell."\|";
1356	} # endif
1357	} # end for on ilst
1358
1359	return $outline;
1360	} # end of idl_index_match
1361
1362
1363	#++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
1364	# 05.29.98csc: Translate F77 builtin functions.
1365	sub f77_functions {
1366
1367	my($input_line) = @_;
1368	my($outline) = "f77_functions(): ERROR in f77toM\n";
1369	my(@botarray,@div_array,@toparray);
1370	my($arg1,$arg2,$arr1,$arr2,$bot,$dividend,$divisor,$divline,$divsubstr,$dummy);
1371	my($eql,$fixed,$lhs,$top);
1372	my($flag) = 1;
1373	my($flag1,$flag2,$ibot,$idiv,$iop,$ip,$itop);
1374
1375	# Begin.
1376	$divsubstr = "BOB";
1377	$zorro = "0";
1378
1379	# A bit of massage.
1380	$input_line =~ s/\n//g;
1381	$input_line =~ s/\s+//g;
1382	if ( $input_line =~ m/^(.+?[^=\|^>\|^<\|^\~])\={1}([^=\|^>\|^<\|^\~].+?)$/ ) {
1383	$tmp1 = $1;
1384	$tmp2 = $2;
1385	# Note that spaces flanking = are inserted here ...
1386	$input_line = $tmp1." = ".$tmp2;
1387	} # endif
1388
1389	# Down to business.
1390	$input_line =~ s/d?sqrt($.+$)/sqrt$1/g;
1391	$input_line =~ s/d?abs($.+$)/abs$1/g;
1392	$input_line =~ s/nint($.+$)/round$1/g;
1393	$input_line =~ s/int($.+$)/floor$1/g;
1394	# Compulsiveness.
1395	$input_line =~ s/(\d+\.)$/$1$zorro/g;
1396	$input_line =~ s/(\d+\.)([^\d])/$1$zorro$2/g;
1397	$input_line =~ s/\\/\^/g;
1398	# sign is the same.
1399
1400	if ( $input_line =~ m/\// ) { # Integer division(s)?
1401
1402	# TEST
1403	@div_array = split('/',$input_line);
1404	for ( $idiv=0;$idiv<=$#div_array;$idiv += 2 ) {
1405
1406	$dividend = $div_array[ $idiv ];
1407	$dividend =~ s/^\S+\s\=\s//;
1408	$dividend =~ s/^$(.+)$$/$1/;
1409	$flag1 = 0;
1410	$divisor = $div_array[ $idiv + 1 ];
1411	$divisor =~ s/^$(.+)$$/$1/;
1412	$flag2 = 0;
1413	$_ = $dividend;
1414
1415	DSWITCH: {
1416	if (/\.+/ \|\| /^[a-lo-z][\w\|\_][$.?$]*$/) { last DSWITCH; }
1417	if (/^[\+\|\-]\d+$/ \|\| /^[i-n][\w\|\_][$.?$]$/) { $flag1 = 1; last DSWITCH; }
1418	if (/[\+\|\-\|\*]/ \|\| /^[\w\|\_]+\(/) { $flag1 = 2; last DSWITCH; }
1419	if (/\S+/) { $flag1 = 3; last DSWITCH; }
1420	} # end of DSWITCH
1421
1422	$_ = $divisor;
1423	SWITCHD: {
1424	if (/\.+/ \|\| /^[a-lo-z][\w\|\_]*$/) { last SWITCHD; }
1425	if (/^[\+\|\-]\d+$/ \|\| /^[i-n][\w\|\_]$/) { $flag2 = 1; last SWITCHD; }
1426	if (/[\+\|\-\|\*]/ \|\| /^[\w\|\_]+\(/) { $flag2 = 2; last SWITCHD; }
1427	if (/\S+/) { $flag2 = 3; last SWITCHD; }
1428	} # end of DSWITCH
1429
1430	if ( !$flag1 \|\| !$flag2 ) { # Skip this.
1431	}
1432	elsif ( 1 == $flag1 && 1 == $flag2 ) { # Integers fo sure.
1433	$div_array[ $idiv ] = "fix(".$dividend;
1434	$div_array[ $idiv + 1 ] = $divisor.")";
1435	$idiv += 2;
1436	}
1437	elsif ( 1 == $flag1 ) {
1438	if ( 2 == $flag2 ) {
1439	@op_array = split('[\+\|\-\|\*]',$divisor);
1440	for ( $iop=0;$iop<=$#op_array;$iop++ ) { # Test.
1441	if ( !($op_array[$iop] =~ m/^\d+$/) &&
1442	!($op_array[$iop] =~ m/^[i-n][\w\|\_]*$/) ) {
1443	$flag1 = $flag2 = 0;
1444	$iop = $#op_array+1;
1445	} # endif
1446	} # end for on iop
1447	if ( $flag1 && $flag2 ) {
1448	$div_array[ $idiv ] = "fix(".$dividend;
1449	$div_array[ $idiv + 1 ] = $divisor.")";
1450	} # endif
1451	}
1452	else {
1453	print " f77_functions(): Case not handled; $flag1 $flag2: $dividend\|$divisor\n";
1454	} # endif
1455	}
1456	elsif ( 1 == $flag2 ) {
1457	if ( 2 == $flag1 ) {
1458	@op_array = split('[\+\|\-\|\*]',$dividend);
1459	for ( $iop=0;$iop<=$#op_array;$iop++ ) { # Test.
1460	if ( !($op_array[$iop] =~ m/^\d+$/) &&
1461	!($op_array[$iop] =~ m/^[i-n][\w\|\_]*$/) ) {
1462	$flag1 = $flag2 = 0;
1463	$iop = $#op_array+1;
1464	} # endif
1465	} # end for on iop
1466	if ( $flag1 && $flag2 ) {
1467	$div_array[ $idiv ] = "fix(".$dividend;
1468	$div_array[ $idiv + 1 ] = $divisor.")";
1469	} # endif
1470	}
1471	else {
1472	print " f77_functions(): Case not handled; $flag1 $flag2: $dividend\|$divisor\n";
1473	} # endif
1474	}
1475	elsif ( 2 == $flag1 ) {
1476	if ( 2 == $flag2 ) {
1477	@op_array = split('[\+\|\-\|\*]',$dividend);
1478	for ( $iop=0;$iop<=$#op_array;$iop++ ) { # Test.
1479	if ( !($op_array[$iop] =~ m/^\d+$/) &&
1480	!($op_array[$iop] =~ m/^[i-n][\w\|\_]*$/) ) {
1481	$flag1 = $flag2 = 0;
1482	$iop = $#op_array+1;
1483	} # endif
1484	} # end for on iop
1485	@op_array = split('[\+\|\-\|\*]',$divisor);
1486	for ( $iop=0;$iop<=$#op_array;$iop++ ) { # Test.
1487	if ( !($op_array[$iop] =~ m/^\d+$/) &&
1488	!($op_array[$iop] =~ m/^[i-n][\w\|\_]*$/) ) {
1489	$flag1 = $flag2 = 0;
1490	$iop = $#op_array+1;
1491	} # endif
1492	} # end for on iop
1493	if ( $flag1 && $flag2 ) {
1494	$div_array[ $idiv ] = "fix(".$dividend;
1495	$div_array[ $idiv + 1 ] = $divisor.")";
1496	} # endif
1497	}
1498	else {
1499	$dividend =~ m/^(.)\((.)$/; $arr1 = $1; $arg1 = $2;
1500	$divisor =~ /^(.)\)(.)$/; $arr2 = $2; $arg2 = $1;
1501	$dummy = " dummy = ".$arg1."/".$arg2;
1502	# Recursion alert!
1503	$dummy = f77_functions( $dummy );
1504	@dummy_array = split(' ',$dummy);
1505	@dumber = split('/',$dummy_array[2]);
1506	@dummy_array = split(' ',$div_array[ $idiv ]);
1507	$div_array[ $idiv ] = $dummy_array[0]." ".$dummy_array[1]." ".$arr1."(".$dumber[0];
1508	$div_array[ $idiv + 1 ] = $dumber[1].")".$arr2;
1509	} # endif
1510	}
1511	elsif ( 3 == $flag1 && 3 == $flag2 ) {
1512	print " f77_functions(): Case not handled; $flag1 $flag2: $dividend\|$divisor\n";
1513	}
1514	else {
1515	print " f77_functions(): Case not possible?; $flag1 $flag2: $dividend\|$divisor\n";
1516	} # endif
1517
1518	} # end for on idiv
1519	$input_line = join('/',@div_array);
1520	# print "TEST after: $input_line\n";
1521
1522	} # endif
1523
1524	$outline = $input_line;
1525
1526	return $outline;
1527	} # end of f77_functions
1528
1529
1530	#++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
1531	# 05.28.98csc: Handle assignment statements, w/F77 functions.
1532	# 07.16.98csc: Ah, need to handle subleties. Like integer
1533	# division ...
1534	sub ed_assignment {
1535
1536	my($f77_line) = @_;
1537	my($outline) = "ed_assignment(): ERROR in f77toM\n";
1538
1539	# Begin.
1540	$outline = "";
1541	$outline .= "% Edit of assignment: >".$f77_line;
1542	$f77_line =~ s/\n//;
1543
1544	# Are there any F77 functions here? We may need to restate in
1545	# Matlab-ese.
1546	$f77_line = f77_functions( $f77_line );
1547	$f77_line .= ";\n";
1548	$outline .= $f77_line;
1549
1550	return $outline;
1551	} # end of ed_assignment
1552
1553
1554	#++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
1555	# 05.19.98csc: From INTEGER to a simple Matlab variable.
1556	sub ed_integer {
1557
1558	my($f77_line) = @_;
1559	my(@f77dims);
1560	my($outline) = "ed_dimension(): ERROR in f77toM\n";
1561
1562	# Begin.
1563
1564	# A redefinition ...
1565	$f77_line =~ s/\n//g;
1566	$f77_line =~ s/^\s+integer //;
1567
1568	# Named common blocks are not AFAIK used in Matlab.
1569	$f77_line =~ s/\/\S+\///;
1570	$f77_line =~ s/\s+//g;
1571
1572	$f77_line = do_declare( $f77_line );
1573
1574	# In theory we are now done.
1575	$outline = $f77_line;
1576
1577	return "$outline\n";
1578	} # end of ed_integer
1579
1580
1581	#++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
1582	# 05.19.98csc: From REAL to a simple Matlab variable.
1583	sub ed_real {
1584
1585	my($f77_line) = @_;
1586	my(@f77dims);
1587	my($outline) = "ed_dimension(): ERROR in f77toM\n";
1588
1589	# Begin.
1590
1591	# A redefinition ...
1592	$f77_line =~ s/\n//g;
1593	$f77_line =~ s/^\s+real(\*8)? //;
1594
1595	# Named common blocks are not AFAIK used in Matlab.
1596	$f77_line =~ s/\/\S+\///;
1597	$f77_line =~ s/\s+//g;
1598
1599	$f77_line = do_declare( $f77_line );
1600
1601	# In theory we are now done.
1602	$outline = $f77_line;
1603
1604	return "$outline\n";
1605	} # end of ed_real
1606
1607
1608	#++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
1609	# 05.19.98csc: From DIMENSION to just declarations.
1610	sub ed_dimension {
1611
1612	my($f77_line) = @_;
1613	my(@f77dims);
1614	my($outline) = "ed_dimension(): ERROR in f77toM\n";
1615
1616	# Begin.
1617
1618	# A redefinition ...
1619	$f77_line =~ s/\n//g;
1620	$f77_line =~ s/^\s+dimension//;
1621
1622	# Named common blocks are not AFAIK used in Matlab.
1623	$f77_line =~ s/\/\S+\///;
1624	$f77_line =~ s/\s+//g;
1625	$f77_line = do_declare( $f77_line );
1626
1627	# In theory we are now done.
1628	$outline = $f77_line;
1629
1630	return "$outline\n";
1631	} # end of ed_dimension
1632
1633
1634	#++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
1635	# 05.19.98csc: Turns a drab Fortran construct into a tasty new
1636	# Matlab dish! That is, it turns lists into "declarations."
1637	sub do_declare {
1638
1639	my($input_line) = @_;
1640	my(@arrs);
1641	my($arrays,$iarr,$outline);
1642
1643	# Begin.
1644
1645	# One per line, despite what Matlab says.
1646	$input_line .= "\;\n";
1647
1648	# Separate out the arrays.
1649	$input_line = "global ".$input_line;
1650	$input_line =~ s/\)\,(\w+)/\);\nglobal $1/g;
1651	$input_line =~ s/(\w+)\,(\w+\()/$1;\nglobal $2/g;
1652	$arrays = $input_line;
1653	# Destroy non-arrays.
1654	$arrays =~ s/(\n?global (\w+\,?)+;\n)//g;
1655	$arrays =~ s/;\n/\\|/g;
1656	$arrays =~ s/global //g;
1657	$arrays =~ s/;//g;
1658
1659	# Convert any/all arrays.
1660	@arrs = split('\\|',$arrays);
1661	for ( $iarr=0;$iarr<=$#arrs;$iarr++ ) {
1662	$arrs[$iarr] = declare_array( $arrs[$iarr] );
1663	$input_line .= $arrs[$iarr];
1664	} # end for on iarr
1665
1666	# Destroy array bounds in globals.
1667	$input_line =~ s/(global \w+)$.+$(;\n)/$1$2/g;
1668
1669	# Each must be on its own line.
1670	$input_line =~ s/(^\|\n)global (\w+)\,(\w+)/$1global $2\;\nglobal $3/g;
1671	$input_line =~ s/(^\|\n)global (\w+)\,(\w+)/$1global $2\;\nglobal $3/g;
1672	$input_line =~ s/(^\|\n)global (\w+)\,(\w+)/$1global $2\;\nglobal $3/g;
1673	$input_line =~ s/(^\|\n)global (\w+)\,(\w+)/$1global $2\;\nglobal $3/g;
1674
1675	$outline = "$input_line\n";
1676	return $outline;
1677
1678	} # end of do_declare
1679
1680
1681	#++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
1682	# 05.19.98csc: In Matlab this is just a global assignment, eh?
1683	sub ed_data{
1684
1685	my($f77_line) = @_;
1686	my(@f77data,@values,@vars);
1687	my($outline) = "ed_data(): ERROR in f77toM\n";
1688	my($data,$idat,$implied_do_flag,$value);
1689	my($gstring) = "\n";
1690
1691	# Begin.
1692	$f77_line =~ s/\n//g;
1693
1694	# For general interest ...
1695	$outline = "\n% Original DATA statement: ".$f77_line."\n";
1696
1697	$f77_line =~ s/\s+//g;
1698	$f77_line =~ s/data//;
1699	$f77_line =~ s/\)$//;
1700
1701	# Write each out as an assignment/global line pair.
1702	@f77data = split('\/',$f77_line);
1703
1704	# 06.12.98csc: New approach to nested implied do loops. Will
1705	# be a subroutine eventually, to expand on the indices.
1706	if ( $f77data[0] =~ m/^$(.+\=+.+)$/ ) {
1707	$f77data[0] = expand_implied_do_loop( $f77data[0] );
1708	$implied_doflag = 1;
1709	}
1710	else { # Regular stuff.
1711	$f77data[0] =~ s/\,/\\|/g;
1712	$implied_doflag = 0;
1713	} # endif
1714
1715	@vars = split('\\|',$f77data[0]);
1716	@values = split(',',$f77data[1]);
1717	if ( $implied_doflag ) { $data = ""; $outline .= $gstring; }
1718	for ( $idat=0;$idat<=$#vars;$idat++ ) {
1719	if ( !($implied_doflag) ) { $data = "global ".$vars[$idat].";\n"; }
1720	$value = $vars[$idat]." = ".$values[$idat].";\n";
1721	$outline .= $data.$value;
1722	} # endfor
1723
1724	return "$outline\n";
1725	} # end of ed_data
1726
1727
1728	#++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
1729	# 05.18.98csc: Truly the incantation of the doomed.
1730	sub ed_goto {
1731
1732	my($f77_line) = @_;
1733	my($outline) = "ed_goto(): ERROR in f77toM\n";
1734
1735	# Begin.
1736	$f77_line =~ s/\n//;
1737	$outline = "disp(\'DANGER: GOTO ALERT >".$f77_line."');\n";
1738
1739	return $outline;
1740	} # end of ed_goto
1741
1742
1743	#++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
1744	# 05.18.98csc: Subroutine call becomes an M-file ...
1745	# 05.28.98csc: This probably means we need to do "global" here.
1746	# 07.10.98csc: Um, need to actually execute the subprogram as
1747	# well ...
1748	sub ed_call {
1749
1750	my($f77_line) = @_;
1751	my($outline) = "ed_call(): ERROR in f77toM\n";
1752	my($argeth,$subprogram);
1753
1754	# Begin.
1755	$f77_line =~ s/\n//;
1756	$f77_line =~ s/\s+//g;
1757	$f77_line =~ s/^call//;
1758
1759	$subprogram = $f77_line;
1760	if ( $f77_line =~ m/(\w+)$(.+)$/ ) { # An argument list!
1761	# $f77_line = " global ".$1;
1762	$nom = $1;
1763	$argeth = $2;
1764	@argarray = split(',',$argeth);
1765	for ( $iarg=0;$iarg<=$#argarray;$iarg++ ) {
1766	if ( !($argarray[$iarg] =~ m/[a-z]+/) ) {
1767	$argarray[$iarg] = "dummy".$nom.$iarg;
1768	} # endif
1769	} # end for on iarg
1770	$argeth = join(',',@argarray);
1771	}
1772	else {
1773	# $f77_line = " global ".$f77_line;
1774	$argeth = "dummy_arg";
1775	} # endif
1776	# $f77_line .= ";\n";
1777	$f77_line = "";
1778
1779	# Now we actually execute ...
1780	$f77_line .= " [".$argeth."] = ".$subprogram.";\n";
1781
1782	$outline = $f77_line;
1783
1784	return $outline;
1785	} # end of ed_call
1786
1787
1788	#++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
1789	# 05.15.98csc: In Matlab this is just a global assignment, eh?
1790	sub ed_parameter {
1791
1792	my($f77_line) = @_;
1793	my(@dummy,@f77params,$ipar);
1794	my($outline) = "ed_parameter(): ERROR in f77toM\n";
1795	my($param);
1796
1797	# Begin.
1798	$f77_line =~ s/\s+//g;
1799	$f77_line =~ s/parameter//;
1800	$f77_line =~ s/^\(//;
1801	$f77_line =~ s/\)$//;
1802
1803	# Write each out as an assignment/global line pair.
1804	@f77params = split(',',$f77_line);
1805	$outline = "";
1806	for ( $ipar=0;$ipar<=$#f77params;$ipar++ ) {
1807
1808	$f77params[$ipar] .= ";\n";
1809	($param,@dummy) = split('=',$f77params[$ipar]);
1810	$param = "global ".$param.";\n";
1811	$outline .= $param.$f77params[$ipar];
1812
1813	} # endfor
1814
1815	return "$outline\n";
1816	} # end of ed_parameter
1817
1818
1819	#++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
1820	# 05.11.98csc: Note we assume no gotos ...
1821	# 05.29.98csc: Should match all these labels to do loops, etc.
1822	sub ed_continue {
1823
1824	my($f77_line) = @_;
1825	my($f77continue,$f77label);
1826	my($nlbl);
1827	my($outline) = "ed_continue(): ERROR in f77toM\n";
1828
1829	# Begin.
1830
1831	# Is there a label?
1832	$f77_line =~ s/\s+/ /g;
1833	# Note that "<label> continue" is entirely replaced here.
1834	if ( $f77_line =~ m/\d+/ ) {
1835
1836	($f77label,$f77continue) = split(' ',$f77_line);
1837	$f77continue = $label_list{ $f77label };
1838	# This ought to be the original scanned label ...
1839	if ( !($f77continue =~ m/continue/) ) { die "ed_continue(): ERROR - This >$f77continue< should have an F77 continue"; }
1840	$outline = "% Original continue: >".$f77_line."\n";
1841
1842	# Only if this matches a do loop do we append an "end" here.
1843	for ( $nlbl=0;$nlbl<$do_num;$nlbl++ ) {
1844	if ( $f77label == $do_vals[$nlbl] ) {
1845	$outline .= "% Matches:".$do_list{$do_vals[$nlbl]}."\n end;\n";
1846	} # endif
1847	} # end for
1848
1849	}
1850	else { # A random continue line, God knows why.
1851	$outline = "% $f77_line\n"
1852	} # endif
1853
1854	return $outline;
1855	} # end of ed_continue
1856
1857
1858	#++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
1859	# 05.11.98csc: Turn do into for.
1860	# 07.15.98csc: Note that $array_list{ $arrayname } would be handy
1861	# for doing comparisons to ensure loop is OK.
1862	sub ed_doloop {
1863
1864	my($f77_line) = @_;
1865	my(@f77_array);
1866	my($f77_orig,$f77continue,$f77label);
1867	my($warning) = "";
1868	my($increment);
1869	my($outline) = "ed_doloop(): ERROR in f77toM\n";
1870
1871	# Begin.
1872	$f77_orig = $f77_line;
1873	$f77_line =~ s/\s+/ /g;
1874	@f77_array = split(' ',$f77_line);
1875	$f77label = $f77_array[1];
1876	$f77continue = $label_list{ $f77label };
1877	if ( !($f77continue =~ m/continue/) ) { die "ed_doloop(): ERROR - This >$f77continue< should be an F77 continue"; }
1878
1879	# Now that we have a do loop, edit to suit.
1880	splice(@f77_array,0,2," for");
1881	$outline = join(' ',@f77_array);
1882	$outline =~ s/\,/\:/;
1883
1884	# Now look for (in\|de)crement not unity.
1885	if ( $outline =~ m/\,(\d+)/ ) {
1886	$increment = $1;
1887	$outline =~ s/\,\d+//;
1888	$outline =~ s/:/:$increment:/;
1889	} # endif
1890	$outline =~ m/\w+\=(\w+)\:/;
1891	if ( !($1 =~ m/\w+/) \|\| $1 < 1 ) {
1892	$warning = "% ed_doloop(): WARNING, initial loop variable may be too small = $1\n";
1893	} # endif
1894
1895	# Put a header string on it.
1896	$f77_orig =~ s/^/\% F77 loop was: \>/;
1897	$outline = $f77_orig.$outline."\n";
1898
1899	return $outline;
1900	} # end of ed_doloop
1901
1902
1903	#++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
1904	# 05.07.98csc: The I in I/O.
1905	# 05.18.98csc: Tackle this in full much later.
1906	# 06.24.98csc: That appears to be now. Note the many convergences
1907	# with ed_write, of course ...
1908	# 07.08.98csc: Looks like we will need to rely on external file
1909	# open and close.
1910	# 07.16.98csc: Modified to handle list-directed input. Sort of.
1911	sub ed_read {
1912
1913	my($f77_line) = @_;
1914	my($outline) = "";
1915	my($verify_line) = "";
1916	my(@iflines) = ("","","");
1917	my($do_flag) = 0;
1918	my($implied_do) = "";
1919	my(@arglist) = "";
1920	my(@fmt_matlab) = "";
1921	my(@fmt_matvar) = "";
1922	my(@listidl) = "";
1923	my(@make_loops) = "";
1924	my(@mloop) = "";
1925	my(@array_parenclose,@array_parenopen);
1926	my(@f77_array,@fmt_array,@fmtpar,@fmtstr);
1927	my(@idl_inc,@idl_init,@idl_lim,@idl_ndx);
1928	my(@var_array,@var_type);
1929	my($Mfid);
1930	my($argnum,$arr_var,$dummy,$eqflag,$f77fid,$f77fmt,$f77label,$f77vars);
1931	my($fmt_edited);
1932	my($idl_var,$idum,$ifmt,$ilups,$imat,$inum,$ivar);
1933	my($jidl,$jmat,$jpar,$lim,$listnum);
1934	my($n_indices,$nargs,$nchars,$nlines,$npar,$nidl,$nstr);
1935	my($parencount,$pflag,$readfilename,$space_str,$wr_string);
1936
1937	# Begin.
1938
1939	# Is this a * format or not?
1940	# Could be a string, could be a string variable, could be *, could be
1941	# a label pointing to a format statement.
1942	if ( $f77_line =~ m/^\s+print\s+[\"\|\']$(.+?)$[\"\|\']\s*\,(.+)$/ ) {
1943	$f77fmt = $1;
1944	$f77vars = $2;
1945	$f77fid = "5";
1946	$Mfid = 1; # Matlab screen output.
1947	}
1948	elsif ( $f77_line =~ m/^\s+print\s+(\w+)\s*\,(.+)$/ ) {
1949	# Darned if I know what to do here!
1950	$warning = "ed_read(): WARNING, this read formatting not supported\n $f77_line Please rewrite with the character variable ".$1." expanded.\n\n";
1951	print $warning;
1952	$outline = "% ".$warning.$2."\n";
1953	return $outline;
1954	}
1955	elsif ( $f77_line =~ m/^\s+read\s+\\s\,(.+)$/ ) {
1956	$f77fmt = "";
1957	$f77vars = $1;
1958	$f77fid = "5";
1959	$Mfid = 1; # Matlab screen output.
1960	}
1961	else { # Must be serious formatting.
1962
1963	$f77_line =~ s/read\s+\(/read\(/;
1964	@f77_array = split(' ',$f77_line);
1965
1966	# Divide and conquer.
1967	$rd_string = shift( @f77_array );
1968
1969	# Get the file ID and format label.
1970	$rd_string =~ s/read\(//;
1971	$rd_string =~ s/\)//;
1972	($f77fid,$f77label) = split(',',$rd_string);
1973
1974	if ( 5 == $f77fid ) { # From the screen.
1975	$Mfid = 1; # Matlab screen output.
1976	}
1977	else { # To a file.
1978	$Mfid = "fid".$f77fid;
1979	$readfilename = $fid_index{ $f77fid };
1980	} # endif
1981
1982	# What if the fid is a variable name?
1983	# TEST
1984	if ( $f77fid =~ m/[^\d]/ ) {
1985	$verify_line =
1986	" clear dummy;\n if (5==".$f77fid."\|6==".$f77fid.")\n ".$Mfid." = 1;\n else\n ".$Mfid." = ".$f77fid.";\n end;\n";
1987	# In this case will do input.
1988	$iflines[0] = " if (5==".$f77fid."\|6==".$f77fid.")\n";
1989	$iflines[1] = " else\n";
1990	$iflines[2] = " end;\n";
1991	} # endif
1992
1993	# This had bloody well better be a format. Note it is global.
1994	if ( $f77label ne "*" ) {
1995	$f77fmt = $label_list{ $f77label };
1996	if ( !($f77fmt =~ m/format/) ) { die "ed_read(): ERROR - This >$f77fmt< should have an F77 format"; }
1997	$f77fmt =~ s/\s+$//;
1998	}
1999	else { $f77fmt = ""; }
2000
2001	# The rest is variables.
2002	$f77vars = join(' ',@f77_array);
2003	$f77vars =~ s/\s+//g;
2004
2005	} # endif
2006
2007	# Extract strings from the format and tag them.
2008	$fmt_edited = $f77fmt;
2009	$nstr = 0;
2010	while ( $fmt_edited =~ m/\'(.*?)\'/ ) {
2011	$fmtstr[ $nstr ] = $1;
2012	# Need to escape as needed by Matlab.
2013	$fmtstr[ $nstr ] =~ s/(\\)/$1$1/g;
2014	$fmtstr[ $nstr ] =~ s/(%)/$1$1/g;
2015	$fmt_edited =~ s/(\'.*?\')(\')?/X$nstr$2/;
2016	if ( $2 ) { $fmt_edited =~ s/(X$nstr)($2)/$1\,$2/; }
2017	$nstr++;
2018	} # end while
2019
2020	# Extract and label paren'd format bits.
2021	$npar = 0;
2022	$fmt_edited =~ s/format$(.+)$$/$1/; # Extract formats only.
2023	while ( $fmt_edited =~ m/$(.+?)$/ ) {
2024	$fmtpar[ $npar ] = $1;
2025	$fmt_edited =~ s/($.+?$)/Y$npar/;
2026	$npar++;
2027	} # end while
2028
2029	# Replace label with expanded format.
2030	for ( $jpar=0;$jpar<$npar;$jpar++ ) {
2031	$dummy = "";
2032	$fmt_edited =~ m/(\d+)?Y$jpar/;
2033	if ( !$1 ) { $lim = 1; }
2034	else { $lim = $1; }
2035	for ( $idum=0;$idum<$lim;$idum++ ) { $dummy .= $fmtpar[$jpar].","; }
2036	chop $dummy;
2037	$fmt_edited =~ s/(\d+)?Y$jpar/$dummy/;
2038	} # end for
2039
2040	# Now tidy up and tag a few remaining things ...
2041	$fmt_edited =~ s/\s+//g;
2042	$fmt_edited =~ s/\//N/g;
2043	$fmt_edited =~ s/N([^\,\|^\)])/N\,$1/g;
2044	$fmt_edited =~ s/N([^\,\|^\)])/N\,$1/g;
2045	$fmt_edited =~ s/([^\,\|^\(])N/$1\,N/g;
2046	$fmt_edited =~ s/([^\,\|^\(])N/$1\,N/g;
2047
2048	# Place each output line in an array element and process.
2049	@fmt_array = split(',',$fmt_edited);
2050	$imat = 0;
2051	$fmt_matlab[ $imat ] = $space_str = "";
2052	$nchars = 0; # Absolute chars.
2053	# Really ought not to happen.
2054	if ( !$f77vars && !f77fmt ) {
2055	die ("ed_read(): ERROR, must have vars with * format here");
2056	}
2057	elsif ( $f77vars ) {
2058	# elsif ( $f77vars && !f77fmt ) {
2059	@var_array = split(',',$f77vars);
2060	for ( $ivar=0;$ivar<=$#var_array;$ivar++ ) {
2061	# Assumes the F77 convention, and no chars at all. Poor policy.
2062	if ( $var_array[$ivar] =~ m/^[a-ho-z]{1}/ ) { $var_type[$ivar] = "real"; }
2063	elsif ( $var_array[$ivar] =~ m/^[i-n]{1}/ ) { $var_type[$ivar] = "int"; }
2064	else { $var_type[$ivar] = "error"; }
2065	} # end for on ivar
2066	}
2067	else {
2068	$var_type[0] = "";
2069	} # endif
2070
2071	# What if we have a * format? Mock up a real format and feed to
2072	# the monster below.
2073	if ( !$f77fmt ) {
2074	for ( $ivar=0;$ivar<=$#var_array;$ivar++ ) {
2075	$vsize = length( $var_array[$ivar] );
2076	$fmt_array[$ivar] = "g".$vsize;
2077	} # end for on ivar
2078	} # endif
2079
2080	for ( $ifmt=0;$ifmt<=$#fmt_array;$ifmt++ ) {
2081
2082	($space_str,$nchars,$imat,\@fmt_matlab,\@fmt_matvar) =
2083	parse_read_fmt($space_str,$nchars,$ifmt,$imat,\@fmt_array,\@fmt_matlab,\@fmt_matvar,\@fmtstr,\@var_type);
2084
2085	} # end for on ifmt
2086	# Need a \n at end.
2087	$fmt_matlab[$imat] .= "\\n";
2088
2089	####################################################################
2090	# Based on the nature of the input variable string, we will make up
2091	# an fscanf for matlab to use, one per line.
2092
2093	# Loop over each line in the output format.
2094	for ( $jmat=0;$jmat<=$imat;$jmat++ ) {
2095
2096	# When fscanf-ing from fid=1, well, we are just waiting for
2097	# user input from the screen ...
2098	if ( $Mfid eq "1" ) {
2099	$dummy = "input(\'>\',\'s\'"
2100	}
2101	else {
2102	$dummy = "fscanf(".$Mfid.",\'".$fmt_matlab[ $jmat ]."\'";
2103	} # endif
2104	if ( $fmt_matvar[ $jmat ] && $Mfid ne "1" ) {
2105	$dummy .= ",[".($#var_array+1).",1]);\n";
2106	}
2107	else { $dummy .= ");\n"; } # endif
2108	$outline .= $dummy;
2109
2110	} # end for on jmat
2111
2112	# Characterize the variables, if any. This involves moving along the
2113	# read line, parsing as we go, usually by parentheses and commas.
2114	if ( $f77vars ) { # We got 'em.
2115
2116	$nargs = 0;
2117	# How many?
2118	@var_array = split(',',$f77vars);
2119	for ( $ivar=0;$ivar<=$#var_array;$ivar++ ) {
2120
2121	if ( $var_array[$ivar] =~ m/^\(/ ) {
2122	# This means we have something special, and we need to paste it
2123	# back together again. Probably an implied do loop.
2124	$idl_var = "";
2125	$parencount = 0;
2126	$pflag = 1;
2127	$eqflag = 0;
2128	# Run to the end, gathering all between the parens.
2129	while ( $var_array[$ivar] =~ m/[$\|$]+/ \|\| $pflag ) {
2130	@array_parenopen = split('\(',$var_array[$ivar]);
2131	@array_parenclose = split('\)',$var_array[$ivar]);
2132	if ( $var_array[$ivar] =~ m/\)$/ ) { $#array_parenclose++; }
2133	$parencount += $#array_parenclose - $#array_parenopen;
2134	# print "$parencount += $#array_parenclose - $#array_parenopen\n";
2135	if ( 0 <= $parencount ) { $pflag = 0; }
2136	# Paste together ...
2137	if ( $var_array[$ivar] =~ m/\)$/ ) { # Not array args.
2138	$idl_var .= $var_array[$ivar]."\|";
2139	}
2140	elsif ( $eqflag \|\| $var_array[$ivar] =~ m/\=/ ) {
2141	$idl_var .= $var_array[$ivar]."\|";
2142	$eqflag = 1;
2143	}
2144	elsif ( !$eqflag && (-1 > $parencount) ) { # Non-robust ...
2145	$idl_var .= $var_array[$ivar].",";
2146	}
2147	else {
2148	$idl_var .= $var_array[$ivar]."\|";
2149	# print "HOW DID I GET HERE? -> $var_array[$ivar]\n";
2150	}
2151	if ( $ivar > $#var_array ) { die "ERROR: paren mismatch in $f77vars"; }
2152	$ivar++;
2153	} # endwhile
2154	$idl_var .= $var_array[$ivar];
2155	$idl_var =~ s/[\\|\|\,]$//;
2156	$arglist[ $nargs++ ] = $idl_var;
2157
2158	}
2159	elsif ( $var_array[$ivar] =~ m/^\w+$.+?$$/ ) { # Array/function.
2160	$arglist[ $nargs++ ] = $var_array[$ivar];
2161	}
2162	elsif ( $var_array[$ivar] =~ m/^\w+\(.+?$/ ) { # Ditto ...
2163	$arr_var = "";
2164	$parencount = 0;
2165	$pflag = 1;
2166	# Run to the end, gathering all between the parens.
2167	while ( $var_array[$ivar] =~ m/[$\|$]+/ \|\| $pflag ) {
2168	@array_parenopen = split('\(',$var_array[$ivar]);
2169	@array_parenclose = split('\)',$var_array[$ivar]);
2170	if ( $var_array[$ivar] =~ m/\)$/ ) { $#array_parenclose++; }
2171	$parencount += $#array_parenclose - $#array_parenopen;
2172	if ( 0 == $parencount ) { $pflag = 0; }
2173	$arr_var .= $var_array[$ivar];
2174	if ( $ivar > $#var_array ) { die "ERROR: paren mismatch in $f77vars"; }
2175	$ivar++;
2176	} # endwhile
2177	$arr_var .= $var_array[$ivar];
2178	$arglist[ $nargs++ ] = $arr_var[$ivar];
2179	}
2180	elsif ( $var_array[$ivar] =~ m/^\w+$/ ) { # Simple variable.
2181	$arglist[ $nargs++ ] = $var_array[$ivar];
2182	}
2183	elsif ( $var_array[$ivar] =~ m/[\*\|\+\|\-\|\/]/ ) { # Statement.
2184	$arglist[ $nargs++ ] = $var_array[$ivar];
2185	}
2186	else { # Dull stuff.
2187	$arglist[ $nargs++ ] = $var_array[$ivar];
2188	} # endif
2189
2190	} # end for on ivar
2191
2192	# At this stage the args are space-delimited, array indices are comma-
2193	# delimited, and implied do bits are pipe-delimited.
2194
2195	} # endif
2196
2197	# Now compare the arglist to the outline to see where the variables,
2198	# if any, need to go.
2199	$argnum = 0;
2200	$listnum = 0;
2201	while ( $outline =~ m/[X\|\'\|$]X[X\|(\,\')\|$]/ ) {
2202
2203	if ( $arglist[ $argnum ] =~ m/\\|/ ) { # Implied do land.
2204
2205	$nidl = 0;
2206	$arglist[ $argnum ] =~ s/^\(//;
2207	$arglist[ $argnum ] =~ s/\)$//;
2208	@listidl = split('\\|',$arglist[ $argnum ]);
2209	$n_indices = 0;
2210	for ( $jdl=0;$jdl<=$#listidl;$jdl++ ) {
2211
2212	if ( $listidl[$jdl] =~ m/(\w+)\=(\S+)/ ) { # An index variable.
2213
2214	$idl_ndx[$n_indices] = $1;
2215	$idl_init[$n_indices] = $2;
2216	$jdl++;
2217	$idl_lim[$n_indices] = $listidl[$jdl];
2218	if ( $listidl[$jdl+1] !=~ m/(\w+)\=(\S+)/ ) { # Increment.
2219	$idl_inc[$n_indices] = $listidl[$jdl+1];
2220	$jdl++;
2221	} # endif
2222	# Construct the necessary Matlab loop(s).
2223	$mloop[$n_indices] = " for ".$idl_ndx[$n_indices].
2224	" = ".$idl_init[$n_indices];
2225	if ( $idl_inc[$n_indices] ) { $mloop[$n_indices] .= ":".$idl_inc[$n_indices]; }
2226	$mloop[$n_indices] .= ":".$idl_lim[$n_indices]."\n";
2227	$n_indices++;
2228
2229	}
2230	else { # It had better be an output variable name ...
2231	$outline =~ s/([\'\|$]?)X{1}([(\,\')\|$]?)/$1\,$listidl[ $jdl ]$2/;
2232	$arglist[ $argnum ] = $listidl[ $jdl ];
2233	$nidl++;
2234	$argnum++;
2235	} # endif
2236
2237	} # end for on jdl
2238
2239	# Now insert the loop(s) into the string of commands.
2240	@make_loops = split(';\n',$outline);
2241	$outline = "";
2242	for ( $nlines=0;$nlines<=$#make_loops;$nlines++ ) {
2243	if ( $make_loops[$nlines] =~ m/$$idl_ndx[0]$/ ) {
2244	# Note that here we decrement as the IDL reads right-to-left.
2245	for ( $ilups=$n_indices-1;$ilups>=0;$ilups-- ) {
2246	if ( 0 < $nlines ) { $make_loops[$nlines-1] .= ";\n"; }
2247	$make_loops[$nlines] = $mloop[ $ilups ]." ".$make_loops[$nlines]
2248	;
2249	$make_loops[$nlines] .= ";\n end;\n";
2250	} # end for ilups
2251	} # endif
2252	$outline .= $make_loops[$nlines]."\n";
2253	} # end for on nlines
2254
2255	}
2256	else { # Reality.
2257	$outline =~ s/([\'\|$]?\,?)X{1}([(\,\')\|$]?)/$1$arglist[$argnum]$2/;
2258	$outline =~ s/\,(\,$arglist[$argnum])/$1/;
2259	# $outline =~ s/([\'\|$]?)X{1}([(\,\')\|$]?)/$1\,$arglist[ $argnum ]$2/;
2260	$argnum++;
2261	} # endif
2262
2263	# Limit here is arbitrary.
2264	if ( $argnum > 7 ) { die "ERROR: $argnum > 7"; }
2265
2266	} # endwhile
2267
2268	# Cut and paste.
2269	if ( !($Mfid =~ /\d+/) ) { # A variable named unit.
2270	$input_line = " dummy = input(\'>\',\'s\');\n";
2271	$input_line .= " dumber = dummy;\n";
2272	$input_line .= " clear dummy;\n";
2273	$input_line .= " dummy = sscanf(dumber,\'%g\');\n";
2274	$outline = $verify_line.$iflines[0].$input_line.$iflines[1].
2275	" dummy = ".$outline.$iflines[2];
2276	}
2277	else {
2278	$input_line = " dummy = sscanf(dumber,\'%g\');\n";
2279	$outline = $verify_line." dumber = ".$outline.$input_line;
2280	} # endif
2281
2282	for ( $ivar=0;$ivar<=$#arglist;$ivar++ ) {
2283	$outline .= " ".$arglist[$ivar]." = dummy(".($ivar+1).");\n";
2284	} # endfor on ivar
2285	$outline .= " clear dummy;\n";
2286
2287	return $outline;
2288	} # end of ed_read
2289
2290
2291	#++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
2292	# 05.07.98csc: The fortran include might be mapped to the running
2293	# of an appropriate M-file of the same name ...
2294	# 07.14.98csc: Vive la France! A more brute force approach,
2295	# where the contents of the include file are dumped to the
2296	# output. Ugly, but Matlab5.1 is less finicky this way.
2297	sub ed_include {
2298
2299	my($f77_line) = @_;
2300	my($outline) = "";
2301
2302	# Begin.
2303	# chop $f77_line;
2304	$f77_line =~ s/include//;
2305	$f77_line =~ s/\'//g;
2306	# New.
2307	$f77_line =~ s/\s+//g;
2308	$fname = $f77_line.".m";
2309	$outline = "\n% INCLUDE file name: ".$f77_line."; contents follow:\n";
2310	open( INCL, "<$fname" );
2311	while (<INCL>) { $outline .= $_; }
2312	close( INCL );
2313	$outline .= "% INCLUDE file name: ".$f77_line."; contents end.\n\n";
2314
2315	return $outline;
2316	} # end of ed_include
2317
2318
2319	#++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
2320	# 05.06.98csc: Very similar to ed_function, oddly enough.
2321	# 05.28.98csc: Note that it is possible to modify the value(s) of
2322	# the argument(s), so these need to be returned.
2323	sub ed_subroutine {
2324
2325	my($f77_line) = @_;
2326	my(@f77_array);
2327	my(@arglist);
2328	my($global_villagers) = "";
2329	my($outline) = "ed_subroutine(): ERROR in f77toM\n";
2330	# local($_);
2331
2332	# Begin.
2333	$f77_line =~ s/\n//;
2334	$f77_line =~ s/subroutine//;
2335	$f77_line =~ s/\s+//g;
2336
2337	if ( $f77_line =~ m/(\w+)$(.+)$/ ) { # An argument list!
2338
2339	$outline = "\[".$2."\] = ".$f77_line.";\n";
2340	$global_villagers = $2;
2341	$global_villagers =~ s/,/;\nglobal /g;
2342	$global_villagers = "global ".$global_villagers.";\n";
2343
2344	}
2345	else {
2346	$outline = "\[dummy\] = ".$f77_line.";\n";
2347	} # endif
2348
2349	$outline = " function ".$outline;
2350	# So that something is returned ...
2351	$outline .= $global_villagers;
2352
2353	return $outline;
2354	} # end of ed_subroutine
2355
2356
2357	#++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
2358	# 05.06.98csc: Better than the original, with save, etc.
2359	sub ed_stop {
2360
2361	my($f77_line) = @_;
2362	my($outline) = "ed_stop(): ERROR in f77toM\n";
2363
2364	# Begin.
2365
2366	# Note that "stop" is entirely replaced here.
2367	$outline = "save;\nquit;\n";
2368
2369	return $outline;
2370	} # end of ed_stop
2371
2372
2373	#++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
2374	# 05.06.98csc: Common goes to global, we hope ...
2375	sub ed_common {
2376
2377	my($f77_line) = @_;
2378	my($outline) = "ed_common(): ERROR in f77toM\n";
2379
2380	# Begin.
2381
2382	# A redefinition ...
2383	$f77_line =~ s/\n//g;
2384	$f77_line =~ s/^\s+common //;
2385
2386	# Named common blocks are not AFAIK used in Matlab.
2387	$f77_line =~ s/\/\S+\///;
2388	$f77_line =~ s/\s+//g;
2389
2390	$f77_line = do_declare( $f77_line );
2391
2392	# In theory we are now done.
2393	$outline = $f77_line;
2394	return $outline;
2395	} # end of ed_common
2396
2397
2398	#++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
2399	# 05.15.98csc: Turn f77 array declaration into Matlab. Up to
2400	# 2-D only.
2401	# 05.21.98csc: Needs a feature to only declare array once.
2402	# 05.27.98csc: Extend to 3-D.
2403	sub declare_array {
2404
2405	my($f77_line) = @_;
2406	my($outline) = "";
2407	my($arrayname);
2408	my($lbnd1,$lbnd2,$lbnd3,$ubnd1,$ubnd2,$ubnd3);
2409
2410	# Begin.
2411
2412	$outline .= "\% Original declaration as: $f77_line\n";
2413
2414	# Probably paranoid.
2415	$f77_line =~ s/\s+//g;
2416
2417	# Rescale any zero-index offsets.
2418	if ( $f77_line =~ m/(\w+)$(\w+):?(\w+)?,?(\w+)?:?(\w+)?,?(\w+)?:?(\w+)?$/ ) {
2419
2420	$arrayname = $1;
2421	if ( !($array_list{ $arrayname }) ) { # New array.
2422	$lbnd1 = $2; $ubnd1 = $3;
2423	$lbnd2 = $4; $ubnd2 = $5;
2424	$lbnd3 = $6; $ubnd3 = $7;
2425	if ( $ubnd1 eq "" ) { $ubnd1 = $lbnd1; $lbnd1 = 1; }
2426	if ( $lbnd2 ne "" && $ubnd2 eq "" ) { $ubnd2 = $lbnd2; $lbnd2 = 1; }
2427	if ( $lbnd3 ne "" && $ubnd3 eq "" ) { $ubnd3 = $lbnd3; $lbnd3 = 1; }
2428	$array_list{ $arrayname } = "$lbnd1..$ubnd1\|$lbnd2..$ubnd2\|$lbnd3..$ubnd3";
2429	$outline .= $arrayname." = zeros(".$ubnd1."-".$lbnd1."+1";
2430	if ( $lbnd3 ne "" ) {
2431	$outline .= ",".$ubnd2."-".$lbnd2."+1".",".$ubnd3."-".$lbnd3."+1".");";
2432	}
2433	elsif ( $lbnd2 ne "" && $lbnd3 eq "" ) {
2434	$outline .= ",".$ubnd2."-".$lbnd2."+1".");";
2435	}
2436	else {
2437	$outline .= ",1);";
2438	} # endif
2439
2440	}
2441	else {
2442	# $outline .= "global ".$arrayname.";\n";
2443	} # endif
2444
2445	}
2446	else {
2447	$f77_line =~ s/\n//g;
2448	$outline = "% WARNING: >$f77_line< is not a convertible F77 array!\n";
2449	} # endif
2450
2451	return $outline;
2452	} # end of declare_array
2453
2454
2455	#++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
2456	# 04.30.98csc: Handle line continuations.
2457	sub ed_asterix {
2458
2459	my($firstline,$secondline) = @_;
2460	my($outline);
2461
2462	# Begin.
2463	$firstline =~ s/\s*\n//g;
2464	$secondline =~ s/^\s{5}\S\s+//;
2465
2466	$outline = join('',$firstline,$secondline);
2467
2468	return($outline);
2469	} # end of ed_asterix
2470
2471
2472	#++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
2473	# 04.30.98csc: Convert write to Matlab output - tricky.
2474	# 05.01.98csc: Now that we prescan the labels, they can be mated
2475	# with the write labels to produce a sane output string.
2476	# 06.22.98csc: Handles most implied do loops. Yech.
2477	sub ed_write {
2478
2479	my($f77_line) = @_;
2480	my($outline) = "";
2481	my($do_flag) = 0;
2482	my($implied_do) = "";
2483	my(@arglist) = "";
2484	my(@fmt_matlab) = "";
2485	my(@fmt_matvar) = "";
2486	my(@listidl) = "";
2487	my(@make_loops) = "";
2488	my(@mloop) = "";
2489	my(@array_parenclose,@array_parenopen);
2490	my(@f77_array,@fmt_array,@fmtpar,@fmtstr);
2491	my(@idl_inc,@idl_init,@idl_lim,@idl_ndx);
2492	my(@var_array,@var_type);
2493	my($Mfid);
2494	my($argnum,$arr_var,$dummy,$eqflag,$f77fid,$f77fmt,$f77label,$f77vars);
2495	my($fclose_string,$fmt_edited,$fopen_string,$wr_string,$writefilename);
2496	my($idl_var,$idum,$ifmt,$ilups,$imat,$inum,$ivar);
2497	my($jidl,$jmat,$jpar,$lim,$listnum,$n_indices,$nargs,$nchars,$nlines,$npar,$nidl,$nstr);
2498	my($parencount,$pflag,$space_str);
2499
2500	# Begin.
2501	$f77_line =~ s/write\s+\(/write\(/;
2502	@f77_array = split(' ',$f77_line);
2503
2504	# Divide and conquer.
2505	$wr_string = shift( @f77_array );
2506	## Not up for unformatted output just yet ...
2507	# if ( $wr_string =~ m/write$\S{1,2},\*$/ ) { die("ed_write(): ERROR - Cannot handle $wr_string"); }
2508
2509	# Get the file ID and format label.
2510	$wr_string =~ s/write\(//;
2511	$wr_string =~ s/\)//;
2512	($f77fid,$f77label) = split(',',$wr_string);
2513
2514	# This had bloody well better be a format. Note it is global.
2515	if ( $f77label ne "*" ) {
2516	$f77fmt = $label_list{ $f77label };
2517	if ( !($f77fmt =~ m/format/) ) { die "ed_write(): ERROR - This >$f77fmt< should have an F77 format"; }
2518	$f77fmt =~ s/\s+$//;
2519	}
2520	else { $f77fmt = ""; }
2521
2522	# The rest is variables.
2523	$f77vars = join(' ',@f77_array);
2524	$f77vars =~ s/\s+//g;
2525
2526	if ( '06' eq $f77fid ) { # To the screen.
2527	$Mfid = 1; # Matlab screen output.
2528	}
2529	else { # To a file.
2530	$Mfid = "fid".$f77fid;
2531	$writefilename = $fid_index{ $f77fid };
2532	} # endif
2533
2534	# Extract strings from the format and tag them.
2535	$fmt_edited = $f77fmt;
2536	$nstr = 0;
2537	while ( $fmt_edited =~ m/\'(.*?)\'/ ) {
2538	$fmtstr[ $nstr ] = $1;
2539	# Need to escape as needed by Matlab.
2540	$fmtstr[ $nstr ] =~ s/(\\)/$1$1/g;
2541	$fmtstr[ $nstr ] =~ s/(%)/$1$1/g;
2542	$fmt_edited =~ s/(\'.*?\')(\')?/X$nstr$2/;
2543	if ( $2 ) { $fmt_edited =~ s/(X$nstr)($2)/$1\,$2/; }
2544	$nstr++;
2545	} # end while
2546
2547	# Extract and label paren'd format bits.
2548	$npar = 0;
2549	$fmt_edited =~ s/format$(.+)$$/$1/; # Extract formats only.
2550	while ( $fmt_edited =~ m/$(.+?)$/ ) {
2551	$fmtpar[ $npar ] = $1;
2552	$fmt_edited =~ s/($.+?$)/Y$npar/;
2553	$npar++;
2554	} # end while
2555	# Replace label with expanded format.
2556	for ( $jpar=0;$jpar<$npar;$jpar++ ) {
2557	$dummy = "";
2558	$fmt_edited =~ m/(\d+)?Y$jpar/;
2559	if ( !$1 ) { $lim = 1; }
2560	else { $lim = $1; }
2561	for ( $idum=0;$idum<$lim;$idum++ ) { $dummy .= $fmtpar[$jpar].","; }
2562	chop $dummy;
2563	$fmt_edited =~ s/(\d+)?Y$jpar/$dummy/;
2564	} # end for
2565
2566	# Now tidy up and tag a few remaining things ...
2567	$fmt_edited =~ s/\s+//g;
2568	$fmt_edited =~ s/\//N/g;
2569	$fmt_edited =~ s/N([^\,\|^\)])/N\,$1/g;
2570	$fmt_edited =~ s/N([^\,\|^\)])/N\,$1/g;
2571	$fmt_edited =~ s/([^\,\|^\(])N/$1\,N/g;
2572	$fmt_edited =~ s/([^\,\|^\(])N/$1\,N/g;
2573
2574	# Place each output line in an array element and process.
2575	@fmt_array = split(',',$fmt_edited);
2576	$imat = 0;
2577	$fmt_matlab[ $imat ] = $space_str = "";
2578	$nchars = 0; # Absolute chars.
2579	# Really ought not to happen.
2580	if ( !$f77vars && !f77fmt ) {
2581	die ("ed_write(): ERROR, must have vars with * format here");
2582	}
2583	elsif ( $f77vars && !f77fmt ) {
2584	@var_array = split(',',$f77vars);
2585	for ( $ivar=0;$ivar<=$#var_array;$ivar++ ) {
2586	# Assumes the F77 convention, and no chars at all. Poor policy.
2587	if ( $var_array[$ivar] =~ m/^[a-ho-z]{1}/ ) { $var_type[$ivar] = "real"; }
2588	elsif ( $var_array[$ivar] =~ m/^[i-n]{1}/ ) { $var_type[$ivar] = "int"; }
2589	else { $var_type[$ivar] = "error"; }
2590	} # end for on ivar
2591	}
2592	else {
2593	$var_type[0] = "";
2594	} # endif
2595
2596	for ( $ifmt=0;$ifmt<=$#fmt_array;$ifmt++ ) {
2597
2598	($space_str,$nchars,$imat,\@fmt_matlab,\@fmt_matvar) =
2599	parse_write_fmt($space_str,$nchars,$ifmt,$imat,\@fmt_array,\@fmt_matlab,\@fmt_matvar,\@fmtstr,\@var_type);
2600
2601	} # end for on ifmt
2602	# Need a \n at end.
2603	$fmt_matlab[$imat] .= "\\n";
2604
2605	####################################################################
2606	# Based on the nature of the output variable string, we will make up
2607	# an fprintf for matlab to use, one per line.
2608
2609	# Loop over each line in the output format.
2610	for ( $jmat=0;$jmat<=$imat;$jmat++ ) {
2611
2612	$dummy = "fprintf(".$Mfid.",\'".$fmt_matlab[ $jmat ]."\'";
2613	if ( $fmt_matvar[ $jmat ] ) {
2614	$dummy .= ",".$fmt_matvar[ $jmat ].");\n";
2615	}
2616	else { $dummy .= ");\n"; } # endif
2617	$outline .= $dummy;
2618
2619	} # end for on jmat
2620
2621	# Characterize the variables, if any. This involves moving along the
2622	# write line, parsing as we go, usually by parentheses and commas.
2623	if ( $f77vars ) { # We got 'em.
2624
2625	$nargs = 0;
2626	# How many?
2627	@var_array = split(',',$f77vars);
2628	for ( $ivar=0;$ivar<=$#var_array;$ivar++ ) {
2629
2630	if ( $var_array[$ivar] =~ m/^\(/ ) {
2631	# This means we have something special, and we need to paste it
2632	# back together again. Probably an implied do loop.
2633	$idl_var = "";
2634	$parencount = 0;
2635	$pflag = 1;
2636	$eqflag = 0;
2637	# Run to the end, gathering all between the parens.
2638	while ( $var_array[$ivar] =~ m/[$\|$]+/ \|\| $pflag ) {
2639	@array_parenopen = split('\(',$var_array[$ivar]);
2640	@array_parenclose = split('\)',$var_array[$ivar]);
2641	if ( $var_array[$ivar] =~ m/\)$/ ) { $#array_parenclose++; }
2642	$parencount += $#array_parenclose - $#array_parenopen;
2643	# print "$parencount += $#array_parenclose - $#array_parenopen\n";
2644	if ( 0 <= $parencount ) { $pflag = 0; }
2645	# Paste together ...
2646	if ( $var_array[$ivar] =~ m/\)$/ ) { # Not array args.
2647	$idl_var .= $var_array[$ivar]."\|";
2648	}
2649	elsif ( $eqflag \|\| $var_array[$ivar] =~ m/\=/ ) {
2650	$idl_var .= $var_array[$ivar]."\|";
2651	$eqflag = 1;
2652	}
2653	elsif ( !$eqflag && (-1 > $parencount) ) { # Non-robust ...
2654	$idl_var .= $var_array[$ivar].",";
2655	}
2656	else {
2657	$idl_var .= $var_array[$ivar]."\|";
2658	# print "HOW DID I GET HERE? -> $var_array[$ivar]\n";
2659	}
2660	if ( $ivar > $#var_array ) { die "ERROR: paren mismatch in $f77vars"; }
2661	$ivar++;
2662	} # endwhile
2663	$idl_var .= $var_array[$ivar];
2664	$idl_var =~ s/[\\|\|\,]$//;
2665	$arglist[ $nargs++ ] = $idl_var;
2666
2667	}
2668	elsif ( $var_array[$ivar] =~ m/^\w+$.+?$$/ ) { # Array/function.
2669	$arglist[ $nargs++ ] = $var_array[$ivar];
2670	}
2671	elsif ( $var_array[$ivar] =~ m/^\w+\(.+?$/ ) { # Ditto ...
2672	$arr_var = "";
2673	$parencount = 0;
2674	$pflag = 1;
2675	# Run to the end, gathering all between the parens.
2676	while ( $var_array[$ivar] =~ m/[$\|$]+/ \|\| $pflag ) {
2677	@array_parenopen = split('\(',$var_array[$ivar]);
2678	@array_parenclose = split('\)',$var_array[$ivar]);
2679	if ( $var_array[$ivar] =~ m/\)$/ ) { $#array_parenclose++; }
2680	$parencount += $#array_parenclose - $#array_parenopen;
2681	if ( 0 == $parencount ) { $pflag = 0; }
2682	$arr_var .= $var_array[$ivar];
2683	if ( $ivar > $#var_array ) { die "ERROR: paren mismatch in $f77vars"; }
2684	$ivar++;
2685	} # endwhile
2686	$arr_var .= $var_array[$ivar];
2687	$arglist[ $nargs++ ] = $arr_var[$ivar];
2688	}
2689	elsif ( $var_array[$ivar] =~ m/^\w+$/ ) { # Simple variable.
2690	$arglist[ $nargs++ ] = $var_array[$ivar];
2691	}
2692	elsif ( $var_array[$ivar] =~ m/[\*\|\+\|\-\|\/]/ ) { # Statement.
2693	$arglist[ $nargs++ ] = $var_array[$ivar];
2694	}
2695	else { # Dull stuff.
2696	$arglist[ $nargs++ ] = $var_array[$ivar];
2697	} # endif
2698
2699	} # end for on ivar
2700
2701	# At this stage the args are space-delimited, array indices are comma-
2702	# delimited, and implied do bits are pipe-delimited.
2703
2704	} # endif
2705
2706	# Now compare the arglist to the outline to see where the variables,
2707	# if any, need to go.
2708	$argnum = 0;
2709	$listnum = 0;
2710	while ( $outline =~ m/[X\|\'\|$]X[X\|(\,\')\|$]/ ) {
2711
2712	if ( $arglist[ $argnum ] =~ m/\\|/ ) { # Implied do land.
2713
2714	$nidl = 0;
2715	$arglist[ $argnum ] =~ s/^\(//;
2716	$arglist[ $argnum ] =~ s/\)$//;
2717	@listidl = split('\\|',$arglist[ $argnum ]);
2718	$n_indices = 0;
2719	for ( $jdl=0;$jdl<=$#listidl;$jdl++ ) {
2720
2721	if ( $listidl[$jdl] =~ m/(\w+)\=(\S+)/ ) { # An index variable.
2722
2723	$idl_ndx[$n_indices] = $1;
2724	$idl_init[$n_indices] = $2;
2725	$jdl++;
2726	$idl_lim[$n_indices] = $listidl[$jdl];
2727	if ( $listidl[$jdl+1] !=~ m/(\w+)\=(\S+)/ ) { # Increment.
2728	$idl_inc[$n_indices] = $listidl[$jdl+1];
2729	$jdl++;
2730	} # endif
2731	# Construct the necessary Matlab loop(s).
2732	$mloop[$n_indices] = " for ".$idl_ndx[$n_indices].
2733	" = ".$idl_init[$n_indices];
2734	if ( $idl_inc[$n_indices] ) { $mloop[$n_indices] .= ":".$idl_inc[$n_indices]; }
2735	$mloop[$n_indices] .= ":".$idl_lim[$n_indices]."\n";
2736	$n_indices++;
2737
2738	}
2739	else { # It had better be an output variable name ...
2740	$outline =~ s/([\'\|$]?)X{1}([(\,\')\|$]?)/$1\,$listidl[ $jdl ]$2/;
2741	$arglist[ $argnum ] = $listidl[ $jdl ];
2742	$nidl++;
2743	$argnum++;
2744	} # endif
2745
2746	} # end for on jdl
2747
2748	# Now insert the loop(s) into the string of commands.
2749	@make_loops = split(';\n',$outline);
2750	$outline = "";
2751	for ( $nlines=0;$nlines<=$#make_loops;$nlines++ ) {
2752	if ( $make_loops[$nlines] =~ m/$$idl_ndx[0]$/ ) {
2753	# Note that here we decrement as the IDL reads right-to-left.
2754	for ( $ilups=$n_indices-1;$ilups>=0;$ilups-- ) {
2755	if ( 0 < $nlines ) { $make_loops[$nlines-1] .= ";\n"; }
2756	$make_loops[$nlines] = $mloop[ $ilups ]." ".$make_loops[$nlines];
2757	$make_loops[$nlines] .= ";\n end;\n";
2758	} # end for ilups
2759	} # endif
2760	$outline .= $make_loops[$nlines]."\n";
2761	} # end for on nlines
2762
2763	}
2764	else { # Reality.
2765	$outline =~ s/([\'\|$]?\,?)X{1}([(\,\')\|$]?)/$1$arglist[$argnum]$2/;
2766	$outline =~ s/\,(\,$arglist[$argnum])/$1/;
2767	# $outline =~ s/([\'\|$]?)X{1}([(\,\')\|$]?)/$1\,$arglist[ $argnum ]$2/;
2768	$argnum++;
2769	} # endif
2770
2771	# Limit here is arbitrary.
2772	if ( $argnum > 7 ) { die "ERROR: $argnum > 7"; }
2773
2774	} # endwhile
2775
2776	# Open file for appending/creation.
2777	if ( 1 != $Mfid ) {
2778	$fopen_string = $Mfid." = fopen(".$writefilename.",\'a\');\n";
2779	$fclose_string = "fclose(".$Mfid.");\n";
2780	}
2781	else {
2782	$fopen_string = "";
2783	$fclose_string = "";
2784	} # endif
2785	$outline = join('',$fopen_string,$outline,$fclose_string);
2786
2787	return $outline;
2788	} # end of ed_write
2789
2790	#++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
2791	# 04.30.98csc: endif -> end;
2792	sub ed_endif {
2793
2794	my($f77_line) = @_;
2795	my($outline) = "";
2796
2797	# Begin.
2798	($outline = $f77_line) =~ s/endif/end;/;
2799
2800	return $outline;
2801	} # end of ed_endif
2802
2803
2804	#++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
2805	# 04.29.98csc: Go to Matlab if ...
2806	# 04.30.98csc: Leading spaces are important for line continuation.
2807	# 07.09.98csc: Add Arithmetic If ...
2808	sub ed_if {
2809
2810	my($f77_line) = @_;
2811	my(@f77_array);
2812	my($outline) = "";
2813	my($condit,$i);
2814
2815	# Begin.
2816
2817	# Destroy all space.
2818	$f77_line =~ s/\(\s+/\(/g;
2819	$f77_line =~ s/\s+\)/\)/g;
2820	$f77_line =~ s/\.\s+/\./g;
2821	$f77_line =~ s/\s+\./\./g;
2822	$f77_line =~ s/(if)(\(.+)/$1 $2/;
2823	$f77_line =~ s/(.+\))(.+)/$1 $2/;
2824	@f77_array = split(' ',$f77_line);
2825
2826	$i=0;
2827	foreach $_ ( @f77_array ) {
2828
2829	if ( /elseif/ ) { # Then the next element may be conditional.
2830
2831	$outline .= " elseif ";
2832	$condit = $f77_array[$i+1];
2833	# Yeah, pretty ugly.
2834	$condit =~ s/\.eq\./\=\=/g;
2835	$condit =~ s/\.ne\./\~\=/g;
2836	$condit =~ s/\.ge\./\>\=/g;
2837	$condit =~ s/\.le\./\<\=/g;
2838	$condit =~ s/\.gt\./\>/g;
2839	$condit =~ s/\.lt\./\</g;
2840	$condit =~ s/\.or\./\\|/g;
2841	$condit =~ s/\.and\./\&/g;
2842	$condit = f77_functions( $condit );
2843	$outline .= $condit;
2844
2845	return "$outline\n";
2846
2847	}
2848	elsif ( /endif/ ) {
2849	$outline .= "% endif here\n end;";
2850	return "$outline\n";
2851	}
2852	elsif ( /if/ ) { # Then the next element is the conditional.
2853
2854	$outline = "% if clause begins here.\n";
2855	$outline .= " if ";
2856	$condit = $f77_array[$i+1];
2857	# Is this an arithmetic if?
2858	if ( $condit =~ m/(\d+)\,(\d+)\,(\d+)/ ) {
2859	$outline = "disp(\'DANGER: ARITHMETIC IF ALERT >".$f77_line."');\n";
2860	return $outline;
2861	} # endif
2862	# Yeah, pretty ugly.
2863	$condit =~ s/\.eq\./\=\=/g;
2864	$condit =~ s/\.ne\./\~\=/g;
2865	$condit =~ s/\.ge\./\>\=/g;
2866	$condit =~ s/\.le\./\<\=/g;
2867	$condit =~ s/\.gt\./\>/g;
2868	$condit =~ s/\.lt\./\</g;
2869	$condit =~ s/\.or\./\\|/g;
2870	$condit =~ s/\.and\./\&/g;
2871	$condit = f77_functions( $condit );
2872	$outline .= $condit;
2873	return "$outline\n";
2874
2875	}
2876	elsif ( /else/ ) {
2877	$outline .= " else ";
2878	}
2879	elsif ( /then/ ) {
2880	}
2881	else { # Uh oh.
2882	die("ed_if(): Why me? $_");
2883	} # endif
2884
2885	$i++;
2886	} # end foreach
2887
2888	# Should not get here, ja?
2889	return "$outline\n";
2890	} # end of ed_if
2891
2892	#++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
2893	# 04.29.98csc: Go to Matlab function.
2894	sub ed_function {
2895
2896	my($f77_line) = @_;
2897	my(@f77_array);
2898	my($global_villagers) = "";
2899	my($outline) = "ERROR: in ed_function in f77toM\n";
2900	local($_);
2901
2902	# Begin.
2903	@f77_array = split(' ',$f77_line);
2904	foreach $_ ( @f77_array ) {
2905
2906	if ( /real/ \|\| /function/ ) { }
2907	else { # Must be the function name and args.
2908
2909	$_ =~ s/^/function \[dummy\] \= /;
2910	($outline = $_) =~ s/$/\;\n/;
2911	if ( $outline =~ m/$(.+)$/ ) {
2912
2913	$global_villagers = $1;
2914	$outline =~ s/dummy/$global_villagers/;
2915	# $outline =~ s/dummy/dummy,$global_villagers/;
2916	$global_villagers =~ s/,/;\nglobal /g;
2917	$global_villagers = "global ".$global_villagers.";\n";
2918
2919	} # endif
2920
2921	} # endif
2922
2923	} # end foreach
2924
2925	# So that something is returned ...
2926	$outline .= "global dummy;\n";
2927	$outline .= $global_villagers;
2928
2929	return( $outline );
2930	} # end of ed_function
2931
2932
2933	#++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
2934	# 04.29.98csc: To F77 just add a ; at end and return.
2935	# 05.28.98csc: Do a comment line as well ...
2936	sub minedit {
2937
2938	my($f77_line) = @_;
2939	my($outline) = "ERROR: in minedit in f77toM\n";
2940
2941	# Begin.
2942	$outline = "";
2943	$outline .= "% Min edit of: >".$f77_line;
2944	$f77_line =~ s/\s+//g;
2945	$f77_line .= ";\n";
2946	$outline .= $f77_line;
2947
2948	return $outline;
2949	} # end of minedit
2950
2951
2952	#++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
2953
2954	# 04.29.98csc: Give a usage.
2955	sub usage {
2956
2957	# Begin.
2958	print "\nUsage: f77toM <list of Fortran files>\n\n";
2959	print "Takes input Fortran program files, makes a crude conversion \n";
2960	print "to Matlab, outputs the corresponding M-files. For every input\n";
2961	print "file there is an output file with the .m suffix, and a backup.\n";
2962	print "\nExample:\n f77toM dog.f cat.f produces dog.m cat.m, and dog.f.bkp cat.f.bkp\n";
2963	print "\nIn the argument list, all f77 files that open external files must \n";
2964	print "occur before f77 files that do I/O to those files. Generally, use\n";
2965	print "the ordering: main, includes, openers, others.\n";
2966	print "\n07.20.98csc, v0.34\n\n";
2967	exit(2);
2968
2969	} # end of usage
2970
2971	1;

Note: See TracBrowser for help on using the browser.

root/gliderproc/trunk/MATLAB/util/f77toM.pl

Download in other formats: