Beispiel #1
0
/** 
 * WINDOW command, parse the parameter setting command
 *    Sets graphics window attributes
 *
 * @param nerr
 *    Error Return Code
 *    - 0 on Success
 *    - Non-Zero on Error
 *
 * @date   861230:  Original version.
 *
 */
void 
xwindow(int *nerr) {
	int iwin;

  int width, height;
  double ratio;
  int ratio_on;
  double tmp[2];

	*nerr = 0;
	iwin = 1;
    ratio = 11.0 / 8.5;
	/* - Loop on each token in command: */

L_1000:
	if( lcmore( nerr ) ){

          /* -- Set up window number. */
          if( lcirc( 1, MWINDOWS, &iwin ) ){  

          } else if( lkrrcp( "XSIZE$",7, 0., 1., &tmp[0], &tmp[1] ) ){
            Xwindowmin[iwin] = tmp[0];
            Xwindowmax[iwin] = tmp[1];
            set_window_width( -1 );
            set_window_height( -1 );
            set_constrain_plot_ratio_x11( FALSE );

          } else if( lkrrcp( "YSIZE$",7, 0., 1., &tmp[0], &tmp[1] ) ){
            Ywindowmin[iwin] = tmp[0];
            Ywindowmax[iwin] = tmp[1];
            set_window_width( -1 );
            set_window_height( -1 );

          } else if( lkint( "WIDTH$", 7, &width) ) { 

            set_window_width( width );

          } else if( lkint( "HEIGHT$", 7, &height) ) { 

            set_window_height( height );

          } else if( lklogr( "ASPECT$", 8, &ratio_on, &ratio) ) { 

              set_constrain_plot_ratio_x11( ratio_on );
              if(ratio_on) {
                  set_plot_ratio_x11( ratio );
              }

          } else{

            cfmt( "ILLEGAL OPTION:",17 );
            cresp();
            
          }
          goto L_1000;
        }
        
 	return;

}
void TestChainTraverserComments::TestFixAnnotationChrFmt()
{
	RTFFileContext context;
	CRtfDocumentChainBuilder bld(&context);
	CChainTraverser_FixCommentStyles trav(&bld);
	
	CRTF_String string(bld.GetContext(), Detached);
	trav.FixAnnotationChrFmt(&string);
	
	CRTF_Note note(bld.GetContext(), Detached);
	trav.FixAnnotationChrFmt(&note);
	
	CRTF_ParaMarker para(bld.GetContext(), Detached);
	CRTF_CharacterProperties props(&context);
	RTFchrfmt cfmt(&context);
	
	cfmt.SetAnnotationChrfmt(asAnnotationConfirmed);
	cfmt.Flags.byBits.m_iHidden = 1;

	props.SetChrfmt(cfmt);
	para.SetCharFormat(&props);

	assertMessage(para.GetCharFormat()->GetChrfmt().GetAnnotationChrfmt()==asNone, _T("Annotation Chrfmt is always set to asNone now.  We don't write them out any more."));
	assertTest(para.GetCharFormat()->GetChrfmt().get_bHidden());

	trav.FixAnnotationChrFmt(&para);
	
	assertTest(para.GetCharFormat()->GetChrfmt().GetAnnotationChrfmt()==asNone);
	assertTest(!para.GetCharFormat()->GetChrfmt().get_bHidden());
}
Beispiel #3
0
/** 
 * Execute the PAUSE command to pause.
 *    The command sends a message to the terminal and then pauses 
 *    and waits for a return message
 * 
 * @param nerr 
 *    Error Return Flag
 *    - 0 on Success
 *
 * @date   860925:  Added PERIOD option.
 * @date   840206:  Original version.
 *
 */
void 
xpause(int *nerr) {

	char kret[9];
	int nc;
	double fperio;

	*nerr = 0;
    fperio = cmexm.nperio / 1000.0;
	while ( lcmore( nerr ) ){

		/* -- "PERIOD ON|OFF|v":  set period of time to pause. */
		if( lklogr( "PERIOD$",8, &cmexm.lperio, &fperio ) ){
			cmexm.nperio = (int)( 1000.0*fperio );
			if( cmexm.nperio <= 0 )
				cmexm.lperio = FALSE;
		}

		/* -- Determine text of pause message. */
		else if( lkchar( "MESSAG$",8, MCMSG - 2, kmexm.kpause,MCMSG+1, 
		 &nc ) ){
			subscpy( kmexm.kpause, nc, -1, MCMSG, " $" );
		}

		/* -- Bad syntax. */
		else{
			cfmt( "ILLEGAL OPTION:",17 );
			cresp();
		}
	}
	if( cmexm.lperio ){
		nc = indexb( kmexm.kpause,MCMSG+1 );
		if( nc > 2 ) {
      int n = 1;
      char *p = &kmexm.kpause[0];
      while(*p && *p != '$' && n < nc-1) {
        fprintf(stdout, "%c", *p);
        p++;
        n++;
      }
      fflush(stdout);
    }
		zsleep( cmexm.nperio );
	}
	else{
		zgtmsg( kmexm.kpause,MCMSG+1, kret,9 );
	}


	return;
}
Beispiel #4
0
/** 
 * Execute the HELP command printing the online help package
 * 
 * @param lprint 
 *    - TRUE print the output on a printer
 *    - FALSE do not print
 * @param nerr 
 *    Error Return Flag
 *    - 0 on Success
 *
 * @date   820823:  Factored from original larger subroutine.
 *
 */
void 
xhelp( int  lprint, 
       int *nerr ) {

	char ktoken[30];
	int lintro;
	static char kintro[9] = "HLPINTRO";

    int i;
    char *file;
    string_list *list;

	*nerr = 0;
	lintro = TRUE;

	/* - Loop on each token in command: */

  if (lcmore(nerr)){
    if( ( list = lcdfl () ) ) {
		lintro = FALSE;

		for(i = 0; i < string_list_length(list); i++) {
            file = string_list_get(list, i);
            strncpy(ktoken, file, strlen(file));
            ktoken[strlen(file)] = 0;
		    modcase ( FALSE, ktoken, strlen (ktoken), ktoken ) ;
		    wrhelp(ktoken,strlen(ktoken)+1, 1, lprint , nerr);
		    if(*nerr != 0){
                if( *nerr < 0 ) *nerr = 0;
                goto L_8888;
		    }
		} /* end for */
	    }
	    else{
		cfmt("ILLEGAL OPTION:",17);
		cresp();
	    }
	}

	if( *nerr != 0 )
	    goto L_8888;

	/* - If there were no tokens in command, print the
	 *   introductory help package. */

	if( lintro )
	    wrhelp( kintro,9, 1, lprint , nerr );

L_8888:
	return;
}
Beispiel #5
0
bool IsParaWithListText(const RTFObject* pObj, RTFfile* pFile, CStdString sListText)
{
	if (pObj->GetType() != rotFormatting)
		return false;

	RTFformatting* pForm = (RTFformatting*) pObj;
    
	CWideString cws;
	RTFFileContext context;
	RTFchrfmt cfmt(&context);
	if (!pForm->GetListNumber(pFile, cws, cfmt))
		return false;

	CStdString csFound = cws.GetData();

	return csFound == sListText;
	
}
Beispiel #6
0
/** 
 * Execute the command READERR which controls behavior for read errors 
 * 
 * @param nerr 
 *    Error Return Flag
 *    - 0 on Success
 *
 * @date   920501:  Added KECMEM, save or delete contents in memory.
 * @date   820817:  Changed to newest set of parsing and checking functions.
 * @date   820113:  Merged old ERRCON command into this command.
 *
 */
void 
xrerr(int *nerr) {

	int index;

	*nerr = 0;

L_1000:
	if( lcmore( nerr ) ){

	  /* -- "BADFILE FATAL|WARNING|IGNORE":  error control for missing
	   *                                     or unreadable data file. */
	  if( lklist( "BADFILE$",9, (char*)kmexm.kectp, 9, 
		      cmexm.nectp, &index ) ){
	    strcpy( kmdfm.kecbdf, kmexm.kectp[index - 1] );
	    
	  }
	  /* -- "NOFILES FATAL|WARNING|IGNORE":  
	   *     error control for null data file list. 
	   */
	  else if( lklist( "NOFILES$",9, (char*)kmexm.kectp,9, 
			   cmexm.nectp, &index ) ){
	    strcpy( kmexm.kecnof, kmexm.kectp[index - 1] );
	    
	  }
	  /* -- "MEMORY SAVE|DELETE":  error control for memory contents. */
	  else if( lklist( "MEMORY$",8, (char*)kmexm.kectp,9, 
			   cmexm.nectp, &index ) ){
	    strcpy( kmdfm.kecmem, kmexm.kectp[index - 1] );
	    
	  }
	  /* -- Bad syntax. */
	  else {
	    cfmt( "ILLEGAL OPTION:",17 );
	    cresp();
	  }
	  goto L_1000;
	}
       
	return;
}
Beispiel #7
0
/** 
 * parse the parameter-setting command COLOR.
 *    COLOR controls the color display attributes.
 * 
 * @param nerr 
 *   Error return Flag
 *   - 0 on Success
 *   - Non-Zero on Error
 *
 * @bug Not sending error message if user attempts to create a
 *      too large a color list.  The last color in list is changed.
 *
 * @date   821221:  Added ability to change color list.
 * @date   820809:  Changed to newest set of parsing and checking functions.
 * @date   820305:  Original version.
 *
 */
