summaryrefslogtreecommitdiff
path: root/lib/sbin/f_file_processor.pl
blob: 8a4e359ea920d787577b9fbbb7a01af7036028c7 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
#!/usr/bin/perl -s
#/*@@
#  @file      f_file_processor.pl
#  @date      Jan 22 1995
#  @author    Paul Walker
#  @desc
#  Postprocessor for Fortran files.
#   
#  Reads STDIN, writes to STDOUT.
#
#  removes all comments
#  replaces && with newline and tab to col 7
#  replaces &! with newline at col 0
#  replaces \ at end of line with proper Fortran continuation lines
#      (depending on -free_format)
#  Breaks lines greater than 72 cols
#  Does this using multi-line matching!
#  
#  If run with -free_format, chooses free-format 
#  line splitting.
#  
#  @enddesc 
#  @history 
#  @hdate Wed Apr 21 1997 @hauthor Joan Masso
#  @hdesc get rid of cC comments and handle ! comments properly
#         and fix it so now it is really 72 and we do not get
#         breaks in the middle of fortran strings!
#  @hdate Wed Nov 24 12:17:43 1999 @hauthor Tom Goodale
#  @hdesc Added in Erik Schnetters free-format stuff
#         grdoc-ed
#         reformated as per rest of perl code in Cactus.
#  @endhistory 
#  @version $Header$
#@@*/

$* = 1;                         # Multi-line is on!

# Pick the correct set of comments to remove.
if ($free_format)
{
  $standard_comments = "\\s*[!]";
}
else
{
  $standard_comments = "[cC!]";
}

# Loop over all lines.
while (<>) 
{
  # Get rid of final \n
  chomp;

  # concatenate lines if \ at end-of-line
  while (/\\$/)
  {
    chop;                       # drop the backslash
    chomp($_ .= <STDIN>);	# concatenate the following line (sans \n)
  }

  next if (/^\s*$/);            # Blank lines slow down compilation,
				# and on some systems cpp makes ++lots of them

  next if (/^\#/);              # Remove any remaining # directives (e.g. line directives).

  # Get rid of any tabs
  s/\t/        /g;
  
  # Ignore some fortran comments (they stay in code)
  # (standard c C, or even ! comments)
  if (/^$standard_comments.*$/ || /(.)![^'"]*$/)
  {
     print;
     print "\n";
  }
  else 
  {
    # Get rid of ! comments : a bit tricky as ! may appear inside strings
    s/(.)![^'"]*$/\1\n/g;

    # OK, now put in the line breaks (&& or &!)
    s/\&\&\s*/\n      /g;
    s/\&\!\s*/\n/g;

    # Get rid of lonesome semicolons
    s/\s*\;\s*$//;

    # And now we can fix the lines.  This is actually a little complicated.
    # since there is a different case if the thing matches a newline
    # than if it doesn't.
    if (/\n/)
    {
      foreach $LINE (split('\n',$_)) 
      {
        &splitline($LINE);
      }
    }
    else
    {
      &splitline($_);
    }
  }
}

#/*@@
#  @routine    splitline
#  @date       Wed Nov 24 12:14:55 1999
#  @author     Tom Goodale
#  @desc 
#  Chooses the correct routine to split lines.  
#  @enddesc 
#  @calls     
#  @calledby   
#  @history 
#
#  @endhistory 
#
#@@*/
sub splitline
{
  my ($line) = @_;

  if($free_format)
  {
    &free_format_splitline($line);
  }
  else
  {
    &fixed_format_splitline($line);
  }

}

#/*@@
#  @routine    fixed_format_splitline
#  @date       1995
#  @author     Paul Walker
#  @desc 
#  Splits lines for F77 or fixed-format F90
#  @enddesc 
#  @calls     
#  @calledby   
#  @history 
#
#  @endhistory 
#
#@@*/
sub fixed_format_splitline 
{
  my ($LINE) = @_;

  # Remove ,, and , \) from blank thorns
  while ($LINE =~ s/,\s*,/,/) {};
  $LINE =~ s/,\s*\)/\)/;

  # Strip out leading spaces in favor of 7 spaces
  # $LINE =~ s/^\s+/       /;
  # Note the new treatement of comments with \S
  if ($LINE =~ /^([^\S].{71,71}).*/) 
  {
    print "$1\n";
    $LINE =~ s/.{72,72}//;
    while ($LINE =~ /^(.{66,66}).*/) 
    {
      print "     &$1\n";
      $LINE =~ s/.{66,66}//;
    }
    print "     &$LINE\n";
  } 
  else 
  {
    print "$LINE\n";
  }

}

#/*@@
#  @routine    free_format_splitline
#  @date       Thu Sep 30 12:05:36 1999
#  @author     Erik Schnetter
#  @desc 
#  Splits lines for freeformat fortran 90.  
#  @enddesc 
#  @calls     
#  @calledby   
#  @history 
#
#  @endhistory 
#
#@@*/
sub free_format_splitline 
{
  my ($LINE) = @_;
  my $OUT;

  # Remove ,, and , \) from blank thorns
  while ($LINE =~ s/,\s*,/,/) {};
  $LINE =~ s/,\s*\)/\)/;

  # Remove trailing spaces
  $LINE =~ s/\s*$//;

  # Some preprocessors put extraneous spaces in 8-(
  $LINE =~ s:\. ([a-zA-Z]+) \.:\.$1\.:ig;

  # Strip out leading spaces in favor of 3 spaces
  # $LINE =~ s/^\s+/   /;
  if ($LINE =~ /^(.{78,78})...*/) 
  {
    $OUT = $1;
    print "$OUT";
    # Check if the line already has a continuation mark.
    print "&" if (! ($OUT =~ /\&[\s]*$/));
    print "\n";
    $LINE =~ s/.{78,78}//;

    while ($LINE =~ /^(.{75,75}).*/) 
    {
      $LINE =~ /^(.{74,74}).*/;
      $OUT = $1;
      print "   &" if (! ($OUT =~ /^[\s]*\&/));
      print "$OUT";
      print "&" if (! ($OUT =~ /\&[\s]*$/));
      print "\n";
      $LINE =~ s/.{74,74}//;
    }
    print "   &" if (! ($LINE =~ /^[\s]*\&/));
    print "$LINE\n";
  } 
  else 
  {
    print "$LINE\n";
  }

}