changeset 11588:61b5dba429f3 octave-forge

Contributed by Terry Duel / Darien Pardinas Diaz. Provisional Octave version
author prnienhuis
date Mon, 01 Apr 2013 16:56:59 +0000
parents b0dc1a40bf8a
children ccd2ae2dc974
files main/io/inst/read_namelist.m main/io/inst/write_namelist.m
diffstat 2 files changed, 366 insertions(+), 0 deletions(-) [+]
line wrap: on
line diff
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/io/inst/read_namelist.m	Mon Apr 01 16:56:59 2013 +0000
@@ -0,0 +1,265 @@
+## Copyright (C) Darien Pardinas Diaz <darien.pardinas-diaz@monash.edu>
+##
+## This program is free software; you can redistribute it and/or modify it under
+## the terms of the GNU General Public License as published by the Free Software
+## Foundation; either version 3 of the License, or (at your option) any later
+## version.
+##
+## This program is distributed in the hope that it will be useful, but WITHOUT
+## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more
+## details.
+##
+## You should have received a copy of the GNU General Public License along with
+## this program; if not, see <http://www.gnu.org/licenses/>.
+
+## S = READ_NAMELIST (FILENAME) returns the struct S containing namelists and
+## variables in the file FILENAME organised in hierachical way:
+##
+##                |--VAR1
+##                |--VAR2
+##   |-- NMLST_A--|...
+##   |            |--VARNa
+##   |
+##   |            |--VAR1
+##   |-- NMLST_B--|--VAR2
+##   |            |...
+## S --|     ...    |--VARNb
+##     |
+##     |            |--VAR1
+##     |-- NMLST_M--|--VAR2
+##                  |...
+##                  |--VARNm
+## 
+## Note:  The function can read multidimensional variables as well. The  
+## function assumes that there is no more than one namelist section per 
+## line. At this time there is no syntax checking functionality so the 
+## function will crash in case of errors.
+##  
+## Example:
+##     NMLST = read_namelist ("OPTIONS.nam");
+##     NMLST.NAM_FRAC.XUNIF_NATURE = 0.1;
+##     write_namelist(NMlST, "MOD_OPTIONS.nam");
+
+## Written by:     Darien Pardinas Diaz (darien.pardinas-diaz@monash.edu)
+## Version:        1.0
+## Date:           16 Dec 2011
+##
+## Released under GPL License 30/3/2013
+##
+## Notes Re: Use in Octave.
+## -Line 83 causes a problem. Seems to work OK if commented out.FIXED
+## -Cannot find end of namelist if marker (/) is preceded by space.
+## -Copes with Fortran comment (!) e.g.
+## &data1
+##   a = 100.0  ! length metres
+##   b = 25.0   ! mass kg
+## /
+## is read OK
+## Terry Duell 31 mar 2013
+
+function S = read_namelist (filename)
+
+S = struct ();
+  ## Open and read the text file containing the namelists
+  fid = fopen (filename, "r");
+  c = 0;
+  lines = cell(1);
+  
+  ## Read all the text lines in namelist file
+  while (! feof (fid))
+    line = fgetl (fid);
+    ## Remove comments if any on the line
+    idx = find (line == "!");
+    if ~isempty (idx),
+      line = line (1:idx(1) - 1);
+    end
+    if (! isempty (line)),
+      ++c;
+      lines{c} = line;     ## FIXME each time appending to a cell array is slow
+    end
+  end
+  fclose(fid);
+  
+  ii = 0;
+  while (ii < c);    
+    ## Find a record
+    ++ii; 
+    line = lines{ii};
+    idx = find (line == "&");
+    if (! isempty (idx))   ## i.e. a namelist start
+      line = line(idx(1) + 1:end);
+      ## find next space
+      idx = find (line == " ");
+      if (! isempty (idx))
+        namelst = line(1:idx(1) - 1);
+        line = line(idx(1) + 1:end);
+      else
+        namelst = line;
+        line = [];        ##TDuell 31/03/2013 Provisional fix L.102 PRN 1apr2013
+      endif
+      nmlst_bdy = [];
+      if (! isempty (line)); idx = strfind (line, "/"); endif
+      ## Get the variable specification section
+      while (isempty (idx) && ii < c)
+        nmlst_bdy = [ nmlst_bdy " " line ]; 
+        ++ii;
+        line = lines{ii};
+        idx = strfind (line, "/");
+      endwhile
+      if (! isempty (idx) && idx(1) > 1)
+        nmlst_bdy = [ nmlst_bdy " " line ];
+      endif
+      ## Parse current namelist (set of variables)
+      S.(namelst) = parse_namelist (nmlst_bdy);        
+    endif
+  endwhile
+
+endfunction
+
+
+## Internal function to parse the body text of a namelist section.
+## Limitations: the following patterns are prohibited inside the literal
+## strings: ".t." ".f." ".true." ".false." "(:)"
+function S = parse_namelist (strng)
+
+  ## Get all .true., .t. and .false., .f. to T and F
+  strng = regexprep (strng, '\.true\.' , "T", "ignorecase"); 
+  strng = regexprep (strng, '\.false\.', "F", "ignorecase");
+  strng = regexprep (strng, '\.t\.', "T", "ignorecase"); 
+  strng = regexprep (strng, '\.f\.', "F", "ignorecase");
+  
+  ## Make evaluable the (:) expression in MATLAB if any
+  strng = regexprep (strng, '\(:\)', "(1,:)");
+  [strng, islit] = parse_literal_strings ([strng " "]);
+  
+  ## Find the position of all the "="
+  eq_idx = find (strng == "=");
+  nvars = length (eq_idx);
+  
+  arg_start = eq_idx + 1;
+  arg_end   = zeros (size (eq_idx));
+  vars = cell (nvars, 1);
+  S = struct;
+  
+  ## Loop through every variable
+  for kk = 1:nvars,
+    ii = eq_idx(kk) - 1;
+    ## Move to the left and discard blank spaces
+    while (strng(ii) == " "); --ii; endwhile
+    ## Now we are over the variable name or closing parentesis
+    jj = ii;
+    if (strng(ii) == ")"),
+      while (strng(ii) ~= "("); --ii; endwhile
+      --ii;
+      ## Move to the left and discard any possible blank spaces
+      while (strng(ii) == " "); --ii; endwhile
+    endif
+    
+    ## Now we are over the last character of the variable name
+    while (strng(ii) ~= " "); --ii; endwhile    
+    
+    if (kk > 1);
+      arg_end(kk - 1) = ii;
+    endif    
+    vars{kk} = [ "S." strng(ii + 1: jj) ];
+  endfor
+  
+  arg_end(end) = length (strng);
+  
+  ## This variables are used in the eval function to evaluate True/False, 
+  ## so don't remove it!
+  T = ".true.";
+  F = ".false.";
+  ## Loop through every variable guess variable type
+  for kk = 1:nvars    
+    arg = strng(arg_start(kk):arg_end(kk));
+    arglit = islit(arg_start(kk):arg_end(kk))';
+    
+    ## Remove commas in non literal string...
+    commas = (! arglit && arg == ',');
+    if (any (commas))
+      arg(commas) = " ";
+    endif
+    
+    if (any (arglit))
+      ## We are parsing a variable that is literal string
+      arg = [ "{" arg "};"];
+    elseif (! isempty (find (arg == "T" || arg == "F", 1))),
+      ## We are parsing a boolean variable
+      arg = [ "{" arg "};" ];
+    else
+      ## We are parsing a numerical array
+      arg = [ "[" arg "];"];
+    endif
+    ## Eval the modified syntax in Matlab
+    eval ([vars{kk} " = " arg]);
+  endfor
+endfunction
+
+
+## Parse the literal declarations of strings and change to Matlab syntax
+function [strng, is_lit] = parse_literal_strings (strng)
+
+  len = length (strng);
+  add_squote = []; ## Positions to add a scape single quote on syntax
+  rem_dquote = []; ## Positions to remove a double quote scape on syntax
+  ii = 1;
+  while (ii < len)
+    if strng(ii) == "'",  ## Opening string with single quote...
+      ++ii;
+      while ((ii < len && strng(ii) ~= "'") || strcmp (strng(ii:ii+1), '''''')) 
+        ++ii; 
+        if strcmp (strng(ii-1:ii), ''''''),
+          ++ii;
+        endif
+      endwhile
+    endif
+    if (strng(ii) == '"')  ## Opening string with double quote...
+      strng(ii) = "'";     ## Change to single quote
+      ++ii;
+      while (strng(ii) ~= '"' || strcmp (strng(ii:i+1),'""') && ii < len)
+        ## Check for a possible single quote here
+        if strng(ii) == "'",
+          add_squote = [ add_squote ii ];
+        endif
+        ++ii; 
+        if (strcmp (strng(ii-1:ii), '""'))
+          rem_dquote = [ rem_dquote ii-1 ];
+          ++ii;
+        endif
+      endwhile
+      strng(ii) = "'";     ## Change to single quote
+    endif   
+    ++ii;
+  endwhile
+  for ii = 1:length (add_squote);
+      strng = [ strng(1:add_squote(ii)) strng(add_squote(ii):end) ];
+  endfor
+  for ii = 1:length(rem_dquote);
+      strng = [ strng(1:rem_dquote(ii)-1) strng(rem_squote(ii)+1:end) ];
+  endfor
+  
+  ## Now everything should be in Matlab string syntax
+  ## Classify syntax as literal or regular expression
+  ii = 1;
+  len = length (strng);
+  is_lit = zeros(len, 1);
+  while (ii < len)
+    if (strng(ii) == "'")  ## Opening string with single quote...
+      is_lit(ii) = 1;
+      ++ii;
+      while ((ii < len && strng(ii) ~= "'") || strcmp(strng(ii:ii+1), "''")) 
+        is_lit(ii) = 1;
+        ii = ii + 1; 
+        if (strcmp (strng(ii-1:ii), '''''')),
+          is_lit(ii) = 1;
+          ++ii;
+        endif
+      endwhile
+      is_lit(ii) = 1;    
+    endif
+    ++ii;
+  endwhile
+  
+endfunction
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/io/inst/write_namelist.m	Mon Apr 01 16:56:59 2013 +0000
@@ -0,0 +1,101 @@
+## Copyright (C) Darien Pardinas Diaz <darien.pardinas-diaz@monash.edu>
+##
+## This program is free software; you can redistribute it and/or modify it under
+## the terms of the GNU General Public License as published by the Free Software
+## Foundation; either version 3 of the License, or (at your option) any later
+## version.
+##
+## This program is distributed in the hope that it will be useful, but WITHOUT
+## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more
+## details.
+##
+## You should have received a copy of the GNU General Public License along with
+## this program; if not, see <http://www.gnu.org/licenses/>.
+
+## WRITE_NAMELIST(S, FILENAME) writes a namelist data structure S to a
+## file FILENAME. S should follow the following structure:
+##
+##                  |--VAR1
+##                  |--VAR2
+##     |-- NMLST_A--|...
+##     |            |--VARNa
+##     |
+##     |            |--VAR1
+##     |-- NMLST_B--|--VAR2
+##     |            |...
+## S --|     ...    |--VARNb
+##     |
+##     |            |--VAR1
+##     |-- NMLST_M--|--VAR2
+##                  |...
+##                  |--VARNm
+## 
+## Notes: Only supports variables of type: 
+## Scalars, vectors and 2D numeric arrays (integers and floating points)
+## Scalars and 1D boolean arrays specified as '.true.' and '.false.' strings
+## Single and 1D arrays of strings
+##  
+## Example:
+##     NMLST = read_namelist ("OPTIONS.nam");
+##     NMLST.NAM_FRAC.XUNIF_NATURE = 0.1;
+##     write_namelist(NMlST, "MOD_OPTIONS.nam");
+
+## Written by:     Darien Pardinas Diaz (darien.pardinas-diaz@monash.edu)
+## Version:        1.0
+## Date:           16 Dec 2011
+##
+## Released under GPL License 30/3/2013
+
+function [ ret ] = write_namelist (S, filename)
+
+  fid = fopen (filename, "w");
+  name_lists = fieldnames (S);
+  n_name_lists = length(name_lists);
+  
+  for ii = 1:n_name_lists,
+    ## Write individual namelist records
+    fprintf (fid, "&%s\n", name_lists{ii});
+    rcrds = S.(name_lists{ii});
+    
+    rcrds_name = fieldnames(rcrds);
+    n_rcrds = length(rcrds_name);
+    
+    for jj = 1:n_rcrds,
+      var = rcrds.(rcrds_name{jj});
+      ## Find variable type...
+      if (iscell (var)),
+        fprintf (fid, "   %s =", rcrds_name{jj});
+        if (strcmp (var{1}, ".true.") || strcmp (var{1},"'.false.")),    
+          for kk = 1:length (var),
+            fprintf (fid, " %s,", var{kk});    
+          endfor
+        else
+          for kk = 1:length (var),
+            fprintf (fid, " %s,", [ "'" var{kk} "'" ]);    
+          endfor
+        endif
+        fprintf (fid, "%s\n", "");
+      else
+        [r, c] = size (var);
+        if (r == 1 || c == 1)
+          ## Variable is a scalar or vector
+          fprintf (fid, "   %s =", rcrds_name{jj});
+          fprintf (fid, " %g,", var);
+          fprintf (fid, "%s\n", "");
+        else
+          ## Varible is a two dimensional array
+          for kk = 1:r,
+            fprintf (fid, "   %s(%i,:) =", rcrds_name{jj}, kk);
+            fprintf (fid, " %g,", var(kk,:));
+            fprintf (fid, "%s\n", ""); 
+          endfor
+        endif
+      endif
+    endfor
+    fprintf (fid, "%s\n", "/");
+  endfor
+
+  fclose (fid);
+
+endfunction