void 
xcolor(int *nerr)
{
	char ktok[9];
	int lnum;
	int inum;
	*nerr = 0;
  

	/* - Parse position-dependent tokens: */

	if( lclog( &cmgem.lcol ) ) {
  } else if(lcint(&lnum)) { 
    if(!color_data_set(lnum)) {
      BAD_COLOR;
    }
  } else if(lcchar(9,ktok,9,&lnum)) {
    if(!color_data_set_by_name(ktok)) {
      BAD_COLOR;
    }
  }
	

	/* - Parse position-independent tokens: */

	while( lcmore( nerr ) ){

    /* -- "SKELETON color/int":  change skeleton color. */
    if( lckey( "SK$",4 ) ){
      if(lcint(&lnum)) {
        if(!color_skeleton_set(lnum)) {
          BAD_COLOR;
        }
      } else if(lcchar(9,ktok,9,&lnum)) {
        if(!color_skeleton_set_by_name(ktok)) {
          BAD_COLOR;
        }
      } else {
        BAD_COLOR;
      }
		}
    /* -- "BACKGROUND color/int":  change the background color. */
    else if( lckey( "BA$",4 ) ){
      if(lcint(&lnum)) {
        if(!color_background_set(lnum)) {
          BAD_COLOR;
        }
      } else if(lcchar(9,ktok,9,&lnum)){
        if(!color_background_set_by_name(ktok)) {
          BAD_COLOR;
        }
      } else {
        BAD_COLOR;
      }
    }
	    /* -- "LIST STANDARD/colorlist":  change the color list. */
    else if( lckey( "L$",3 ) ){
      if( lckey( "S$",3 ) ){
		    inicol( cmgem.iicol, &cmgem.nicol );
      }
      else{
		    cmgem.nicol = 0;
		    while( lcmore(nerr) ) {
          if(lcint(&inum)) {
            if(inum >= 0) {
              if( cmgem.nicol < MICOL )
                cmgem.nicol = cmgem.nicol + 1;
              cmgem.iicol[cmgem.nicol-1] = inum;
            } else {
              BAD_COLOR;
            }
          } else if(lcchar(9,ktok,9,&lnum)){
            convcolorname( ktok, &inum );
            if( inum >= 0 ){
              if( cmgem.nicol < MICOL )
                cmgem.nicol = cmgem.nicol + 1;
              cmgem.iicol[cmgem.nicol-1] = inum;
            } else {
              BAD_COLOR;
            }
          }
		    }
		    if( cmgem.nicol <= 0 )
          inicol( cmgem.iicol, &cmgem.nicol );
		    cmgem.icol = cmgem.iicol[1-1];
        color_switch(TRUE);
		    cmgem.jicol = 0;
      }
    }
    
    /* -- "INCREMENT ON/OFF":  increment color after each file or not */
    else if( lklog( "I$",3, &cmgem.licol ) ){
      color_switch(TRUE);
      cmgem.jicol = 0;
    }
    
    /* -- Bad syntax. */
    else{
      cfmt( "ILLEGAL OPTION:",17 );
      cresp();
    }
	}  /* end while( lcmore( nerr ) ) */


}
Beispiel #8
0
void xp1(int *nerr)
{
        int n;
	char *kptext, kret[9];
	int l1dttm, lany, lbotaxsave, lbottcsave, lframesave, ltitlsave, 
	 ltoptcsave, lwait, lxgrdsave, lxlabsave, lxlims, lylabsave,
	 lprint = FALSE , ltry = FALSE ;
	int i, jdfl, jdfl1, jdfl2, jfr, jperfr, n1dttm[6], 
	 ncret, nfr, nlcx, nlcy, nperfr, num, notused;
	float tmax, tmaxj, tmin, tminj, toff[MDFL], ypdel, ypmxsave;

	static int lrel = FALSE;
	static int lperpl = FALSE;
	static int nperpl = 3;
	static char kwait[9] = "Waiting$";

	float *const Toff = &toff[0] - 1;


	/*=====================================================================
	 * PURPOSE:  To execute the action command P1.
	 *           This command makes a multi-trace, multi-window plot.
	 *=====================================================================
	 * OUTPUT ARGUMENTS:
	 *    nerr:    Error return flag.  Set to 0 if no error occurred.
	 *             Potential error numbers:  1001, 1504.
	 *=====================================================================
	 * MODULE/LEVEL:  gam/2
	 *=====================================================================
	 * GLOBAL INPUT:
	 *    mach:
	 *    dfm:     ndfl, sacmem
	 *    hdr:     begin, ennd, delta
	 *    gem:     lbotax, lbottc, ltopax, ltoptc, lxlab, lylab, ltitl,
	 *             lxgrd, ypmn, ypmx, chht, tsdef
	 *    gam:     kgddef
	 *=====================================================================
	 * SUBROUTINES CALLED:
	 *=====================================================================
	 * MODIFICATION HISTORY:
	 *    970908:  Modified response to ddttm.  maf 
	 *    970723:  Commented out an if statement to fix a bug which kept
	 *             p1 relative from functioning when xlim was set. maf
         *    970130:  Added arguments to dispid() to plot file number. maf
	 *    910607:  Move stmt label 8888 back to where it was.
	 *             Changed gots to goto plrest after call to plsave.
	 *             Error condition before lframesave goes to return. (wct).
	 *    910607:  Added call to zgetgd when no graphics device specified.
	 *             Changed call to begindevice to begindevices. (wct)
	 *    910220:  Move stmt label 8888, so lframe etc. are restored on err exit
	 *    880411:  Axes annotation now controlled by GEM variables.
	 *    850321:  Now displaying REL offset below FILEID.
	 *    821228:  Added calls to DISPID, DISPPK and PLHOME.
	 *    821122:  Added check for bad date fields.
	 *             Fixed bug involving titles and PP option.
	 *    820823:  Fixed bug involving extra x axes when using PP option.
	 *    820721:  Changed to newest set of parsing and checking functions.
	 *    811228:  Deleted call to ZCLIP.
	 *    810120:  Changed to output message retrieval from disk.
	 *    800920:  Added PERPLOT option.
	 *             Fixed bug in REL/ABS option.
	 *    800905:  Pick and file id options to new DISPLAY command.
	 *    800618:  Added pick display capability to this plot.
	 *=====================================================================
	 * DOCUMENTED/REVIEWED: 
	 *===================================================================== */
	/* PROCEDURE: */
	/* Errors before plsave have to avoid going to execute plrest. */
	*nerr = 0;

	/* PARSING PHASE: */

	/* - Loop on each token in command: */

	while ( lcmore( nerr ) ){
	    /* -- "PERPLOT ON/OFF/n":  change number of files plotted per frame. */
	    if( lklogi( "PERPLOT$",9, &lperpl, &nperpl ) )
	    { /* do nothing */ }

	    /* -- "RELATIVE/ABSOLUTE":  change method of displaying time on x axis. */
	    else if( lclog2( "RELATIVE$",10, "ABSOLUTE$",10, &lrel ) )
	    { /* do nothing */ }

            /* if PRINT option is tried, get printer name */
            else if ( ltry ) {
                lcchar ( MAXPRNTRNAMELEN   , kmgem.kptrName ,
                         MAXPRNTRNAMELEN+1 , &notused ) ;
                terminate ( kmgem.kptrName ) ;
                if ( !lprint )
                    kmgem.kptrName[0] = '\0' ;

                ltry = FALSE ;
            }

	    /* -- "PRINT":  print the final product */
	    else if( lckey( "PRINT#$", 8 ) ) {
		ltry = TRUE ;
		if ( cmgdm.lbegf ) {
		    setmsg ( "WARNING" , 2403 ) ;
		    outmsg () ;
		    clrmsg () ;
		}
		else {
		    lprint = TRUE ;
		}
	    }

	    /* -- Bad syntax. */
	    else{
		cfmt( "ILLEGAL OPTION:",17 );
		cresp();
	    }
	} /* end while */

	/* - The above loop is over when one of two conditions has been met:
	 *   (1) An error in parsing has occurred.  In this case NERR is > 0 .
	 *   (2) All the tokens in the command have been successfully parsed. */

	if( *nerr != 0 )
	    goto L_8888;

	/* CHECKING PHASE: */

	/* - Check for null data file list. */

	vflist( nerr );
	if( *nerr != 0 )
	    goto L_8888;

	/* - Check to make sure all files are time series files. */

	vftime( nerr );
	if( *nerr != 0 ){
	    aplmsg( "Use PLOTSP command to plot spectral data.",42 );
	    goto L_8888;
	}

	/* - If no graphics device is open, try to open the default device. */

	getstatus( "ANY", &lany );
	if( !lany ){
	    zgetgd( kmgam.kgddef,9 );
	    begindevices( kmgam.kgddef,9, 1, nerr );
	    if( *nerr != 0 )
		goto L_8888;
	}

	/* EXECUTION PHASE: */

	/* - Save current plot and x limit attributes.
	 * - Error after plsave have to go to execute plrest. */

	plsave();

        /* initialize plot offsets */
        for ( i=0; i<MDFL; i++) toff[i] = 0.0;

	/* - Set up specific options that apply only to this plot. */

	lbotaxsave = cmgem.axis[BOTTOM].annotate;
	lbottcsave = cmgem.axis[BOTTOM].ticks;
	ltoptcsave = cmgem.axis[TOP].ticks;
	cmgem.axis[BOTTOM].ticks    = FALSE;
	cmgem.axis[BOTTOM].annotate = FALSE;

	lxlabsave = cmgem.xlabel.on;
	lylabsave = cmgem.ylabel.on;
	ltitlsave = cmgem.title.on;
	lxgrdsave = cmgem.lxgrd;
	cmgem.xlabel.on = FALSE;
	cmgem.ylabel.on = FALSE;
	cmgem.title.on  = FALSE;
	cmgem.lxgrd = FALSE;

	/* - Set up y window for each subplot. */

	if( lperpl ){
	    nfr = (cmdfm.ndfl - 1)/nperpl + 1;
	    nperfr = nperpl;
	}
	else{
	    nfr = 1;
	    nperfr = cmdfm.ndfl;
	}
	ypdel = (cmgem.plot.ymax - cmgem.plot.ymin)/(float)( nperfr );

	/* - Check WAIT option.  This is on when:
	 * -- A wait request has been made.
	 * -- An active device (normally the user's terminal) is on. */

	if( cmgam.lwaitr )
	    getstatus( "ACTIVE", &lwait );
	else
	    lwait = FALSE;

	/* - Loop on number of frames: */

	jdfl1 = 1;
	ypmxsave = cmgem.plot.ymax;
	lframesave = cmgem.lframe;
	for( jfr = 1; jfr <= nfr; jfr++ ){
	    /* set cmgem.lframe FALSE for each pass through loop, because 
		endframe() sets it back to TRUE for the next pass. */
	    cmgem.lframe = FALSE;

	    /* -- No wait after last frame. */
	    if( jfr == nfr && !cmgam.lwaite )
		lwait = FALSE;

	    /* -- Loop on data files in each frame: */

	    jdfl2 = min( cmdfm.ndfl, jdfl1 + nperfr - 1 );

	    /* -- Determine time limits for x axis of this frame.
	     *    (Correct for any differences in GMT reference time.) */

	    getfil( jdfl1, TRUE, &num, &nlcy, &nlcx, nerr );
	    if( *nerr != 0 )
		goto L_7777;
	    jperfr = 1;
	    getxlm( &lxlims, &tmin, &tmax );
/*            if( !lxlims ){	commented out to allow relative mode when xlim is set. maf 970723 */
		if( lrel ){
		    tmax = tmax - tmin;
		    Toff[jperfr] = -tmin;
		    tmin = 0.;
	    	}
	    	else{
		    copyi( nzdttm, n1dttm, 6 );
		    l1dttm = ldttm( n1dttm );
		    Toff[jperfr] = 0.;
	    	}
		for( jdfl = jdfl1 + 1; jdfl <= jdfl2; jdfl++ ){
		    jperfr = jperfr + 1;
		    getfil( jdfl, TRUE, &num, &nlcy, &nlcx, nerr );
		    if( *nerr != 0 )
			goto L_7777;
		    getxlm( &lxlims, &tminj, &tmaxj );
		    if( lrel ){
			tmax = fmax( tmax, tmaxj - tminj );
			Toff[jperfr] = -tminj;
		    }
		    else{
			if( l1dttm && ldttm( nzdttm ) ){
			    ddttm( nzdttm, n1dttm, &Toff[jperfr] );
			    /* if it starts 2 days after the first file,
				plot relative. maf 970908 */
			    if ( fabs ( Toff[jperfr] ) > TWODAYS )
				Toff[jperfr] = 0 ;
			}
			else{
			    Toff[jperfr] = 0.;
			}
			tmin = fmin( tmin, tminj + Toff[jperfr] );
			tmax = fmax( tmax, tmaxj + Toff[jperfr] );
		    } /* end else associated with if ( lrel ) */
		} /* end for( jdfl = jdfl1 + 1; jdfl <= jdfl2; jdfl++ ) */
/*	    }  end if ( !lxlims ) commented out to allow relative mode when xlim is set. maf 970723 */

	    /* - Check range of time limits to avoid errors that could occur
	     *   later during plotting. *

	    if( fabs( tmax - tmin ) > (float)( MLARGE ) ){
		*nerr = 1504;
		setmsg( "ERROR", *nerr );
		goto L_7777;
	    } */

	    /* - Set x axis plot limits. */

	    cmgem.lxlim = TRUE;
	    cmgem.ximn = tmin;
	    cmgem.ximx = tmax;

	    if( lframesave ){
		beginframe( lprint , nerr );
		if( *nerr != 0 )
		    goto L_7777;
		getvspace( &cmgem.view.xmin, &cmgem.view.xmax, 
                           &cmgem.view.ymin, &cmgem.view.ymax );
	    }
	    jperfr = 0;

	    cmgem.tsdef = fmin( cmgem.tsdef, (cmgem.view.ymax - cmgem.view.ymin)/(8.0*
	     (float)( nperfr )) );
	    cmgam.tsfid = cmgem.tsdef;
	    cmgam.tspk = cmgem.tsdef;
	    cmgem.tsaxis = cmgem.tsdef;

	    for( jdfl = jdfl1; jdfl <= jdfl2; jdfl++ ){
		jperfr = jperfr + 1;
		cmgem.plot.ymin = cmgem.plot.ymax - ypdel;

		/* --- Get pointers to this file's location in memory. */

		getfil( jdfl, TRUE, &num, &nlcy, &nlcx, nerr );
		if( *nerr != 0 )
		    goto L_7777;

		/* --- Set up x axis data values. */

		if( *leven ){
		    cmgem.xgen.on = TRUE;
		    cmgem.xgen.delta = *delta;
		    cmgem.xgen.first = *begin + Toff[jperfr];
		}
		else{
		    cmgem.xgen.on = FALSE;
		}

		/* --- Set up y axis plot limits. */

		getylm( &cmgem.lylim, &cmgem.yimn, &cmgem.yimx );

		/* --- Plot this file. */

		pl2d( cmmem.sacmem[nlcx], cmmem.sacmem[nlcy], num, 1, 1, nerr );
		if( *nerr != 0 )
		    goto L_7777;

		/* --- Plot picks and fileid. */

		disppk( Toff[jperfr] );
                
		/* --- Add a label with offset time if this is a REL plot. */
                kptext = NULL;
                n = 0;
		if( lrel && cmgam.lfidrq ){
                  asprintf(&kptext, "OFFSET: %10.3e", -Toff[jperfr] );
                  n = 1;
                }
		dispid( cmgam.lfinorq , jdfl, n, &kptext );
                if(kptext) {
                  free(kptext);
                  kptext = NULL;
                }
		cmgem.plot.ymax = cmgem.plot.ymin;
	    } 

	    /* -- Draw bottom x axis. */
	    cmgem.axis[BOTTOM].annotate = lbotaxsave;
	    cmgem.axis[BOTTOM].ticks    = lbottcsave;
	    cmgem.axis[TOP].ticks       = ltoptcsave;
	    cmgem.lxgrd = lxgrdsave;
	    cmgem.uplot.ymax = ypmxsave*cmgem.view.ymax;
	    cmgem.chht = cmgem.tsaxis;
	    cmgem.chwid = cmgem.txrat*cmgem.chht;
	    settextsize( cmgem.chwid, cmgem.chht );
	    if( cmgem.ixint == AXIS_LINEAR ){
		xlinax();
	    }
	    else if( cmgem.ixint == AXIS_LOG ){
		xlogax();
	    }

	    /* -- Draw axes labels and title. */
	    if( lxlabsave )
                centxt( kmgem.kxlab,145, cmgem.xlabel.len, cmgem.xlabel.pos, cmgem.xlabel.text_size );
	    if( lylabsave )
		centxt( kmgem.kylab,145, cmgem.ylabel.len, cmgem.ylabel.pos, cmgem.ylabel.text_size );
	    if( ltitlsave )
		centxt( kmgem.ktitl,145, cmgem.title.len, cmgem.title.pos, cmgem.title.text_size );

	    /* -- Home cursor, advance frame and restore some GEM parameters. */
	    plhome();
	    if( lframesave )
		endframe( FALSE , nerr );
            else
              flushbuffer( nerr );
	    cmgem.plot.ymax = ypmxsave;
	    cmgem.axis[BOTTOM].annotate = FALSE;
	    cmgem.axis[BOTTOM].ticks    = FALSE;

	    /* -- Wait for user prompt before plotting next frame if appropriate. */
	    if( lwait ){
		zgpmsg( kwait,9, kret,9 );
		ncret = indexb( kret,9 );
		upcase( kret, ncret, kret,9 );
		if( kret[0] == 'K' )
		    goto L_7777;
		if( kret[0] == 'G' )
		    lwait = FALSE;
	    }

	    jdfl1 = jdfl2 + 1;
	} /* end for ( jfr ) */

	/* - Restore plot and x limit attributes.  Return. */

L_7777:
	plrest();
	cmgam.tsfid = cmgem.tsdef;
	cmgam.tspk = cmgem.tsdef;
	cmgem.tsaxis = cmgem.tsdef;

	cmgem.plot.ymax = ypmxsave;
	cmgem.axis[BOTTOM].annotate = lbotaxsave;
	cmgem.axis[BOTTOM].ticks    = lbottcsave;
	cmgem.lframe = lframesave;

L_8888:
	return;
} /* end of function */
Beispiel #9
0
/** 
 * Execute the getbb command which gets the blackboard variables
 * 
 * @param nerr 
 *    Error Return Flag
 *    - 0 on Success
 *
 * @date   890104:  Changed from terminal output to message subsystem.
 * @date   880901:  Added TO, NAMES, and NEWLINE options.
 * @date   870917:  Added ALL option.
 * @date   870514:  Original version.
 *
 */
