Example #1
0
int main(int argc, char **argv)
{
  int stack_top=0;
  memory_stack_top = &stack_top;
#ifdef CMK_G95
  g95_runtime_start(argc, argv);
#endif
  ConverseInit(argc, argv, (CmiStartFn) _initCharm, 0, 0);
#ifdef CMK_G95
    // FIXME:  not right place to call, but not calling it does not quite hurt
  g95_runtime_stop();
#endif
  return 0;
}
Example #2
0
int f_new_grid(ARG4) {
    struct local_struct *save;

    unsigned int i;
    int is_u, is_v, ftn_npnts, ftn_nout;
    int kgds[200], km;
    float *data_in, *data_out;
    double x0, y0, dx, dy, xn, yn;
    double lov, lad, latin1, latin2;
    int proj;					// projection: for LC 0 = NP, 128 = SP
    char name[NAMELEN];
    int j, ibi, ibo, iret, nnx, nny, n_out;
    unsigned char *new_sec[8], *s, *bitmap, *bitmap_out, *p;

    /* for lambertc */
    double r_maj, r_min, ref_lon, ref_lat;

    if (mode == -1) {			// initialization
        decode = 1;
        output_order_wanted = raw;	// in raw order


#ifdef G95
        // initialize g95 runtime library
        if (g95_runstop == 0) {
            g95_runtime_start(0,NULL);
            g95_runstop = 1;
        }
#endif

//        if ( (sizeof(vectors) / sizeof (vectors[0])) % 2 == 1) fatal_error("new_grid: program error in vectors[]","");

        // allocate static variables

        *local = save = (struct local_struct *) malloc( sizeof(struct local_struct));
        if (save == NULL) fatal_error("memory allocation -wind_speed","");

        if ((save->out = ffopen(arg4, file_append ? "ab" : "wb")) == NULL) {
            fatal_error("-new_grid: could not open file %s", arg1);
        }
        save->has_u = 0;
        save->radius_major = save->radius_minor = 0.0;
        init_sec(save->clone_sec);
        s = NULL;

        // parse NCEP grids */
        ncep_grids(&arg1, &arg2, &arg3);

        // for each output grid
        if (strcmp(arg1,"latlon") == 0) {
            if (sscanf(arg2,"%lf:%d:%lf", &x0, &nnx, &dx) != 3)
                fatal_error("new_grid: XDEF wrong:%s",arg2);
            if (sscanf(arg3,"%lf:%d:%lf", &y0, &nny, &dy) != 3)
                fatal_error("new_grid: YDEF wrong:%s",arg3);

            if (x0 < 0.0) x0 += 360.0;
            save->nx = nnx;
            save->ny = nny;
            save->npnts_out = n_out = nnx*nny;
            if (n_out <= 0) fatal_error("new_grid: bad nx, ny","");

            // make a new section 3
            s = sec3_lola(nnx, x0, dx, nny, y0, dy, sec);
        }
        else if (strncmp(arg1,"mercator:",9) == 0) {
            if (sscanf(arg1,"mercator:%lf",  &lad) != 1)
                fatal_error("new_grid: LaD (latitude interesection) not specified","");
            if (sscanf(arg2,"%lf:%d:%lf:%lf", &x0, &nnx, &dx, &xn) != 4)
                fatal_error("new_grid: XDEF wrong:%s",arg2);
            if (sscanf(arg3,"%lf:%d:%lf:%lf", &y0, &nny, &dy, &yn) != 4)

                if (x0 < 0.0) x0 += 360.0;
            save->nx = nnx;
            save->ny = nny;
            save->npnts_out = n_out = nnx*nny;
            if (n_out <= 0) fatal_error("new_grid: bad nx, ny","");

            // make a new section 3
            s = sec3_mercator(lad, nnx, x0, dx, xn, nny, y0, dy, yn, sec);
        }
        else if (strcmp(arg1,"gaussian") == 0) {
            if (sscanf(arg2,"%lf:%d:%lf", &x0, &nnx, &dx) != 3)
                fatal_error("new_grid: XDEF wrong:%s",arg2);
            if (sscanf(arg3,"%lf:%d", &y0, &nny) != 2)
                fatal_error("new_grid: YDEF wrong:%s",arg3);

            if (x0 < 0.0) x0 += 360.0;
            save->nx = nnx;
            save->ny = nny;
            save->npnts_out = n_out = nnx*nny;
            if (n_out <= 0) fatal_error("new_grid: bad nx, ny","");
            // make a new section 3
            s = sec3_gaussian(nnx, x0, dx, nny, y0, sec);
        }
        else if (strncmp(arg1,"lambert:",8) == 0) {
            i = sscanf(arg1,"lambert:%lf:%lf:%lf:%lf", &lov, &latin1, &latin2, &lad);
            if (i < 2) fatal_error("new_grid: arg1 wrong:%s",arg1);
            if (lov < 0.0)  lov += 360.0;
            if (i < 3) latin2 = latin1;
            if (i < 4) lad = latin2;
            proj = 0;
            if (latin2 < 0.0) proj = 128;

            if (sscanf(arg2,"%lf:%d:%lf", &x0, &nnx, &dx) != 3)
                fatal_error("new_grid: XDEF wrong:%s",arg2);
            if (sscanf(arg3,"%lf:%d:%lf", &y0, &nny, &dy) != 3)
                fatal_error("new_grid: YDEF wrong:%s",arg3);

            if (x0 < 0.0) x0 += 360.0;
            save->nx = nnx;
            save->ny = nny;
            save->npnts_out = n_out = nnx*nny;
            if (n_out <= 0) fatal_error("new_grid: bad nx, ny","");

            // make a new section 3
            s = sec3_lc(lov, lad, latin1, latin2, proj, nnx, x0, dx, nny, y0, dy, sec);
        }

        /* for lambertc, input is the lon-lat of center point */
        /* can not calc grid until radius is given, so do lambert code to check args */

        else if (strncmp(arg1,"lambertc:",9) == 0) {
            i = sscanf(arg1,"lambertc:%lf:%lf:%lf:%lf", &lov, &latin1, &latin2, &lad);
            if (i < 2) fatal_error("new_grid: arg1 wrong:%s",arg1);
            if (lov < 0.0)  lov += 360.0;
            if (i < 3) latin2 = latin1;
            if (i < 4) lad = latin2;
            proj = 0;
            if (latin2 < 0.0) proj = 128;

            if (sscanf(arg2,"%lf:%d:%lf", &x0, &nnx, &dx) != 3)
                fatal_error("new_grid: XDEF wrong:%s",arg2);
            if (sscanf(arg3,"%lf:%d:%lf", &y0, &nny, &dy) != 3)
                fatal_error("new_grid: YDEF wrong:%s",arg3);

            if (x0 < 0.0) x0 += 360.0;
            save->nx = nnx;
            save->ny = nny;
            save->npnts_out = n_out = nnx*nny;
            if (n_out <= 0) fatal_error("new_grid: bad nx, ny","");

            // make a new section 3
            s = sec3_lc(lov, lad, latin1, latin2, proj, nnx, x0, dx, nny, y0, dy, sec);
        }

        else if (strncmp(arg1,"nps:",4) == 0 || strncmp(arg1,"sps:",4) == 0)  {
            if (sscanf(arg1,"%*[ns]ps:%lf:%lf", &lov, &lad) != 2) fatal_error("new_grid: arg1 wrong:%s",arg1);
            if (lad != 60.0) fatal_error("New_grid: only LatD = 60 is supported","");
            proj = 0;
            if (arg1[0] == 's') proj = 128;
            if (sscanf(arg2,"%lf:%d:%lf", &x0, &nnx, &dx) != 3)
                fatal_error("new_grid: XDEF wrong:%s",arg2);
            if (sscanf(arg3,"%lf:%d:%lf", &y0, &nny, &dy) != 3)
                fatal_error("new_grid: YDEF wrong:%s",arg3);
            if (lov < 0.0)  lov += 360.0;

            if (x0 < 0.0) x0 += 360.0;
            save->nx = nnx;
            save->ny = nny;
            save->npnts_out = n_out = nnx*nny;
            if (n_out <= 0) fatal_error("new_grid: bad nx, ny","");

            // make a new section 3
            s = sec3_polar_stereo(lov, lad, proj, nnx, x0, dx, nny, y0, dy, sec);
        }
        else fatal_error("new_grid: unsupported output grid %s", arg1);

        // save new section 3
        i = (int) uint4(s);         // size of section 3
        new_sec[3] = save->sec3 = (unsigned char *) malloc(i * sizeof(unsigned char));
        for (j = 0; j < i; j++) save->sec3[j] = s[j];

        // apply wind rotation .. change flag 3.3
        if (wind_rotation == undefined) {
            fprintf(stderr,"Warning: -new_grid wind orientation undefined, "
                    "use \"-new_grid_winds (grid|earth)\", earth used (N=North Pole)\n");
            if ( (p = flag_table_3_3_location(new_sec)) ) *p = *p & (255 - 8);
        }

        if (wind_rotation == grid && (p = flag_table_3_3_location(new_sec))) *p = *p | 8;

        if (mk_kgds(new_sec, save->kgds_out)) fatal_error("new_grid: encoding output kgds","");

        /* some vectors need by interpolation routines */
        if ((save->rlat = (float *) malloc(n_out * sizeof(float))) == NULL)
            fatal_error("new_grid memory allocation","");
        if ((save->rlon = (float *) malloc(n_out * sizeof(float))) == NULL)
            fatal_error("new_grid memory allocation","");
        if ((save->crot = (float *) malloc(n_out * sizeof(float))) == NULL)
            fatal_error("new_grid memory allocation","");
        if ((save->srot = (float *) malloc(n_out * sizeof(float))) == NULL)
            fatal_error("new_grid memory allocation","");

        return 0;
    }

    save = (struct local_struct *) *local;

    if (mode == -2) {			// cleanup
#ifdef G95
        if (g95_runstop == 1) {
            g95_runtime_stop();
            g95_runstop = 0;
        }
#endif
        if (save->has_u > 0) {
            fprintf(stderr,"-new_grid: last field %s was not interpolated (missing V)\n", save->name);
            free(save->u_val);
            free_sec(save->clone_sec);
        }
        free(save->rlon);
        free(save->rlat);
        free(save->crot);
        free(save->srot);
        free(save->sec3);
        ffclose(save->out);
        free(save);

        return 0;
    }

    if (mode >= 0) {			// processing

        /* The kgds of some output grids will change depending on input grid */
        /* for example, radius of earth is not known grib file is read, */
        /*   and mass vs wind fields */
        /* right nowm, only affects lambertc */

        if (strncmp(arg1,"lambertc:",8) == 0) {

            // lambertc depends on the radius of the earth which is
            // set by the input grib file

            /* read earth radius */
            i = axes_earth(sec, &r_maj, &r_min);
            if (i) fatal_error_i("axes_earth: error code %d", i);

            if (save->radius_major != r_maj || save->radius_minor != r_min) {

                // update sec3 and kgds

                i = sscanf(arg1,"lambertc:%lf:%lf:%lf:%lf", &lov, &latin1, &latin2, &lad);
                if (i < 2) fatal_error("new_grid: arg1 wrong:%s",arg1);
                if (lov < 0.0)  lov += 360.0;
                if (i < 3) latin2 = latin1;
                if (i < 4) lad = latin2;
                proj = 0;
                if (latin2 < 0.0) proj = 128;

                if (sscanf(arg2,"%lf:%d:%lf", &x0, &nnx, &dx) != 3)
                    fatal_error("new_grid: XDEF wrong:%s",arg2);
                if (sscanf(arg3,"%lf:%d:%lf", &y0, &nny, &dy) != 3)
                    fatal_error("new_grid: YDEF wrong:%s",arg3);

                if (x0 < 0.0) x0 += 360.0;
                save->nx = nnx;
                save->ny = nny;
                save->npnts_out = n_out = nnx*nny;
                if (n_out <= 0) fatal_error("new_grid: bad nx, ny","");

                ref_lon = x0;
                ref_lat = y0;

                i = new_grid_lambertc(nnx, nny, ref_lon, ref_lat, latin1, latin2, lov, lad, r_maj, r_min, dx, dy, &x0, &y0);
                if (i) fatal_error_i("new_grid_lambertc: error code %d", i);

                // make a new section 3
                s = sec3_lc(lov, lad, latin1, latin2, proj, nnx, x0, dx, nny, y0, dy, sec);

                // save new section 3
                i = (int) uint4(s);         // size of section 3
                for (j = 0; j < i; j++) save->sec3[j] = s[j];

                // make kgds
                new_sec[3] = save->sec3;
                if (mk_kgds(new_sec, save->kgds_out)) fatal_error("new_grid: encoding output kgds","");

                // save radius of earth, to show sec3 and kgds has been done
                save->radius_major = r_maj;
                save->radius_minor = r_min;
            }
        }

        if (output_order != raw) fatal_error("new_grid: must be in raw output order","");
        i = getName(sec, mode, NULL, name, NULL, NULL);
        is_u = is_v = 0;
//	for (j = 0 ; j < sizeof(vectors) / sizeof(vectors[0]); j++) {
        for (j = 0; vectors[j] != NULL; j++) {
            if (strcmp(name,vectors[j]) == 0) {
                if (j % 2 == 0) is_u = 1;
                else is_v = 1;
                break;
            }
        }

// fprintf(stderr, " %s isu %d isv %d has_u %d\n", name, is_u, is_v, save->has_u);
//  for (i = 0; i < 12; i++) { printf("kgds_out[%d] = %d ",i,save->kgds_out[i]); }

        // check if V matches expectation

        if (is_v && (save->has_u == 0  || (same_sec0(sec,save->clone_sec) != 1 ||
                                           same_sec1(sec,save->clone_sec) != 1 ||
                                           same_sec3(sec,save->clone_sec) != 1 ||
                                           same_sec4(sec,save->clone_sec) != 1) )) {
            fprintf(stderr,"-new_grid: %s doesn't pair with previous vector field, field ignored\n", name);
            return 0;
        }

        // if U field - save

        if (is_u) {
            if (save->has_u > 0) {
                fprintf(stderr,"-new_grid: missing V, %s not interpolated\n",save->name);
                free(save->u_val);
                free_sec(save->clone_sec);
            }
            copy_sec(sec, save->clone_sec);
            copy_data(data,ndata,&(save->u_val));
            GB2_ParmNum(save->clone_sec) = GB2_ParmNum(sec) + 1;
            save->has_u = 1;
            strncpy(save->name, name,NAMELEN-1);
            save->name[NAMELEN-2]=0;
            return 0;
        }

        // at this point will call polates with either a scalar or vector

        n_out = save->npnts_out;
        nnx = save->nx;
        nny = save->ny;
        km = 1;			// only one field

        if (mk_kgds(sec, kgds)) fatal_error("new_grid: encoding input kgds","");

        data_in = (float *) malloc(npnts * (1 + (is_v != 0)) * sizeof(float));
        bitmap = (unsigned char *) malloc(npnts * sizeof(unsigned char));
        bitmap_out = (unsigned char *) malloc(n_out * sizeof(unsigned char));
        data_out = (float *) malloc(n_out * (1 + (is_v != 0)) * sizeof(float));

        if (data_in == NULL || data_out == NULL || bitmap == NULL || bitmap_out == NULL)
            fatal_error("new_grid: memory allocation problem","");

        ibi = 0;                        // input bitmap is not used
        if (is_v) {
            for (i = 0; i < npnts; i++) {
                if (DEFINED_VAL(data[i]) && DEFINED_VAL(save->u_val[i])) {
                    data_in[i] = save->u_val[i];
                    data_in[i+npnts] = data[i];
                    bitmap[i] = 1;
                }
                else {
                    data_in[i] = data_in[i + npnts] = 0.0;
                    bitmap[i] = 0;
                    ibi = 1;                // input bitmap is used
                }
            }
            if (mode == 98) fprintf(stderr," UV interpolation %s , %s\n", save->name, name);
        }
        else {
            for (i = 0; i < npnts; i++) {
                if (DEFINED_VAL(data[i])) {
                    data_in[i] = data[i];
                    bitmap[i] = 1;
                }
                else {
                    data_in[i] = 0.0;
                    bitmap[i] = 0;
                    ibi = 1;                // input bitmap is used
                }
            }
        }

        // interpolate

// for (i = 0; i < 12; i++) { printf("\nkgds_in[%d] = %d  out=%d ",i,kgds[i],save->kgds_out[i]); }
        ftn_npnts = (int) npnts;
        ftn_nout = (int) n_out;
        if (is_v) {
            IPOLATEV(&interpol_type, ipopt,kgds,save->kgds_out,
                     &ftn_npnts, &n_out, &km, &ibi, bitmap, data_in, data_in+npnts,
                     &ftn_nout,save->rlat,save->rlon, save->crot, save->srot,
                     &ibo, bitmap_out, data_out, data_out + n_out, &iret);
        }
        else {
            IPOLATES(&interpol_type, ipopt,kgds,save->kgds_out,
                     &ftn_npnts, &n_out, &km, &ibi, bitmap, data_in, &ftn_nout,
                     save->rlat,save->rlon, &ibo, bitmap_out, data_out, &iret);
        }
        if (iret != 0) {
            for (i = 0; i < 12; i++) {
                fprintf(stderr," IPOLATES error: kgds[%d] input %d output %d\n", i+1,kgds[i],save->kgds_out[i]);
            }
            if (iret == 2) fatal_error("IPOLATES failed, unrecognized input grid or no grid overlap","");
            if (iret == 3) fatal_error("IPOLATES failed, unrecognized output grid","");
            fatal_error_i("IPOLATES failed, error %d",iret);

        }
        n_out = (unsigned int) ftn_nout;

        /* use bitmap to set UNDEFINED values */
        if (ibo == 1) {         // has a bitmap
            if (is_v) {
                for (i = 0; i < n_out; i++) {
                    if (bitmap_out[i] == 0) data_out[i] = data_out[i+n_out] = UNDEFINED;
                }
            }
            else {
                for (i = 0; i < n_out; i++) {
                    if (bitmap_out[i] == 0) data_out[i] = UNDEFINED;
                }
            }
        }

        // now to write out the grib file

        for (i = 0; i < 8; i++) new_sec[i] = sec[i];
        new_sec[3] = save->sec3;

        if (is_v != 0) {
            GB2_ParmNum(new_sec) = GB2_ParmNum(new_sec) - 1;
            grib_wrt(new_sec, data_out, n_out, nnx, nny, use_scale, dec_scale, bin_scale,
                     wanted_bits, max_bits, grib_type, save->out);
            GB2_ParmNum(new_sec) = GB2_ParmNum(new_sec) + 1;
            grib_wrt(new_sec, data_out+n_out, n_out, nnx, nny, use_scale, dec_scale, bin_scale,
                     wanted_bits, max_bits, grib_type, save->out);
        }
        else {
            grib_wrt(new_sec, data_out, n_out, nnx, nny, use_scale, dec_scale, bin_scale,
                     wanted_bits, max_bits, grib_type, save->out);
        }
        if (flush_mode) fflush(save->out);
        free(data_in);
        free(bitmap);
        free(bitmap_out);
        free(data_out);
        if (is_v != 0) {
            save->has_u = 0;
            free(save->u_val);
            free_sec(save->clone_sec);
        }
    }
    return 0;
}