/**
* 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(¬e);
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(¶);
assertTest(para.GetCharFormat()->GetChrfmt().GetAnnotationChrfmt()==asNone);
assertTest(!para.GetCharFormat()->GetChrfmt().get_bHidden());
}
/**
* 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;
}
/**
* 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;
}
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;
}
/**
* 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;
}
/**
* 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 ) ) */
}
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 , ¬used ) ;
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 */
/**
* 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 */
/**
* 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;
}
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;
}
/**
* 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;
}
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;
}
/**
* 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;
}
/**
* 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 );
}
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;
}
/**
* 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;
}
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;
}