void 
xgetbb(int *nerr) {

	char kbbvalue[MCMSG+1];
	int ic1, ic2, nc, ncbb ;
  var *v;
  char *name;

	*nerr = 0;

    memset(kmexm.knmbbwrite,0, sizeof(kmexm.knmbbwrite));
    memset(kbbvalue, 0, sizeof(kbbvalue));

	while ( lcmore( nerr ) ){

	    /* -- "ALL": report all of the currently defined blackboard variables. */
    if( lckey( "ALL#$",6 ) ){
      cmexm.lbball = TRUE;
    }
    
    /* -- "TO TERMINAL|filename": define where the output is to be sent. */
    else if( lckey( "TO#$",5 ) ){
      if( lckey( "TERM#INAL$",11 ) ){
		    cmexm.nunbbwrite = MUNOUT;
      }
      else if( lcchar( MCPFN, kmexm.knmbbwrite,MCPFN+1, &nc ) ){
		    cmexm.nunbbwrite = (FILE *)NULL;
		    if( *nerr != 0 )
          goto L_8888;
      }
      else{
		    cfmt( "ILLEGAL OPTION:",17 );
		    cresp();
      }
    }
    
	    /* -- "NAMES ON|OFF": option to include the
         bb variable name with the value. */
    else if( lklog( "NAMES#$",8, &cmexm.lnames ) ) { }
    
	    /* -- "NEWLINE ON|OFF": option to append newline
         after each bb variable value. */
    else if( lklog( "NEWLINE#$",10, &cmexm.lnewline ) ) { }
    
    /* -- The rest of the tokens should be names of a blackboard variables.
     *    First unset ALL flag and initialize list of bb variables.
     *    Then set up an inner parsing loop to collect all of the 
     *    variable names. */
    else{
      cmexm.lbball = FALSE;
      memset ( kmexm.kbbcl , ' ' , MCMSG );
      
      if(!lccl(kmexm.kbbcl, MCMSG+1, &ncbb)) {
        cfmt( "ILLEGAL OPTION:",17 );
        cresp();
      }
    }
	} /* end while */

	/* - The above loop is over when one of two conditions has been met:
	 *   (1) An error in parsing has occurred.  In this case NERR is > 0 .
	 *   (2) All the tokens in the command have been successfully parsed. */

	if( *nerr != 0 )
		goto L_8888;

	/* EXECUTION PHASE: */

	/* - Open disk file if necessary. */

	if( cmexm.nunbbwrite != MUNOUT ){
    znfiles( &cmexm.nunbbwrite, kmexm.knmbbwrite,MCPFN+1, "TEXT",5,  nerr );
    if( *nerr != 0 )
      goto L_8888;
    if ( fseek ( cmexm.nunbbwrite , 0L , SEEK_END ) != 0 )
      fprintf ( stdout , "fseek returned error-xgetbb\n" ) ;
	}

	/* - Sequentially access blackboard if ALL was requested. */

	setmsg( "OUTPUT", 99 );
	if( cmexm.lbball ){
    int i = 0;
    char **keys = sac_vars_keys(kmbbs.knmbbs);
    while(keys && keys[i]) { i++; }
    if(i > 0) {
      qsort(keys, i, sizeof(char*), string_cmp);
      i = 0;
      while ( keys && keys[i] ){
        if(!(v = sac_vars_get_var(kmbbs.knmbbs, keys[i]))) {
          error(ERROR_FINDING_VARIABLE, "%s", keys[i]);
          outmsg();
          clrmsg();
          i++;
          continue;
        }
        show_var(v, keys[i], cmexm.nunbbwrite);
        i++;
      }
      if( !cmexm.lnewline ) {
        newline( cmexm.nunbbwrite );
      }
      i = 0;
      while(keys && keys[i]) {
        FREE(keys[i]);
        i++;
      }
      FREE(keys);
    }
	}

	/* - Otherwise, get value for each item in request list. */
	else {
    ic1 = 0;    
    while ( lnxtcl( kmexm.kbbcl,MCMSG+1, &ic1, &ic2 ) ){
      name = strcut(kmexm.kbbcl, ic1, ic2);
      if(!(v = getbb(name))) {
        error(ERROR_FINDING_VARIABLE, "%s", name);
        outmsg();
        clrmsg();
        continue;
      }
      show_var(v, name, cmexm.nunbbwrite);
      free(name);
    }
    if( !cmexm.lnewline ) {
      newline( cmexm.nunbbwrite );
    }
	}

	clrmsg();
	if( cmexm.nunbbwrite != MUNOUT ){
	    zcloses( &cmexm.nunbbwrite, nerr );
	    if( *nerr != 0 )
		goto L_8888;
	}

L_8888:
	return;

} /* end of function */
Beispiel #10
0
/** 
 * Write a File to disk
 * 
 * @param lsdd 
 *    Set the Output to be a SDD file
 * @param nerr 
 *    Error Return Flag 
 *    - 0 on Success
 *
 * @date   970702:  Changed lckey and lkchar to lckeyExact and lkcharExact
 *                  throughout xw.c.  This will allow files to begin with 
 *                  the same string as the various options (eg. sacxz.021.z)
 *                  maf.
 * @date   910731:  Bug fixed in options PREPEND, DELETE, CHANGE.
 * @date   900904:  Added SDD as a format for write.
 * @date   881228:  Added four new options for generating write file list
 *                  from data file list: APPEND, PREPEND, CHANGE, DELETE.
 * @date   880204:  Fixed logic involving use of DIR option in READ and WRITE
 *                  by adding an ON/OFF flag as well as a directory name.
 * @date   880115:  Deleted call that forced default directory to lowercase.
 * @date   870626:  Added default directory option.
 * @date   860917:  Changed to character lists for storing data file names.
 * @date   850730:  Deleted SOCKITTOME  format.
 * @date   830120:  Added SOCK and CI output formats.
 * @date   820721:  Changed to newest set of parsing and checking functions.
 * @date   810120:  Changed to output message retrieval from disk.
 * @date   810203:  Fixed bug in file overwrite option.
 *
 */
