rangechk.src

没有说明

/*
* rangechk.src - Check Data Range Specified.
** (C) Copyright 1992-1998 by Aptech Systems, Inc.
** All Rights Reserved.
**
** This Software Product is PROPRIETARY SOURCE CODE OF APTECH
** SYSTEMS, INC.    This File Header must accompany all files using
** any portion, in whole or in part, of this Source Code.   In
** addition, the right to create such files is strictly limited by
** Section 2.A. of the GAUSS Applications License Agreement
** accompanying this Software Product.
**
** If you wish to distribute any portion of the proprietary Source
** Code, in whole or in part, you must first obtain written
** permission from Aptech Systems.
**
** > _rngchk
**
** Format:  { nr,start,counter,lastobs } = _rngchk(dataset,range);
**
*/

proc(4)=_rngchk(dataset,range);

    local fp,nr,row,start,counter,l_obs,r,errmsg1,errmsg2;

    dataset = "" $+ dataset;
    fp = -1;
    open fp = ^dataset;
    if fp == -1;
       goto errout("ERROR:  Data file not found.","dataset: " $+ dataset);
    endif;

    if not range >= 0;
       goto errout("ERROR:  Data range is invalid",
                   "Range:  " $+ ftos(range[1],"%*.*lf",1,0)
                    $+ " to " $+ ftos(range[2],"%*.*lf",1,0));
    endif;

    row=rowsf(fp);
    if range[1]==1 or range[1]==0;
       start=1;
    else;
       start=range[1];
    endif;
    if range[2]==0;
       l_obs=row;
    elseif range[2] > row;
       goto errout("ERROR:  Data range is invalid",
                   "Range:  " $+ ftos(range[1],"%*.*lf",1,0)
                    $+ " to " $+ ftos(range[2],"%*.*lf",1,0));
    else;
       l_obs=range[2];
    endif;

    r=l_obs-start+1;

    if r-1 < 0;
       goto errout("ERROR:  Data range is invalid",
                   "Range:  " $+ ftos(range[1],"%*.*lf",1,0)
                    $+ " to " $+ ftos(range[2],"%*.*lf",1,0));
    endif;

    nr=minc(getnr(3.5,colsf(fp))|r);
    counter=start-1;

    if fp > 0;
       fp=close(fp);
    endif;
    retp(nr,start,counter,l_obs);

errout:
    pop errmsg2;
    pop errmsg1;

    print;
    printdos "\27[1;35;40m";
    errorlog errmsg2;
    printdos "\27[1;33;40m";
    errorlog errmsg1;
    printdos "\27[0m";
    if fp > 0;
       fp=close(fp);
    endif;
    end;

endp;