1 | # |
---|
2 | open(F,$ARGV[0]) || die "Cannot open $ARGV[0]: $!"; |
---|
3 | my $gotnml = 0; |
---|
4 | my $varlist = ''; |
---|
5 | while(my $iline = <F> ) { |
---|
6 | # Start processing loop (checks are case and whitespace independent) |
---|
7 | # |
---|
8 | # 1. If a namelist block is open then |
---|
9 | # |
---|
10 | if ( $gotnml == 1 ) { |
---|
11 | # |
---|
12 | # 2. If leading ampersand: this line is part of a continuation |
---|
13 | # |
---|
14 | if ( $iline =~ /^\s*&/) { |
---|
15 | ($ivars2 = $iline) =~ s/(^\s*&\s*)([^&!]*)(.*)/\2/; |
---|
16 | chomp($ivars2); |
---|
17 | $ivars2 =~ s/^\s+//; $ivars2 =~ s/\s+$//; |
---|
18 | my $i1 = index($iline, "&"); |
---|
19 | my $i2 = index($iline, "&", $i1+1); |
---|
20 | # |
---|
21 | # 3. If no trailing ampersand: reached the end of a continuation |
---|
22 | # |
---|
23 | if ( $i2 == -1 ) { |
---|
24 | print "&".$iargs."\n"; |
---|
25 | @allvars = split(',',$varlist.$ivars2); |
---|
26 | foreach my $v (@allvars) { |
---|
27 | $v =~ s/^\s+|\s+$//g; |
---|
28 | print " ".$v." = \n"; |
---|
29 | } |
---|
30 | print "/\n"; |
---|
31 | $gotnml = 0; |
---|
32 | $varlist = ''; |
---|
33 | # |
---|
34 | # 4. Else trailing ampersand: Append to list and expect more |
---|
35 | # |
---|
36 | } else { |
---|
37 | $varlist = $varlist.$ivars2; |
---|
38 | } |
---|
39 | # |
---|
40 | # 5. Else no leading ampersand: it must have been a single line declaration |
---|
41 | # |
---|
42 | } else { |
---|
43 | print "&".$iargs."\n"; |
---|
44 | @allvars = split(',',$varlist); |
---|
45 | foreach my $v (@allvars) { |
---|
46 | $v =~ s/^\s+|\s+$//g; |
---|
47 | print " ".$v." = \n"; |
---|
48 | } |
---|
49 | print "/\n"; |
---|
50 | $gotnml = 0; |
---|
51 | $varlist = ''; |
---|
52 | # |
---|
53 | # 6. But better check if this line starts a new declaration |
---|
54 | # |
---|
55 | if ( $iline =~ /^\s*namelist\s*\//i) { |
---|
56 | ($iargs = $iline) =~ s/(^\s*namelist\s*\/\s*)([A-Z,a-z,0-9,_]*)(.*)/\2/i; |
---|
57 | chomp($iargs); |
---|
58 | $iargs =~ s/^\s+//; $iargs =~ s/\s+$//; |
---|
59 | ($ivars = $iline) =~ s/(^\s*namelist\s*\/\s*[A-Z,a-z,0-9,_]*\s*\/)([^&!]*)(.*)/\2/i; |
---|
60 | chomp($ivars); |
---|
61 | $ivars =~ s/^\s+//; $ivars =~ s/\s+$//; |
---|
62 | $gotnml = 1; |
---|
63 | $varlist = $ivars; |
---|
64 | } |
---|
65 | # |
---|
66 | } |
---|
67 | # |
---|
68 | # 7. Else if a namelist declaration is found |
---|
69 | # |
---|
70 | } elsif ( $iline =~ /^\s*namelist\s*\//i) { |
---|
71 | # |
---|
72 | # 8. Store the namelst name |
---|
73 | # |
---|
74 | ($iargs = $iline) =~ s/(^\s*namelist\s*\/\s*)([A-Z,a-z,0-9,_]*)(.*)/\2/i; |
---|
75 | chomp($iargs); |
---|
76 | $iargs =~ s/^\s+//; $iargs =~ s/\s+$//; |
---|
77 | ($ivars = $iline) =~ s/(^\s*namelist\s*\/\s*[A-Z,a-z,0-9,_]*\s*\/)([^&!]*)(.*)/\2/i; |
---|
78 | chomp($ivars); |
---|
79 | $ivars =~ s/^\s+//; $ivars =~ s/\s+$//; |
---|
80 | $gotnml = 1; |
---|
81 | $varlist = $ivars; |
---|
82 | # |
---|
83 | # |
---|
84 | # 9. Else any other statement |
---|
85 | # |
---|
86 | } else { |
---|
87 | # |
---|
88 | # 10. Not a namelist statement so ignore |
---|
89 | # |
---|
90 | } |
---|
91 | } |
---|