void 
xw(int  lsdd, 
   int *nerr) {

    int i;
        char delimiter[2], kcdir[9], kchange[MCPFN+1], kdirpart[MCPFN+1];
	char kfile[MCPFN+1], kpdir[9], kstring[MCPFN+1], ktemp[9];
	int lexpnd;
	int jdfl, nchange, nchar, nchg, ndx1, ndx2;
	int nlen, nstr, nstring, nwrdir;
	static int lwrdir = FALSE;
    char *cattemp;
    char *strtemp1, *strtemp2, *strtemp3;
    
    char *file;
    string_list *list, *files;

	kschan[12]='\0';
	kschdr[80]='\0';
	ksclas[4]='\0';
	kscom[40]='\0';
	ksevnm[8]='\0';
	ksfrmt[8]='\0';
	ksstnm[8]='\0';
    memset(kfile, 0, sizeof(kfile));
    memset(kdirpart, 0, sizeof(kdirpart));
    memset(kchange, 0, sizeof(kchange));
    memset(ktemp, 0, sizeof(ktemp));
    memset(kstring, 0, sizeof(kstring));
    memset(kpdir, 0, sizeof(kpdir));
    memset(kcdir, 0, sizeof(kcdir));
    memset(delimiter, 0, sizeof(delimiter));

        lexpnd = FALSE;

	*nerr = 0;

    files = string_list_init();
    list  = NULL;

	if( lsdd )
	    cmdfm.iwfmt = 3;

	/* PARSING PHASE: */
	/* - Loop on each token in command: */
	while ( lcmore( nerr ) ){

	    /* -- "SAC|ALPHA":  set format to be used in writing files. */
	    if( lckeyExact( "SAC#$",6 ) )
		cmdfm.iwfmt = 1;

	    else if( lckeyExact( "ALPHA#$",8 ) )
		cmdfm.iwfmt = 2;

	    else if( lckeyExact( "CI#$",5 ) )
		cmdfm.iwfmt = 2;

	    else if( lckeyExact( "SDD#$",6 ) )
		cmdfm.iwfmt = 3;

	    else if( lckeyExact( "XDR#$",6 ) ) {
		cmdfm.iwfmt = 4;
            }
            else if( lckeyExact( "SEGY#$", 7 ) )
                cmdfm.iwfmt = 5;

	    /* -- "OVER":  overwrite files from previous READ command. */
	    else if( lckeyExact( "OVER#$",7 ) ){
		cmdfm.lovrrq = TRUE;
		lexpnd = FALSE;
        string_list_extend(files, datafiles);
	    }

	    /* generate names from the KSTCMP header field */
	    else if( lckeyExact( "KSTCMP#$",9 ) ){
		lexpnd = FALSE;
		gennames("KSTCMP ",7,files,string_list_length(datafiles),nerr);
		if(*nerr != 0)
		    goto L_8888;
	    }

	    /* -- "APPEND string": append string to filenames from READ command. */
	    else if( lkcharExact( "APPEND#$",9, MCPFN, kstring,MCPFN+1, &nstring ) ){
        for(i = 0; i < cmdfm.ndfl; i++) {
            strtemp1 = string_list_get(datafiles, i);
		    appendstring( kstring,MCPFN+1, strtemp1, strlen(strtemp1)+2, kfile,MCPFN+1 );

            string_list_put(files, kfile, MCPFN+1);
		    if( *nerr != 0 )
                goto L_8888;
		}
		cmdfm.lovrrq = FALSE;
		lexpnd = TRUE;
	    }

	    /* -- "PREPEND string": prepend string to filenames from READ command. */
	    else if( lkcharExact( "PREPEND#$",10, MCPFN, kstring,MCPFN+1, &nstring ) ){
        for(i = 0; i < cmdfm.ndfl; i++) {
		    strtemp1 = malloc(nstring+1);
		    strncpy(strtemp1,kstring,nstring);
		    strtemp1[nstring] = '\0';
            strtemp2 = string_list_get(datafiles, i);
		    prependstring( strtemp1, nstring+1, strtemp2, strlen(strtemp2)+2, kfile,MCPFN+1);

		    free(strtemp1);
            string_list_put(files, kfile, MCPFN+1);
		    if( *nerr != 0 )
			goto L_8888;
		}
		cmdfm.lovrrq = FALSE;
		lexpnd = TRUE;
	    }

	    /* -- "DELETE string": delete string from filenames from READ command. */
	    else if( lkcharExact( "DELETE#$",9, MCPFN, kstring,MCPFN+1, &nstring ) ){
        for(i = 0; i < cmdfm.ndfl; i++) {
		    strtemp1 = malloc(nstring+1);
		    strncpy(strtemp1,kstring,nstring);
		    strtemp1[nstring] = '\0';
            strtemp2 = string_list_get(datafiles, i);

		    deletestring( strtemp1, nstring+1, strtemp2, strlen(strtemp2)+2, kfile,MCPFN+1);

		    free(strtemp1);
            string_list_put(files, kfile, MCPFN+1);
		    if( *nerr != 0 )
			goto L_8888;
		}
		cmdfm.lovrrq = FALSE;
		lexpnd = TRUE;
	    }

	    /* -- "CHANGE string1 string2": change string1 to string2 in READ filenames. */
	    else if( lkcharExact( "CHANGE#$",9, MCPFN, kstring,MCPFN+1, &nstring ) ){
		lcchar( MCPFN, kchange,MCPFN+1, &nchange );
        for(i = 0; i < cmdfm.ndfl; i++) {
		    nstr = indexb( kstring,MCPFN+1 );
		    nchg = indexb( kchange,MCPFN+1 );

		    strtemp1 = malloc(nstr+1);
		    strtemp2 = malloc(nchg+1);
		    strncpy(strtemp1,kstring,nstr);
		    strncpy(strtemp2,kchange,nchg);
		    strtemp1[nstr] = '\0';
		    strtemp2[nchg] = '\0';
            strtemp3 = string_list_get(datafiles, i);
		    changestring( strtemp1, nstr+1, strtemp2, nchg+1,
                          strtemp3, strlen(strtemp3)+2, kfile,MCPFN+1 );

		    free(strtemp1);            
		    free(strtemp2);

            string_list_put(files, kfile, MCPFN+1);
		    if( *nerr != 0 )
			goto L_8888;
		}
		cmdfm.lovrrq = FALSE;
		lexpnd = TRUE;
	    }

	    /* -- "DIR ON|OFF|CURRENT|name":  set the name of the default subdirectory. */
	    else if( lkcharExact( "DIR#$",6, MCPFN, kmdfm.kwrdir,MCPFN+1, &nchar ) ){
		modcase( TRUE, kmdfm.kwrdir, MCPW, ktemp );

		if( strncmp(ktemp,"OFF     ",8) == 0 ) {
          lwrdir = FALSE;
        } else if( strncmp(ktemp,"CURRENT ",8) == 0 ){
          lwrdir = TRUE;
          fstrncpy( kmdfm.kwrdir, MCPFN, " ", 1);
		} else if( kmdfm.kwrdir[nchar - 1] != KDIRDL ){ 
          /* If the string is mising the "/" path separator */
          lwrdir = TRUE;
          delimiter[0] = KDIRDL;
          delimiter[1] = '\0';
          subscpy( kmdfm.kwrdir, nchar, -1, MCPFN, delimiter );
		} else {
          /* Path is not OFF, CURRENT and has the "/" at the end */
          lwrdir = TRUE;
	    }
        }
	    /* -- "COMMIT|RECALLTRACE|ROLLBACK": 
	          how to treat existing data */
	    else if ( lckeyExact ( "COMMIT" , 7 ) )
		cmdfm.icomORroll = COMMIT ;
	    else if (lckeyExact ( "RECALLTRACE" , 12 ) )
		cmdfm.icomORroll = RECALL ;
	    else if ( lckeyExact ( "RECALL" , 7 ) )
		cmdfm.icomORroll = RECALL ;
	    else if ( lckeyExact ( "ROLLBACK" , 9 ) ) 
		cmdfm.icomORroll = ROLLBACK ;


	    /* -- "filelist":  write files using names in new filelist. */
	    else if( ( list = lcdfl() ) ){
		cmdfm.lovrrq = FALSE;
		lexpnd = FALSE;
	    }

	    /* -- Bad syntax. */
	    else{
		cfmt( "ILLEGAL OPTION:",17 );
		cresp();
	    }
	} /* end while ( lcmore( nerr ) ) */

	/* - The above loop is over when one of two conditions has been met:
	 *   (1) An error in parsing has occurred.  In this case NERR is > 0 .
	 *   (2) All the tokens in the command have been successfully parsed. */

	if( *nerr != 0 )
	    goto L_8888;

	/* CHECKING PHASE: */
    if(!list) {
        list = files;
    } else {
        /* List + Modifiers :: Use List */
        string_list_free(files);
        files = NULL;
    }

	/* - Check for null write filelist. */
	if( string_list_length(list) <= 0 ){
	    *nerr = 1311;
	    setmsg( "ERROR", *nerr );
	    goto L_8888;
	}

	/* - Make sure the write filelist has as many entries as read filelist. */

	if( string_list_length(list) != cmdfm.ndfl ){
	    *nerr = 1312;
        error(1312, "%d %d", string_list_length(list), cmdfm.ndfl);
	    goto L_8888;
	}

	/* EXECUTION PHASE: */

        /* - Commit or rollback data according to cmdfm.icomORroll */
	alignFiles ( nerr ) ;
	if ( *nerr )
	    return ;


	/* - Echo expanded filelist if requested. */

	if( cmdfm.lechof && lexpnd ){
	    setmsg( "OUTPUT", 0 );

        for(i = 0; i < string_list_length(list); i++) {
            file = string_list_get(list, i);

            getdir( file, strlen(file)+1, kcdir,9, kfile,MCPFN+1 );

		/* -- Echo the filename part if there is no directory part. */
            if( strcmp(kcdir,"        ") == 0 )
                apcmsg( kfile,MCPFN+1 );

		/* -- Prepend the filename part with some special characters if
         *    directory part is same as that of the previous file. */
            else if( memcmp(kcdir,kpdir,min(strlen(kcdir),strlen(kpdir)))
                     == 0 ){
                cattemp = malloc(3+strlen(kfile)+1);
                strcpy(cattemp, "...");
                strcat(cattemp,kfile);
                apcmsg( cattemp, 3+strlen(kfile)+1 );
                free(cattemp);
            }
		/* -- Echo complete pathname if directory part is different. */
            else{
                apcmsg2(file, strlen(file)+1);
                strcpy( kpdir, kcdir );
            }
	    }
	    wrtmsg( MUNOUT );
	}

	/* - Write each file in memory to disk. */

	nwrdir = indexb( kmdfm.kwrdir,MCPFN+1 );
	for( jdfl = 1; jdfl <= cmdfm.ndfl; jdfl++ ){
	    /* -- Get file from memory manager. */
        file = string_list_get(list, jdfl-1);
	    getfil( jdfl, TRUE, &nlen, &ndx1, &ndx2, nerr );
	    if( *nerr != 0 )
		goto L_8888;

	    /* isolate file name */
        file = string_list_get(list, jdfl-1);

	    /* -- Check overwrite-protect flag in header record. */
	    if( cmdfm.lovrrq && !*lovrok ){
		*nerr = 1303;
		setmsg( "ERROR", *nerr );
		apcmsg2(file, strlen(file)+1);
		outmsg () ;
		clrmsg () ;
		goto L_8888;
	    }

	    /* -- Prepare output file name:
	     * --- If directory option is ON (lwrdir=.TRUE. and nwrdir>0), 
	     *     concatenate directory name with file name part of write file list.
	     * --- If directory option is CURRENT (lwrdir=.TRUE. and nwrdir=0), 
	     *     use file name part of write file list.
	     * --- If directory option is OFF, use write file list. */
	    if( lwrdir ){
		if( nwrdir > 0 ){
		    fstrncpy( kfile, MCPFN, kmdfm.kwrdir,min(nwrdir,MCPFN));

            strtemp1 = file;
		    strtemp2 = malloc(130-(nwrdir+1));
		    strncpy(strtemp2,kfile+nwrdir,MCPFN+1-(nwrdir + 1));
		    strtemp2[MCPFN+1-(nwrdir+1)] = '\0';
		    getdir( strtemp1, strlen(strtemp1)+1, 
                    kdirpart, MCPFN+1, strtemp2,-(nwrdir+1)+130);
		    subscpy(kfile,nwrdir,-1,MCPFN,strtemp2);
		    free(strtemp2);
		}
		else{
		    fstrncpy( kfile, MCPFN, " ", 1);
		    getdir( file, strlen(file)+1, kdirpart,MCPFN+1, kfile,MCPFN+1 );
		}
	    }
	    else {
            fstrncpy( kfile, MCPFN, file, strlen(file));
        }
	    /* -- Write file in appropriate format. */
	    if( cmdfm.iwfmt == 2 )
		wrci( jdfl, kfile,MCPFN+1, "%#15.7g", nerr );

	    else if( cmdfm.iwfmt == 3 )
		wrsdd( jdfl, kfile,MCPFN+1, TRUE, nerr );

	    else if( cmdfm.iwfmt == 4 )
		wrxdr( jdfl, kfile,MCPFN+1, TRUE, nerr );

	    else if( cmdfm.iwfmt == 5 )
		wrsegy( jdfl , kfile , nerr ) ;

	    else
		wrsac( jdfl, kfile,MCPFN+1, TRUE, nerr );

	    if( *nerr != 0 )
		goto L_8888;

	} /* end for ( jdfl ) */

L_8888:
	return;
}
Beispiel #11
0
bool TimeStamp::toString( String &target, const String &fmt ) const
{
    AutoCString cfmt( fmt );
    struct tm theTime;

    theTime.tm_sec = m_second;
    theTime.tm_min = m_minute;
    theTime.tm_hour = m_hour;
    theTime.tm_mday = m_day;
    theTime.tm_mon = m_month-1;
    theTime.tm_year = m_year - 1900;

    char timeTgt[512];
    if( strftime( timeTgt, 512, cfmt.c_str(), &theTime) != 0 )
    {
        target.bufferize( timeTgt );

        uint32 pos = target.find( "%i" );
        if( pos !=  String::npos )
        {
            String rfc;
            toRFC2822( rfc );
            while( pos != String::npos )
            {
                target.change( pos, pos + 2, rfc );
                pos = target.find( "%i", pos + 2 );
            }
        }

        pos = target.find( "%q" );
        if( pos !=  String::npos )
        {
            String msecs;
            msecs.writeNumber( (int64) m_msec );
            while( pos != String::npos )
            {
                target.change( pos, pos + 2, msecs );
                pos = target.find( "%q", pos + 2 );
            }
        }

        pos = target.find( "%Q" );
        if( pos !=  String::npos )
        {
            String msecs;
            if( m_msec < 10 )
                msecs = "00";
            else if ( m_msec < 100 )
                msecs = "0";

            msecs.writeNumber( (int64) m_msec );

            while( pos != String::npos )
            {
                target.change( pos, pos + 2, msecs );
                pos = target.find( "%Q", pos + 2 );
            }
        }

        return true;
    }

    return false;
}
Beispiel #12
0
/** 
 * Execute the action command "DIVF". This command divides a set of 
 *     files into data in memory.
 * 
 * @param nerr 
 *    Error Return Flag
 *    - 0 on Success
 *    - ERROR_OPERATION_ON_SPECTRAL_FILE
 *    - ERROR_OPERATION_ON_UNEVEN_FILE
 *    - ERROR_HEADER_FILE_MISMATCH
 *
 * @date   881130:  Fixed bug in begin time error checking.
 * @date   850730:  Changes due to new memory manager.
 * @date   820809:  Changed to newest set of parsing and checking functions.
 * @date   820331:  Combined "parse" and "control" modules.
 * @date   810224:  Original version.
 *
 */
