int f_code_table_3_2(ARG0) {
int val;
const char *string;
if (mode >= 0) {
val = code_table_3_2(sec);
if (val >= 0) {
string = NULL;
switch(val) {
#include "CodeTable_3.2.dat"
}
if (string == NULL) sprintf(inv_out,"code table 3.2=%d", val);
else sprintf(inv_out,"code table 3.2=%d %s", val, string);
}
if (mode > 0) {
inv_out += strlen(inv_out);
sprintf(inv_out,", ave radius of earth=%lf km",radius_earth(sec)/1000.0);
}
}
return 0;
}
int f_cress_lola(ARG4) {
int n, nx, ny, nxny, ix, iy, i, j, k, m, iradius;
double x0,dx, y0,dy, x, y, z, r_sq, sum;
unsigned char *new_sec[8];
double *cos_lon, *sin_lon, s, c, tmp, *tmpv, *inc, *wt;
float *background;
struct local_struct {
int nlat, nlon, nRadius;
double lat0, lon0, dlat, dlon, latn, lonn;
FILE *out;
int last_GDS_change_no;
double Radius[MAX_SCANS];
double R_earth;
double *in_x, *in_y, *in_z;
double *out_x, *out_y, *out_z;
char *mask;
};
struct local_struct *save;
/* initialization phase */
if (mode == -1) {
decode = latlon = 1; /* request decode of data, lat and lon */
*local = save = (struct local_struct *) malloc( sizeof(struct local_struct));
if (save == NULL) fatal_error("cress_lola memory allocation ","");
/* parse command line arguments */
if (sscanf(arg1,"%lf:%d:%lf", &x0, &nx, &dx) != 3)
fatal_error("cress_lola parsing longitudes lon0:nx:dlon %s", arg1);
if (dx < 0) fatal_error("cress_lola: dlon < 0", "");
if (nx <= 0) fatal_error_i("cress_lola: bad nlon %d", nx);
if (x0 < 0.0) x0 += 360.0;
if (x0 < 0.0 || x0 >= 360.0) fatal_error("cress_lola: bad initial longitude","");
save->nlon = nx;
save->lon0 = x0;
save->dlon = dx;
save->lonn = x0 + (nx-1) * dx;
if (sscanf(arg2,"%lf:%d:%lf", &y0, &ny, &dy) != 3)
fatal_error("cress_lola parsing latitudes lat0:nx:dlat %s", arg2);
if (dy < 0) fatal_error("cress_lola: dlat < 0","");
if (ny <= 0) fatal_error_i("cress_lola: bad nlat %d", ny);
save->nlat = ny;
save->lat0 = y0;
save->dlat = dy;
save->latn = y0 + (ny-1)*dy;
if (save->latn > 90.0 || save->lat0 < -90.0) fatal_error("cress_lola: bad latitude","");
nxny = nx*ny;
if ((save->out = ffopen(arg3,file_append ? "ab" : "wb")) == NULL)
fatal_error("cress_lola could not open file %s", arg3);
iradius = 0;
save->mask = NULL;
k = sscanf(arg4, "%lf%n", &tmp, &m);
while (k == 1) {
if (iradius >= MAX_SCANS) fatal_error("cres_lola: too many radius parameters","");
save->Radius[iradius++] = tmp;
if (tmp < 0.0 && save->mask == NULL) {
save->mask = (char *) malloc(nxny * sizeof(char));
if (save->mask == NULL) fatal_error("cress_lola memory allocation ","");
}
arg4 += m;
k = sscanf(arg4, ":%lf%n", &tmp, &m);
}
save->nRadius = iradius;
fprintf(stderr,"nRadius=%d nx=%d ny=%d\n",save->nRadius, nx, ny);
save->out_x = (double *) malloc(nxny * sizeof(double));
save->out_y = (double *) malloc(nxny * sizeof(double));
save->out_z = (double *) malloc(nxny * sizeof(double));
if (save->out_x == NULL || save->out_y == NULL || save->out_z == NULL)
fatal_error("cress_lola: memory allocation","");
save->in_x = save->in_y = save->in_z = NULL;
save->last_GDS_change_no = 0;
/* out_x, out_y, out_z have the 3-d coordinates of the lola grid */
cos_lon = (double *) malloc(nx * sizeof(double));
sin_lon = (double *) malloc(nx * sizeof(double));
if (cos_lon == NULL || sin_lon == NULL) fatal_error("cress_lola: memory allocation","");
for (i = 0; i < nx; i++) {
x = (x0 + i*dx) * (M_PI / 180.0);
cos_lon[i] = cos(x);
sin_lon[i] = sin(x);
}
for (k = j = 0; j < ny; j++) {
y = (y0 + j*dy) * (M_PI / 180.0);
s = sin(y);
c = sqrt(1.0 - s * s);
for (i = 0; i < nx; i++) {
save->out_z[k] = s;
save->out_x[k] = c * cos_lon[i];
save->out_y[k] = c * sin_lon[i];
k++;
}
}
free(cos_lon);
free(sin_lon);
return 0;
}
save = (struct local_struct *) *local;
if (mode == -2) {
ffclose(save->out);
return 0;
}
/* processing phase */
fprintf(stderr,">>processing\n");
nx = save->nlon;
ny = save->nlat;
nxny = nx*ny;
background = (float *) malloc(nxny * sizeof(float));
tmpv = (double *) malloc(nxny * sizeof(double));
inc = (double *) malloc(nxny * sizeof(double));
wt = (double *) malloc(nxny * sizeof(double));
if (background == NULL || tmpv == NULL || wt == NULL || inc == NULL) fatal_error("cress_lola: memory allocation","");
/* Calculate x, y and z of input grid if new grid */
if (save->last_GDS_change_no != GDS_change_no || save->in_x == NULL) {
save->last_GDS_change_no = GDS_change_no;
if (lat == NULL || lon == NULL || data == NULL) fatal_error("cress_lola: no lat, lon, or data","");
save->R_earth = radius_earth(sec);
if (save->in_x) free(save->in_x);
if (save->in_y) free(save->in_y);
if (save->in_z) free(save->in_z);
save->in_x = (double *) malloc(npnts * sizeof(double));
save->in_y = (double *) malloc(npnts * sizeof(double));
save->in_z = (double *) malloc(npnts * sizeof(double));
if (save->in_x == NULL || save->in_y == NULL || save->in_z == NULL)
fatal_error("cress_lola: memory allocation","");
for (i = 0; i < npnts; i++) {
tmp = lon[i];
if (tmp < save->lon0) tmp += 360.0;
if (lat[i] >= 999.0 || lat[i] > save->latn || lat[i] < save->lat0 || tmp > save->lonn) {
save->in_x[i] = 999.9;
}
else {
s = sin(lat[i] * (M_PI / 180.0));
c = sqrt(1.0 - s * s);
save->in_z[i] = s;
save->in_x[i] = c * cos(lon[i] * (M_PI / 180.0));
save->in_y[i] = c * sin(lon[i] * (M_PI / 180.0));
}
}
fprintf(stderr,"done new gds processing npnts=%d\n", npnts);
}
/* at this point x, y, and z of input and output grids have been made */
/* make new_sec[] with new grid definition */
for (i = 0; i < 8; i++) new_sec[i] = sec[i];
new_sec[3] = sec3_lola(nx, save->lon0, save->dlon, ny, save->lat0, save->dlat, sec);
/* set background to average value of data */
n = 0;
sum = 0.0;
/* make background = ave value */
for (i = 0; i < npnts; i++) {
if (save->in_x[i] < 999.0 && ! UNDEFINED_VAL(data[i]) ) {
n++;
sum += data[i];
}
}
if (n == 0) {
/* write undefined grid */
for (i = 0; i < nxny; i++) background[i] = UNDEFINED;
grib_wrt(new_sec, background, nxny, nx, ny, use_scale, dec_scale, bin_scale,
wanted_bits, max_bits, grib_type, save->out);
if (flush_mode) fflush(save->out);
free(background);
free(tmpv);
free(inc);
free(wt);
return 0;
}
sum /= n;
for (i = 0; i < nxny; i++) background[i] = sum;
fprintf(stderr,">>sum=%lf n %d background[1] %lf\n", sum, n, background[1]);
for (iradius = 0; iradius < save->nRadius; iradius++) {
fprintf(stderr,">>radias=%lf nxny %d npnts %d\n", save->Radius[iradius],nxny, npnts);
/* save->Radius has units of km */
/* normalize to a sphere of unit radius */
r_sq = save->Radius[iradius] / (save->R_earth / 1000.0);
r_sq = r_sq * r_sq;
/* wt = inc = 0.0; */
for (k = 0; k < nxny; k++) inc[k] = wt[k] = 0.0;
for (j = 0; j < npnts; j++) {
if (save->in_x[j] > 999.0 || UNDEFINED_VAL(data[j]) ) continue;
/* find the background value */
x = lon[j] - save->lon0;
x = (x < 0.0) ? (x + 360.0) / save->dlon : x / save->dlon;
y = (lat[j] - save->lat0) / save->dlat;
ix = floor(x);
iy = floor(y);
if ((double) ix == x && ix == nx-1) ix--;
if ((double) iy == y && iy == ny-1) iy--;
if (ix < 0 || iy < 0 || ix >= nx || iy >= ny) fatal_error("cress_lola: prog error ix, iy","");
x = x - ix;
y = y - iy;
/* find background value */
tmp = background[ix+iy*nx] * (1-x)*(1-y) +
background[ix+1+iy*nx] * (x)*(1-y) +
background[ix+(iy+1)*nx] * (1-x)*(y) +
background[(ix+1)+(iy+1)*nx] * (x)*(y);
// fprintf(stderr,"obs: lat/lon %lf %lf, ix %d / %d iy %d data %lf, background %lf\n", lat[j],lon[j], ix, nx, iy, data[j], tmp);
/* data increment */
tmp = data[j] - tmp;
x = save->in_x[j];
y = save->in_y[j];
z = save->in_z[j];
for (k = 0; k < nxny; k++) {
tmpv[k] = DIST_SQ(x-save->out_x[k], y-save->out_y[k], z-save->out_z[k]);
if (tmpv[k] < r_sq) {
tmpv[k] = (r_sq - tmpv[k]) / (r_sq + tmpv[k]);
wt[k] += tmpv[k];
inc[k] += tmpv[k] * tmp;
}
}
}
/* make mask or update background */
if (save->Radius[iradius] < 0.0) {
for (k = 0; k < nxny; k++) save->mask[k] = (wt[k] > 0) ? 1 : 0;
}
for (k = 0; k < nxny; k++) {
if (wt[k] > 0) background[k] += inc[k]/wt[k];
}
}
if (save->mask) {
for (k = 0; k < nxny; k++) {
if (save->mask[k] == 0) background[k] = UNDEFINED;
}
}
grib_wrt(new_sec, background, nxny, nx, ny, use_scale, dec_scale, bin_scale,
wanted_bits, max_bits, grib_type, save->out);
if (flush_mode) fflush(save->out);
free(background);
free(tmpv);
free(wt);
free(inc);
return 0;
}
int mercator2ll(unsigned char **sec, double **lat, double **lon) {
double dx, dy, lat1, lat2, lon1, lon2;
double *llat, *llon;
int i, j;
unsigned int k;
double dlon, circum;
double n,s,e,w,tmp,error;
unsigned char *gds;
int nnx, nny, nres, nscan;
unsigned int nnpnts;
get_nxny(sec, &nnx, &nny, &nnpnts, &nres, &nscan);
gds = sec[3];
dy = GDS_Mercator_dy(gds);
dx = GDS_Mercator_dx(gds);
lat1 = GDS_Mercator_lat1(gds);
lat2 = GDS_Mercator_lat2(gds);
lon1 = GDS_Mercator_lon1(gds);
lon2 = GDS_Mercator_lon2(gds);
if (lon1 < 0.0 || lon2 < 0.0 || lon1 > 360.0 || lon2 > 360.0) fatal_error("BAD GDS lon","");
if (lat1 < -90.0 || lat2 < -90.0 || lat1 > 90.0 || lat2 > 90.0) fatal_error("BAD GDS lat","");
if (GDS_Mercator_ori_angle(gds) != 0.0) {
fprintf(stderr,"cannot handle non-zero mercator orientation angle %f\n",
GDS_Mercator_ori_angle(gds));
return 0;
}
if (nnx == -1 || nny == -1) {
fprintf(stderr,"Sorry geo/mercator code does not handle variable nx/ny yet\n");
return 0;
}
if ((*lat = (double *) malloc(nnpnts * sizeof(double))) == NULL) {
fatal_error("mercator2ll memory allocation failed","");
}
if ((*lon = (double *) malloc(nnpnts * sizeof(double))) == NULL) {
fatal_error("mercator2ll memory allocation failed","");
}
/* now figure out the grid coordinates mucho silly grib specification */
/* find S and N latitude */
if (GDS_Scan_y(nscan)) {
s = lat1;
n = lat2;
}
else {
s = lat2;
n = lat1;
}
if (s > n) fatal_error("Mercator grid: lat1 and lat2","");
/* find W and E longitude */
if ( ((nscan & 16) == 16) && (nny % 2 == 0) && ((nres & 32) == 0) ) {
fatal_error("grib GDS ambiguity","");
}
if ( ((nscan & 16) == 16) && (nny % 2 == 0) ) {
fatal_error("more code needed to decode GDS","");
}
if (GDS_Scan_x(nscan)) {
w = lon1;
e = lon2;
} else {
w = lon2;
e = lon1;
}
if (e <= w) e += 360.0;
llat = *lat;
llon = *lon;
dlon = (e-w) / (nnx-1);
circum = 2.0 * M_PI * radius_earth(sec) * cos(GDS_Mercator_latD(gds) * (M_PI/180.0));
dx = dx * 360.0 / circum;
// dlon should be almost == to dx
// replace dx by dlon to get end points to match
if (dx != 0.0) {
error = fabs(dx-dlon) / fabs(dx);
if (error >= 0.001) { fprintf(stderr,
"\n*** Mercator grid error: inconsistent d-longitude, radius and grid domain\n"
"*** d-longitude from grid domain %lf (used), d-longitude from dx %lf (not used)\n",
dlon, dx);
}
dx = dlon;
}
s = log(tan((45+s/2)*M_PI/180));
n = log(tan((45+n/2)*M_PI/180));
dy = (n - s) / (nny - 1);
for (j = 0; j < nny; j++) {
tmp = (atan(exp(s+j*dy))*180/M_PI-45)*2;
for (i = 0; i < nnx; i++) {
*llat++ = tmp;
}
}
for (j = 0; j < nnx; j++) {
llon[j] = w + j*dx >= 360.0 ? w + j*dx - 360.0 : w + j*dx;
}
for (k = nnx; k < nnpnts; k++) {
llon[k] = llon[k-nnx];
}
return 0;
} /* end mercator2ll() */
int lambert2ll(unsigned char **sec, double **llat, double **llon) {
double n;
double *lat, *lon;
double dx, dy, lat1r, lon1r, lon2d, lon2r, latin1r, latin2r;
double lond, latd, d_lon;
double f, rho, rhoref, theta, startx, starty;
int j, nnx, nny, nres, nscan;
double x, y, tmp;
unsigned char *gds;
double latDr;
double earth_radius;
unsigned int nnpnts;
get_nxny(sec, &nnx, &nny, &nnpnts, &nres, &nscan);
if (nnx <= 0 || nny <= 0) {
fprintf(stderr,"Sorry code does not handle variable nx/ny yet\n");
return 0;
}
earth_radius = radius_earth(sec);
gds = sec[3];
dy = GDS_Lambert_dy(gds);
dx = GDS_Lambert_dx(gds);
lat1r = GDS_Lambert_La1(gds) * (M_PI / 180.0);
lon1r = GDS_Lambert_Lo1(gds) * (M_PI / 180.0);
lon2d = GDS_Lambert_Lov(gds);
lon2r = lon2d * (M_PI / 180.0);
latin1r = GDS_Lambert_Latin1(gds) * (M_PI/180.0);
latin2r = GDS_Lambert_Latin2(gds) * (M_PI/180.0);
// fix for theta start value crossing 0 longitude
// if ((lon1r - lon2r) > 0) lon2r = lon2r + 2*M_PI;
//
// Latitude of "false origin" where scales are defined.
// It is used to estimate "reference_R", rhoref.
// Often latDr == latin1r == latin2r and non-modified code is true and works fine.
// But could be different if intersection latitudes latin1r and latin2r are different.
// Usually latDr must be latin1r <= latDr <= latin2r, other could be strange.
//
latDr = GDS_Lambert_LatD(gds) * (M_PI/180.0);
if (lon1r < 0) fatal_error("bad GDS, lon1r < 0.0","");
if ( fabs(latin1r - latin2r) < 1E-09 ) {
n = sin(latin1r);
}
else {
n = log(cos(latin1r)/cos(latin2r)) /
log(tan(M_PI_4 + latin2r/2.0) / tan(M_PI_4 + latin1r/2.0));
}
f = (cos(latin1r) * pow(tan(M_PI_4 + latin1r/2.0), n)) / n;
rho = earth_radius * f * pow(tan(M_PI_4 + lat1r/2.0),-n);
// old rhoref = earth_radius * f * pow(tan(M_PI_4 + latin1r/2.0),-n);
rhoref = earth_radius * f * pow(tan(M_PI_4 + latDr/2.0),-n);
// 2/2009 .. new code
d_lon = lon1r - lon2r;
if (d_lon > M_PI) d_lon -= 2*M_PI;
if (d_lon < -M_PI) d_lon += 2*M_PI;
theta = n * d_lon;
// 2/2009 theta = n * (lon1r - lon2r);
startx = rho * sin(theta);
starty = rhoref - rho * cos(theta);
if ((*llat = (double *) malloc(nnpnts * sizeof(double))) == NULL) {
fatal_error("lambert2ll memory allocation failed","");
}
if ((*llon = (double *) malloc(nnpnts * sizeof(double))) == NULL) {
fatal_error("lambert2ll memory allocation failed","");
}
lat = *llat;
lon = *llon;
/* put x[] and y[] values in lon[] and lat[] */
if (stagger(sec, nnpnts, lon, lat)) fatal_error("geo: stagger problem","");
dx = fabs(dx);
dy = fabs(dy);
#pragma omp parallel for private(j,x,y,tmp,theta,rho,lond,latd)
for (j = 0; j < nnpnts; j++) {
y = starty + lat[j]*dy;
x = startx + lon[j]*dx;
tmp = rhoref - y;
theta = atan(x / tmp);
rho = sqrt(x * x + tmp*tmp);
rho = n > 0 ? rho : -rho;
lond = lon2d + todegrees(theta/n);
latd = todegrees(2.0 * atan(pow(earth_radius * f/rho,1.0/n)) - M_PI_2);
lond = lond >= 360.0 ? lond - 360.0 : lond;
lond = lond < 0.0 ? lond + 360.0 : lond;
lon[j] = lond;
lat[j] = latd;
}
return 0;
} /* end lambert2ll() */
int polar2ll(unsigned char **sec, double **llat, double **llon) {
double *lat, *lon;
unsigned char *gds;
double dx, dy, orient, de, de2, dr, tmp, xp, yp, h, lat1, lon1, dr2;
double di, dj, LatD;
int ix, iy;
int nnx, nny, nres, nscan;
unsigned int nnpnts;
get_nxny(sec, &nnx, &nny, &nnpnts, &nres, &nscan);
gds = sec[3];
if (nnx == -1 || nny == -1) {
fprintf(stderr,"Sorry code does not handle variable nx/ny yet\n");
return 0;
}
if ((*llat = (double *) malloc(nnpnts * sizeof(double))) == NULL) {
fatal_error("polar2ll memory allocation failed","");
}
if ((*llon = (double *) malloc(nnpnts * sizeof(double))) == NULL) {
fatal_error("polar2ll memory allocation failed","");
}
lat = *llat;
lon = *llon;
/* based on iplib */
lat1 = GDS_Polar_lat1(gds) * (M_PI/180);
lon1 = GDS_Polar_lon1(gds);
orient = GDS_Polar_lov(gds);
LatD = GDS_Polar_lad(gds);
lon1 *= (M_PI/180.0);
orient *= (M_PI/180.0);
dy = GDS_Polar_dy(gds);
dx = GDS_Polar_dx(gds);
h = 1.0;
if (GDS_Polar_sps(gds)) {
h = -1.0;
/* added 12/19/2008 WNE sps checkout */
orient -= M_PI;
}
// removed 12/11 if (! (GDS_Scan_x(nscan))) dx = -dx;
// removed 12/11 if (! (GDS_Scan_y(nscan))) dy = -dy;
/* 60 probably becomes something else in grib2 */
/* vsm: from comment to grib2 polar template:
"Grid length is in units of 10-3 m at the latitude specified by LaD"
do use GDS_Polar_lad(gds) instead of 60?
Do use fabs for southern hemisphere?
*/
de = (1.0 + sin(fabs(LatD)*(M_PI/180.0))) * radius_earth(sec);
dr = de * cos(lat1) / (1 + h*sin(lat1));
xp=-h*sin(lon1-orient)*dr/dx;
yp= cos(lon1-orient)*dr/dy;
// added 12/11
if (! (GDS_Scan_y(nscan))) {
yp = yp - nny + 1;
}
if (! (GDS_Scan_x(nscan))) {
xp = xp - nnx + 1;
}
de2 = de*de;
#pragma omp parallel for private(iy,ix,di,dj,dr2,tmp)
for (iy = 0; iy < nny; iy++) {
for (ix = 0; ix < nnx; ix++) {
di = (ix - xp) * dx;
dj = (iy - yp) * dy;
dr2 = di*di + dj*dj;
if (dr2 < de2*1e-6) {
lon[ix+iy*nx] = 0.0;
lat[ix+iy*nx] = h*90.0;
} else {
tmp = (orient+h*atan2(di,-dj))*(180.0/M_PI);
if (tmp < 0.0) tmp += 360.0;
if (tmp > 360.0) tmp -= 360.0;
lon[ix+iy*nx] = tmp;
lat[ix+iy*nx] = h*asin((de2-dr2)/(de2+dr2))*(180.0/M_PI);
}
}
}
return 0;
}
