  P A S - P. WOLFERS SOFTWARE: V2.1-E OF 31-AUG-2009  RUN THE 10-DEC-2009 AT 15:16:04     PAGE   1
 The Current Source File is "/home/wolfers/Soft/cpsh_kits/MXDV4_src/mxd_dcp_lsq.pas".

 The Current Compiled Module is ".standard.".

       C    1    1  { %pragma listlvl:2; }
       C    1    2  {
       C    1    3   ******************************************************************************
       C    1    4   *                                                                            *
       C    1    5   *                                                                            *
       C    1    6   *                                                                            *
       C    1    7   *                        MMM    MMM   XXX      XXX  DDDDDDDD                 *
       C    1    8   *                        MMMM  MMMM    XXX    XXX   DDDDDDDDDD               *
       C    1    9   *                        MM MMMM MM     XXX  XXX    DD      DDD              *
       C    1   10   *                        MM  MM  MM      XXXXXX     DD       DD              *
       C    1   11   *                        MM      MM       XXXX      DD       DD              *
       C    1   12   *          T  H  E       MM      MM       XXXX      DD       DD              *
       C    1   13   *                        MM      MM      XXXXXX     DD       DD              *
       C    1   14   *                        MM      MM     XXX  XXX    DD      DDD              *
       C    1   15   *                        MM      MM    XXX    XXX   DDDDDDDDDD               *
       C    1   16   *                       MMMM    MMMM  XXX      XXX  DDDDDDDD                 *
       C    1   17   *                                                                            *
       C    1   18   *                                                                            *
       C    1   19   *                                                                            *
       C    1   20   *                 SSSSS Y     Y  SSSSS TTTTTTT EEEEEE M     M                *
       C    1   21   *                S       Y   Y  S         T    E      MM   MM                *
       C    1   22   *                S        Y Y   S         T    E      M M M M                *
       C    1   23   *                 SSSS     Y     SSSS     T    EEEEE  M  M  M                *
       C    1   24   *                     S    Y         S    T    E      M     M                *
       C    1   25   *                     S    Y         S    T    E      M     M  ..            *
       C    1   26   *                SSSSS     Y    SSSSS     T    EEEEEE M     M  ..            *
       C    1   27   *                                                                            *
       C    1   28   *                                                                            *
       C    1   29   *                                                                            *
       C    1   30   *              ---  Version  3.999 000 alpha -- 31/03/2010 ---               *
       C    1   31   *                                                                            *
       C    1   32   *                by :                                                        *
       C    1   33   *                                                                            *
       C    1   34   *                     P. Wolfers                                             *
       C    1   35   *                         c.n.r.s.                                           *
       C    1   36   *                         Institut Neel (MCMF), Bat F,                       *
       C    1   37   *                         B.P.  166 X   38042  Grenoble Cedex                *
       C    1   38   *                                                FRANCE.                     *
       C    1   39   *                                                                            *
       C    1   40   *                                                                            *
       C    1   41   ******************************************************************************
       C    1   42  
       C    1   43  
       C    1   44  ///////////////////////////////////////////////////////////////////////////////
       C    1   45  //                                                                           //
       C    1   46  //                                                                           //
       C    1   47  //                     Global Public Licence (GPL)                           //
       C    1   48  //                                                                           //
       C    1   49  //                                                                           //
       C    1   50  //    This license described in this file overrides all other licenses       //
       C    1   51  //    that might be specified in other files for this software.              //
       C    1   52  //                                                                           //
       C    1   53  //    This program is free software; you can redistribute it and/or          //
       C    1   54  //    modify it under the terms of the GNU Lesser General Public             //
       C    1   55  //    License as published by the Free Software Foundation; either           //
  P A S - P. WOLFERS SOFTWARE: V2.1-E OF 31-AUG-2009  RUN THE 10-DEC-2009 AT 15:16:04     PAGE   2
 The Current Source File is "/home/wolfers/Soft/cpsh_kits/MXDV4_src/mxd_dcp_lsq.pas".

 The Current Compiled Module is ".standard.".

       C    1   56  //    version 2.1 of the License, or (at your option) any later version.     //
       C    1   57  //                                                                           //
       C    1   58  //    This software is distributed in the hope that it will be useful,       //
       C    1   59  //    but WITHOUT ANY WARRANTY; without even the implied warranty of         //
       C    1   60  //    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU      //
       C    1   61  //    Library General Public License for more details.                       //
       C    1   62  //                                                                           //
       C    1   63  //    You should have received a copy of the GNU Lesser General Public       //
       C    1   64  //    License along with this library (see COPYING.LIB); if not, write to    //
       C    1   65  //    the Free Software Foundation :                                         //
       C    1   66  //                         Inc., 675 Mass Ave, Cambridge, MA 02139, USA.     //
       C    1   67  //                                                                           //
       C    1   68  ///////////////////////////////////////////////////////////////////////////////
       C    1   69  
       C    1   70  
       C    1   71  
       C    1   72  *******************************************************************************
       C    1   73  *                                                                             *
       C    1   74  *                                                                             *
       C    1   75  *        MXD   Data   Compiler   Least-Squares   Specific   Routines          *
       C    1   76  *                                                                             *
       C    1   77  *                                                                             *
       C    1   78  *******************************************************************************
       C    1   79  
       C    1   80  
       C    1   81  }
       C    1   82  
       C    1   83  {************     CPAS  version    *************}
       C    1   84  
       C    1   85  {
       C    1   86          *** Modification(s) from major version ***
       C    1   87  
       C    1   88  
       C    1   89                    ----
       C    1   90  
       C    1   91                   NOTHING
       C    1   92  
       C    1   93                    ----
       C    1   94  
       C    1   95  }
       C    1   96  
            1   97  module MXD_DCP_LSQ;
            1   98  
            1   99  
            1  100    %include       'MXDSRC:mxd_dcp_env';          { Load the MXD data Compiler Environment }
            1  101  
            1  102  
            1  103  
            1  104  
       C    1  105  {**************************************************}
       C    1  106  {*******          Type Declarations          ******}
       C    1  107  {**************************************************}
       C    1  108  
       C    1  109  
       C    1  110  
  P A S - P. WOLFERS SOFTWARE: V2.1-E OF 31-AUG-2009  RUN THE 10-DEC-2009 AT 15:16:04     PAGE   3
 The Current Source File is "/home/wolfers/Soft/cpsh_kits/MXDV4_src/mxd_dcp_lsq.pas".

 The Current Compiled Module is "mxd_dcp_lsq".

       C    1  111  
       C    1  112  { ******************************************************************** }
       C    1  113  { ***********  Variables to get and parse a SHELL command  *********** }
       C    1  114  { ******************************************************************** }
       C    1  115  
            1  116  var
            1  117    curr_idname:        str_ptr :=   nil; { Current identifier name pointer to search (when not in sy_ident) }
            1  118  
            1  119    module_status:      boolean := false; { Current module status flag }
            1  120  
            1  121    lsq_id_count:       integer :=     0; { Count for LSQ identifier sequence number }
            1  122  
            1  123  
            1  124  
       C    1  125    { Data Reduction Result files }
       C    1  126  
            1  127    ddi:                        ddi_file; { Data directory file }
            1  128    bdt:                        bdt_file; { Binary data file }
            1  129  
            1  130  
            1  131  
       C    1  132  { ************************************************************************************* }
       C    1  133  { ***  Global Variables of MXD-Data ComPiler environment declared with init values  *** }
       C    1  134  { ************************************************************************************* }
       C    1  135  
       C    1  136  
       C    1  137  
       C    1  138  
       C    1  139  
       C    1  140  { *************************************************************************************
       C    1  141    *                                                                                   *
       C    1  142    *                                                                                   *
       C    1  143    *        Least-Squares   Specific   Routines  for the MXD-V4 Data Compiler          *
       C    1  144    *                                                                                   *
       C    1  145    *                                                                                   *
       C    1  146    *************************************************************************************
       C    1  147  }
       C    1  148  
       C    1  149  
       C    1  150  
       C    1  151  
            1  152  [global]
            1  153  procedure DCP_LSQ_INIT;
            1  154  begin
     1      1  155    OPEN( pcd, mpcspcfile, [error_file,write_file] );
            1  156    if iostatus <> 0 then
            1  157    begin
     2      1  158      WRITELN( ' *** ', task_name, ' ERROR : Cannot Create the output MXD-PCODE file "', mpcspcfile, '".' );
            1  159      PASCAL_EXIT( 4 )                        { Stop on this fatal error }
     1      1  160    end
     0      1  161  end DCP_LSQ_INIT;
            1  162  
            1  163  
            1  164  
            1  165  [global]
  P A S - P. WOLFERS SOFTWARE: V2.1-E OF 31-AUG-2009  RUN THE 10-DEC-2009 AT 15:16:04     PAGE   4
 The Current Source File is "/home/wolfers/Soft/cpsh_kits/MXDV4_src/mxd_dcp_lsq.pas".

 The Current Compiled Module is "mxd_dcp_lsq".

            1  166  procedure DCP_LSQ_MODULE;
            1  167  begin
            1  168  end DCP_LSQ_MODULE;
            1  169  
            1  170  
            1  171  
            1  172  [global]
            1  173  procedure DCP_LSQ_SUMMARY;
            1  174  begin
     1      1  175    CLOSE( pcd )
     0      1  176  end DCP_LSQ_SUMMARY;
            1  177  
            1  178  
            1  179  
            1  180  procedure ASSIGN_VARIABLE_VALUE( ip: ide_ptr;  bdcl: boolean );
            1  181  const
            1  182    mdnam = 'SVAR';
            1  183  
            1  184  var
            1  185    bvl, btv, bnd:      boolean := false;
            1  186    val, vsg:           mxd_flt :=   0.0;
            1  187    stn:                          string;
            1  188    tbs:                         tbs_ptr;
            1  189  
            1  190  begin
     1      1  191    with sy_sym, ip^ do
            1  192    if (sy = becomes) or ((sy = relop) and (op = eq_op)) then
            1  193    begin { In the source we can find "=" or ":=" }
     2      1  194      INSYMBOL;
            1  195      GET_EXPRESSION;
            1  196      case exp_res.exp_form of
            1  197        form_valstr: ;
            1  198        form_valint: ;
            1  199        form_valflt: ;
            1  200        form_tabstr: ;
            1  201        form_tabint: ;
            1  202        form_tabflt: ;
            1  203  
            1  204      otherwise
            1  205      end;
            1  206  
            1  207  
       C    1  208  (*
       C    1  209        if sy = lparen then
       C    1  210        begin  btv := true; sy := comma  end
       C    1  211        else
       C    1  212        begin
       C    1  213          val := GET_FLTEXPR( 0.0 );
       C    1  214          if sy = colon then
       C    1  215          begin  INSYMBOL; vsg := GET_FLTEXPR( 0.0 )  end
       C    1  216        end
       C    1  217      end;
       C    1  218  
       C    1  219      if ide_obj.knd = idek_tabflt then
       C    1  220      begin { We create an array of LSQ Variables }
  P A S - P. WOLFERS SOFTWARE: V2.1-E OF 31-AUG-2009  RUN THE 10-DEC-2009 AT 15:16:04     PAGE   5
 The Current Source File is "/home/wolfers/Soft/cpsh_kits/MXDV4_src/mxd_dcp_lsq.pas".

 The Current Compiled Module is "assign_variable_value".

       C    1  221        lsq_id_count := lsq_id_count + aaf^.ide_all;
       C    1  222        NEW( asg, aaf^.ide_all );                 { Allocate the related sigma table }
       C    1  223        tbs := USR_ELTAB_SCINIT( idev_asr );      { Initialize the index scan }
       C    1  224        for ii := 1 to aaf^.ide_all do
       C    1  225        begin
       C    1  226          WRITEV( stn, ide_name^ );
       C    1  227          USR_ELTAB_SCAN( tbs, stn, bnd );        { Create the index reference and skip for next (bnd = true when 
                    it is the last elem.) }
       C    1  228          if btv then
       C    1  229          begin
       C    1  230            if sy = comma then INSYMBOL
       C    1  231                          else SRC_ERROR( mdnam, 29, e_error );
       C    1  232            val := GET_FLTEXPR( val );
       C    1  233            if sy = colon then begin  INSYMBOL; vsg := GET_FLTEXPR( vsg )  end
       C    1  234          end;
       C    1  235          aaf^.ide_ftb[ii] := val;
       C    1  236          asg^.ide_ftb[ii] := vsg;
       C    1  237          WRITELN( pcd, ORD( nd_varbl ):4, ' ', ide_sequnb + ii - 1:6,  ' ', val:16:8, ' ', vsg:16:8, ' ', stn.len
                    gth:3, ' ', stn )
       C    1  238        end;
       C    1  239        USR_ELTAB_SCEND( tbs );
       C    1  240        if btv then
       C    1  241          if sy = rparen then INSYMBOL
       C    1  242                         else SRC_ERROR( mdnam, 23, e_error )
       C    1  243      end
       C    1  244      else { We create a single of LSQ Variable }
       C    1  245      begin
       C    1  246        lsq_id_count := lsq_id_count + 1;
       C    1  247        flt := val; ide_parerr := sig;
       C    1  248        WRITELN( pcd, ORD( nd_varbl ):4, ' ', ide_sequnb:6, ' ', val:16:8, ' ', vsg:16:8, ide_name^.length:3, ' ',
                     ide_name^ )
       C    1  249      end
       C    1  250  *)
     1      1  251    end
     0      1  252  end ASSIGN_VARIABLE_VALUE;
            1  253  
            1  254  
            1  255  
            1  256  procedure OUT_VARIABLE_DCLCH( ip: ide_ptr; bdcl: boolean );
            1  257  var
            1  258    bnd:        boolean := false;
            1  259    stn:                  string;
            1  260    tbs:                 tbs_ptr;
            1  261    nd:                node_code;
            1  262  
            1  263  begin
     1      1  264    if bdcl then nd := nd_varbl
            1  265            else nd := nd_param;
            1  266  
            1  267    with sy_sym, ip^ do
            1  268    begin
     2      1  269      if idev_form = form_tabflt then
            1  270      begin { We have create or modify an array of LSQ Variables }
     3      1  271        NEW( asg, aaf^.ide_all );                 { Allocate the related sigma table }
            1  272        tbs := USR_ELTAB_SCINIT( idev_asr );      { Initialize the index scan }
  P A S - P. WOLFERS SOFTWARE: V2.1-E OF 31-AUG-2009  RUN THE 10-DEC-2009 AT 15:16:04     PAGE   6
 The Current Source File is "/home/wolfers/Soft/cpsh_kits/MXDV4_src/mxd_dcp_lsq.pas".

 The Current Compiled Module is "out_variable_dclch".

            1  273        for ii := 1 to aaf^.ide_all do
            1  274        begin
     4      1  275          if bdcl then
            1  276          begin
     5      1  277            WRITEV( stn, ide_name^ );
            1  278            USR_ELTAB_SCAN( tbs, stn, bnd )       { Create the index reference and skip for next (bnd = true when 
                    it is the last elem.) }
     4      1  279          end;
            1  280          WRITE( pcd, ORD( nd ):4, ' ', idev_sequnb + ii - 1:6,  ' ', aaf^.ide_ftb[ii]:16:8, ' ', asg^.ide_ftb[ii]
                    :16:8 );
            1  281          if bdcl then WRITELN( pcd, ' ', stn.length:3, ' ', stn )
            1  282                  else WRITELN( pcd )
     3      1  283        end;
            1  284        if bdcl then USR_ELTAB_SCEND( tbs )
     2      1  285      end
            1  286      else { We create a single of LSQ Variable }
            1  287      begin
     3      1  288        lsq_id_count := lsq_id_count + 1;
            1  289        WRITE( pcd, ORD( nd ):4, ' ', idev_sequnb:6, ' ', flt:16:8, ' ', sig::16:8 );
            1  290        if bdcl then WRITELN( pcd, ide_name^.length:3, ' ', ide_name^ )
            1  291                else WRITELN( pcd )
     2      1  292      end
     1      1  293    end
     0      1  294  end OUT_VARIABLE_DCLCH;
            1  295  
            1  296  
            1  297  
            1  298  [global]
            1  299  procedure DCP_DEF_LSQ_VARBL( ip: ide_ptr );
       C    1  300  { Call tp complete a (LSQ) VARIABLE <name> [ := <initial value> [ : <initial_std_err> ]] declaration }
            1  301  const
            1  302    mdnam = 'LSQV';
            1  303  
            1  304  var
            1  305    bvl, btv:   boolean := false;
            1  306    val, vsg:   mxd_flt :=   0.0;
            1  307  
            1  308  begin
     1      1  309    with sy_sym, ip^ do
            1  310    begin { In the source we can find "=" or ":=" or "," or ";" }
     2      1  311      if (sy = becomes) or ((sy = relop) and (op = eq_op)) then bvl := true;
            1  312      idev_sequnb := lsq_id_count;
            1  313      if bvl then
            1  314      begin
     3      1  315        INSYMBOL;
            1  316        if sy = lparen then
            1  317        begin  btv := true; sy := comma  end
            1  318        else
            1  319        begin
     4      1  320          val := GET_FLTEXPR( 0.0 );
            1  321          if sy = colon then
            1  322          begin  INSYMBOL; vsg := GET_FLTEXPR( 0.0 )  end
     3      1  323        end
     2      1  324      end;
            1  325  
  P A S - P. WOLFERS SOFTWARE: V2.1-E OF 31-AUG-2009  RUN THE 10-DEC-2009 AT 15:16:04     PAGE   7
 The Current Source File is "/home/wolfers/Soft/cpsh_kits/MXDV4_src/mxd_dcp_lsq.pas".

 The Current Compiled Module is "P_dcp_def_lsq_varbl".

            1  326      if idev_form = form_tabflt then
            1  327      begin { We create an array of LSQ Variables }
     3      1  328        lsq_id_count := lsq_id_count + aaf^.ide_all;
            1  329        NEW( asg, aaf^.ide_all );                 { Allocate the related sigma table }
            1  330        for ii := 1 to aaf^.ide_all do
            1  331        begin
     4      1  332          if btv then
            1  333          begin
     5      1  334            if sy = comma then INSYMBOL
            1  335                          else SRC_ERROR( mdnam, 29, e_error );
            1  336            val := GET_FLTEXPR( val );
            1  337            if sy = colon then begin  INSYMBOL; vsg := GET_FLTEXPR( vsg )  end
     4      1  338          end;
            1  339          aaf^.ide_ftb[ii] := val;
            1  340          asg^.ide_ftb[ii] := vsg
     3      1  341        end;
            1  342        if btv then
            1  343          if sy = rparen then INSYMBOL
            1  344                         else SRC_ERROR( mdnam, 23, e_error )
     2      1  345      end
            1  346      else { We create a single of LSQ Variable }
            1  347      begin
     3      1  348        lsq_id_count := lsq_id_count + 1;
            1  349        flt := val; sig := vsg
     2      1  350      end;
            1  351      OUT_VARIABLE_DCLCH( ip, true )
     1      1  352    end
     0      1  353  end DCP_DEF_LSQ_VARBL;
            1  354  
            1  355  
            1  356  
            1  357  [global]
            1  358  procedure DCP_ASS_LSQ_VARBL( ip: ide_ptr );
       C    1  359  { Call tp complete a (LSQ) VARIABLE <name> [ := <initial value> [ : <initial_std_err> ]] declaration }
            1  360  const
            1  361    mdnam = 'LSQV';
            1  362  
            1  363  var
            1  364    bvl, btv: boolean := false;
            1  365    val, vsg: mxd_flt :=   0.0;
            1  366    stn:                string;
            1  367  
            1  368  begin
     1      1  369    with sy_sym, ip^ do
            1  370    begin { In the source we can find "=" or ":=" or "," or ";" }
     2      1  371      if (sy = becomes) or ((sy = relop) and (op = eq_op)) then bvl := true;
            1  372      if bvl then
            1  373      begin
     3      1  374        INSYMBOL;
            1  375        if sy = lparen then
            1  376        begin  btv := true; sy := comma  end
            1  377        else
            1  378        begin
     4      1  379          val := GET_FLTEXPR( 0.0 );
            1  380          if sy = colon then
  P A S - P. WOLFERS SOFTWARE: V2.1-E OF 31-AUG-2009  RUN THE 10-DEC-2009 AT 15:16:04     PAGE   8
 The Current Source File is "/home/wolfers/Soft/cpsh_kits/MXDV4_src/mxd_dcp_lsq.pas".

 The Current Compiled Module is "P_dcp_ass_lsq_varbl".

            1  381          begin  INSYMBOL; vsg := GET_FLTEXPR( 0.0 )  end
     3      1  382        end
     2      1  383      end;
            1  384      if idev_form = form_tabflt then
            1  385      begin { We create an array of LSQ Variables }
     3      1  386        for ii := 1 to aaf^.ide_all do
            1  387        begin
     4      1  388          WRITEV( stn, ide_name^, '[', ii:0, ']' );
            1  389          if btv then
            1  390          begin
     5      1  391            if sy = comma then INSYMBOL
            1  392                          else SRC_ERROR( mdnam, 29, e_error );
            1  393            val := GET_FLTEXPR( val );
            1  394            if sy = colon then begin  INSYMBOL; vsg := GET_FLTEXPR( vsg )  end
     4      1  395          end;
            1  396          aaf^.ide_ftb[ii] := val;
            1  397          asg^.ide_ftb[ii] := vsg;
            1  398          WRITELN( pcd, ORD( nd_varbldf ):4, ' ', stn.length:3, ' ', stn, ' ', val:16:8, ' ', vsg:16:8 )
     3      1  399        end;
            1  400        if btv then
            1  401          if sy = rparen then INSYMBOL
            1  402                         else SRC_ERROR( mdnam, 23, e_error )
     2      1  403      end
            1  404      else { We create a single of LSQ Variable }
            1  405      begin
     3      1  406        flt := val;
            1  407        sig := vsg;
            1  408        WRITELN( pcd, ORD( nd_varbldf ):4, ' ', ide_name^.length:3, ' ', ide_name^, ' ', val:16:8, ' ', vsg:16:8 )
     2      1  409      end
     1      1  410    end
     0      1  411  end DCP_ASS_LSQ_VARBL;
            1  412  
            1  413  
            1  414  
            1  415  
            1  416  [global]
            1  417  procedure DCP_DEF_LSQ_PARM( ip: ide_ptr );
       C    1  418  { Call to perform a (LSQ) PARAM <name> = <expression> declaration }
            1  419  var
            1  420    bvl, btv: boolean := false;
            1  421    val, sig: mxd_flt :=   0.0;
            1  422    stn:                string;
            1  423  
            1  424  begin
            1  425    
            1  426  end DCP_DEF_LSQ_PARM;
            1  427  
            1  428  
            1  429  
            1  430  
            1  431  
            1  432  end MXD_DCP_LSQ.
            1  433  