void 
xdivf(int *nerr) {
	int jdx, jbfl, jdfl, n1zdtm[6];
	int ndx1, ndx1b, ndx2, ndx2b, nlen, nlenb, npts1;
	int lnewhdr ; /* let header data come from new file */

	float begin1, delta1, delta2, divsor;

    float *Sacmem1, *Sacmem2;
    string_list *list;

	*nerr = 0;

    list = NULL;

	while ( lcmore( nerr ) ){
	    /* -- NEWHDR:  take the header from the new file being merged in.*/
	    if ( lklog ( "NEWHDR" , 7 , &lnewhdr ) ) {
		cmbom.lnewhdr = lnewhdr ;
	    }

	    /* -- "filelist':  define a new binop filelist. */
	    if( ( list = lcdfl() ) ){
		cmbom.ibflc = 0;
	    }

	    else{
		cfmt( "ILLEGAL OPTION:",17 );
		cresp();
	    }
	}

	if( *nerr != 0 )
	    goto L_8888;

	/* CHECKING PHASE: */
	/* - Check for null data file list. */
	vflist( nerr );
	if( *nerr != 0 )
	    goto L_8888;

	/* - Check to make sure all files are evenly 
	 *   spaced time series files. */
	vfeven( nerr );
	if( *nerr != 0 )
	    goto L_8888;

	/* - Check for a null binop file list. */
    if(!list || string_list_length(list) <= 0) {
        *nerr = ERROR_BINOP_FILE_LIST_EMPTY;
        error(*nerr,"");
	    goto L_8888;
    }

	/* - Make sure each file in BFL are of the proper type. */
	for( jdfl = 1; jdfl <= cmdfm.ndfl; jdfl++ ){
	    getfil( jdfl, FALSE, &nlen, &ndx1, &ndx2, nerr );
	    if( *nerr != 0 )
			goto L_8888;
	    npts1 = *npts;
	    delta1 = *delta;
	    copyi( nzdttm, n1zdtm, 6 );
	    begin1 = *begin;
	    jbfl = min( jdfl, string_list_length(list));
	    getbfl( list, jbfl, FALSE, &nlen, &ndx1, &ndx2, nerr );
	    if( *nerr != 0 )
			goto L_8888;

        if((*nerr = vbeven()) != 0) {
            error(*nerr, "%s", string_list_get(list, jbfl-1));
            goto L_8888;
        }
        if((*nerr = delta_equal(delta1, *delta, datafiles, list, jdfl, jbfl)) != 0) {
            goto L_8888;
        }
        if((*nerr = npts_equal(npts1, *npts, datafiles, list, jdfl, jbfl)) != 0) {
            goto L_8888;
        }
        if((*nerr = time_equal(n1zdtm, nzdttm, begin1, *begin, 
                               datafiles, list, jdfl, jbfl)) != 0) {
            goto L_8888;
        }
        
	}

	/* - Release last binop file. */
	relbfl( nerr );
	if( *nerr != 0 )
	    goto L_8888;

	/* EXECUTION PHASE: */
	/* - Perform the file division on each file in DFL. */
	for( jdfl = 1; jdfl <= cmdfm.ndfl; jdfl++ ){

	    /* -- Get the next file in DFL, moving header to CMHDR. */
	    getfil( jdfl, TRUE, &nlen, &ndx1, &ndx2, nerr );
	    if( *nerr != 0 )
		goto L_8888;
	    delta2 = *delta;

	    /* -- Get the next file in the BFL, moving header to CMHDR. */
	    jbfl = min( jdfl, string_list_length(list));
	    getbfl( list, jbfl, TRUE, &nlenb, &ndx1b, &ndx2b, nerr );
	    if( *nerr != 0 )
		goto L_8888;
	    *delta = delta2;

	    /* -- Output file is the shorter of two input files. */
	    npts1 = min( nlen, nlenb );
	    Nlndta[jdfl] = npts1;

	    /* -- Perform file division on these two files. */
	    Sacmem1 = cmmem.sacmem[ndx1b];
	    Sacmem2 = cmmem.sacmem[ndx1];
	    for( jdx = 0; jdx <= (npts1 - 1); jdx++, Sacmem1++, Sacmem2++ ){
		divsor = *Sacmem1;
		if( fabs( divsor ) <= VSMALL ){
		    *Sacmem2 = sign( VLARGE, *Sacmem2 * divsor );
		}
		else{
		    *Sacmem2 = *Sacmem2/divsor;
		}
	    }

	    /* -- Adjust header of file in DFL. */
	    if ( !cmbom.lnewhdr )
		getfil ( jdfl , FALSE , &nlen , &ndx1 , &ndx2 , nerr ) ;
	    *npts = npts1 ;
	    extrma( cmmem.sacmem[ndx1], 1, *npts, depmin, depmax, depmen );

	    /* -- Return file in DFL to memory manager. */
	    putfil( jdfl, nerr );
	    if( *nerr != 0 )
		goto L_8888;

	}

	/* - Release last binop file. */
	relbfl( nerr );
	if( *nerr != 0 )
	    goto L_8888;

	/* - Calculate and set new range of dependent variable. */
	setrng();

L_8888:
	return;
}
Beispiel #13
0
BOOL WINAPI _export TerLocateChangedChar2(HWND hWnd, int InsRev, int DelRev, int FmtRev,BOOL present, long far *StartLine, int far *StartCol, BOOL forward)
{
    PTERWND w;
    long line;
    int  i,col,CurCfmt,CurInsRev,CurDelRev,CurFmtRev;
    LPWORD fmt;

    if (NULL==(w=GetWindowPointer(hWnd))) return false;  // get the pointer to window data

    // reset the checked flag
    for (i=0;i<TotalFonts;i++) ResetUintFlag(TerFont[i].flags,FFLAG_CHECKED);

    // scan each line in the forward direction
    if (forward) {
       for (line=(*StartLine);line<TotalLines;line++) {
          if (line==(*StartLine)) col=*StartCol;
          else                    col=0;

          if (col>=LineLen(line)) continue;                   // go to next line
          if (LineLen(line)==0) continue;

          if (cfmt(line).info.type==UNIFORM) {
             CurCfmt=cfmt(line).info.fmt;
             if (True(TerFont[CurCfmt].flags&FFLAG_CHECKED)) continue;  // this font id already checked
             TerFont[CurCfmt].flags|=FFLAG_CHECKED;
             
             CurInsRev=TerFont[CurCfmt].InsRev;
             CurDelRev=TerFont[CurCfmt].DelRev;
             CurFmtRev=TerFont[CurCfmt].FmtRev;

             if (LocateRevMatched(w,present,InsRev,DelRev,FmtRev,CurInsRev,CurDelRev,CurFmtRev)) {
                *StartLine=line;
                *StartCol=col;
                return true;
             }
             else continue;                       // style not found
          }

          // open the line
          fmt=OpenCfmt(w,line);
          for (i=col;i<LineLen(line);i++) {
            CurCfmt=fmt[i];
            if (True(TerFont[CurCfmt].flags&FFLAG_CHECKED)) continue;  // this font id already checked
            TerFont[CurCfmt].flags|=FFLAG_CHECKED;

            CurInsRev=TerFont[CurCfmt].InsRev;
            CurDelRev=TerFont[CurCfmt].DelRev;
            CurFmtRev=TerFont[CurCfmt].FmtRev;

            if (LocateRevMatched(w,present,InsRev,DelRev,FmtRev,CurInsRev,CurDelRev,CurFmtRev)) {
               *StartLine=line;
               *StartCol=i;
               CloseCfmt(w,line);
               return true;
            }
          }
          CloseCfmt(w,line);

          if (line==(TotalLines-1)) {       // 20080530: end of the file reached
             *StartLine=line;
             *StartCol=LineLen(line);
             return true;
          } 
       }
    }
    else { // scan each line in the backward direction
       for (line=(*StartLine);line>=0;line--) {
          if (line==(*StartLine)) col=*StartCol;
          else                    col=LineLen(line)-1;

          if (col<0) continue;
          if (LineLen(line)==0) continue;

          if (cfmt(line).info.type==UNIFORM) {
             CurCfmt=cfmt(line).info.fmt;
             if (True(TerFont[CurCfmt].flags&FFLAG_CHECKED)) continue;  // this font id already checked
             TerFont[CurCfmt].flags|=FFLAG_CHECKED;
             
             CurInsRev=TerFont[CurCfmt].InsRev;
             CurDelRev=TerFont[CurCfmt].DelRev;
             CurFmtRev=TerFont[CurCfmt].FmtRev;

             if (LocateRevMatched(w,present,InsRev,DelRev,FmtRev,CurInsRev,CurDelRev,CurFmtRev)) {
                *StartLine=line;
                *StartCol=col;
                return true;
             }
             else continue;                       // style not found
          }

          // open the line
          fmt=OpenCfmt(w,line);
          for (i=col;i>=0;i--) {
            CurCfmt=fmt[i];
            if (True(TerFont[CurCfmt].flags&FFLAG_CHECKED)) continue;  // this font id already checked
            TerFont[CurCfmt].flags|=FFLAG_CHECKED;
            
            CurInsRev=TerFont[CurCfmt].InsRev;
            CurDelRev=TerFont[CurCfmt].DelRev;
            CurFmtRev=TerFont[CurCfmt].FmtRev;

            if (LocateRevMatched(w,present,InsRev,DelRev,FmtRev,CurInsRev,CurDelRev,CurFmtRev)) {
               *StartLine=line;
               *StartCol=i;
               CloseCfmt(w,line);
               return true;
            }
          }
          CloseCfmt(w,line);
       }
    }

    return false;
}
Beispiel #14
0
/** 
 * Execute the command READCSS to read a CSS file 
 * 
 * @param nerr 
 *    Error Return Flag
 *    - 0 on Success
 *
 * @date   970403:  New option to conveniently select the channel.
 * @date   970206:  New option to specify which magnitude to read.  maf
 * @date   961216:  Now filtering on station rather than gain.  maf
 * @date   920420:  Changed null string, "", to ' ' - porting to IBM. 
 * @date   910703:  add # to parameter keyword GAIN; 
 *                  add * as a legal value for params GAIN, BAND, ORIENT
 * @date   910402:  New code.
 *
 */
