static int dc()
/*********/
{
float *spectrum;
int trace; /* index of the current spectrum */
if(init2d(1,1)) ABORT;
trace = currentindex();
if (trace == 0) trace = 1;
if ((spectrum=gettrace(trace-1,0)) == 0) ABORT;
disp_status("DC ");
dodc(spectrum,1,c_block.head->lvl,c_block.head->tlt);
disp_status(" ");
P_setreal(CURRENT,"lvl",lvl,0);
P_setreal(CURRENT,"tlt",tlt,0);
return(rel_spec());
}
int main(int argc, char **argv){
PetscErrorCode ierr;
int nx = 63, ny = 63;
DM dm;
PetscBool flg;
Mat A;
Vec u, b;
KSP solver;
PC pc;
double norm;
PetscInt stage;
ierr = PetscInitialize(&argc, &argv, NULL, NULL);CHKERRQ(ierr);
ierr = PetscOptionsGetInt(PETSC_NULL, "-nx", &nx, PETSC_NULL);CHKERRQ(ierr);
ierr = PetscOptionsGetInt(PETSC_NULL, "-ny", &ny, PETSC_NULL);CHKERRQ(ierr);
ierr = PetscOptionsHasName(PETSC_NULL, "-assemble", &flg);CHKERRQ(ierr);
ierr = PetscLogStageRegister("preparing",&stage); CHKERRQ(ierr);
ierr = PetscLogStagePush(stage);CHKERRQ(ierr);
ierr = PetscLogStageRegister("Domain creation",&stage); CHKERRQ(ierr);
ierr = PetscLogStagePush(stage);CHKERRQ(ierr);
ierr = createDomain(&dm, nx, ny);CHKERRQ(ierr);
ierr = PetscLogStagePop();CHKERRQ(ierr);
ierr = PetscLogStageRegister("matrix creation",&stage); CHKERRQ(ierr);
ierr = PetscLogStagePush(stage);CHKERRQ(ierr);
ierr = createMat(dm, &A, flg);CHKERRQ(ierr);
ierr = PetscLogStagePop();CHKERRQ(ierr);
ierr = PetscLogStageRegister("Vector creation",&stage); CHKERRQ(ierr);
ierr = PetscLogStagePush(stage);CHKERRQ(ierr);
ierr = PetscLogStagePop();CHKERRQ(ierr);
ierr = DMCreateGlobalVector(dm, &b);CHKERRQ(ierr);
ierr = VecDuplicate(b, &u);CHKERRQ(ierr);
ierr = PetscLogStageRegister("Domain initialisation",&stage); CHKERRQ(ierr);
ierr = PetscLogStagePush(stage);CHKERRQ(ierr);
ierr = init2d(dm, b);CHKERRQ(ierr);
ierr = PetscLogStagePop();CHKERRQ(ierr);
ierr = PetscLogStageRegister("solver creation",&stage); CHKERRQ(ierr);
ierr = PetscLogStagePush(stage);CHKERRQ(ierr);
ierr = KSPCreate(PETSC_COMM_WORLD, &solver);CHKERRQ(ierr);
ierr = KSPSetOptionsPrefix(solver, "poisson_");CHKERRQ(ierr);
ierr = KSPSetOperators(solver, A, A, DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr);
ierr = KSPSetType(solver, KSPCG);
ierr = KSPGetPC(solver, &pc);CHKERRQ(ierr);
ierr = PCSetType(pc, PCNONE);CHKERRQ(ierr);
ierr = KSPSetFromOptions(solver);CHKERRQ(ierr);
ierr = PetscLogStagePop();CHKERRQ(ierr);
ierr = PetscLogStagePop();CHKERRQ(ierr);
ierr = PetscLogStageRegister("Solving",&stage); CHKERRQ(ierr);
ierr = PetscLogStagePush(stage);CHKERRQ(ierr);
ierr = KSPSolve(solver, b, u);CHKERRQ(ierr);
ierr = PetscLogStagePop();CHKERRQ(ierr);
//ierr = VecView(u, PETSC_VIEWER_DRAW_WORLD);CHKERRQ(ierr);
//sleep(10);
VecDestroy(&u);
VecDestroy(&b);
MatDestroy(&A);
DMDestroy(&dm);
KSPDestroy(&solver);
ierr = PetscFinalize();
return 0;
}
int mark(int argc, char *argv[], int retc, char *retv[] )
{
int firstarg, cmd_is_ds, mark_ret_val, num_num_args, reset_flag,
trace_flag;
double mark_args[ 4 ];
/************************************************************************/
/* Check for `reset' as a keyword. Need to verify syntax. Three */
/* situations: "reset" used improperly; "reset" used correctly; */
/* no "reset" keyword. */
/************************************************************************/
reset_flag = check_reset( argc, argv );
if (reset_flag < 0)
ABORT;
else if (reset_flag > 0) {
if (do_mark_reset() == 0)
RETURN;
else
ABORT;
}
/************************************************************************/
/* Check for `trace' as a keyword. Situation is similar to `reset', */
/* except there is no file name and the returned value distinguishes */
/* `trace' as first from `trace' as last argument (the only 2 choices) */
/************************************************************************/
firstarg = 1; /* Skip command name */
trace_flag = check_trace( argc, argv );
if (trace_flag < 0)
ABORT;
if (trace_flag != 0) {
if (retc > 2) {
Werrprintf(
"%s: cannot return more than 2 values when using `trace' keyword", argv[ 0 ]
);
ABORT;
}
if (trace_flag == 1) /* Skip over 1st argument */
firstarg = 2; /* if it was `trace' */
else /* Otherwise it was the last */
argc--; /* argument, so reduce total */
} /* number of arguments by 1 */
/************************************************************************/
/* Extract numeric values, number of numeric values. The `mark' */
/* command accepts 0, 1, 2 or 4 such arguments. If `num_vals_args' */
/* returns -1, the subroutine has already posted an error message. */
/************************************************************************/
num_num_args = num_vals_args( firstarg, argc, argv, &mark_args[ 0 ], 4 );
if (num_num_args < 0)
ABORT;
else if (num_num_args == 3 || num_num_args > 4) {
Werrprintf( "%s: incorrect number of numeric arguments", argv[ 0 ] );
ABORT;
}
/************************************************************************/
/* Get the current graphics command to establish if DS was the last */
/* such command executed. In that case, we perform a 1D operation */
/* unless MARK was called with 4 numeric arguments. */
/* */
/* Abort if current graphics command is not DS or DCONI. Add checks */
/* for other display commands (DCON, DPCON, etc.) here if required. */
/************************************************************************/
cmd_is_ds = WgraphicsdisplayValid( "ds" );
if ( !cmd_is_ds &&
!WgraphicsdisplayValid( "dconi" ) &&
num_num_args == 0 )
{
Werrprintf(
"%s: requires arguments when no data displayed", argv[ 0 ]
);
ABORT;
}
/************************************************************************/
/* `init2d' subroutine defines `d2flag' and many other important */
/* variables. First argument instructs `init2d' to set "reverse" */
/* flag if trace = "f1". Second argument instructs `init2d' to */
/* prepare chart variables for displaying data. */
/************************************************************************/
if (init2d( 1, 1 ))
ABORT;
/************************************************************************/
/* Now that `d2flag' is defined, check on 4 more error conditions: */
/* A. 2D data is present, last command not `ds', 1 numeric argument */
/* and no `trace' keyword. */
/* B. No 2D data present and 4 numeric arguments entered. */
/* C. No 2D data present and the `trace' keyword was used. */
/* D. No 2D data present and command returns more than 2 values. */
/************************************************************************/
if (d2flag) {
if (trace_flag == 0 && cmd_is_ds == 0 && num_num_args == 1) {
Werrprintf(
"%s: 'trace' keyword required with 2D data and 1 numeric argument", argv[ 0 ]
);
ABORT;
}
}
else { /* No 2D data */
if (num_num_args == 4) {
Werrprintf(
"%s: Cannot have 4 numeric arguments with 1D data", argv[ 0 ]
);
ABORT;
}
if (trace_flag) {
Werrprintf(
"%s: Cannot use 'trace' keyword with 1D data", argv[ 0 ]
);
ABORT;
}
if (retc > 2) {
Werrprintf(
"%s: Cannot return more than 2 values with 1D data", argv[ 0 ]
);
ABORT;
}
}
/* 2D operations. If 2D data is present and the `trace' keyword was
NOT selected, then there were either 2 or 4 numeric arguments. */
if (num_num_args == 4 || (d2flag && trace_flag == 0 && cmd_is_ds == 0)) {
mark_ret_val = do_2d_mark(
retc, retv,
num_num_args,
&mark_args[ 0 ]
);
}
/* 1D operations. Come here if
A. num_num_args != 4 AND
B. d2flag is clear OR trace_flag is set OR cmd_is_ds is set. */
else {
mark_ret_val = do_1d_mark(
cmd_is_ds,
retc, retv,
num_num_args,
&mark_args[ 0 ]
);
}
if (mark_ret_val == 0)
RETURN;
else
ABORT;
}
int wrspec(int argc, char *argv[], int retc, char *retv[] )
{
char *cmd_name, *outfile_name;
char ow_prompt[ MAXPATHL + 20 ], ow_ans[ 4 ];
int elem1_num, elem2_num, elem3_num, elem4_num,
i, ival, np_out;
int proctype; /* proctype for processing function type */
float *vdata, /* output data */
epscale = 0.0,
rms = 0.0;
double swmagic, tmp;
FILE *tfile=NULL;
/* retv[0]=0 ok; retv[0]=1 failed */
cmd_name = argv[ 0 ];
if (argc < MINNEW_ARGS) /* compare MAXNEW_ARGS in wrspec_args */
{
Werrprintf( "Usage: %s( 'file_name' <, trace number > )", cmd_name);
if (retc>0) retv[0] = intString(1);
return( 0 );
}
outfile_name = argv[ WRFILE_ARG ]; /* address of (output) file name: argv[1] */
/* do avg_scale if asked for it */
if (strcmp(outfile_name, "expl_avg_scale")==0) {
if (argc < 3) {
if (retc>0) retv[0] = intString(1);
return( 0 );
}
if (calc_avg_scale( cmd_name, argv[2] ) != 0) {
/* errors reported in function */
if (retc>0) retv[0] = intString(1);
return( 0 );
}
if (retc>0) retv[0] = intString(0);
return( 0 );
}
init2d(1,1); /* get data headers */
if ((datahead.status & S_SPEC) == 0)
{
Werrprintf("%s: data must be ft'd first", cmd_name);
if (retc>0) retv[0] = intString(1);
return( 0 );
}
if (wrspec_args( argc, argv, &proctype, &elem1_num, &elem2_num, &elem3_num, &elem4_num ) != 0)
{
if (retc>0) retv[0] = intString(1);
return( 0 );
/* `writefid_args' reports error */ /* depends on argc */
}
EPRINT0(1,"calling wrspec...\n");
EPRINT1(1," wrspec: proctype %d, ", proctype);
EPRINT2(1,"trace numbers %d %d ",elem1_num,elem2_num);
EPRINT2(1,"%d %d\n",elem3_num,elem4_num);
/* if (proctype == 8) { outfile_name="ds"; for dmg; use outfile_name="dmg" and proctype=2?
} else { below; } */
vdata=(float *)malloc((fn/2) * sizeof(float));
if (!vdata) {
Werrprintf( "ddph: memory allocation failure" );
if (retc>0) retv[0] = intString(1);
return( 0 );
}
if ( strcmp( outfile_name, "ds") != 0) {
/* Handle situation where the output file is already present. */
if (access( outfile_name, F_OK ) == 0) {
if (!Bnmr) {
sprintf( &ow_prompt[ 0 ], "OK to overwrite %s? ", outfile_name);
W_getInputCR( &ow_prompt[ 0 ], &ow_ans[ 0 ], sizeof( ow_ans ) - 1);
if (ow_ans[ 0 ] != 'Y' && ow_ans[ 0 ] != 'y') {
free((char*) vdata);
Winfoprintf( "%s: operation aborted", cmd_name );
if (retc>0) retv[0] = intString(1);
return( 0 );
}
}
ival = unlink( outfile_name );
if (ival != 0) {
free((char*) vdata);
Werrprintf( "%s: cannot remove %s", cmd_name, outfile_name );
if (retc>0) retv[0] = intString(1);
return( 0 );
}
}
tfile = fopen( outfile_name, "w" ); /* open file */
if (tfile == NULL) {
free((char*) vdata);
Werrprintf( "%s: problem opening %s", cmd_name, outfile_name );
if (retc>0) retv[0] = intString(1);
return( 0 );
}
} /* end "not ds" mode */
if (proctype==2 || proctype==4 || proctype==5 || proctype==7) {
if (wrspec_find_epscale( &epscale, proctype, elem1_num, elem2_num) != 0) {
Werrprintf( "%s: find epscale failed", cmd_name);
free((char*) vdata);
if (retc>0) retv[0] = intString(1);
return( 0 );
}
}
if (proctype != 5) {
if (wrspec_calcdata(cmd_name, proctype, elem1_num, elem2_num, elem3_num, elem4_num, vdata) != 0)
{
free((char*) vdata);
if (retc>0) retv[0] = intString(1);
return( 0 );
/* calcdata reports error */
}
if (wrspec_output( cmd_name, outfile_name, tfile, vdata, proctype, epscale, &rms) != 0)
{
if (retc>0) retv[0] = intString(1);
return( 0 );
/* write output to file or 'ds' */
}
}
else { /* proctype == 5 */
if ( (ival=P_getreal(CURRENT, "gzwin", &swmagic, 1)) ) {
swmagic = 100.0;
}
else {
if (swmagic < 0.0) swmagic = -swmagic;
tmp = 100.0 * 1.0/((float) (fn/2-1));
if (swmagic < tmp) swmagic = tmp;
if (swmagic > 100.0) swmagic = 100.0;
}
swmagic /= 100.0;
np_out = fn/2 - 2 * (int) ((1.0 - ((float) swmagic)) * ((float) (fn/4)) );
ival = ((datahead.nblocks + 1) / 2) - 2; /* ival is gzsize, number of z shims */
if ( epscale < NEW_AMP_TOL ) {
fprintf( tfile, "exp 4\n %d %d\nFrequency (hz) vs Phase\n",
ival, np_out );
}
else {
fprintf( tfile, "exp 4\n %d %d\nFrequency (hz) vs Field (hz)\n",
ival, np_out );
}
for (i=0; i<ival; i++) {
fprintf( tfile, "\n%d 0 0 0\n", i+1 );
elem3_num = 2 * i + 3;
elem4_num = 2 * i + 4;
if (wrspec_calcdata(cmd_name, 4, elem1_num, elem2_num, elem3_num, elem4_num, vdata) != 0)
{
if (retc>0) retv[0] = intString(1);
return( 0 );
/* calcdata reports error; use proctype=4 */
}
rms = (float) elem3_num;
if (wrspec_output( cmd_name, outfile_name, tfile, vdata, proctype, epscale, &rms) != 0)
{
if (retc>0) retv[0] = intString(1);
return( 0 );
/* write output to file or 'ds' */
}
}
}
if (strcmp( outfile_name, "ds") != 0) fclose( tfile );
free((char*) vdata);
if (retc>0) retv[0] = intString(0);
if (retc>1) retv[1] = realString( ((double)rms) );
EPRINT0(1,"wrspec done!\n");
return( 0 );
}
