//#################################################################//
void Bmp::save_float(const char*filename)
{
FILE* fn;
if ((fn = fopen (filename,"wb")) == NULL) error_stop("Bmp::save_float");
fwrite(data,1,4*width*height,fn);
fclose(fn);
}
//#################################################################//
void Bmp::load_float(const char*filename)
{
FILE* fn;
if ((fn = fopen (filename,"rb")) == NULL) error_stop("Bmp::load_float");
fread(data,1,4*width*height,fn);
fclose(fn);
}
void startPrint(HWND hWnd, char *dirpath, char *filename, char* maptitle)
{
char *pdfDriver = "Win2PDF";
pdfDC = CreateDC("WINSPOOL", pdfDriver, NULL, NULL);
if (!pdfDC) {
error_stop("cannot open PDF driver: ", pdfDriver);
}
int horzres = GetDeviceCaps(pdfDC, HORZRES);
int vertres = GetDeviceCaps(pdfDC, VERTRES);
// Let's find the aspect ratio of the page
double aspectRatio = (double) vertres / (double)horzres;
pageWidth = DESIRED_PAGE_WIDTH;
pageHeight = (int)((double)DESIRED_PAGE_WIDTH * aspectRatio);
SetMapMode(pdfDC, MM_ISOTROPIC);
SetViewportExtEx(pdfDC, horzres, vertres, NULL);
SetWindowExtEx(pdfDC, pageWidth, pageHeight, NULL);
DOCINFO docInfo = {0};
docInfo.cbSize = sizeof(docInfo);
char fullpath[MAX_PATH] = {0};
strcpy_s(fullpath, sizeof(fullpath), dirpath);
strcat_s(fullpath, sizeof(fullpath), filename);
docInfo.lpszDocName = filename;
docInfo.lpszOutput = fullpath;
StartDoc(pdfDC, &docInfo);
StartPage(pdfDC);
}
void opt_scale (long *ratio)
{
read_output_opt ();
if (! scale.spec_found)
error_stop ("SCALE not found in output options file","");
*ratio = scale.ratio;
}
void opt_grid (double *meshsize, int *gridmethod)
{
read_output_opt ();
if (! contour.spec_found)
error_stop ("CONTOUR not found in output options file", "");
*meshsize = contour.meshsize;
*gridmethod = contour.gridmethod;
}
void opt_zvalue (char **zname, int *digits)
{
read_output_opt ();
if (! zvalue.spec_found)
error_stop ("ZVALUE not found in output options file","");
*zname = zvalue.zname;
*digits = zvalue.digits;
}
//#################################################################//
int Bmp::get_pixel(int x,int y)
{
if(data==0) error_stop("get_pixel data=0");
if(x>=width)return 0;
if(y>=height)return 0;
return
data[(x+y*width)*(bpp/8)+0]+
data[(x+y*width)*(bpp/8)+1]*256+
data[(x+y*width)*(bpp/8)+2]*256*256;
}
void opt_post (char **labelfont, int *labelsize, int *labelrotate)
{
read_output_opt ();
if (! post.spec_found)
error_stop ("POST not found in output options file","");
*labelfont = post.labelfont;
*labelsize = post.labelsize;
*labelrotate = post.labelrotate;
}
void
_gfortran_caf_error_stop_str (const char *string, int32_t len)
{
fputs ("ERROR STOP ", stderr);
while (len--)
fputc (*(string++), stderr);
fputs ("\n", stderr);
error_stop (1);
}
void opt_contour (double *intervalsize, int *nlevels,
char *smoothmethod, int *bsplineorder, int *npoints)
{
if (! contour.spec_found)
error_stop ("CONTOUR not found in output options file", "");
*intervalsize = contour.intervalsize;
*nlevels = contour.numberoflevels;
*smoothmethod = contour.smoothmethod;
*bsplineorder = contour.bs_order;
*npoints = contour.approx_pts;
}
//#################################################################//
void Bmp::set(int x,int y,int b,unsigned char*buffer)
{
width=x;
height=y;
bpp=b;
if(data) free(data);
data=(unsigned char*) malloc(width*height*(bpp/8));
if(!data) error_stop("Bmp::set : out of memory");
if(buffer==0)
memset(data,0,width*height*(bpp/8));
else
memmove(data,buffer,width*height*(bpp/8));
bmp[18] =width;
bmp[19] =width>>8;
bmp[22] =height;
bmp[23] =height>>8;
bmp[28] =bpp;
}
//#################################################################//
void Bmp::save(const char*filename)
{
printf("saving image %s\n",filename);
unsigned char bmp[58]=
{0x42,0x4D,0x36,0x30,0,0,0,0,0,0,0x36,0,0,0,0x28,0,0,0,
0x40,0,0,0, // X-Size
0x40,0,0,0, // Y-Size
1,0,0x18,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0};
bmp[18] =width;
bmp[19] =width>>8;
bmp[22] =height;
bmp[23] =height>>8;
bmp[28] =bpp;
FILE* fn;
if ((fn = fopen (filename,"wb")) != NULL)
{
fwrite(bmp ,1,54 ,fn);
fwrite(data,1,width*height*(bpp/8),fn);
fclose(fn);
}
else error_stop("Bmp::save");
}
/* SYNC IMAGES. Note: SYNC IMAGES(*) is passed as count == -1 while
SYNC IMAGES([]) has count == 0. Note further that SYNC IMAGES(*)
is not equivalent to SYNC ALL. */
void
_gfortran_caf_sync_images (int count, int images[], int *stat, char *errmsg,
int errmsg_len)
{
int ierr;
if (count == 0 || (count == 1 && images[0] == caf_this_image))
{
if (stat)
*stat = 0;
return;
}
#ifdef GFC_CAF_CHECK
{
int i;
for (i = 0; i < count; i++)
if (images[i] < 1 || images[i] > caf_num_images)
{
fprintf (stderr, "COARRAY ERROR: Invalid image index %d to SYNC "
"IMAGES", images[i]);
error_stop (1);
}
}
#endif
/* FIXME: SYNC IMAGES with a nontrivial argument cannot easily be
mapped to MPI communicators. Thus, exist early with an error message. */
if (count > 0)
{
fprintf (stderr, "COARRAY ERROR: SYNC IMAGES not yet implemented");
error_stop (1);
}
/* Handle SYNC IMAGES(*). */
if (unlikely (caf_is_finalized))
ierr = STAT_STOPPED_IMAGE;
else
ierr = MPI_Barrier (MPI_COMM_WORLD);
if (stat)
*stat = ierr;
if (ierr)
{
char *msg;
if (caf_is_finalized)
msg = "SYNC IMAGES failed - there are stopped images";
else
msg = "SYNC IMAGES failed";
if (errmsg_len > 0)
{
int len = ((int) strlen (msg) > errmsg_len) ? errmsg_len
: (int) strlen (msg);
memcpy (errmsg, msg, len);
if (errmsg_len > len)
memset (&errmsg[len], ' ', errmsg_len-len);
}
else
caf_runtime_error (msg);
}
}
static int nextspecs (char ***field)
{
static char **fld = NULL;
static FILE *fp = NULL;
static int eof = 0;
static int fld_size = 0;
static int line_number = 0;
int nfield = 0;
/* all done if end of file found on prior call */
if (eof)
{
fclose (fp);
free (fld);
return (0);
}
/* initialize on the first call */
if (fp == NULL)
{
fopen_s(&fp, "output.opt", "r");
if (fp == NULL)
error_stop ("cannot open file", "output.opt");
fld_size = 100;
fld = (char **) malloc ((unsigned) fld_size * sizeof (char *));
if (fld == NULL)
error_stop ("cannot allocate vector fld", "for output.opt specs");
}
/* get specs from the next non-blank line */
while (1)
{
char buf[200];
char cur_line[50];
char *line;
int cur_fld_len;
int line_continued;
int eol_found = 0;
/* read the next line */
line = fgets (buf, 200, fp);
++line_number;
sprintf_s (cur_line, sizeof(cur_line), "line %d of file output.opt", line_number);
if (line == NULL)
{
eof = 1;
break;
}
/* find the fields on the line */
cur_fld_len = 0;
line_continued = 0;
while (*line)
{
if (*line == '"')
{
if (cur_fld_len > 0)
error_stop ("embedded quote on", cur_line);
while (++line)
{
if (*line == '\0' || *line == '\n')
error_stop ("missing quote on", cur_line);
if (*line == '"')
{
*line = ' ';
break;
}
++cur_fld_len;
}
}
if ((*line == '/' && *(line + 1) == '/') || *line == '\n')
eol_found = 1;
if (*line == '+' && *(line + 1) == '+')
{
eol_found = 1;
line_continued = 1;
{
char *p = line + 2;
while (*p && *p != '\n')
{
if (*p == '/' && *(p + 1) == '/')
break;
if (*p != ' ' && *p != '\t')
error_stop ("characters after ++ on", cur_line);
++p;
}
}
}
if (*line == ' ' || *line == '\t' || eol_found)
{
if (cur_fld_len > 0)
{
if (nfield == fld_size)
{
fld_size += 100;
fld = (char **) realloc (fld, (unsigned) fld_size *
sizeof (char *));
if (fld == NULL)
error_stop ("cannot reallocate vector fld on",
cur_line);
}
fld[nfield] = (char *) malloc ((unsigned) cur_fld_len + 1);
if (fld[nfield] == NULL)
error_stop ("cannot allocate space for option spec on",
cur_line);
*line = '\0';
strcpy_s(fld[nfield++], cur_fld_len + 1, line - cur_fld_len);
cur_fld_len = 0;
}
}
else
++cur_fld_len;
if (eol_found)
break;
++line;
}
if (! eol_found)
error_stop ("line is too long -", cur_line);
/* stop reading if field(s) found and line not continued */
if (nfield > 0 && ! line_continued)
break;
}
/* set output arguments and return */
*field = fld;
return (nfield);
}
static void read_output_opt (void)
{
static int alldone = 0;
if (alldone)
return;
zvalue.spec_found = 0;
scale.spec_found = 0;
post.spec_found = 0;
contour.spec_found = 0;
maplabel.nspec = 0;
maplabel.maplab = NULL;
mapline.nspec = 0;
mapline.maplin = NULL;
selects.nspec = 0;
selects.condition = NULL;
while (1)
{
char **field;
int nspec;
nspec = nextspecs (&field);
if (! nspec)
break;
if (_stricmp (field[0], "zvalue") == 0)
{
if (zvalue.spec_found)
error_stop (field[0],
"specified more than once in file output.opt");
if (nspec != 3)
error_stop (field[0],
"has the wrong number of fields in file output.opt");
zvalue.spec_found = 1;
zvalue.zname = field[1];
zvalue.digits = atoi (field[2]);
if (not_int (field[2]) || zvalue.digits < 0 || zvalue.digits > 10)
error_stop ("invalid digits field in output.opt ZVALUE:",
field[2]);
}
else if (_stricmp (field[0], "scale") == 0)
{
if (scale.spec_found)
error_stop (field[0],
"specified more than once in file output.opt");
if (nspec != 2)
error_stop (field[0],
"has the wrong number of fields in file output.opt");
scale.spec_found = 1;
scale.ratio = atol (field[1]);
if (not_int (field[1]) || scale.ratio < 1 || scale.ratio > 1000000)
error_stop ("invalid ratio field in output.opt SCALE:",
field[1]);
}
else if (_stricmp (field[0], "post") == 0)
{
if (post.spec_found)
error_stop (field[0],
"specified more than once in file output.opt");
if (nspec != 4)
error_stop (field[0],
"has the wrong number of fields in file output.opt");
post.spec_found = 1;
post.labelfont = field[1];
post.labelsize = atoi (field[2]);
if (not_int (field[2]) || post.labelsize < 1 ||
post.labelsize > 100)
error_stop ("invalid labelsize field in output.opt POST:",
field[2]);
post.labelrotate = atoi (field[3]);
if (not_int (field[3]))
error_stop ("invalid labelrotate field in output.opt POST:",
field[3]);
}
else if (_stricmp (field[0], "contour") == 0)
{
if (contour.spec_found)
error_stop (field[0],
"specified more than once in file output.opt");
if (nspec < 6)
error_stop (field[0],
"has the wrong number of fields in file output.opt");
contour.spec_found = 1;
contour.meshsize = atof (field[1]);
if (not_float (field[1]) || contour.meshsize <= 0)
error_stop ("invalid meshsize field in output.opt CONTOUR:",
field[1]);
contour.gridmethod = atoi (field[2]);
if (not_int (field[2]) || contour.gridmethod < 1 ||
contour.gridmethod > 20)
error_stop ("invalid gridmethod field in output.opt CONTOUR:",
field[2]);
if (_stricmp (field[3], "SIZE") == 0)
{
contour.intervalsize = atof (field[4]);
contour.numberoflevels = 0;
if (not_float (field[4]) || contour.intervalsize <= 0)
error_stop (
"invalid intervalsize field in output.opt CONTOUR:",
field[4]);
}
else if (_stricmp (field[3], "LEVELS") == 0)
{
contour.intervalsize = 0;
contour.numberoflevels = atoi (field[4]);
if (not_int (field[4]) || contour.numberoflevels <= 0)
error_stop (
"invalid numberoflevels field in output.opt CONTOUR:",
field[4]);
}
else
error_stop (
"intervalspec is not SIZE or LEVELS in output.opt CONTOUR:",
field[3]);
if (_stricmp (field[5], "LINEAR") == 0)
{
contour.smoothmethod = 'L';
if (nspec != 6)
error_stop (field[0],
"has the wrong number of fields in file output.opt");
contour.approx_pts = 0;
contour.bs_order = 0;
}
else if (_stricmp (field[5], "CUBIC_SPLINE") == 0)
{
contour.smoothmethod = 'C';
if (nspec != 7)
error_stop (field[0],
"has the wrong number of fields in file output.opt");
contour.approx_pts = atoi (field[6]);
if (not_int (field[6]) || contour.approx_pts < 4 ||
contour.approx_pts > 20)
error_stop ("invalid npoints field in output.opt CONTOUR:",
field[6]);
contour.bs_order = 0;
}
else if (_stricmp (field[5], "BSPLINE") == 0)
{
contour.smoothmethod = 'B';
if (nspec != 8)
error_stop (field[0],
"has the wrong number of fields in file output.opt");
contour.bs_order = atoi (field[6]);
if (not_int (field[6]) || contour.bs_order < 2 ||
contour.bs_order > 10)
error_stop (
"invalid bspline order field in output.opt CONTOUR:",
field[6]);
contour.approx_pts = atoi (field[7]);
if (not_int (field[7]) || contour.approx_pts < 4 ||
contour.approx_pts > 20)
error_stop ("invalid npoints field in output.opt CONTOUR:",
field[7]);
}
else
error_stop ("invalid smoothmethod in output.opt CONTOUR:",
field[5]);
}
else if (_stricmp (field[0], "maplabel") == 0)
{
MAPLABEL *ml;
++maplabel.nspec;
maplabel.maplab = (MAPLABEL *) realloc (maplabel.maplab,
(unsigned) maplabel.nspec * sizeof (MAPLABEL));
if (maplabel.maplab == NULL)
error_stop ("cannot reallocate MAPLABEL space", "");
ml = maplabel.maplab + maplabel.nspec - 1;
if (nspec != 7)
error_stop (field[0],
"has the wrong number of fields in file output.opt");
ml->label = field[1];
ml->xpos = atof (field[2]);
if (not_float (field[2]))
error_stop ("invalid xpos field in output.opt MAPLABEL:",
field[2]);
ml->ypos = atof (field[3]);
if (not_float (field[3]))
error_stop ("invalid ypos field in output.opt MAPLABEL:",
field[3]);
ml->font = field[4];
ml->fontsize = atoi (field[5]);
if (not_int (field[5]) || ml->fontsize < 1 || ml->fontsize > 100)
error_stop ("invalid fontsize field in output.opt MAPLABEL:",
field[5]);
ml->rotate = atoi (field[6]);
if (not_int (field[6]))
error_stop ("invalid rotate field in output.opt MAPLABEL:",
field[6]);
}
else if (_stricmp (field[0], "mapline") == 0)
{
int i, k;
MAPLINE *ml;
++mapline.nspec;
mapline.maplin = (MAPLINE *) realloc (mapline.maplin,
(unsigned) mapline.nspec * sizeof (MAPLINE));
if (mapline.maplin == NULL)
error_stop ("cannot reallocate MAPLINE space", "");
ml = mapline.maplin + mapline.nspec - 1;
if (nspec < 3)
error_stop (field[0],
"has the wrong number of fields in file output.opt");
ml->width = atoi (field[1]);
if (not_int (field[1]) || ml->width < 1 || ml->width > 100)
error_stop ("invalid width field in output.opt MAPLINE:",
field[1]);
ml->intensity = atof (field[2]);
if (not_float (field[2]))
error_stop ("invalid intensity field in output.opt MAPLINE:",
field[2]);
ml->npoint = (nspec - 3) / 2;
if (ml->npoint < 2 || ml->npoint * 2 + 3 != nspec)
error_stop ("invalid coordinate pairs in output.opt MAPLINE",
"");
ml->x = (double *) malloc ((unsigned) ml->npoint * sizeof (double));
ml->y = (double *) malloc ((unsigned) ml->npoint * sizeof (double));
if (ml->x == NULL || ml->y == NULL)
error_stop ("cannot allocate space for MAPLINE coordinates","");
k = 3;
for (i = 0; i < ml->npoint; i++)
{
ml->x[i] = atof (field[k++]);
ml->y[i] = atof (field[k++]);
}
}
else if (_stricmp (field[0], "select") == 0)
{
SELECT *sel;
int nclause = 0;
int k = 0;
if (nspec == 4)
nclause = 1;
else if (nspec == 8)
nclause = 2;
else
error_stop (field[0],
"has the wrong number of fields in output.opt");
while (nclause--)
{
++selects.nspec;
selects.condition = (SELECT *) realloc (selects.condition,
(unsigned) selects.nspec * sizeof (SELECT));
if (selects.condition == NULL)
error_stop ("cannot reallocate SELECT space", "");
sel = selects.condition + selects.nspec - 1;
++k;
{
DATATYPE dt;
dt = CODE;
if (_stricmp (field[k], "code") == 0)
dt = CODE;
else if (_stricmp (field[k], "obs") == 0)
dt = OBS;
else if (_stricmp (field[k], "x") == 0)
dt = X;
else if (_stricmp (field[k], "y") == 0)
dt = Y;
else if (_stricmp (field[k], "fit") == 0)
dt = FIT;
else if (_stricmp (field[k], "resid") == 0)
dt = RESID;
else
error_stop ("invalid datatype in output.opt SELECT:",
field[k]);
sel->datatype = dt;
}
++k;
{
LOG_OPERATOR op;
op = LT;
if (_stricmp (field[k], "<") == 0)
op = LT;
else if (_stricmp (field[k], "<=") == 0)
op = LE;
else if (_stricmp (field[k], "=") == 0)
op = EQ;
else if (_stricmp (field[k], "!=") == 0)
op = NE;
else if (_stricmp (field[k], ">") == 0)
op = GT;
else if (_stricmp (field[k], ">=") == 0)
op = GE;
else
error_stop ("invalid operator in output.opt SELECT:",
field[k]);
sel->logop = op;
}
++k;
sel->value = atof (field[k]);
if (not_float (field[k]))
error_stop ("invalid value field in output.opt SELECT:",
field[k]);
sel->or_next = nclause;
if (nclause)
{
++k;
if (_stricmp (field[k], "OR") != 0)
error_stop ("OR not found in output.opt SELECT:",
field[k]);
}
}
}
else
error_stop ("unknown output.opt type:", field[0]);
}
alldone = 1;
}
void
_gfortran_caf_error_stop (int32_t error)
{
fprintf (stderr, "ERROR STOP %d\n", error);
error_stop (error);
}
void map (int argc, char *argv[], HWND hWnd, char *dirpath, char *map_filename)
{
char *datatitle;
char *maptitle;
char *zname;
DATATYPE data_type;
double hscale, vscale;
double xmin, xmax, ymin, ymax;
double *x, *y, *z;
double *fit, *resid;
int fit_degree;
int i, k;
int npoint;
int zdigits;
unsigned long *code;
/* get data to plot */
npoint = prepdata (argc, argv,
&datatitle, &data_type, &code, &x, &y, &z,
&fit_degree, &fit, &resid);
/* use select conditions to select points */
k = 0;
for (i = 0; i < npoint; i++)
{
double fitval, residval;
if (fit_degree > 0) {
fitval = fit[i];
residval = resid[i];
}
else {
fitval = residval = 0.0;
}
if (opt_select (code[i], x[i], y[i], z[i], fit_degree, fitval, residval))
{
code[k] = code[i];
x[k] = x[i];
y[k] = y[i];
z[k] = z[i];
if (fit_degree)
{
fit[k] = fit[i];
resid[k] = resid[i];
}
++k;
}
}
npoint = k;
if (npoint == 0)
error_stop ("no points remain after selections in output.opt","");
/* prepare map title */
opt_zvalue (&zname, &zdigits);
if (strlen (datatitle) > 100 || strlen (zname) > 100)
error_stop ("data title or observed value name too long", "");
maptitle = (char *) malloc (250);
if (maptitle == NULL)
error_stop ("cannot allocate vector for map title", "");
switch (data_type)
{
case CODE:
sprintf_s (maptitle, 250, "%s - Station Codes", datatitle);
break;
case OBS:
sprintf_s (maptitle, 250, "%s - %s Values", datatitle, zname);
break;
case FIT:
sprintf_s (maptitle, 250, "%s - Degree %d Fit of %s Values",
datatitle, fit_degree, zname);
break;
case RESID:
sprintf_s (maptitle, 250, "%s - Degree %d Fit Residual of %s Values",
datatitle, fit_degree, zname);
break;
}
/* determine range of coordinate values */
xmin = ymin = 1.e+30;
xmax = ymax = -xmin;
for (i = 0; i < npoint; i++)
{
xmin = x[i] < xmin ? x[i] : xmin;
ymin = y[i] < ymin ? y[i] : ymin;
xmax = x[i] > xmax ? x[i] : xmax;
ymax = y[i] > ymax ? y[i] : ymax;
}
/* convert coordinates to map scale inches, assuming that the */
/* x and y values are longitude and latitude, respectively */
{
double center_latitude = (ymin + ymax) / 2;
double cos_cent;
double degrees_per_radian = M_PI / 180.;
double s, t;
long ratio;
opt_scale (&ratio);
cos_cent = cos (center_latitude * degrees_per_radian);
t = 1 - cos_cent * cos_cent * 0.006693422;
s = (cos_cent * 2.5026656e+8) / sqrt (t);
hscale = ratio / (s * degrees_per_radian);
t = (6.305541e+16 - 0.006693422 * s * s);
t = t * sqrt (t) / 6.284403e+16;
vscale = ratio / (t * degrees_per_radian);
for (i = 0; i < npoint; i++)
{
x[i] = - x[i] / hscale; /* switch sign on longitude for */
/* correct map orientation */
y[i] = y[i] / vscale;
}
{ /* must also switch sign on */
double hold = xmin; /* xmin and xmax */
xmin = - xmax / hscale;
xmax = - hold / hscale;
}
ymin = ymin / vscale;
ymax = ymax / vscale;
}
/* create pdf map file */
startPrint(hWnd, dirpath, map_filename, maptitle);
printHeader(maptitle);
printStations(data_type, npoint, code, x, y, z, fit, resid,
hscale, vscale, xmin, xmax, ymin, ymax, zdigits);
endPrint();
return;
}