void 
xrcss(int *nerr) {

    char _c0[2];
    char file[MCMSG+1];
    int len;
	int lmore, lshift, lscale, larray ;
	int nchar;
    static int Verbose = 0;
    static int ibinORasc;
    static string_list *last_list = NULL;
    double memory_max;

    memory_max = 0.30;

	char kmag[4] ;	/* magnitude type: mb, ms, or ml. maf 970206 */
    string_list *list;

    if(!last_list) {
        last_list = string_list_init();
    }

	*nerr = 0;
    list = string_list_init();

	/* PARSING PHASE: */
	/* - Parse position-dependent tokens: */
	lmore = FALSE;
  
	while ( lcmore( nerr ) ){
    
    /* -- "MORE":  signifies addition of more files to current read 
     *  filelist rather than replacement of current list with new one */
    if( lckey( "MORE#$",7 ) && cmdfm.ndfl > 0 ){
      lmore = TRUE;
      continue ;
    }
    
    /* -- "VERBOSE ON|OFF":  turn Verbose mode on or off. */
    else if( lklog( "VER$BOSE",9, &Verbose ) ){
      continue ;
    }
    /* -- "SHIFT ON|OFF":  turn calibration on or off. */
    else if( lklog( "SHIFT$",7, &lshift ) ){
      cmdfm.lshift = lshift ;
      continue ;
    }

	    /* -- "SCALE ON|OFF":  turn scaling on or off. */
    else if( lklog( "SCALE$",7, &lscale ) ){
      cmdfm.lscale = lscale ;
      continue ;
    }
    
    /* -- "ARRAY ON|OFF":  turn lienient array behavior on or off. */
    else if ( lklog ( "ARRAY$" , 7 , &larray ) ) {
      cmdfm.larray = larray ;
      continue ;
    }
    
    /* -- "MAXMEM v": change maximum fractional memory used by SeisMgr*/
    else if( lkreal( "MAX#MEM$",9, &memory_max ) )
	    { 
        MaxMem = memory_max;
      }
    
    /* -- "DIR CURRENT|name": set the name of the default subdirectory*/
    else if(lkchar("DIR#$",6,MCPFN,kmdfm.krdcssdir,MCPFN+1,&nchar)){
      if( memcmp(kmdfm.krdcssdir,"CURRENT",7) == 0 ||
          memcmp(kmdfm.krdcssdir ,"current",7) == 0 ){
		    cfmt( "ILLEGAL PARAM VALUE: current",30 );
		    cresp();
		    return ;
      }
      else if( kmdfm.krdcssdir[nchar - 1] != KDIRDL ){
		    _c0[0] = KDIRDL;
		    _c0[1] = '\0';
		    subscpy( kmdfm.krdcssdir, nchar, -1, MCPFN, _c0 );
      }
      continue;
    }
    
    /* -- "MAGNITUDE|mb|ms|ml|def":  specify a field for magnitude, or
       if def is found, use the algorithm to determine which
       magnitude to read.  maf 970206. */
    else if ( lkchar ( "MAG#NITUDE$", 12 , 4 , kmag , 4 , &nchar ) ) {
      if ( kmag [ 0 ] == 'm' || kmag[ 0 ] == 'M' ) {
		    if ( kmag [ 1 ] == 'b' || kmag [ 1 ] == 'B' ) 
          cmdfm.nMagSpec = MbMag ;
		    else if ( kmag [ 1 ] == 's' || kmag [ 1 ] == 'S' )
          cmdfm.nMagSpec = MsMag ;
		    else if ( kmag [ 1 ] == 'l' || kmag [ 1 ] == 'L' )
          cmdfm.nMagSpec = MlMag ;
		    else {
          cfmt( "ILLEGAL PARAM VALUE:",22 );
          cresp();
          return ;
		    }
      } /* end if ( kmag [ 0 ] == 'm' ... ) */
      else if ( strncmp ( kmag , "def" , 3 ) == 0 || 
                strncmp ( kmag , "DEF" , 3 ) == 0 )
		    cmdfm.nMagSpec = Any ;
      else {
		    cfmt( "ILLEGAL PARAM VALUE:",22 );
		    cresp();
		    return ;
      }
    } /* end if ( lkchar ( "MAG#NITUDE$", ... ) */


	    /* -- "STATION": whether wfdisc record fld 'sta' matches given */
	    /*		string.   maf 961216 */
    else if( lklogc("STA#TION$",10,&kmdfm.lstation,kmdfm.kstation,7 ) ){
      char *ptr ; 
      
      ptr = strchr ( kmdfm.kstation , ' ' ) ;
      if ( ptr != NULL )
		    *ptr = '\0' ;
      continue;
    }

    /* -- "CHANNEL": whether wfdisc record fld 'chan' matches the 
     *              given string.  maf 970403 */
    else if( lklogc("CHAN#NEL$",10,&kmdfm.lchannel,kmdfm.kchannel,9 ) ){
      char *ptr ;
      
      ptr = strchr ( kmdfm.kchannel , ' ' ) ;
      if ( ptr != NULL )
		    *ptr = '\0' ;
      //if( jcdflbeg > 0 && jcdflend == 0 )
      //  jcdflend = jcparmbeg - 1;
      continue;
    }


    /* -- "BANDWIDTH": whether wfdisc record fld 'chan' has a leading 
     *     letter which is S(short), M(medium), or L(long) */
    else if( lklogc( "BAND#WIDTH$",12, &kmdfm.lbandw,kmdfm.kbandw,9 ) ){
      //if( jcdflbeg > 0 && jcdflend == 0 )
      //jcdflend = jcparmbeg - 1;
      continue;
    } /* end else if( lklogc( "BAND#WIDTH$" ... */

	    /* -- "ORIENTATION: whether wfdisc record fld 'chan' has a second 
	     *     letter which is N(north), E(east), or Z(vertical) */
    else if(lklogc("ORIENT#ATION$",14,&kmdfm.lorient,kmdfm.korient,9)){
      //if( jcdflbeg > 0 && jcdflend == 0 )
      //jcdflend = jcparmbeg - 1;
      continue;
    } /* end else if( lklogc( "ORIENT#ATION$" ... */
    
    /* -- TRUST:  whether or not to trust matching evids while moving
       data from SAC buffers to CSS buffers. */
    else if( lklog( "TRUST#$",8, &cmdfm.ltrust ) )
      { /* do nothing */ }
    
    /* -- "COMMIT|RECALLTRACE|ROLLBACK":
       how to treat existing data */
    else if ( lckeyExact ( "COMMIT" , 7 ) )
      cmdfm.icomORroll = COMMIT ;
    else if (lckeyExact ( "RECALLTRACE" , 12 ) )
      cmdfm.icomORroll = RECALL ;
    else if ( lckeyExact ( "RECALL" , 7 ) )
      cmdfm.icomORroll = RECALL ;
    else if ( lckeyExact ( "ROLLBACK" , 9 ) )
      cmdfm.icomORroll = ROLLBACK ;
    
    
    /* -- "BINARY|ASCII": CSSB versus flat files */
    else if( lclist( (char*)kmdfm.kbinORasc,9, 2, &ibinORasc ) ) {
      cmdfm.lrascii = ibinORasc - 1 ;
    }
    
	    /* -- Else assume it to be beginning/continuing dfl, if not 
	     *    recognized as above 
	     *    Use kdflin as dummy buffer to skip a string  */
	    else if(lcchar(MCMSG, file, MCMSG+1, &len)) {
            string_list_put(list, file, len);
	    } 
	} 

	/* - The above loop is over when one of two conditions has been met:
	 *   (1) An error in parsing has occurred.  In this case NERR is > 0 .
	 *   (2) All the tokens in the command have been successfully parsed. */

	if( *nerr != 0 )
	    return ;

    if(string_list_length(list) <= 0) {
        string_list_extend(list, last_list);
    }
	/* EXECUTION PHASE: */

        /* - Commit or rollback data according to lmore and cmdfm.icomORroll */
        if ( lmore ) {
            alignFiles ( nerr ) ;
	    if ( *nerr )
		return ;
	    cmdfm.nfilesFirst = cmdfm.ndfl ;
        } /* end if */
	else {
	    cmdfm.nreadflag = HIGH ;
	    cmdfm.nfilesFirst = 0 ;
	}

        /* Copy Current List to Last_List */
        string_list_clear(last_list);
        string_list_extend(last_list, list);
        /* - Expand the filelist and read the files into memory.
         * -- Parameter kstation, kband, korient are picked up in readcfl from
         *    ../../inc/dfm */
        readcfl( lmore, kmdfm.krdcssdir,MCPFN+1, list, 
                 Verbose, cmdfm.lrascii, MaxMem, nerr );

        string_list_free(list);
        list = NULL;
	return;

}
Beispiel #15
0
/** 
 * Parse a range checked real variable pair command construct
 * 
 * @param realmn 
 *    Minimum value
 * @param realmx 
 *    Maximum value
 * @param realv1 
 *    First real value
 * @param realv2 
 *    Second real value
 * 
 * @return 
 *    - TRUE if the real pair was found
 *    - FALSE if the real pair was not found
 *
 * @date   820622:  Original version.
 *
 */
