| 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 | } |
|---|