int
lcrrcp(double  realmn, 
       double  realmx, 
       double *realv1, 
       double *realv2) {

	int lcrrcp_v;
	int nerr;
	float rv;
  Token *t;

	/* - Get real variable from next symbol.
	 * - Check variable against allowed range.
	 * - Perform standard command error recovery if not found.
	 * - Repeat for second real. */
L_2000:
  if((t = arg()) && token_is_number(t)) {
    //if( Itypcm[cmcom.jcom] == cmcom.inumbr ){
		lcrrcp_v = TRUE;
		rv = t->value;
		if( rv >= realmn && rv <= realmx ){
			*realv1 = rv;
      arg_next();
L_3000:
      if((t = arg()) && token_is_number(t)) {
        //if( Itypcm[cmcom.jcom] == cmcom.inumbr ){
				rv = t->value;
				if( rv >= *realv1 && rv <= realmx ){
					*realv2 = rv;
          arg_next();
				}
				else{
					cfmt( "OUTSIDE ALLOWED RANGE:",24 );
          fprintf(stdout," Allowed range is: %16.5g%16.5g\n", *realv1, realmx );
					cresp();
					if( lcmore( &nerr ) )
						goto L_3000;
					lcrrcp_v = TRUE;
				}
			}
			else{
				cfmt( "NEED A REAL VARIABLE:",23 );
				cresp();
				if( lcmore( &nerr ) )
					goto L_2000;
				lcrrcp_v = TRUE;
			}
		}
		else{
			cfmt( "OUTSIDE ALLOWED RANGE:",24 );
      fprintf(stdout," Allowed range is: %16.5g%16.5g\n", realmn, realmx );
			cresp();
			if( lcmore( &nerr ) )
				goto L_2000;
			lcrrcp_v = TRUE;
		}
	}
	else{
		lcrrcp_v = FALSE;
	}

	return( lcrrcp_v );
}
Beispiel #16
0
LIS_INT lis_eii(LIS_ESOLVER esolver)
{
  LIS_MATRIX A;
  LIS_VECTOR x;
  LIS_SCALAR evalue, ievalue;
  LIS_SCALAR lshift;
  LIS_INT emaxiter;
  LIS_REAL tol;
  LIS_INT iter,iter2,output;
  LIS_REAL nrm2,resid;
  LIS_VECTOR z,q;
  LIS_SOLVER solver;
  double time,itime,ptime,p_c_time,p_i_time;

  LIS_INT err;
  LIS_PRECON precon;
  LIS_INT nsol, precon_type;
  char solvername[128], preconname[128];

  LIS_DEBUG_FUNC_IN;

  emaxiter = esolver->options[LIS_EOPTIONS_MAXITER];
  tol = esolver->params[LIS_EPARAMS_RESID - LIS_EOPTIONS_LEN]; 
  lshift = esolver->lshift;
  output  = esolver->options[LIS_EOPTIONS_OUTPUT];

  A = esolver->A;
  x = esolver->x;
  if (esolver->options[LIS_EOPTIONS_INITGUESS_ONES] ) 
    {
      lis_vector_set_all(1.0,x);
    }
  evalue = 1.0;
  z = esolver->work[0];
  q = esolver->work[1];

  iter=0;
  ievalue = 1/(evalue);
#ifdef _LONG__DOUBLE
  if( output & (A->my_rank==0) ) printf("local shift           : %Le\n", lshift);
#else
#if defined(_COMPLEX)
  if( output & (A->my_rank==0) ) printf("local shift           : "CFMT"\n", cfmt(lshift));
#else
  if( output & (A->my_rank==0) ) printf("local shift           : %e\n", lshift);
#endif
#endif
  if (lshift != 0) lis_matrix_shift_diagonal(A, lshift);
  lis_solver_create(&solver);
  lis_solver_set_option("-i bicg -p none",solver);
  lis_solver_set_optionC(solver);
  lis_solver_get_solver(solver, &nsol);
  lis_solver_get_precon(solver, &precon_type);
  lis_solver_get_solvername(nsol, solvername);
  lis_solver_get_preconname(precon_type, preconname);
  if( output & (A->my_rank==0) ) printf("linear solver         : %s\n", solvername);
  if( output & (A->my_rank==0) ) printf("preconditioner        : %s\n", preconname);

  /* create preconditioner */
  solver->A = A;
  err = lis_precon_create(solver, &precon);
  if( err )
    {
      lis_solver_work_destroy(solver);
      solver->retcode = err;
      return err;
    }

  while (iter<emaxiter)
    {
      iter = iter+1;

      /* x = x / ||x||_2 */
      lis_vector_nrm2(x, &nrm2);
      lis_vector_scale(1/nrm2, x);

      /* z = (A - lshift I)^-1 * x */
      lis_solve_kernel(A, x, z, solver, precon);
      lis_solver_get_iter(solver,&iter2);

      /* 1/evalue = <x,z> */
      lis_vector_dot(x, z, &ievalue); 

      /* resid = ||z - 1/evalue * x||_2 / |1/evalue| */
      lis_vector_axpyz(-ievalue,x,z,q); 
      lis_vector_nrm2(q, &resid); 
      resid = sabs(resid/ievalue);

      /* x = z */
      lis_vector_copy(z,x);

      /* convergence check */
      lis_solver_get_timeex(solver,&time,&itime,&ptime,&p_c_time,&p_i_time);
      esolver->ptime += solver->ptime;
      esolver->itime += solver->itime;
      esolver->p_c_time += solver->p_c_time;
      esolver->p_i_time += solver->p_i_time;

      if( output )
	{
	  if( output & LIS_EPRINT_MEM ) esolver->rhistory[iter] = resid;
	  if( output & LIS_EPRINT_OUT && A->my_rank==0 ) lis_print_rhistory(iter,resid);
	}

      if( tol >= resid ) 
	{
	  esolver->retcode    = LIS_SUCCESS;
	  esolver->iter[0]    = iter;
	  esolver->resid[0]   = resid;
	  esolver->evalue[0]  = 1/ievalue;
	  lis_vector_nrm2(x, &nrm2);
	  lis_vector_scale(1/nrm2, x);
	  if (lshift != 0) lis_matrix_shift_diagonal(A, -lshift);
	  lis_precon_destroy(precon);
	  lis_solver_destroy(solver); 
	  LIS_DEBUG_FUNC_OUT;
	  return LIS_SUCCESS;
	}
    }

  lis_precon_destroy(precon);

  esolver->retcode    = LIS_MAXITER;
  esolver->iter[0]    = iter;
  esolver->resid[0]   = resid;
  esolver->evalue[0]  = 1/ievalue;
  lis_vector_nrm2(x, &nrm2);
  lis_vector_scale(1/nrm2, x);
  if (lshift != 0) 
    {
      lis_matrix_shift_diagonal(A, -lshift);
    }
  lis_solver_destroy(solver); 
  LIS_DEBUG_FUNC_OUT;
  return LIS_MAXITER;
}
Beispiel #17
0
/** 
 * Execute the command LISTHDR (LH) which lists header values
 * 
 * @param nerr 
 *    Error Return Flag
 *    - 0 on Success
 *
 * @date   970425:  Fix bug so display fits in the window.  maf
 * @date   970129:  Print file number (jdfl).  maf
 * @date   961212:  All of the header variables are now in the default list.
 *                  Added INCLUSIVE option to show headers whether they are
 *                  defined or not.  maf
 * @date   900507:  Fixed bug with an odd number of items being listed with
 *                  the two-column output option. (VAX/VMS bug fix.)
 * @date   890104:  Now sending output to message handling system.
 * @date   860930:  Added a wait mechanism after each full screen.
 * @date   841026:  Extensive modifications made to entire subroutine.
 * @date   820806:  Changed to newest set of parsing and checking functions.
 *                  Updated line formatting using F77 character constructs.
 * @date   820119:  Fixed bug in listing KHDR values.
 * @date   811029:  Changed floating point output to G8.1 format.
 * @date   810528:  Added option to list only first file in dfl.
 * @date   810223:  Added check for null data file list.
 * @date   810120:  Changed to output message retrieval from disk.
 *
 */
void 
xlh(int *nerr) {

	char kerase[41], kline[MCMSG+1], kresp[9], krpttx[MRPT][41], ktok[9], 
	 kwait[9];
	int lwait;
	int j, j_, jdfl, jrpt, jrpt_, jrpttx, jrpttx_, 
	 jsprpt, junk1, junk2, junk3, nc1, nc2, nc3, nc4, nctx[MRPT], 
	 nctxm, nferr, nlscrn, nlw, nrpttx, ntused;

	static int iform = 1;
	static char kblank[41] = "                                        ";
        char *cattemp;
        char *strtemp1, *strtemp2, *strtemp3, *strtemp4, *strtemp5;
	int idx, ldef ;
    char *tmp;
	int *const Nctx = &nctx[0] - 1;

	*nerr = 0;
	ldef = FALSE;
        for( idx = 0 ; idx < 8 ; idx++ )
            ktok[idx] = ' ' ;
        ktok[ 8 ] = '\0' ;

	/* currently executing listhdr command. maf 961212 */
	cmhdr.llh = TRUE ;
	for( idx = 0 ; idx < MCMSG ; idx++ )
	    kline[ idx ] = ' ' ;
        kline[ MCMSG ] = '\0' ;

	jsprpt = 0;

	/* - Loop on each token in command: */
	while ( lcmore( nerr ) ){

		/* -- "DEFAULT/PICKS/SPECIAL":  change type of header report. */
		if( lclist( (char*)kmlhf.krpttp,9, cmlhf.nrpttp, &cmlhf.irpttp ) ){
			if( cmlhf.irpttp == 1 || cmlhf.irpttp == 4 ){
				for( j = 1; j <= cmlhf.nstrpt; j++ ){
				  j_ = j - 1;
				  strcpy( kmlhf.krpt[j_], kmlhf.kstrpt[j_] );
				}
				cmlhf.nrpt = cmlhf.nstrpt;
			} 
			else if( cmlhf.irpttp == 2 ){
				for( j = 1; j <= cmlhf.npkrpt; j++ ){
				  j_ = j - 1;
				  strcpy( kmlhf.krpt[j_], kmlhf.kpkrpt[j_] );
				}
				cmlhf.nrpt = cmlhf.npkrpt;
			} 
			else if( cmlhf.irpttp == 3 ){
				for( j = 1; j <= cmlhf.nsprpt; j++ ){
				  j_ = j - 1;
				  strcpy( kmlhf.krpt[j_], kmlhf.ksprpt[j_] );
				}
				cmlhf.nrpt = cmlhf.nsprpt;
			} 

		}

		/* -- "FILES ALL/nlist":  print all headers or only a subset. */
		else if( lckey( "FILES#$",8 ) ){
		  if( lckey( "ALL$",5 ) ){
		    cmlhf.lstall = TRUE;
		  }
		  else if( lckey( "NONE$",6 ) ){
		    ldef = TRUE;
		  }
		  else if( lcia( 1, cmdfm.ndfl, cmlhf.ilhlst, &cmlhf.nlhlst ) ){
		    cmlhf.lstall = FALSE;
		  }
		} 

		/* -- "INCLUSIVE": print headers even if they are undefined.*/
                else if ( lklog( "INC#LUSIVE$", 12, &cmhdr.linc ) )
                { /* do nothing */ }

		/* -- "COLUMNS n": change number of output columns. */
		else if( lkirc( "COLUMNS#$",10, 1, 2, &cmlhf.nlhcol ) )
		{ /* do nothing */ }

		/* -- "FIRST": Obsolete keyword for first file only. */
		else if( lckey( "FIRST#$",8 ) ){
			cmlhf.lstall = FALSE;
			cmlhf.nlhlst = 1;
			Ilhlst[1] = 1;
		}

		else if( lcchar( MCPW, ktok,9, &ntused ) ){
			if( jsprpt < MSPRPT ){
				jsprpt = jsprpt + 1;
				strcpy( kmlhf.ksprpt[jsprpt - 1], ktok );
				cmlhf.nrpt = jsprpt;
				strcpy( kmlhf.krpt[cmlhf.nrpt - 1], ktok );
			}
			else{
				*nerr = 1309;
				setmsg( "ERROR", *nerr );
				apimsg( jsprpt );
			}
		} else{
		  /* -- Bad syntax. */
			cfmt( "ILLEGAL OPTION:",17 );
			cresp();
		}
	}

	if( *nerr != 0 ) {
	  /* no longer executing xlh() */
	  cmhdr.llh = FALSE ;
	  return;
	}

	/* - Save length of special report if needed. */
	if( jsprpt > 0 )
		cmlhf.nsprpt = jsprpt;
       
        if( ldef ) {
	  /* no longer executing xlh(). */
	  cmhdr.llh = FALSE;
	  return;
        }

	/* CHECKING PHASE: */
	/* - Check for null data file list. */
	vflist( nerr );
	if( *nerr != 0 ) {
	  /* no longer executing xlh().*/
	  cmhdr.llh = FALSE ;
	  return;
	}

	/* EXECUTION PHASE: */

	/* - Get screen attributes (number of lines per screen and
	 *   text to send to erase screen, if any.) */

	getalphainfo( &nlscrn, kerase,41 );
	if( nlscrn <= 0 )
		nlscrn = 23;

	if( cmlhf.lstall ){
		setinputmode( "ALL" );
	}
	else{
		setinputmode( "SELECT" );
		selectinputfiles( cmlhf.ilhlst, cmlhf.nlhlst );
	}

	nlw = 0;
	gettextwait( kwait,9 );
	lwait = memcmp(kwait,"ON",2) == 0;
	autooutmsg( TRUE );
	setmsg( "OUTPUT", 99 );
    if(!use_tty()) {
      lwait = FALSE;
    }
	jdfl = 0;
L_4000:
	if( nextinputfile( &jdfl ) ){
		getfil( jdfl, FALSE, &junk1, &junk2, &junk3, nerr );
		if( *nerr != 0 ) {
		    autooutmsg( FALSE );
		    /* no longer executing xlh(). */
		    cmhdr.llh = FALSE ;	
		    return ;
		}
        if((tmp = string_list_get(datafiles, jdfl-1))) {
            aplmsg( " ",2 );
            cattemp = malloc(7+strlen(tmp)+7);
            sprintf(cattemp, " FILE: %s - %d", tmp, jdfl);
            aplmsg( cattemp, strlen ( cattemp ) + 1 );
            free(cattemp);

            memset(kline,'-',strlen(tmp)+6);
            kline[strlen(tmp)+6]='\n';
            kline[strlen(tmp)+7]='\0';
            
            aplmsg( kline,MCMSG+1 );
            nlw = nlw + 4;
        }
		nrpttx = 0;
		nctxm = 0;
		for( jrpt = 1; jrpt <= cmlhf.nrpt; jrpt++ ){
		  jrpt_ = jrpt - 1;
		  nrpttx = nrpttx + 1;
		  formhv( (char*)kmlhf.krpt[jrpt_],9, 
			  iform, (char*)krpttx[nrpttx - 1], 41, &nferr );
		  if( nferr == 0 ){
		    Nctx[nrpttx] = indexc((char*)krpttx[nrpttx - 1], 41, '=' );
		    nctxm = max( nctxm, Nctx[nrpttx] );
		  }
		  else if ( !cmhdr.linc ) {
		    nrpttx = nrpttx - 1;
		  }
		}
		if( cmlhf.nlhcol == 1 ){
		  for( jrpttx = 1; jrpttx <= nrpttx; jrpttx++ ){
		    jrpttx_ = jrpttx - 1;
		    nc1 = 2 + nctxm - Nctx[jrpttx];
		    nc2 = indexb( (char*)krpttx[jrpttx_],41 );
		    
		    strtemp1 = malloc(nc1+1);
		    strtemp2 = malloc(nc2+1);
		    strncpy(strtemp1,kblank,nc1);
		    strncpy(strtemp2,krpttx[jrpttx_],nc2);
		    strtemp1[nc1] = '\0';
		    strtemp2[nc2] = '\0';
		    
		    sprintf(kline," %s %s",strtemp1,strtemp2);
		    
		    free(strtemp1);
		    free(strtemp2);
		    
		    aplmsg( kline,MCMSG+1 );
		    nlw = nlw + 1;
		    if( lwait && (nlw >= (nlscrn - 2)) ){
		      outmsg();
		      clrmsg();
		      setmsg( "OUTPUT", 99 );
		      zgpmsg( "Waiting $",10, kresp,9 );
		      upcase( kresp, 1, kresp,9 );
		      nlw = 0;
		      if( kresp[0] == 'K' || kresp[0] == 'Q' ) {
			autooutmsg( FALSE );
			/* no longer executing xlh(). */
			cmhdr.llh = FALSE ;	
			return ;
		      }
		      else if( kresp[0] == 'G' ){
			if( strcmp(kerase,"                                        ") != 0 ) {
			  fprintf(MUNOUT," %s\n",kerase);
			}
			lwait = FALSE;
		      }
		      else if( kresp[0] == 'N' ){
			if( strcmp(kerase,"                                        ") != 0 ) {
			  fprintf(MUNOUT," %s\n",kerase);
			}
			goto L_4000;
		      }
		    }
		  }
		} else {
		  strcpy( krpttx[nrpttx], "                                        " );
		  for( jrpttx = 1; jrpttx <= nrpttx; jrpttx += 2 ){
		    jrpttx_ = jrpttx - 1;
		    nc1 = 2 + nctxm - Nctx[jrpttx];
		    nc2 = indexb( (char*)krpttx[jrpttx_],41 );
		    nc3 = 2 + nctxm - Nctx[jrpttx + 1];
		    nc4 = indexb( (char*)krpttx[jrpttx_ + 1],41 );
		    if( nc4 > 0 ){
		      strtemp1 = malloc(nc1+1);
		      strtemp2 = malloc(nc2+1);
		      strtemp3 = malloc(nc3+1);
		      strtemp4 = malloc(nc4+1);
		      
		      strncpy(strtemp1,kblank,nc1);
		      strtemp1[nc1] = '\0';
		      strncpy(strtemp2,krpttx[jrpttx_],nc2);
		      strtemp2[nc2] = '\0';
		      strncpy(strtemp3,kblank,nc3);
		      strtemp3[nc3] = '\0';
		      strncpy(strtemp4,krpttx[jrpttx_ + 1],nc4);
		      strtemp4[nc4] = '\0';
		      if ((nc1+nc2) < 40 ) {
			strtemp5 = malloc(40-(nc1+nc2)+1);
			memset(strtemp5,' ',40-(nc1+nc2));
			strtemp5[40-(nc1+nc2)] = '\0';
			sprintf(kline," %s%s%s%s%s",
				strtemp1,strtemp2,strtemp5,strtemp3,strtemp4);
			free(strtemp5);
		      }
		      else {
			sprintf(kline," %s%s%s%s",
				strtemp1,strtemp2,strtemp3,strtemp4);
		      }
		      free(strtemp1);
		      free(strtemp2);
		      free(strtemp3);
		      free(strtemp4);
		    }
		    else{
		      strtemp1 = malloc(nc1+1);
		      strtemp2 = malloc(nc2+1);
                      
		      strncpy(strtemp1,kblank,nc1);
		      strtemp1[nc1] = '\0';
		      strncpy(strtemp2,krpttx[jrpttx_],nc2);
		      strtemp2[nc2] = '\0';
                      
		      sprintf(kline," %s%s",strtemp1,strtemp2);
		      
		      free(strtemp1);
		      free(strtemp2);
		      
		    }
		    aplmsg( kline,MCMSG+1 );
		    nlw = nlw + 1;
		    if( lwait && (nlw >= (nlscrn - 1)) ){
		      outmsg();
		      clrmsg();
		      setmsg( "OUTPUT", 99 );
		      nlw = 0;
		      zgpmsg( "Waiting $",10, kresp,9 );
		      upcase( kresp, 1, kresp,9 );
		      if( kresp[0] == 'K' || kresp[0] == 'Q' ) {
			autooutmsg( FALSE );
			/* no longer executing xlh(). */
			cmhdr.llh = FALSE ;	
			return ;
		      }
		      else if( kresp[0] == 'G' ){
			if( strcmp(kerase,"                                        ") != 0 ) {
			  fprintf(MUNOUT," %s\n",kerase);
			}
			lwait = FALSE;
		      }
		      else if( kresp[0] == 'N' ){
			if( strcmp(kerase,"                                        ") != 0 ) {
			  fprintf(MUNOUT," %s\n",kerase);
			}
			goto L_4000;
		      }
		    }
		  }
		}
		
		/* -- Loop on entries in input dfl. */
		goto L_4000;
	}

	/* - Turn automatic output mode off before returning. */
	autooutmsg( FALSE );

	/* no longer executing xlh() */
	cmhdr.llh = FALSE ;
	return;

}
Beispiel #18
0
Datei: etest5.c Projekt: rwl/lis
LIS_INT main(LIS_INT argc, char* argv[])
{
  LIS_INT nprocs,my_rank;
#ifdef USE_MPI
  int int_nprocs,int_my_rank;
#endif
  LIS_INT nsol;
  LIS_MATRIX A,B;
  LIS_VECTOR x,y,z,w;
  LIS_SCALAR evalue0;
  LIS_ESOLVER esolver;
  LIS_REAL residual;
  LIS_INT iter;
  double time;
  double itime,ptime,p_c_time,p_i_time;
  char esolvername[128];

  LIS_DEBUG_FUNC_IN;
    
  lis_initialize(&argc, &argv);

#ifdef USE_MPI
  MPI_Comm_size(MPI_COMM_WORLD,&int_nprocs);
  MPI_Comm_rank(MPI_COMM_WORLD,&int_my_rank);
  nprocs = int_nprocs;
  my_rank = int_my_rank;
#else
  nprocs  = 1;
  my_rank = 0;
#endif
    
  if( argc < 6 )
    {
      if( my_rank==0 ) 
	{
	  printf("Usage: %s matrix_filename evalues_filename evectors_filename residuals_filename iters_filename [options]\n", argv[0]);
	}
      CHKERR(1);
    }

  if( my_rank==0 )
    {
      printf("\n");
      printf("number of processes = %d\n",nprocs);
    }

#ifdef _OPENMP
  if( my_rank==0 )
    {
      printf("max number of threads = %d\n",omp_get_num_procs());
      printf("number of threads = %d\n",omp_get_max_threads());
    }
#endif
		
  /* create matrix and vectors */
  lis_matrix_create(LIS_COMM_WORLD,&A);
  lis_input_matrix(A,argv[1]);
  lis_vector_duplicate(A,&x);
  lis_esolver_create(&esolver);
  lis_esolver_set_option("-e si -ss 1 -eprint mem",esolver);
  lis_esolver_set_optionC(esolver);
  lis_esolve(A, x, &evalue0, esolver);
  lis_esolver_get_esolver(esolver,&nsol);
  lis_esolver_get_esolvername(nsol,esolvername);
  lis_esolver_get_residualnorm(esolver, &residual);
  lis_esolver_get_iter(esolver, &iter);
  lis_esolver_get_timeex(esolver,&time,&itime,&ptime,&p_c_time,&p_i_time);
  if( my_rank==0 ) {
    printf("%s: mode number          = %d\n", esolvername, 0);
#ifdef _LONG__DOUBLE
    printf("%s: eigenvalue           = %Le\n", esolvername, evalue0);
#else
#if defined(_COMPLEX)
    printf("%s: eigenvalue           = "CFMT"\n", esolvername, cfmt(evalue0));
#else
    printf("%s: eigenvalue           = %e\n", esolvername, evalue0);
#endif
#endif
#ifdef _LONGLONG
    printf("%s: number of iterations = %lld\n",esolvername, iter);
#else
    printf("%s: number of iterations = %d\n",esolvername, iter);
#endif
    printf("%s: elapsed time         = %e sec.\n", esolvername, time);
    printf("%s:   preconditioner     = %e sec.\n", esolvername, ptime);
    printf("%s:     matrix creation  = %e sec.\n", esolvername, p_c_time);
    printf("%s:   linear solver      = %e sec.\n", esolvername, itime);
#ifdef _LONG__DOUBLE
    printf("%s: relative residual    = %Le\n\n",esolvername, residual);
#else
    printf("%s: relative residual    = %e\n\n",esolvername, residual);
#endif
  }

  lis_vector_create(LIS_COMM_WORLD,&y);
  lis_vector_create(LIS_COMM_WORLD,&z);
  lis_vector_create(LIS_COMM_WORLD,&w);
  lis_matrix_create(LIS_COMM_WORLD,&B);
  lis_esolver_get_evalues(esolver,y);
  lis_esolver_get_residualnorms(esolver,z);
  lis_esolver_get_iters(esolver,w);
  lis_esolver_get_evectors(esolver,B);

  /* write eigenvalues */
  lis_output_vector(y,LIS_FMT_MM,argv[2]);

  /* write eigenvectors */
  lis_output_matrix(B,LIS_FMT_MM,argv[3]);

  /* write residual norms */
  lis_output_vector(z,LIS_FMT_MM,argv[4]);

  /* write numbers of iterations */
  lis_output_vector(w,LIS_FMT_MM,argv[5]);

  lis_esolver_destroy(esolver);
  lis_matrix_destroy(A);
  lis_vector_destroy(x);
  lis_matrix_destroy(B);
  lis_vector_destroy(y);
  lis_vector_destroy(z);
  lis_vector_destroy(w);

  lis_finalize();

  LIS_DEBUG_FUNC_OUT;

  return 0;
}