void wgem_er_wmsg( char *errgrp, int *numerr, char *errstr, int *iret )
/************************************************************************
* wgem_er_wmsg *
* *
* This function is a wrapper for er_wmsg. *
* *
* void wgem_er_wmsg( errgrp, numerr, errstr, iret ) *
* *
* Input parameters: *
* *errgrp char error group *
* *numerr int error number *
* *errstr char error string to be embedded *
* *
* Output parameters: *
* *iret int return code *
** *
* Log: *
* E. Safford/SAIC 12/07 initial coding *
***********************************************************************/
{
er_wmsg( errgrp, numerr, errstr, iret, strlen( errgrp ), strlen( errstr ) );
}
void db_gtim ( char *queryType, char *source, char *qparms,
char *times, int *ltimes, int *iret )
/************************************************************************
* *
* db_gtim *
* *
* m.gamazaychikov/SAIC 11/08 Created *
************************************************************************/
{
int bufferSize = 200000;
char xsltFile[LLSCRN] = "response.xlt";
char xsltDir[LLSCRN] = "$NAWIPS/gempak/tables/xslt";
//char queryType[11] = "dbaseTime";
int ier, nbytes, ier1, ier2, iparm = 129, ierEvt;
long flen;
char queryText[320], queryResult[bufferSize+1], evtName[iparm-1];
char errStr[100], xsltfile[FILE_FULLSZ], parm[iparm-1];
unsigned char* bigStr;
struct timeb t_start, t_query, t_run, t_xml, t_current;
/*---------------------------------------------------------------------*/
ftime(&t_start);
/*
* Initialization
*/
*iret = 0;
times[0] = '\0';
queryText[0] = '\0';
queryResult[0] = '\0';
db_getparm ( parm, &ier2, iparm);
if ( ier2 != 0 ) {
*iret = -1;
return;
}
db_getevtname ( evtName, &ierEvt, iparm);
/*
* Populate the query strings
*/
if (strcmp ( queryType, "dbTime" ) == 0 ) {
strcpy (eSrc, source);
if ( strcmp ( source, "GRID") == 0 ) {
sprintf (ePlugIn, "%s", parm);
sprintf (eGrid, "%s", qparms);
sprintf (eLibClass, "%s", "GempakCatalogTimeQuery");
if ( ierEvt == 0 ) {
sprintf (gEventName, "%s", evtName);
}
}
else if ( strcmp ( source, "METAR") == 0 ) {
sprintf (ePlugIn, "%s", "obs");
sprintf (eLibClass, "%s", "NomTimeQuery");
}
/*
else if ( strcmp ( source, "BUFRUA") == 0 ) {
sprintf (ePlugIn, "%s", "bufrua");
sprintf (eLibClass, "%s", "GempakCatalogTimeQuery");
}
else if ( strcmp ( source, "SYNOP") == 0 ) {
sprintf (ePlugIn, "%s", "sfcobs");
sprintf (eLibClass, "%s", "GempakCatalogTimeQuery");
}
*/
else {
ier = -9;
sprintf (errStr, "%s+", queryType);
strcat (errStr, source);
er_wmsg ( "DB", &ier, errStr, &ier1, 2, strlen(errStr) );
*iret = -1;
return;
}
}
else {
ier = -8;
er_wmsg ( "DB", &ier, queryType, &ier1, 2, strlen(queryType) );
*iret = -1;
return;
}
/*
* Get the query text
*/
ftime(&t_query);
db_getQueryText ( queryType, queryText, &ier);
ftime(&t_current);
// printf("\t\t\t time spent in db_getQueryText: %d\n", (int) (1000.0 * (t_current.time - t_query.time) + (t_current.millitm - t_query.millitm)));
if ( ier !=0 ) {
/*
* Query text not set -> returning
*/
ier = -3;
er_wmsg ( "DB", &ier, NULL, &ier1, 2, 0 );
*iret = -1;
return;
}
/*
* Connect to database and get the query result
*/
ftime(&t_run);
db_runQuery ( queryText, queryResult, &ier);
ftime(&t_current);
// printf("\t\t\t time spent in db_runQuery: %d\n", (int) (1000.0 * (t_current.time - t_run.time) + (t_current.millitm - t_run.millitm)));
if ( ier !=0 ) {
ier = -4;
er_wmsg ( "DB", &ier, NULL, &ier1, 2, 0 );
*iret = -1;
return;
}
/*
* Transform XML string to a string containing list of header parameters
*/
cfl_inqr(xsltFile, xsltDir, &flen, xsltfile, &ier);
if ( ier !=0 ) {
/*
* XSLT file not found -> returning
*/
ier = -5;
er_wmsg ( "DB", &ier, xsltFile, &ier1, 2, strlen(xsltFile) );
*iret = -1;
return;
}
ftime(&t_xml);
nbytes=xml_transform( queryResult, strlen(queryResult), xsltfile, &bigStr, &ier );
ftime(&t_current);
// printf("\t\t\t time spent in xml_transform: %d\n", (int) (1000.0 * (t_current.time - t_xml.time) + (t_current.millitm - t_xml.millitm)));
if ( ier !=0 || nbytes==0) {
/*
* XML Transform run unsuccessfully -> returning
*/
ier = -6;
er_wmsg ( "DB", &ier, NULL, &ier1, 2, 0 );
G_FREE( bigStr, unsigned char );
*iret = -1;
return;
}
sprintf (times, "%s", bigStr);
*ltimes = strlen(times);
G_FREE( bigStr, unsigned char );
ftime(&t_current);
// printf("\t\t time spent in db_gtim: %d\n", (int) (1000.0 * (t_current.time - t_start.time) + (t_current.millitm - t_start.millitm)));
return;
}
void dg_adcl ( int *iret )
/************************************************************************
* dg_adcl *
* *
* This subroutine adds a column to a grid. *
* *
* dg_adcl ( iret ) *
* *
* Input parameters: *
* *
* Output parameters: *
* *iret int Return code *
* 0 = normal return *
** *
* Log: *
* R. Tian/SAIC 10/03 *
* K. Brill/HPC 2/04 Initialize gwrapg and addcol *
* R. Tian/SAIC 5/04 Removed check for addcol *
* R. Tian/SAIC 2/06 Recoded from Fortran *
* K. Brill/HPC 11/11 Remove check for exceeding LLMXTG *
************************************************************************/
{
float rgx[2], rgy[2];
int np, ier, ier2;
/*----------------------------------------------------------------------*/
*iret = 0;
_dgsubg.gwrapg = G_FALSE;
_dgfile.addcol = G_FALSE;
grc_rnav ( _dgsubg.refnav, _dgfile.cprj, &_dgfile.kxd, &_dgfile.kyd, &ier );
if ( ( strcmp ( _dgfile.cprj, "MER" ) == 0 ) ||
( strcmp ( _dgfile.cprj, "CED" ) == 0 ) ) {
/* if ( ( _dgfile.kyd * (_dgfile.kxd+1) ) > LLMXTG ) return; */
rgx[0] = 1.;
rgy[0] = 1.;
rgx[1] = (float)( _dgfile.kxd + 1 );
rgy[1] = 1.;
np = 2;
gtrans ( sys_G, sys_M, &np, rgx, rgy, rgx, rgy, &ier,
strlen(sys_G), strlen(sys_M) );
if ( G_ABS ( rgy[0] - rgy[1] ) < 0.01 ||
( G_ABS ( rgy[0] + 180. ) < 0.01 &&
G_ABS ( rgy[1] - 180. ) < 0.01 ) ) {
_dgfile.kxd += 1;
_dgfile.kxyd = _dgfile.kxd * _dgfile.kyd;
_dggrid.maxdgg = NDGRD;
gsgprj ( _dgfile.cprj, &_dgsubg.refnav[10], &_dgsubg.refnav[11],
&_dgsubg.refnav[12], &_dgfile.kxd, &_dgfile.kyd,
&_dgsubg.refnav[6], &_dgsubg.refnav[7], &_dgsubg.refnav[8],
&_dgsubg.refnav[7], &ier, strlen(_dgfile.cprj) );
if ( ier != 0 ) {
er_wmsg ( "GEMPLT", &ier, " ", &ier2,
strlen("GEMPLT"), strlen(" ") );
*iret = -7;
}
_dgfile.addcol = G_TRUE;
/*
* Free all existing grids since grid size is changed.
*/
dg_fall ( &ier );
}
} else {
_dgfile.addcol = G_FALSE;
}
if ( ( strcmp ( _dgfile.cprj, "MER" ) == 0 ) ||
( strcmp ( _dgfile.cprj, "MCD" ) == 0 ) ||
( strcmp ( _dgfile.cprj, "CED" ) == 0 ) ) {
/*
* Set GWRAPG flag for globe wrapping grid.
*/
rgx[0] = 1.;
rgy[0] = 1.;
rgx[1] = (float)_dgfile.kxd;
rgy[1] = 1.;
np = 2;
gtrans ( sys_G, sys_M, &np, rgx, rgy, rgx, rgy, &ier,
strlen(sys_G), strlen(sys_M) );
if ( G_ABS ( rgy[0] - rgy[1] ) < 0.01 ||
( G_ABS ( rgy[0] + 180. ) < 0.01 &&
G_ABS ( rgy[1] - 180. ) < 0.01 ) ) {
_dgsubg.gwrapg = G_TRUE;
}
}
return;
}
/* ARGSUSED */
static void pglpfw_openCtlBtnCb ( Widget wid, long which, XtPointer call )
/************************************************************************
* pglpfw_openCtlBtnCb *
* *
* This is the callback function for the open control buttons (OK, and *
* CANCEL) on the bottom of the file popup window. *
* *
* void pglpfw_openCtlBtnCb (wid, which, call ) *
* *
* Input parameters: *
* wid Widget Widget that activated callback *
* which long which button *
* call XtPointer not used *
* *
* Output parameters: *
* Return parameters: *
* NONE *
* *
** *
* Log: *
* T. Lee/SAIC 04/02 *
* T. Lee/SAIC 05/02 Removed open check *
***********************************************************************/
{
int ier, ier1;
/*---------------------------------------------------------------------*/
ier = 0;
switch ( which ) {
case 0: /* Open */
/*
* Exit layering if necessay.
*/
if ( pglayrw_isUp () ) {
pglayrw_exit ();
}
if ( strlen( _fileName ) > (size_t)0) {
pglpfw_loadLPF (&ier);
}
else {
ier = -1;
er_wmsg ( "CTB", &ier, _fileName, &ier1, 3, strlen(_fileName) );
NxmErr_update();
}
pglpfw_popdown ();
pgundo_initUndo ();
break;
case 1: /* CANCEL */
pglpfw_popdown ();
break;
} /* the end of switch */
/*
* Reset to previous oper selection.
*/
if (ier == 0) {
pgpalw_setPrevOper ();
}
}
void ctb_permccrd ( char *tblnam, char *dirsym, Permclust_t *pc, int *iret )
/************************************************************************
* ctb_permccrd *
* *
* This routine will read the permanent clustered county table into a *
* structure. *
* *
* ctb_permccrd ( tblnam, dirsym, pc, iret ) *
* *
* Input parameters: *
* *tblnam char Data type table name *
* *dirsym char Directory *
* *
* Output parameters: *
* *pc Permclust_t Perm. clustered cnty structure *
* *iret int Return code *
** *
* Log: *
* A. Hardy/NCEP 10/04 copied from ctb_ccrd *
* A. Hardy/NCEP 1/05 Added creation of virtual cluster combos*
* & added error check on 1st cst_split *
***********************************************************************/
{
FILE *ftbl;
char buff[256], pcname[32], *next;
int ii, jj, ij, in, inx, numclust, fips[50], nfips, len, ier, ierr;
int ik, kk, ll, nn, itotal, srchfip, inum, ivfips, cfips[20];
Boolean found, match;
static Permclust_t vpc, tpc;
/*---------------------------------------------------------------------*/
*iret = 0;
/*
* Open the table.
*/
ftbl = cfl_tbop ( tblnam, dirsym, iret );
if ( *iret != 0 ) {
tpc.nclust = 0;
return;
}
/*
* Get number of valid table entries.
*/
cfl_tbnr( ftbl, &numclust, &ier );
if ( numclust != 0 ) {
/*
* Allocate the structure elements.
*/
tpc.nclust = numclust;
tpc.clust = (PCinfo *) malloc( numclust * sizeof(PCinfo) );
}
else {
/*
* Problem opening table file; set error code and return.
*/
cfl_clos( ftbl, &ier );
*iret = -2;
return;
}
rewind ( ftbl );
/*
* For every valid table entry, read in, parse, put in structure
*/
ii = 0;
while ( ii < numclust ) {
cfl_trln( ftbl, sizeof(buff), buff, &ier );
if ( ier == 0 ) {
next = cst_split ( buff, '|', 4, tpc.clust[ii].pcwfo, &ier );
if ( ier == 0 ) {
next = cst_split ( next, '|', 32, pcname, &ier );
tpc.clust[ii].pcname =
(char *)malloc( (strlen(pcname)+1) * sizeof(char) );
strcpy ( tpc.clust[ii].pcname, pcname );
cst_rmbl ( next, next, &len, &ier );
cst_ilst ( next, '+', IMISSD, sizeof(fips)/sizeof(fips[0]),
fips, &nfips, &ier );
tpc.clust[ii].npc = nfips;
tpc.clust[ii].pc = (int *)malloc( nfips * sizeof(int) );
for ( jj = 0; jj < nfips; jj++ ) {
tpc.clust[ii].pc[jj] = fips[jj];
}
}
else {
ierr = 3;
er_wmsg ( "CTB", &ierr, buff, &ier, 3, strlen (buff) );
}
ii++;
}
}
cfl_clos ( ftbl, &ier );
/*
* Create virtual clusters.
* Allocate the structure elements.
*/
vpc.nclust = 0;
vpc.clust = (PCinfo *) malloc( (numclust*4) * sizeof(PCinfo) );
inum = vpc.nclust;
ii = 0;
/*
* Loop over all perm clusters.
*/
while ( ii < numclust ) {
for ( jj = 1;jj < tpc.clust[ii].npc; jj++ ) {
found = False;
srchfip = tpc.clust[ii].pc[jj];
/*
* Compare search fip value to the other 1st fips codes.
* Search permanent table first.
*/
ij = 0;
while ( (!found) && (ij < numclust ) ) {
if ( srchfip == tpc.clust[ij].pc[0] ) {
found = True;
}
ij++;
}
/*
* Search virtual cluster table next.
*/
ij = 0;
while ( (!found) && (ij < vpc.nclust ) ) {
if ( srchfip == vpc.clust[ij].pc[0] ) {
found = True;
}
ij++;
}
/*
* Didn't find a cluster group with search fip as first key.
* Find all cluster groups in perm. table with this key in
* the cluster groups. Create a new virtual cluster entry.
*/
if ( !found ) {
cfips[0] = srchfip;
ik = 0;
/* Loop over rest of current clustered combo fips
* and store the codes temporarily.
*/
for ( ij = 0; ij < tpc.clust[ii].npc;ij++ ) {
if ( tpc.clust[ii].pc[ij] != srchfip ) {
ik++;
cfips[ik] = tpc.clust[ii].pc[ij];
}
}
/* Set the number of virtual fips codes we have so far*/
ivfips = ik+1;
/*
* Check rest of perm clusters combox for srchfip.
* Start with the next perm cluster combo.
*/
inx = ii + 1;
match = False;
/* loop over rest of combo clusters */
for ( kk= inx; kk < numclust; kk++ ) {
/* loop over number of counties in each cluster */
for ( ll = 0; ll < tpc.clust[kk].npc; ll++ ) {
/* look for a match in a cluster */
if ( tpc.clust[kk].pc[ll] == srchfip ) {
/* store all new codes in cfips array */
for ( nn = 0; nn < tpc.clust[kk].npc; nn++ ) {
/* loop over current cluster array, store
one's we don't have*/
in = 0;
while ( (in < ivfips ) && ( !match) ) {
if ( tpc.clust[kk].pc[nn] == cfips[in] ) {
match = True;
}
in++;
}
/* didn't find fips in cfips array, keep it */
if ( !match ) {
cfips[ivfips] = tpc.clust[kk].pc[nn];
ivfips++;
}
match = False;
}
}
}
}
/*
* Put temporary pcname, pcwfo, npc and fips array into
* virtual perm clust. combos.
* Increment number of virtual fip cluster combos
*/
strcpy ( vpc.clust[inum].pcwfo, tpc.clust[ii].pcwfo );
vpc.clust[inum].pcname =
(char *)malloc( (strlen(pcname)+1) * sizeof(char) );
/*
* Store the number of fips codes and the code numbers
*/
vpc.clust[inum].npc = ivfips;
vpc.clust[inum].pc = (int *)malloc( ivfips * sizeof(int) );
for ( ij= 0; ij < ivfips; ij++ ) {
vpc.clust[inum].pc[ij] = cfips[ij];
}
vpc.nclust++;
inum++;
} /* (!found) loop */
} /* for jj loop */
ii++;
} /* while ii loop */
/*
* Fill out output permanent cluster structure.
* Allocate the structure elements.
*/
itotal = numclust + vpc.nclust;
pc->nclust = itotal;
pc->clust = (PCinfo *) malloc( itotal * sizeof(PCinfo) );
ii = 0;
/*
* Write out permanent table cluster combos first.
*/
while ( ii < numclust ) {
strcpy (pc->clust[ii].pcwfo, tpc.clust[ii].pcwfo);
pc->clust[ii].pcname =
(char *)malloc( (strlen(tpc.clust[ii].pcname)+1) * sizeof(char) );
strcpy ( pc->clust[ii].pcname, tpc.clust[ii].pcname );
pc->clust[ii].npc = tpc.clust[ii].npc;
pc->clust[ii].pc = (int *)malloc( tpc.clust[ii].npc * sizeof(int) );
for ( jj = 0; jj < pc->clust[ii].npc; jj++ ) {
pc->clust[ii].pc[jj] = tpc.clust[ii].pc[jj];
}
ii++;
}
/*
* Write out virtual cluster combos next.
*/
jj = 0;
while ( ii < pc->nclust ) {
strcpy (pc->clust[ii].pcwfo, vpc.clust[jj].pcwfo);
pc->clust[ii].pcname =
(char *)malloc( 12 * sizeof(char) );
sprintf ( pc->clust[ii].pcname, "VClust %d", jj+1 );
pc->clust[ii].npc = vpc.clust[jj].npc;
pc->clust[ii].pc = (int *)malloc( vpc.clust[jj].npc * sizeof(int) );
for ( ij = 0; ij < pc->clust[ii].npc; ij++ ) {
pc->clust[ii].pc[ij] = vpc.clust[jj].pc[ij];
}
ii++;
jj++;
}
}
FILE *spf_create ( char *filnam, int *hlen, int *iret )
/************************************************************************
* spf_create *
* *
* This function creates a new SPF file with an appropriate header. If *
* the file suffix is not ".spf", it will be added. *
* *
* Note: If the tag value contains a "<", it must be preceeded by a *
* backslash '\\' so as not to confuse it with the start of another tag.*
* *
* FILE *spf_create ( filnam, hlen, iret ) *
* *
* Input parameters: *
* *filnam char file name with full path *
* *
* Output parameters: *
* *hlen int Header length *
* *iret int Return code *
* 0 - Normal *
* -3 - Failure to create SPF file *
* Return parameters: *
* *spf_create FILE File pointer *
* *
** *
* Log: *
* J. Wu/GSC 6/01 create *
* J. Wu/GSC 6/01 correct cfl_aopn to cfl_wopn *
* J. Wu/SAIC 6/03 add comments about escaped '<' *
* B. Yin/SAIC 3/04 changed css_gtim calling sequences *
* T. Piper/SAIC 03/06 Added GROUP_PERMS_SPF logic and actions *
***********************************************************************/
{
int ier, ierr, ipos, itype = 0;
char outstr[1024], perms_prefs[16], curdat[20], *usernam;
char filepart[MXFLSZ], pathpart[LLPATH];
char exn[] = "!\n", ex[] = "!",
linf[] = "!----------------------------------------",
linb[] = "----------------------------------------\n",
str1[] = "This is a stored procedure file for nmap2.",
str2[] = "Creation date:",
str3[] = "Created by:",
esp1[] = " Note: If the tag value contains a '<', it must be ",
esp2[] = "preceeded by a backslash \n! '\\' so as not to ",
esp3[] = "confuse it with the start of another tag.";
FILE *fptr;
mode_t mode = S_IRUSR|S_IWUSR|S_IRGRP|S_IWGRP|S_IROTH; /*rw_rw_r*/
/*---------------------------------------------------------------------*/
*iret = G_NORMAL;
fptr = (FILE *)NULL;
/*
* If the file suffix is not ".spf", add it.
*/
cfl_path ( filnam, pathpart, filepart, &ier ) ;
cst_srch ( 0, (int)strlen(filepart), ".spf", filepart, &ipos, &ier );
if ( ier == -4 ) {
strcat ( filnam, ".spf" );
}
/*
* Create the file for writing and add the header discription.
*/
fptr = cfl_wopn( filnam, &ier );
if ( fptr == NULL ) {
*iret = -3; /* fail to create */
er_wmsg ( "CFL", &ier, filnam, &ierr, 3, strlen( filnam ) );
}
else {
ctb_pfstr ( "GROUP_PERMS_SPF", perms_prefs, &ier);
if ( strcmp(perms_prefs, "TRUE") == 0 ) {
chmod(filnam, mode);
}
/*
* Write an appropriate header to the file.
*/
css_gtim( &itype, curdat, &ier );
usernam = getenv("LOGNAME");
sprintf( outstr, "%s%s%s%s%s%s %s\n%s%s %s\n%s%s%s%s%s \n%s%s %s\t%s\n%s%s %s\t\t%s\n%s%s%s%s%s%s",
linf, linb, linf, linb,
exn, ex, filnam,
exn, ex, str1,
exn, ex, esp1, esp2, esp3,
exn, ex, str2, curdat,
exn, ex, str3, usernam,
exn, linf, linb, linf, linb, exn );
*hlen = (int)(strlen( outstr ) * sizeof( char ));
cfl_writ( fptr, *hlen, (unsigned char*)outstr, &ier );
if ( ier < 0 ) {
*iret = -3; /* fail to create */
er_wmsg ( "CFL", &ier, filnam, &ierr, 3, strlen( filnam ) );
fptr = (FILE *)NULL;
}
}
return fptr;
}
void gb2_gdtpstr( float *navblk, int *igdtmpl, int *iret )
/************************************************************************
* gb2_gdtpstr *
* *
* This routine converts a STR Gempak grid navigation block to a *
* GRIB2 Grid Definition Template 3.20. *
* *
* gb2_gdtpstr ( navblk, igdtmpl, iret ) *
* *
* Input parameters: *
* *navblk float Decoded GRIB2 structure *
* *
* Output parameters: *
* *igdtmpl int GDT 3.20 values *
* *iret int Return code *
* -36 = Projection not STR *
** *
* Log: *
* S. Gilbert/NCEP 08/05 Calculations taken from GDS_STR *
* S. Gilbert/NCEP 03/06 Chngs to remove compiler warnings *
***********************************************************************/
{
double rlat1, rlon1, rlat2, rlon2, dx, dy, polat, rlov;
double rnx, rny, sign, clon, re, x1, y1, x2, y2;
double tlat1, tlon1;
double tan1, tan2, dlon1, dlon2;
int ier;
int nx, ny;
/*---------------------------------------------------------------------*/
*iret = 0;
/*
* ensure grid navigation block is STR
*/
if ( strncmp( (char *)(navblk+1), "STR", 3) != 0 ) {
*iret=-36;
er_wmsg("GB", iret, (char *)(navblk+1), &ier, 2, 4 );
}
nx = G_NINT(navblk[4]);
ny = G_NINT(navblk[5]);
rlat1 = navblk[6];
rlon1 = navblk[7];
rlat2 = navblk[8];
rlon2 = navblk[9];
polat = navblk[10];
rlov = navblk[11];
/*
* compute the grid increments
*/
if ( polat > 0.0 ) sign = -1.0;
else sign = 1.0;
rnx = navblk[4];
rny = navblk[5];
tlat1 = rlat1 * DTR / 2.;
rlat2 = rlat2 * DTR / 2.;
tlon1 = rlon1 * DTR;
rlon2 = rlon2 * DTR;
clon = rlov * DTR;
re = RADIUS;
tan1 = tan ( PI4TH + sign * tlat1 );
tan2 = tan ( PI4TH + sign * rlat2 );
dlon1 = tlon1 - clon;
dlon2 = rlon2 - clon;
x1 = re * tan1 * sin ( dlon1 );
y1 = sign * re * tan1 * cos ( dlon1 );
x2 = re * tan2 * sin ( dlon2 );
y2 = sign * re * tan2 * cos ( dlon2 );
dx = ( x2 - x1 ) * 1.8660254 / ( rnx - 1. );
dy = ( y2 - y1 ) * 1.8660254 / ( rny - 1. );
/*
* Set Grid Definition Template
*/
igdtmpl[0] = 1; /* Earth Assumed Spherical */
igdtmpl[1] = 0; /* Radius scale factor */
igdtmpl[2] = G_NINT(RADIUS); /* Radius of Earth */
igdtmpl[3] = 0; /* Oblate info n/a */
igdtmpl[4] = 0; /* Oblate info n/a */
igdtmpl[5] = 0; /* Oblate info n/a */
igdtmpl[6] = 0; /* Oblate info n/a */
igdtmpl[7] = nx; /* Kx */
igdtmpl[8] = ny; /* Kx */
igdtmpl[9] = G_NINT(rlat1*1000000.0);
/* Lat of 1st grid point */
if ( rlon1 < 0.0 ) rlon1 += 360.0;
igdtmpl[10] = G_NINT(rlon1*1000000.0);
/* Lon of 1st grid point */
igdtmpl[11] = 56; /* Res and Comp flags */
igdtmpl[12] = 60000000; /* Lat where Dx,Dy true */
if ( rlov < 0.0 ) rlov += 360.0;
igdtmpl[13] = G_NINT(rlov*1000000.0);
/* Lon of Orientation */
igdtmpl[14] = G_NINT(dx*1000.0); /* Dx */
igdtmpl[15] = G_NINT(dy*1000.0); /* Dy */
igdtmpl[16] = 0;
if ( polat < 0.0 ) igdtmpl[16] = 128; /* Projection center flag */
igdtmpl[17] = 64; /* Scanning mode */
}
int db_gFileNames ( const char *dir, int isearch, struct dirent ***ret_namelist)
/************************************************************************
* *
* db_gFileNames *
* *
* m.gamazaychikov/SAIC 11/08 Created *
************************************************************************/
{
int possible_ens_nmbr = 100;
int possible_fcst_hrs = 500;
int max_file_name_length = 50;
int max_number_components = 13;
int max_component_length = 75;
int possible_fileNames;
int ii, jj, ier, ier1, len;
int used, allocated,istmax;
char modelName[30], dbTag[5], ensTag[20], timeTmpl[75];
char *fileNames;
char **starr;
struct dirent *entry=NULL, *entry2=NULL;
struct dirent **namelist = NULL;
/*---------------------------------------------------------------------*/
/*
* Initialization
*/
modelName[0] = '\0';
dbTag[0] = '\0';
ensTag[0] = '\0';
timeTmpl[0] = '\0';
/*
* Allocate memmory for starr and get the components
*/
starr = (char **)malloc((size_t)max_number_components * sizeof(char *));
istmax = 0;
for( jj=0; jj < max_number_components; jj++ )
starr[jj] = (char *)malloc( max_component_length * sizeof(char));
cst_clst (dir, '_', " ", max_number_components, max_component_length, starr, &istmax, &ier);
if ( istmax ==4 ) {
sprintf ( modelName, "%s", starr[0] );
sprintf ( dbTag, "%s", starr[1] );
sprintf ( ensTag, "%s", starr[2] );
sprintf ( timeTmpl, "%s", starr[3] );
}
else {
if ( istmax > 4 ) {
sprintf ( modelName, "%s", starr[0] );
sprintf ( dbTag, "%s", starr[1] );
sprintf ( ensTag, "%s", starr[2] );
for ( jj = 3; jj < istmax; jj ++ ) {
if ( starr[jj][0] == '[' ) {
sprintf ( timeTmpl, "%s", starr[jj] );
break;
}
else {
strcat ( ensTag,"_" );
strcat ( ensTag,starr[jj] );
}
}
istmax = 4;
}
else {
for ( jj = 0; jj < max_number_components; jj++ ) free( starr[jj] );
if( starr ) free( (char **)starr );
return(0);
}
}
/*
* Free memory allocated for starr
*/
for ( jj = 0; jj < max_number_components; jj++ ) free( starr[jj] );
if( starr ) free( (char **)starr );
/*
* Allocate memmory for fileNames
*/
possible_fileNames = possible_ens_nmbr * possible_fcst_hrs;
fileNames = (char *)malloc( possible_fileNames * max_file_name_length * sizeof(char));
db_scandb ( modelName, dbTag, ensTag, timeTmpl, fileNames, &ier);
if ( ier != 0 ) {
return (0);
}
/*
* Allocate memmory for starr and
* break the fileNames string into parts each representing 'file'
*/
starr = (char **)malloc((size_t)possible_fileNames * sizeof(char *));
istmax = 0;
for( jj=0; jj < possible_fileNames; jj++ )
starr[jj] = (char *)malloc( max_file_name_length * sizeof(char));
cst_clst (fileNames, '|', " ", possible_fileNames, max_file_name_length, starr, &istmax, &ier);
/*
* Free memory allocated for fileNames
*/
free( fileNames );
/*
* Fake scandir function to return back namelist structure
*/
used = 0;
allocated = 2;
namelist = malloc(allocated * sizeof(struct dirent *));
entry = (struct dirent *) malloc (sizeof(struct dirent));
for ( ii = 0; ii < istmax; ii++ ) {
sprintf ( entry->d_name, "%s", starr[ii] );
len = offsetof(struct dirent, d_name) + strlen(entry->d_name) + 1;
if ((entry2 = malloc(len)) == NULL) {
for ( jj = 0; jj < possible_fileNames; jj++ ) free( starr[jj] );
if( starr ) free( (char **)starr );
free (entry);
ier = -7;
er_wmsg ( "DB", &ier, NULL, &ier1, 2, 0 );
return(0);
}
if (used >= allocated) {
allocated *= 2;
namelist = realloc(namelist, allocated * sizeof(struct dirent *));
if (!namelist) {
for ( jj = 0; jj < possible_fileNames; jj++ ) free( starr[jj] );
if( starr ) free( (char **)starr );
free (entry);
ier = -7;
er_wmsg ( "DB", &ier, NULL, &ier1, 2, 0 );
ier = -7;
er_wmsg ( "DB", &ier, NULL, &ier1, 2, 0 );
return(0);
}
}
memcpy(entry2, entry, len);
namelist[used++] = entry2;
}
free (entry);
for ( jj=0; jj < possible_fileNames; jj++ ) free( starr[jj] );
if ( starr ) free( (char **)starr );
*ret_namelist = namelist;
return(istmax);
}
void na_gnav ( const char *proj, const char *kxky, const char *gdarea,
char *cprj, int *kx, int *ky, float *grdout,
float *rnvblk, int *iret )
/************************************************************************
* na_gnav *
* *
* This subroutine takes the user input for PROJ and KXKY and *
* makes a grid navigation block. *
* *
* na_gnav ( proj, kxky, gdarea, cprj, kx, ky, grdout, rnvblk, iret ) *
* *
* Input parameters: *
* *proj const char User input for PROJ *
* *kxky const char User input for KXKY *
* *gdarea const char User input for GDAREA *
* *
* Output parameters: *
* *cprj char Grid projection *
* *kx int Number of points in x dir *
* *ky int Number of points in y dir *
* *grdout float Grid corners *
* *rnvblk float Grid navigation block *
* *iret int Return code *
* 0 = normal return *
* -4 = invalid navigation *
* -5 = invalid grid area *
* -6 = invalid grid size *
** *
* Log: *
* S. Jacobs/EAI 7/93 Copied from GDCNAV *
* G. Krueger/EAI 6/96 Add default projection *
* R. Tian/SAIC 7/06 Recoded from Fortran *
* S. Gilbert/NCEP 10/06 Added call to GR_VNAV *
************************************************************************/
{
char cdproj[31], tprj[31];
float zmarg[4], rarr[2], rltln[4], angle[3], centrd[2],
angle1, angle2, angle3, xspace, yspace;
int angflg, space, valid;
int iarr[2], len, num, ier, ier1, i;
/*----------------------------------------------------------------------*/
*iret = 0;
/*
* Translate grid projection information.
*/
gg_proj ( proj, tprj, angle, zmarg, &angflg, &ier,
strlen(proj), sizeof(tprj) );
tprj[30] = '\0';
cst_lstr ( tprj, &len, &ier1 );
tprj[len] = '\0';
strcpy ( cprj, tprj );
angle1 = angle[0];
angle2 = angle[1];
angle3 = angle[2];
/*
* Check for error.
*/
if ( ier != 0 ) {
er_wmsg ( "GG", &ier, (char *)proj, &ier1,
strlen("GG"), strlen(proj) );
*iret = -4;
return;
}
/*
* Translate grid area.
*/
lc_gare ( (char *)gdarea, rltln, tprj, centrd, &ier,
strlen(gdarea), sizeof(tprj) );
tprj[30] = '\0';
cst_lstr ( tprj, &len, &ier1 );
tprj[len] = '\0';
strcpy ( cdproj, tprj );
if ( ier != 0 ) {
*iret = -5;
er_wmsg ( "NAGRIB", iret, (char *)gdarea, &ier,
strlen("NAGRIB"), strlen(gdarea) );
return;
}
/*
* Translate the input for KXKY.
*/
if ( ( strcmp ( cprj, "CED" ) == 0 ) && ( kxky[0] == '#' ) ) {
space = G_TRUE;
} else {
space = G_FALSE;
}
/*
* Check for input as grid spacing.
*/
if ( space == G_TRUE ) {
/*
* Get x- and y- spacing and check that there are two numbers.
*/
cst_rlst ( (char *)&kxky[1], ';', 0., 2, rarr, &num, &ier );
if ( ( rarr[0] <= 0. ) || ( rarr[1] <= 0. ) ) {
*iret = -6;
er_wmsg ( "NAGRIB", iret, " ", &ier,
strlen("NAGRIB"), strlen(" ") );
return;
} else {
xspace = rarr[0];
yspace = rarr[1];
}
/*
* Align on grid points and exit for error.
*/
grc_algn ( rltln, &xspace, &yspace, grdout, kx, ky, iret );
if ( *iret != 0 ) {
er_wmsg ( "GR", iret, " ", &ier, strlen("GR"), strlen(" ") );
*iret = -4;
return;
}
/*
* Otherwise, find kx, ky.
*/
} else {
for ( i = 0; i < 4; i++ ) {
grdout[i] = rltln[i];
}
/*
* Get two numbers and check for error.
*/
cst_ilst ( (char *)kxky, ';', 0, 2, iarr, &num, &ier );
*kx = iarr[0];
*ky = iarr[1];
if ( ( *kx < 2 ) || ( *ky < 2 ) ) {
*iret = -6;
er_wmsg ( "NAGRIB", iret, " ", &ier,
strlen("NAGRIB"), strlen(" ") );
return;
}
}
/*
* Fill navigation block.
*/
gr_vnav ( cprj, kx, ky, &grdout[0], &grdout[1], &grdout[2], &grdout[3],
&angle1, &angle2, &angle3, &angflg, &valid, &ier, strlen(cprj) );
if ( ier == 0 )
grc_mnav ( cprj, kx, ky, &grdout[0], &grdout[1], &grdout[2], &grdout[3],
&angle1, &angle2, &angle3, &angflg, rnvblk, &ier );
else
*iret = -2;
return;
}
void db_rdtr ( char *queryType, char *source, char *part, char *dattim,
char *stid, char *dataUri, int *icnt, float *rdata, int *nword,
int *iret )
/************************************************************************
* *
* db_rdtr *
* *
* This function returns array of data values from the AWIPS II DB *
* given certain data criteria. *
* *
* void db_rdtr ( char *queryType, char *source, char *part, *
* char *dattim, char *stid, char *dataUri, int *icnt, *
* float *rdata, int *nword, int *iret ) *
* *
* Input parameters: *
* queryType char Type of query *
* source char Source of data *
* part char Part name *
* dattim char The data time *
* stid char Station ID *
* dataUri char Data URI *
* icnt int Number of stations (obsolete) *
* *
* Output parameters: *
* rdata float Array of data values *
* nword float Length of rdata array *
* iret int Return code: *
* 0 - normal return *
* -1 - unable to get dataURI *
* *
** *
* Log: *
* m.gamazaychikov/CWS 04/11 Created *
************************************************************************/
{
int numberPayloadParts = 2;
int payloadPartLength = 50;
int bufferSize = 200000;
char xsltFile[LLSCRN] = "response.xlt";
char xsltDir[LLSCRN] = "$NAWIPS/gempak/tables/xslt";
int ier, nbytes, ier1, nwrd, istmax, jj;
long flen;
char queryText[320], queryResult[bufferSize+1], xsltfile[FILE_FULLSZ];
char errStr[100], payload[100];
unsigned char* bigStr;
char **starr;
/*---------------------------------------------------------------------*/
/*
* Initialization
*/
*iret = 0;
queryText[0] = '\0';
queryResult[0] = '\0';
/*
* Populate the query strings
*/
if (strcmp ( queryType, "gridDat" ) == 0 ) {
if ( strcmp ( source, "GRID") == 0 ) {
strcpy (eSrc, source);
sprintf (eDistnctField, "%s", dataUri);
sprintf (gDattim, "%s", dattim);
eCount = 1;
sprintf (eLibClass, "%s", "GempakGridLinkRequest");
}
else {
ier = -9;
sprintf (errStr, "%s+", queryType);
strcat (errStr, source);
er_wmsg ( "DB", &ier, errStr, &ier1, 2, strlen(errStr) );
*iret = -1;
return;
}
}
else {
ier = -8;
er_wmsg ( "DB", &ier, queryType, &ier1, 2, strlen(queryType) );
*iret = -1;
return;
}
/*
* Get the query text
*/
db_getQueryText ( queryType, queryText, &ier);
if ( ier !=0 ) {
ier = -3;
er_wmsg ( "DB", &ier, NULL, &ier1, 2, 0 );
*iret = -1;
return;
}
/*
* Connect to database and get the query result
*/
db_runQuery ( queryText, queryResult, &ier);
if ( ier !=0 ) {
ier = -4;
er_wmsg ( "DB", &ier, NULL, &ier1, 2, 0 );
*iret = -1;
return;
}
/*
* Transform XML string to a string containing the name of the file
* stored on the server side
*/
cfl_inqr(xsltFile, xsltDir, &flen, xsltfile, &ier);
if ( ier !=0 ) {
/*
* XSLT file not found -> returning
*/
ier = -5;
er_wmsg ( "DB", &ier, xsltFile, &ier1, 2, strlen(xsltFile) );
*iret = -1;
return;
}
nbytes=xml_transform( queryResult, strlen(queryResult), xsltfile, &bigStr, &ier );
if ( ier !=0 || nbytes==0) {
/*
* XML Transform run unsuccessfully -> returning
*/
ier = -6;
er_wmsg ( "DB", &ier, NULL, &ier1, 2, 0 );
G_FREE( bigStr, unsigned char );
*iret = -1;
return;
}
sprintf( payload, "%s", bigStr );
G_FREE( bigStr, unsigned char );
/*
* Break the payload string into parts containing the dbHost and fileName
*/
starr = (char **)malloc((size_t)numberPayloadParts * sizeof(char *));
for( jj=0; jj < numberPayloadParts; jj++ )
starr[jj] = (char *)malloc( payloadPartLength * sizeof(char));
cst_clst (payload, '|', " ", numberPayloadParts, payloadPartLength, starr, &istmax, &ier);
if ( ier !=0 || istmax != 2 ) {
ier = -13;
er_wmsg ( "DB", &ier, source, &ier1, 2, strlen(source) );
*iret = -1;
for ( jj = 0; jj < numberPayloadParts; jj++ ) free( starr[jj] );
if( starr ) free( (char **)starr );
return;
}
/*
* Get the data from the server side
*/
db_getRData(starr[0], starr[1], rdata, &nwrd, &ier);
for ( jj = 0; jj < numberPayloadParts; jj++ ) free( starr[jj] );
if( starr ) free( (char **)starr );
*nword = nwrd;
if ( ier !=0 ) {
if ( ier == -1 ) {
ier = -10;
er_wmsg ( "DB", &ier, source, &ier1, 2, strlen(source) );
*iret = -1;
return;
}
if ( ier == -2 ) {
ier = -15;
er_wmsg ( "DB", &ier, NULL, &ier1, 2, 0 );
*iret = -1;
return;
}
}
return;
}
int main ( void )
/************************************************************************
* TESTSPF *
* *
* This program tests the CGEMLIB "SPF" library functions. *
* *
** *
* Log: *
* J. Wu/GSC 6/01 create *
* H. Zeng/SAIC 9/04 spf_read() para. list change *
***********************************************************************/
{
int cont, numsub, iret, nbytes, ier, eliblen, errlen;
char select[LLSCRN], filnam[LLSCRN], newfil[FILE_FULLSZ];
char ans[LLSCRN], tag[LLSCRN], data[TAGDATA_BUF];
char errlib[3], errstr[2];
long lflen;
FILE *filptr;
/*---------------------------------------------------------------------*/
cont = G_TRUE;
filptr = NULL;
strcpy( errlib, "SPF" );
strcpy( errstr, " " );
eliblen = strlen( errlib );
errlen = strlen( errstr );
while ( cont == G_TRUE ) {
printf ( "\n\n" );
printf ( " ? = Print HELP file\n\n");
printf ( " D - Dump a loaded SPF file\n\n");
printf ( " 1 = SPF_CREATE 2 = SPF_OPEN 3 = SPF_READ\n" );
printf ( " 4 = SPF_LOAD 5 = SPF_WRITE 6 = SPF_GTFLD\n" );
printf ( " 7 = SPF_CLNUP 8 = SPF_CLOSE \n" );
printf ( "\n" );
printf ( "Select a subroutine number or type EXIT: " );
scanf ( " %s", select );
numsub = 0;
switch ( select[0] ) {
case '?':
printf ("\n *** HELP FILE ***\n\n");
printf (" D - Dump a loaded SPF file\n\n");
printf (" 1 = spf_create - Create an SPF file\n" );
printf (" 2 = spf_open - Open an SPF file\n" );
printf (" 3 = spf_read - Read an opened SPF into buffer\n" );
printf (" 4 = spf_load - Load an unopened SPF into buffer\n" );
printf (" 5 = spf_write - Write a tag/data pair to an SPF\n" );
printf (" 6 = spf_gtfld - Get data field associated with a tag\n" );
printf (" 7 = spf_clnup - Clean up SPF buffer\n" );
printf (" 8 = spf_close - Close an SPF file\n" );
printf ( "\n" );
break;
case 'd':
case 'D':
if ( _spfBuffer != (char *)NULL ) {
printf ( "\n%s\n", _spfBuffer );
}
else {
printf ( "\nPlease load the buffer first.\n" );
}
break;
case 'e':
case 'E':
cont = G_FALSE;
break;
default:
numsub = atoi ( select );
break;
}
/*---------------------------------------------------------------------*/
if ( numsub == 1 ) {
if ( filptr != NULL ) {
printf ( "\nPlease close the opened file first.\n" );
}
else {
printf ( "Enter the file name:\n" );
scanf ( " %s", filnam );
cfl_inqr( filnam, NULL, &lflen, newfil, &ier );
if ( ier != 0 ) {
strcat( filnam, ".spf" );
cfl_inqr( filnam, NULL, &lflen, newfil, &ier );
}
if ( ier == 0 ) {
printf ( "\nCan't create, file %s already exists!\n", newfil );
}
else {
nbytes = (int)lflen;
filptr = (FILE *)spf_create ( filnam, &nbytes, &iret );
if ( iret == 0 ) {
printf ( "\nSPF_CREATE: iret = %d\n\n", iret );
}
else {
er_wmsg ( errlib, &iret, filnam, &ier, eliblen, strlen(filnam) );
}
}
}
}
/*---------------------------------------------------------------------*/
if ( numsub == 2 ) {
if ( filptr != NULL ) {
printf ( "\nPlease close the opened file first.\n" );
}
else {
printf ( "\nEnter the file name:\n" );
scanf ( " %s", filnam );
printf ( "Do you want to create it if the file doesn't exist?\n" );
scanf ( " %s", ans );
if ( ans[0] == 'y' || ans[0] == 'Y' ) {
spf_open ( filnam, TRUE, &filptr, &nbytes, &iret );
}
else {
spf_open ( filnam, FALSE, &filptr, &nbytes, &iret );
}
if ( iret == 0 ) {
printf ( "\nSPF_OPEN: iret = %d\n\n", iret );
}
else {
er_wmsg ( errlib, &iret, filnam, &ier, eliblen, strlen(filnam) );
}
}
}
/*---------------------------------------------------------------------*/
if ( numsub == 3 ) {
printf ( "Enter length in bytes:\n" );
scanf ( " %d", &nbytes );
spf_read ( filptr, filnam, nbytes, &iret );
if ( iret == 0 ) {
printf ( "\nSPF_READ: iret = %d\n\n", iret );
}
else {
er_wmsg ( errlib, &iret, errstr, &ier, eliblen, errlen );
}
}
/*---------------------------------------------------------------------*/
if ( numsub == 4 ) {
if ( filptr != NULL ) {
printf ( "\nPlease close the opened file first.\n" );
}
else {
printf ( "\nEnter the file name:\n" );
scanf ( " %s", filnam );
spf_load ( filnam, &iret );
if ( iret == 0 ) {
printf ( "\nSPF_LOAD: iret = %d\n\n", iret );
}
else {
er_wmsg ( errlib, &iret, filnam, &ier, eliblen, strlen(filnam) );
}
}
}
/*---------------------------------------------------------------------*/
if ( numsub == 5 ) {
printf ( "\nEnter the tag name:\n" );
scanf ( " %s", tag );
printf ( "Enter the data string:\n" );
scanf ( " %s", data );
spf_write ( filptr, tag, data, &iret );
if ( iret == 0 ) {
printf ( "\nSPF_WRITE: iret = %d\n\n", iret );
}
else {
er_wmsg ( errlib, &iret, errstr, &ier, eliblen, errlen );
}
}
/*---------------------------------------------------------------------*/
if ( numsub == 6 ) {
printf ( "Enter the tag name:\n" );
scanf ( " %s", tag );
spf_gtfld ( tag, data, &iret );
if ( iret == 0 ) {
printf ( "\nSPF_GTFLD: iret = %d\n\n", iret );
}
else {
er_wmsg ( errlib, &iret, tag, &ier, eliblen, strlen(tag) );
}
printf ( "\n Tag: %s \t Data: %s\n", tag, data );
}
/*---------------------------------------------------------------------*/
if ( numsub == 7 ) {
spf_clnup ( &iret );
if ( iret == 0 ) {
printf ( "\nSPF_CLNUP: iret = %d\n\n", iret );
}
else {
er_wmsg ( errlib, &iret, errstr, &ier, eliblen, errlen );
}
}
/*---------------------------------------------------------------------*/
if ( numsub == 8 ) {
spf_close ( filptr, &iret );
filptr = NULL;
if ( iret == 0 ) {
printf ( "\nSPF_CLOSE: iret = %d\n\n", iret );
}
else {
er_wmsg ( errlib, &iret, errstr, &ier, eliblen, errlen );
}
}
/*---------------------------------------------------------------------*/
}
if ( filptr != NULL ) fclose ( filptr );
return 0;
}
int main ( void )
/************************************************************************
* GDGRIB2 *
* *
* This program encodes a selected GEMPAK grid into a GRIB2 message. *
* *
* Command line: *
* gdgrib2 *
** *
* Log: *
* S. Gilbert/NCEP 5/2005 Orig *
* S. Gilbert/NCEP 3/2006 Replaced dg_clal with dg_nend *
* T. Piper/SAIC 01/08 Added GD_INIT; removed from IN_BDTA *
* B. Yin/ERT 09/15 Added bulk processing from table *
***********************************************************************/
{
int respond, ret, ier, mode=1, done, skip, j;
int g2len; /* Length of GRIB2 message */
unsigned char *g2msg; /* GRIB2 message */
char cur_gbfile[LLMXLN]="";
char chdr[22]; /* WMO Header */
FILE *gbfptr=0;
GDG2_input input; /* user input variables */
GDG2_gemgrid gemgrid; /* GEMPAK grid and info */
/*---------------------------------------------------------------------*/
/*
* Initialize TAE.
*/
ip_init ( &respond, &ret );
if ( ret == 0 ) {
ip_idnt ( "GDGRIB2", &done, 7 );
/*
* Initialize GEMPLT.
*/
gg_init ( &mode, &ret );
if ( ret == 0 ) {
/*
* Initialize grid library common area grdcmn.cmn
*/
gd_init ( &ier );
/*
* Initialize the DG library
*/
dg_intl ( &ret );
done = 0;
skip = 1;
}
else {
done = 1;
}
}
else {
done = 1;
}
/*
* Process next request, if user has one.
*/
while ( done == 0 ) {
/*
* Wait for user input, if not first time through this loop
*/
if ( skip == 0 ) ip_dynm( &done, &ret );
skip = 0;
if ( done != 0 ) break; /* Exit out of interactive loop */
/*
* Get user input info
*/
gdg2in( &input, &ret );
if ( ret != 0 ) {
er_wmsg("GDGRIB2",&ret," ",&ier,7,1);
continue;
}
else if ((strlen(input.g2conv) != (size_t)0) && (ret == 0)) {
/*
* Skip program prompt and get input from conversion table
*/
skip = 1;
}
if ( strlen(input.g2file) == (size_t)0 ) {
ret=-28;
er_wmsg("GDGRIB2",&ret," ",&ier,7,1);
continue;
}
/*
* Get requested grid
*/
gdgetgrid( &input, &gemgrid, &ret );
if ( ret != 0 ) {
er_wmsg("GDGRIB2",&ret," ",&ier,7,1);
continue;
}
/*
* Make GRIB2 field
*/
gdmakeg2( &input, &gemgrid, &g2msg, &g2len, &ret );
if ( ret != 0 ) {
er_wmsg("GDGRIB2",&ret," ",&ier,7,1);
continue;
}
/*
* Open GRIB2 file, if not already open.
*/
if ( strncmp(input.g2file, cur_gbfile, LLMXLN) != 0 ) {
/*
* If output GRIB file is different, must close previous one first
*/
if ( strlen(cur_gbfile) != (size_t)0 ) {
cfl_clos( gbfptr, &ret);
gbfptr=0;
}
/*
* Open GRIB file
*/
gbfptr = cfl_aopn( input.g2file, &ret);
if ( ret == 0 ) {
strncpy( cur_gbfile, input.g2file, LLMXLN);
}
else {
er_wmsg("CFL",&ret,input.g2file,&ier,7,strlen(input.g2file));
ret = -24;
er_wmsg("GDGRIB2",&ret," ",&ier,7,1);
gbfptr = 0;
continue;
}
}
/*
* Write out WMO Header, if requested
*/
gdmakewmo( &input, &gemgrid, chdr, &ret );
if ( strlen(chdr) == (size_t)21 ) {
cfl_writ( gbfptr, strlen(chdr), (unsigned char*)chdr, &ret );
}
/*
* Write out GRIB2 message.
*/
cfl_writ( gbfptr, g2len, g2msg, &ret );
if ( ret != 0 ) {
er_wmsg("CFL",&ret,input.g2file,&ier,7,strlen(input.g2file));
ret = -25;
er_wmsg("GDGRIB2",&ret," ",&ier,7,1);
continue;
}
/*
* Free no longer needed allocated space
*/
if ( gemgrid.grid != 0 ) free(gemgrid.grid);
if ( g2msg != 0 ) free(g2msg);
}
/*
* Clean up files
*/
dg_nend( &ret );
if ( gbfptr != 0 ) cfl_clos( gbfptr, &ret);
/*
* Exit the GEMPAK user interface
*/
ip_exit( &ret );
return(0);
}
int main ( void )
/************************************************************************
* TESTNSN *
* *
* This program test the NSN library of routines. *
* *
** *
* Log: *
* S. Jacobs/NCEP 6/99 Created *
* M. Li/GSC 7/00 Added nsn_save and nsn_rest *
* T. Lee/SAIC 8/03 Add time interval to nsn_gtim, nsn_dspl *
* T. Lee/SAIC 2/04 Add reference time flag to nsn_gtim *
* T. Lee/SAIC 4/04 Added delta reference time to nsn_gtim *
* T. Lee/SAIC 10/04 Added bin hours *
* T. Piper/SAIC 01/08 Added GD_INIT; removed from IN_BDTA *
* F. J. Yen/NCEP 04/08 Insert new parms for nsn_dspl (CSC). *
* Request input for bin hours. *
***********************************************************************/
{
int cont, ier, iret, numsub, id;
char ergrp[4], erstr[81], select[LLSCRN];
int iindex, jindex, knt, ntime, match, ititl, idelta,
mode, istat, minute, isbcat, mrange, intrvl,
ibfr, iaftr, mbfr, maftr, mstrct;
char alias[81], cycle[81], parms[81], color[81],
level[81], vcord[81], filter[81], txtatt[81],
garea[81], proj[5], panel[81], dattim[21], device[81],
map[21], ltln[21], ans[9];
unsigned int jflag;
Boolean iflag;
dttms_t endtim, timarr[2000];
char blank[] = " ";
/*---------------------------------------------------------------------*/
in_bdta ( &ier );
gd_init ( &ier );
mode = 1;
ginitp ( &mode, &istat, &ier );
printf ( "Enter full DEVICE string:\n" );
scanf ( " %s", device );
gg_sdev ( device, &ier, strlen ( device ) );
strcpy ( ergrp, "NSN" );
cont = G_TRUE;
while ( cont ) {
printf ( "\n\n" );
printf ( " 1 = NSN_INIT 2 = NSN_SATT 3 = NSN_QATT\n" );
printf ( " 4 = NSN_GTIM 5 = NSN_DSPL 6 = NSN_SAVE\n" );
printf ( " 7 = NSN_REST\n\n" );
printf ( " 20 = Change device\n\n" );
printf ( "\n" );
printf ( "Select a subroutine number or type EXIT: " );
scanf ( " %s", select );
switch ( select[0] ) {
case 'e':
case 'E':
cont = G_FALSE;
default:
numsub = atoi ( select );
break;
}
/*---------------------------------------------------------------------*/
if ( numsub == 1 ) {
nsn_init ( &iret );
printf ( "iret = %d\n", iret );
if ( iret != 0 ) {
strcpy ( erstr, " " );
er_wmsg ( ergrp, &iret, erstr, &ier,
strlen ( ergrp ), strlen ( erstr ) );
}
}
/*---------------------------------------------------------------------*/
if ( numsub == 2 ) {
printf ( "Enter index number:\n" );
scanf ( " %d", &iindex );
printf ( "Enter the data alias (e.g., UAIR):\n" );
scanf ( " %s", alias );
printf ( "Enter data subcategory number:\n" );
scanf ( " %d", &isbcat );
printf ( "Enter the cycle date/time or NONE:\n" );
scanf ( " %s", cycle );
printf ( "Enter the parm list:\n" );
scanf ( " %s", parms );
printf ( "Enter the color list:\n" );
scanf ( " %s", color );
printf ( "Enter the level:\n" );
scanf ( " %s", level );
printf ( "Enter the vertical coordinate:\n" );
scanf ( " %s", vcord );
printf ( "Enter the filter:\n" );
scanf ( " %s", filter );
printf ( "Enter the text attributes string:\n" );
scanf ( " %s", txtatt );
nsn_satt ( iindex, alias, isbcat, cycle, parms, color,
level, vcord, filter, txtatt, &jindex,
&iret );
printf ( "iret = %d\n", iret );
printf ( "jindex = %d\n", jindex );
if ( iret != 0 ) {
strcpy ( erstr, " " );
er_wmsg ( ergrp, &iret, erstr, &ier,
strlen ( ergrp ), strlen ( erstr ) );
}
}
/*---------------------------------------------------------------------*/
if ( numsub == 3 ) {
printf ( "Enter index number:\n" );
scanf ( " %d", &iindex );
nsn_qatt ( iindex, alias, &isbcat, cycle, parms, color,
level, vcord, filter, txtatt, &iret );
printf ( "iret = %d\n", iret );
printf ( "alias = %s\n", alias );
printf ( "isbcat = %d\n", isbcat );
printf ( "cycle = %s\n", cycle );
printf ( "parms = %s\n", parms );
printf ( "color = %s\n", color );
printf ( "level = %s\n", level );
printf ( "vcord = %s\n", vcord );
printf ( "filter = %s\n", filter );
printf ( "txtatt = %s\n", txtatt );
if ( iret != 0 ) {
strcpy ( erstr, " " );
er_wmsg ( ergrp, &iret, erstr, &ier,
strlen ( ergrp ), strlen ( erstr ) );
}
}
/*---------------------------------------------------------------------*/
if ( numsub == 4 ) {
printf ( "Enter index number:\n" );
scanf ( " %d", &iindex );
printf ( "Enter end time for range:\n" );
scanf ( " %s", endtim );
printf ( "Enter time range in minutes:\n" );
scanf ( " %d", &mrange );
printf ( "Enter time interval in minutes:\n" );
scanf ( " %d", &intrvl );
printf ( "Enter reference time flag:\n" );
scanf ( " %u", &jflag );
iflag = (Boolean) jflag;
printf ( "Enter delta reference time in minutes:\n" );
scanf ( " %d", &idelta );
nsn_gtim ( iindex, endtim, mrange, intrvl, iflag,
&idelta, &ntime, timarr, &iret );
printf ( "idelta = %d\n", idelta );
printf ( "iret = %d\n", iret );
printf ( "ntime = %d\n", ntime );
if ( ntime > 0 ) {
for ( knt = 0; knt < ntime; knt++ ) {
printf ( "Times: timarr[%d] = %s\n",
knt, timarr[knt] );
}
}
if ( iret != 0 ) {
strcpy ( erstr, " " );
er_wmsg ( ergrp, &iret, erstr, &ier,
strlen ( ergrp ), strlen ( erstr ) );
}
}
/*---------------------------------------------------------------------*/
if ( numsub == 5 ) {
printf ( "Enter index number:\n" );
scanf ( " %d", &iindex );
nsn_qatt ( iindex, alias, &isbcat, cycle, parms, color,
level, vcord, filter, txtatt, &iret );
printf ( "Enter GAREA:\n" );
scanf ( " %s", garea );
printf ( "Default projection? (y/n)\n" );
scanf ( " %s", ans );
if ( ans[0] == 'N' || ans[0] == 'n' ) {
printf ( "Enter PROJ:\n" );
scanf ( " %s", proj );
}
else {
strcpy ( proj, blank );
}
printf ( "Enter PANEL:\n" );
scanf ( " %s", panel );
printf ( "Enter DATTIM:\n" );
scanf ( " %s", dattim );
printf ( "Enter end time for range:\n" );
scanf ( " %s", endtim );
printf ( "Enter the time range in minutes:\n" );
scanf ( " %d", &mrange );
printf ( "Enter the time interval in minutes:\n" );
scanf ( " %d", &intrvl );
printf ( "Enter time match type:\n" );
scanf ( " %d", &match );
printf ( "Enter minutes for difference match:\n" );
scanf ( " %d", &minute );
printf ( "Enter title line:\n" );
scanf ( " %d", &ititl );
printf ( "Enter binning time before current time: hh mm:\n" );
scanf ( " %d %d", &ibfr, &mbfr );
printf ( "Enter binning time after current time: hh mm:\n" );
scanf ( " %d %d", &iaftr, &maftr );
printf ( "Enter most recent only flag (0 for no; 1 for yes)\n" );
scanf ( " %d", &mstrct );
gg_maps ( proj, garea, blank, &id, &ier,
strlen ( proj ), strlen ( garea ),
strlen ( blank ) );
gclear ( &ier );
strcpy ( map, "1" );
gg_map ( map, &ier, strlen ( map ) );
strcpy ( ltln, "2" );
gg_ltln ( ltln, &ier, strlen ( ltln ) );
nsn_dspl ( panel, dattim, alias, &isbcat, cycle, parms,
color, level, vcord, filter, txtatt,
endtim, &mrange, &intrvl, &match, &minute,
&ititl, &ibfr, &mbfr, &iaftr, &maftr,
&mstrct, &iret,
strlen ( panel ), strlen ( dattim ),
strlen ( alias ), strlen ( cycle ),
strlen ( parms ), strlen ( color ),
strlen ( level ), strlen ( vcord ),
strlen ( filter ), strlen ( txtatt ),
strlen ( endtim ) );
geplot ( &ier );
if ( iret != 0 ) {
strcpy ( erstr, " " );
er_wmsg ( ergrp, &iret, erstr, &ier,
strlen ( ergrp ), strlen ( erstr ) );
}
}
/*---------------------------------------------------------------------*/
if ( numsub == 6 ) {
nsn_save ( &iret );
printf ( "iret = %d\n", iret );
if ( iret != 0 ) {
strcpy ( erstr, " " );
er_wmsg ( ergrp, &iret, erstr, &ier,
strlen ( ergrp ), strlen ( erstr ) );
}
}
/*---------------------------------------------------------------------*/
if ( numsub == 7 ) {
nsn_rest ( &iret );
printf ( "iret = %d\n", iret );
if ( iret != 0 ) {
strcpy ( erstr, " " );
er_wmsg ( ergrp, &iret, erstr, &ier,
strlen ( ergrp ), strlen ( erstr ) );
}
}
/*---------------------------------------------------------------------*/
if ( numsub == 10 ) {
dumpcmn ( &iret );
}
/*---------------------------------------------------------------------*/
if ( numsub == 20 ) {
printf ( "Enter full DEVICE string:\n" );
scanf ( " %s", device );
gg_sdev ( device, &ier, strlen ( device ) );
}
}
return(0);
}
int main ( void )
/************************************************************************
* GRPHGD *
* *
* This program runs the graph-to-grid algorithm. *
* *
** *
* Log: *
* D.W.Plummer/NCEP 2/05 Re-write in C based on grphgd.f *
* R. Tian/SAIC 3/05 Added dg_intl *
* M. Li/SAIC 4/05 Modified ggdriv *
* D.W.Plummer/NCEP 5/05 Move dg_intl into gg_driv driver *
* m.gamazaychikov/SAIC 12/05 Add ces_gtrtbl *
* T. Piper/SAIC 01/08 Added GD_INIT; removed from IN_BDTA *
***********************************************************************/
{
int respnd, iperr, done, one=1, ier, iret, rspflg=G_TRUE;
int kx=0, ky=0, npoints;
float *grid, *grid1, *hist, *work1, *work2, *work3, *buffer;
/*---------------------------------------------------------------------*/
/*
* Initialize TAE.
*/
ip_init ( &respnd, &iperr );
if ( iperr == G_NORMAL ) {
ip_idnt ( "GRPHGD", &ier, strlen("GRPHGD") );
/*
* Initialize grid library common area grdcmn.cmn
*/
gd_init ( &ier );
done = G_FALSE;
}
else {
iperr = -1;
done = G_TRUE;
}
/*
* Initialize GEMPLT in order to set grid navigation later.
*/
if ( done == G_FALSE ) {
gg_init ( &one, &iret );
if ( iret != G_NORMAL ) {
iperr = -3;
done = G_TRUE;
}
}
/*
* Initialize device.
*/
if ( done == G_FALSE ) {
gg_sdev ( "GN", &ier, strlen("GN") );
if ( ier != G_NORMAL ) {
done = G_TRUE;
}
}
/*
* Initialize the _grpTbl structure.
*/
if ( done == G_FALSE ) {
ces_gtrtbl( &ier );
if ( ier != G_NORMAL ) {
done = G_TRUE;
}
}
/*
* Main loop.
*/
while ( done == G_FALSE ) {
npoints = LLMXTG;
G_MALLOC ( grid, float, npoints, "Error allocating grid" );
G_MALLOC ( grid1, float, npoints, "Error allocating grid1" );
G_MALLOC ( hist, float, npoints, "Error allocating hist" );
G_MALLOC ( work1, float, npoints, "Error allocating work1" );
G_MALLOC ( work2, float, npoints, "Error allocating work2" );
G_MALLOC ( work3, float, npoints, "Error allocating work3" );
G_MALLOC ( buffer, float, npoints, "Error allocating buffer" );
ggdriv ( grid, grid1, &kx, &ky, hist, work1, work2, work3,
buffer, &rspflg, &ier );
G_FREE ( hist, float );
G_FREE ( grid, float );
G_FREE ( grid1, float );
G_FREE ( work1, float );
G_FREE ( work2, float );
G_FREE ( work3, float );
G_FREE ( buffer, float );
/*
* Call dynamic tutor.
*/
ip_dynm ( &done, &ier );
}
/*
* Final error messages.
*/
if ( iperr != G_NORMAL ) {
er_wmsg ( "GRPHGD", &iperr, " ", &ier, strlen("GRPHGD"), strlen(" ") );
}
ip_exit ( &iret );
return 0;
}
void de_mbr1 ( const int *k, const char *infl, char *outfl, int *iret )
/************************************************************************
* de_mbr1 *
* *
* This subroutine parses a GDFILE entry to find and handle ensemble *
* specifications. It is called from DG_NFIL. The routine turns an *
* ensemble entry into a single entry that DG_NFIL can handle. *
* *
* de_mbr1 ( k, infl, outfl, iret ) *
* *
* Input parameters: *
* *k const int GDFILE entry position number *
* *infl const char Input file entry *
* *
* Output parameters: *
* *outfl char* Output file replaces INFL *
* *iret int Return code *
* 0 = normal return *
* -2 = grid file or template not *
* exist *
* *
* Log: *
* T. Lee/SAIC 12/04 *
* T. Lee/SAIC 06/05 Parsed weight value *
* R. Tian/SAIC 12/05 Translated from Fortran *
* m.gamazaychikov/SAIC 04/06 Added idtmch flag to CTB_DTGET CS *
* T. Piper/SAIC 04/07 Modified for cfl_scnt CSC *
* F. J. Yen/NCEP 4/08 Added bin mins & mstrct to CTB_DTGET CSC*
* S. Jacobs/NCEP 12/11 Fixed check if there is no table entry *
* returned by ctb_dtget *
***********************************************************************/
{
int index, nfarr, ic, is, iff, ir, ii, ino, ihb, mnb, iha, mna,
mstrct, idtmch, nfile, istar, last, len, ier;
long lens;
char lsv[MXFLSZ], newfil[MXFLSZ], filnam[MXFLSZ], cycle[DTTMSZ],
path[MXFLSZ], tmplt[MXFLSZ], dum[DTTMSZ], rplc[DTTMSZ], membr[17];
char *opnptr, *clsptr, *starp, *ptr, **farr, *def = " ";
struct dirent **dnlist=NULL;
/*----------------------------------------------------------------------*/
*iret = 0;
outfl[0] = '\0';
/*
* Check if INFL contains a curly-bracket enclosed ensemble spec.
* If not, the first entry is not an ensemble grid. Do nothing.
*/
opnptr = strchr ( infl, '{' );
if ( ! opnptr ) {
strcpy ( outfl, infl );
return;
}
/*
* Save the string between curly brackets to ensspc (k). Get
* the first element of the file(s).
*/
cst_opcl ( infl, opnptr, &clsptr, &ier );
if ( ier != 0 ) {
*iret = -2;
return;
}
for ( index = 0, ptr = opnptr + 1; ptr < clsptr; index++, ptr++ ) {
_ensdiag.ensspc[*k-1][index] = *ptr;
}
_ensdiag.ensspc[*k-1][index] = '\0';
clsptr = strchr ( _ensdiag.ensspc[*k-1], ',' );
if ( ! clsptr ) {
strcpy ( lsv, _ensdiag.ensspc[*k-1] );
} else {
for ( index = 0, ptr = _ensdiag.ensspc[*k-1];
ptr < clsptr; index++, ptr++ ) {
lsv[index] = *ptr;
}
lsv[index] = '\0';
}
/*
* If file name is not an alias, do nothing.
*/
cfl_inqr ( lsv, NULL, &lens, newfil, &ier );
if ( ier == 0 ) {
strcpy ( outfl, lsv );
return;
}
/*
* Get the template. If the template does not end with "*",
* do nothing.
*/
farr = (char **)cmm_malloc2d ( 2, MXFLSZ, sizeof(char), &ier );
if ( strchr ( lsv, '%' ) ) {
cst_clst ( lsv, '%', def, 2, MXFLSZ, farr, &nfarr, &ier );
strcpy ( lsv, farr[1] );
}
cst_clst ( lsv, '|', def, 2, MXFLSZ, farr, &nfarr, &ier );
strcpy ( filnam, farr[0] );
strcpy ( cycle, farr[1] );
cmm_free2d ( (void **)farr, &ier );
ctb_dtget ( filnam, path, tmplt, &ic, &is, &iff, &ir, &ii, &ino,
&ihb, &mnb, &iha, &mna, &mstrct, &idtmch, &ier );
if ( ier != 0 ) {
strcpy ( outfl, lsv );
return;
}
else {
starp = strchr ( tmplt, '*' );
istar = (int)( starp - tmplt );
if ( ! starp ) {
strcpy ( outfl, lsv );
return;
}
}
/*
* If the template contains an "*", then it is an ensemble with
* multiple members. The last member is the one sought.
*/
if ( strcmp ( cycle, def ) != 0 ) {
cti_stan ( cycle, "YYMMDD/HHNN", dum, &ier );
if ( strstr ( tmplt, "YYYYMMDD" ) ) {
strcpy ( rplc, "YY" );
strncat ( rplc, dum, 6 );
rplc[8] = '\0';
cst_rpst ( tmplt, "YYYYMMDD", rplc, tmplt, &ier );
} else {
strncpy ( rplc, dum, 6 );
rplc[6] = '\0';
cst_rpst ( tmplt, "YYMMDD", rplc, tmplt, &ier );
}
strncpy ( rplc, &dum[7], 2 );
rplc[2] = '\0';
cst_rpst ( tmplt, "HH", rplc, tmplt, &ier );
}
/*
* Retrieve the last member of the ensemble alias.
*/
cfl_scnt ( path, tmplt, -1, &dnlist, &nfile, &ier );
if ( nfile == 0 ) {
*iret = -2;
er_wmsg ( "DE", iret, " ", &ier, strlen("DE"), strlen(" ") );
return;
}
strcpy ( newfil, dnlist[0]->d_name );
for (ii=0;ii<nfile;ii++){
free(dnlist[ii]);
}
if ( dnlist != NULL ) free(dnlist);
/*
* Replace "*" in the template with member names. Note
* that "*" may be embedded in the template.
*/
if ( *(starp+1) == '\0' ) {
last = G_TRUE;
} else {
last = G_FALSE;
}
if ( last == G_TRUE ) {
strcpy ( membr, &newfil[istar] );
} else {
len = strlen ( newfil ) - strlen ( tmplt ) + 1;
cst_ncpy ( membr, &newfil[istar], len, &ier );
}
/*
* Recombine the alias and last member with the cycle.
*/
strcpy ( outfl, filnam );
strcat ( outfl, ":" );
strcat ( outfl, membr );
if ( strcmp ( cycle, def ) != 0 ) {
strcat ( outfl, "|" );
strcat ( outfl, cycle );
}
return;
}
void dgc_subg ( const char *ijskip, int *maxgrid, int *imll, int *jmll,
int *imur, int *jmur, int *iret )
/************************************************************************
* dgc_subg *
* *
* This subroutine sets the internal subset grid given the reference *
* grid navigation set in GPLT and the map projection set in GPLT. *
* If the reference grid is globe wrapping with the addition of an *
* extra grid column, then the navigation set in GPLT must be that for *
* the grid with the extra column. *
* *
* The subset grid is larger by five grid points than that strictly *
* needed to cover the map projection area. This extension permits *
* more accurate computation of derivatives. The subset grid relative *
* coordinates of the region strictly needed for the map are returned. *
* *
* *
* IJSKIP is parsed by IN_GSKP. IJSKIP information is entered using *
* the following format, where items in square brackets are optional: *
* *
* IJSKIP = Iskip[;Istart][;Iend][/Jskip[;Jstart][;Jend]], *
* *
* IJSKIP=Y[ES], or IJSKIP=N[O] *
* *
* The following rules apply in using IJSKIP input: *
* *
* 1. If only Iskip is entered, then I and J skips are Iskip. The *
* beginning points and ending points are determined by querying *
* the display projection to find the area on the reference grid *
* needed to cover it. *
* *
* 2. If any bounding value is omitted, it is determined automatically *
* by querying the display projection as in 1 above. *
* *
* 3. If IJSKIP is blank or NO, skipping is not used to determine the *
* internal grid navigation. *
* *
* 4. If IJSKIP is YES, all skip parameters are determined *
* automatically. *
* *
* dgc_subg ( ijskip, maxgrid, imll, jmll, imur, jmru, iret ) *
* *
* Input parameters: *
* *ijskip const char User input for skip subsetting *
* *maxgrid int Maximum grid size *
* *
* Output parameters: *
* *IMLL int Lower left map I bound *
* *JMLL int Lower left map J bound *
* *IMUR int Upper right map I bound *
* *JMUR int Upper right map J bound *
* *IRET int Return code *
* 0 = normal return *
* -37 = no ref grid navigation set*
* -38 = glb wrap grd inconsistency*
* -39 = map projection is not set *
* -40 = subset grd bound error *
* -41 = subset grid is too big *
* -43 = cannot rearrange grid *
* -44 = error set subset grid nav *
* -48 = both I bounds required *
** *
* Log: *
* K. Brill/HPC 08/02 *
* K. Brill/HPC 9/02 Also initialize gparmd () to blank *
* S. Jacobs/NCEP 11/02 Added check for current nav vs saved nav*
* K. Brill/HPC 11/02 Eliminate use of the SUBA logical array *
* K. Brill/HPC 12/02 Use IJSKIP input for subset by skipping *
* R. Tian/SAIC 3/04 Add check for outflg *
* R. Tian/SAIC 5/04 Added call to DG_CONE *
* R. Tian/SAIC 2/06 Recoded from Fortran *
* S. Gilbert/NCEP 5/07 Added maxgrid argument *
************************************************************************/
{
char gprj[5], cnum[5];
float aglt1, agln1, aglt2, agln2, ag1, ag2, ag3, rimn, rjmn, rimx,
rjmx, rglt[2], rgln[2], tnav[LLNNAV];
double a, b, c;
int lmx, mx, my, imn, jmn, imx, jmx, nx, ny, ix1, ix2, nsx, iy1, iy2,
nsy, n, idx, idy, ichk, iadlx, iadly, iadrx, iadry, kxsg, kysg,
kxysg, nu, mxnu, imn2, jmn2, imx2, jmx2, iadd, navsz;
int nc, tobig, autos, angflg, navflg, done, ishf, ier, ierr, iir, i, k;
/*
* timing vars
*/
struct timeb t_gsgprj1, t_gsgprj2, t_gsgprj3, t_gqgprj1, t_gqgprj2,
t_gsgprj4, t_setr, t_gqbnd, t_gskp, t_gtrans1, t_mnav, t_cnav,
t_cone, t_current;
/*----------------------------------------------------------------------*/
*iret = 0;
_dgsubg.dgsubg = G_TRUE;
for ( i = 0; i < NGDFLS; i++ ) {
if ( _nfile.outflg[i] == G_TRUE ) {
*iret = -63;
return;
}
}
/*
* Set LMX to maximum allowed threshold for ijskip=yes
*/
lmx = LLMXTH;
/*
* Set the reference grid navigation in GPLT.
*/
cst_itos ( (int *)(&_dgsubg.refnav[1]), 1, &nc, gprj, &ier );
cst_rmbl ( gprj, gprj, &nc, &ier );
mx = G_NINT ( _dgsubg.refnav[4] );
my = G_NINT ( _dgsubg.refnav[5] );
agln1 = _dgsubg.refnav[7];
if ( _dgfile.addcol == G_TRUE ) {
mx += 1;
agln2 = _dgsubg.refnav[7];
} else {
agln2 = _dgsubg.refnav[9];
}
ftime(&t_gsgprj1);
gsgprj ( gprj, &_dgsubg.refnav[10], &_dgsubg.refnav[11],
&_dgsubg.refnav[12], &mx, &my, &_dgsubg.refnav[6],
&_dgsubg.refnav[7], &_dgsubg.refnav[8], &agln2, &ier,
strlen(gprj) );
ftime(&t_current);
if ( ier != 0 ) {
er_wmsg ( "GEMPLT", &ier, " ", &ierr, strlen("GEMPLT"), strlen(" ") );
*iret = -37;
return;
} else if ( _dgsubg.gwrapg == G_TRUE &&
( ! COMPAR ( agln1, agln2 ) && ! COMPAR ( (agln1+360.), agln2 ) ) ) {
*iret = -38;
return;
}
/*
* Get the shift for re-arranging any globe wrapping grid.
* ISHIFT is stored in DGCMN.CMN.
*/
ftime(&t_setr);
grc_setr ( &mx, &my, &_dgsubg.ishift, &ier );
ftime(&t_current);
if ( ier == -22 ) {
*iret = -39;
return;
} else if ( ier != 0 ) {
*iret = -43;
return;
}
ftime(&t_gqgprj1);
gqgprj ( gprj, &ag1, &ag2, &ag3, &mx, &my, &aglt1, &agln1, &aglt2,
&agln2, &ier, sizeof(gprj) );
ftime(&t_current);
gprj[4] = '\0';
cst_lstr ( gprj, &nc, &ier );
gprj[nc] = '\0';
/*
* Get the grid index bounds for the subset grid.
*/
ftime(&t_gqbnd);
gqbnd ( sys_G, &rimn, &rjmn, &rimx, &rjmx, &ier, strlen(sys_D) );
ftime(&t_current);
if ( ier != 0 ) {
er_wmsg ( "GEMPLT", &ier, " ", &ierr, strlen("GEMPLT"), strlen(" ") );
*iret = -40;
return;
}
imn = (int)rimn;
jmn = (int)rjmn;
imx = G_NINT ( rimx + .5 );
if ( G_DIFFT((float)((int)rimx), rimx, GDIFFD) ) imx = (int)rimx;
jmx = G_NINT ( rjmx + .5 );
if ( G_DIFFT((float)((int)rjmx), rjmx, GDIFFD) ) jmx = (int)rjmx;
if ( imn < 1 ) imn = 1;
if ( jmn < 1 ) jmn = 1;
if ( imx > mx ) imx = mx;
if ( jmx > my ) jmx = my;
nx = imx - imn + 1;
ny = jmx - jmn + 1;
if ( nx * ny > lmx ) {
tobig = G_TRUE;
} else {
tobig = G_FALSE;
}
/*
* Check for subsetting by skipping.
*
* The bounds are returned from IN_GSKP as IMISSD if
* not provided. The skip value returned is converted
* to a stride value by adding one, i.e. IDX=1 means
* no skipping, IDX=2 means skip one point.
*
* The mathematical relationship stating that the
* original number of grid points from IMN to IMX must
* equal the number of points skipped plus the number
* kept is this:
*
* (IMX - IMN + 1) = N + (N - 1) * nskip
*
* where N is the number of points remaining after
* skipping and nskip is the number of points skipped
* between the points that are kept.
*
* This equation appears a number of times in various
* forms below.
*/
ftime(&t_gskp);
in_gskp ( ijskip, &ix1, &ix2, &nsx, &iy1, &iy2, &nsy, &autos, &ier );
ftime(&t_current);
if ( ier != 0 ) {
er_wmsg ( "IN", &ier, " ", &iir, strlen("IN"), strlen(" ") );
*iret = -40;
return;
}
if ( ix2 > mx ) {
ier = -49;
er_wmsg ( "DG", &ier, "I", &iir, strlen("DG"), strlen("I") );
*iret = -40;
return;
} else if ( iy2 > my ) {
ier = -49;
er_wmsg ( "DG", &ier, "J", &iir, strlen("DG"), strlen("J") );
*iret = -40;
return;
}
if ( autos == G_TRUE && tobig == G_TRUE ) {
a = (double)( lmx - 1 );
b = (double)( nx + ny - 2 * lmx );
c = (double)( lmx - nx * ny );
n = (int)( ( b + sqrt ( b * b - 4. * a * c ) ) / ( 2. * a ) );
nsx = n + 1;
nsy = nsx;
cst_inch ( nsx, cnum, &ier );
ier = 7;
er_wmsg ( "DG", &ier, cnum, &iir, strlen("DG"), strlen(cnum) );
}
idx = nsx + 1;
idy = nsy + 1;
if ( nsx > 0 ) {
ichk = nx / nsx;
if ( ichk <= 4 ) {
ier = 6;
er_wmsg ( "DG", &ier, "I", &iir, strlen("DG"), strlen("I") );
}
}
if ( nsy > 0 ) {
ichk = ny / nsy;
if ( ichk <= 4 ) {
ier = 6;
er_wmsg ( "DG", &ier, "J", &iir, strlen("DG"), strlen("J") );
}
}
/*
* Extend the grid bounds if possible.
*/
iadlx = 0;
iadly = 0;
iadrx = 0;
iadry = 0;
imn2 = imn;
jmn2 = jmn;
imx2 = imx;
jmx2 = jmx;
iadd = 0;
done = G_FALSE;
while ( done == G_FALSE && iadd < 5 ) {
iadd += 1;
if ( imn2 > idx ) {
imn2 -= idx;
iadlx += idx;
}
if ( jmn2 > idy ) {
jmn2 -= idy;
iadly += idy;
}
if ( imx2 < ( mx - idx ) ) {
imx2 += idx;
iadrx += idx;
}
if ( jmx2 < ( my - idy ) ) {
jmx2 += idy;
iadry += idy;
}
kxsg = G_NINT ( (float)( imx2 - imn2 + 1 + nsx ) / (float)( 1 + nsx ) );
kysg = G_NINT ( (float)( jmx2 - jmn2 + 1 + nsy ) / (float)( 1 + nsy ) );
kxysg = kxsg * kysg;
if ( (kxysg > *maxgrid) && (*maxgrid != IMISSD) ) {
done = G_TRUE;
if ( imn != imn2 ) {
imn = imn2 + idx;
iadlx -= idx;
}
if ( jmn != jmn2 ) {
jmn = jmn2 + idy;
iadly -= idy;
}
if ( imx != imx2 ) {
imx = imx2 - idx;
iadrx -= idx;
}
if ( jmx != jmx2 ) {
jmx = jmx2 - idy;
iadry -= idy;
}
} else {
imn = imn2;
jmn = jmn2;
imx = imx2;
jmx = jmx2;
}
}
/*
* Adjust extend margins using the stride values.
*/
iadlx = iadlx / idx;
iadrx = iadrx / idx;
iadly = iadly / idy;
iadry = iadry / idy;
/*
* Set the I dimension extraction bounds. No shifting
* is done if the user provides these bounds. No
* extend region is allowed if user provides bounds.
*/
ishf = _dgsubg.ishift;
if ( ix1 > 0 ) {
_dgsubg.ishift = 0;
iadlx = 0;
imn = ix1;
}
if ( ix2 > 0 ) {
_dgsubg.ishift = 0;
iadrx = 0;
imx = ix2;
}
if ( ishf != _dgsubg.ishift ) {
if ( ix1 < 0 || ix2 < 0 ) {
*iret = -48;
return;
}
/*
* Reset the grid projection in GPLT.
*/
mx = G_NINT ( _dgsubg.refnav[4] );
my = G_NINT ( _dgsubg.refnav[5] );
agln1 = _dgsubg.refnav[7];
if ( _dgfile.addcol == G_TRUE ) {
mx += 1;
agln2 = _dgsubg.refnav[7];
} else {
agln2 = _dgsubg.refnav[9];
}
ftime(&t_gsgprj2);
gsgprj ( gprj, &_dgsubg.refnav[10], &_dgsubg.refnav[11],
&_dgsubg.refnav[12], &mx, &my, &_dgsubg.refnav[6],
&_dgsubg.refnav[7], &_dgsubg.refnav[8], &agln2, &ier,
strlen(gprj) );
ftime(&t_current);
ftime(&t_gqgprj2);
gqgprj ( gprj, &ag1, &ag2, &ag3, &mx, &my, &aglt1, &agln1,
&aglt2, &agln2, &ier, sizeof(gprj) );
ftime(&t_current);
if ( diagClbkPtr != NULL )
gprj[4] = '\0';
cst_lstr ( gprj, &nc, &ier );
gprj[nc] = '\0';
ierr = 5;
er_wmsg ( "DG", &ierr, " ", &ier, strlen("DG"), strlen(" ") );
}
/*
* Adjust IMX and IMN for skipping.
*/
if ( idx > 1 ) {
nu = G_NINT ( (float)( imx - imn + 1 + nsx ) / (float)( 1 + nsx ) );
mxnu = nu * ( 1 + nsx ) + imn - 1 - nsx;
if ( mxnu > ( mx - idx ) && mxnu != ix2 ) {
mxnu = mx;
imn = mxnu - nu * ( 1 + nsx ) + 1 + nsx;
if ( imn < 1 ) {
/*
* Start at 1 when full range is needed.
*/
imn = 1;
nu = ( mxnu - imn + 1 + nsx ) / ( 1 + nsx );
mxnu = nu * ( 1 + nsx ) + imn - 1 - nsx;
}
}
imx = mxnu;
if ( ( ix2 > 0 && imx != ix2 ) ||
( ix1 > 0 && imn != ix1 ) ) {
ierr = 4;
er_wmsg ( "DG", &ierr, "I", &ier, strlen("DG"), strlen("I") );
}
}
/*
* Set the J dimension extraction bounds. No extend
* region is allowed if user provides bounds.
*/
if ( iy1 > 0 ) {
iadly = 0;
jmn = iy1;
}
if ( iy2 > 0 ) {
iadry = 0;
jmx = iy2;
}
/*
* Adjust JMX and JMN for skipping.
*/
if ( idy > 1 ) {
nu = G_NINT ( (float)( jmx - jmn + 1 + nsy ) / (float)( 1 + nsy ) );
mxnu = nu * ( 1 + nsy ) + jmn - 1 - nsy;
if ( mxnu > ( my - idy ) && mxnu != iy2 ) {
mxnu = my;
jmn = mxnu - nu * ( 1 + nsy ) + 1 + nsy;
if ( jmn < 1 ) {
/*
* Start at 1 when full range is needed.
*/
jmn = 1;
nu = ( mxnu - jmn + 1 + nsy ) / ( 1 + nsy );
mxnu = nu * ( 1 + nsy ) + jmn - 1 - nsy;
}
}
jmx = mxnu;
if ( ( iy2 > 0 && jmx != iy2 ) || ( iy1 > 0 && jmn != iy1 ) ) {
ierr = 4;
er_wmsg ( "DG", &ierr, "J", &ier, strlen("DG"), strlen("J") );
}
}
/*
* Compute subset grid final dimensions.
*/
kxsg = ( imx - imn + 1 + nsx ) / ( 1 + nsx );
kysg = ( jmx - jmn + 1 + nsy ) / ( 1 + nsy );
if ( kxsg <= 0 || kysg <= 0 ) {
*iret = -40;
return;
}
kxysg = kxsg * kysg;
/*
* Set common block subset coordinates on reference grid.
*/
_dgsubg.jsgxmn = imn;
_dgsubg.jsgymn = jmn;
_dgsubg.jsgxmx = imx;
_dgsubg.jsgymx = jmx;
_dgsubg.jsgxsk = idx;
_dgsubg.jsgysk = idy;
/*
* Set DG_HILO area bounds on subset grid.
*/
_dgarea.kgxmin = iadlx + 1;
_dgarea.kgymin = iadly + 1;
_dgarea.kgxmax = kxsg - iadrx;
_dgarea.kgymax = kysg - iadry;
/*
* Strict map bounds are same as above.
*/
*imll = _dgarea.kgxmin;
*jmll = _dgarea.kgymin;
*imur = _dgarea.kgxmax;
*jmur = _dgarea.kgymax;
/*
* Set the DGAREA common grid bounds calculation flag.
*/
_dgarea.jgxmin = 1;
_dgarea.jgxmax = kxsg;
_dgarea.jgymin = 1;
_dgarea.jgymax = kysg;
_dgarea.ksub1 = 1;
_dgarea.ksub2 = kxysg;
/*
* Compute grid size and maximum number of internal grids
* for the common block.
*/
if ( (kxysg > *maxgrid) && (*maxgrid != IMISSD) ) {
/*
* Here is the future location to set up some other
* remapping.
*/
*iret = -41;
return;
}
_dgfile.kxd = kxsg;
_dgfile.kyd = kysg;
_dgfile.kxyd = kxysg;
_dggrid.maxdgg = NDGRD;
/*
* Compute the navigation of the internal (subset) grid.
*/
strcpy ( _dgfile.cprj, gprj );
rglt[0] = _dgsubg.jsgxmn;
rgln[0] = _dgsubg.jsgymn;
rglt[1] = _dgsubg.jsgxmx;
rgln[1] = _dgsubg.jsgymx;
nc = 2;
ftime(&t_gtrans1);
gtrans ( sys_G, sys_M, &nc, rglt, rgln, rglt, rgln, &ier,
strlen(sys_G), strlen(sys_M) );
ftime(&t_current);
if ( G_ABS ( rgln[0] - 180. ) < .01 || G_ABS ( rgln[0] + 180. ) < .01 )
rgln[0] = -180.;
if ( G_ABS ( rgln[1] - 180. ) < .01 || G_ABS ( rgln[1] + 180. ) < .01 )
rgln[0] = 180.;
if ( G_ABS ( rgln[0] - rgln[1]) < 0.01 )
rgln[1] = rgln[0];
ftime(&t_gsgprj3);
gsgprj ( _dgfile.cprj, &ag1, &ag2, &ag3, &_dgfile.kxd, &_dgfile.kyd,
&rglt[0], &rgln[0], &rglt[1], &rgln[1], &ier, strlen(_dgfile.cprj) );
ftime(&t_current);
if ( ier != 0 ) {
if ( _dgsubg.gwrapg == G_TRUE) {
ag2 += 180.;
if ( ag2 >= 360. ) ag2 -= 360.;
ftime(&t_gsgprj4);
gsgprj ( _dgfile.cprj, &ag1, &ag2, &ag3, &_dgfile.kxd, &_dgfile.kyd,
&rglt[0], &rgln[0], &rglt[1], &rgln[1], &ier,
strlen(_dgfile.cprj) ) ;
ftime(&t_current);
if ( ier != 0 ) {
*iret = -44;
return;
}
} else {
*iret = -44;
return;
}
}
angflg = G_TRUE;
ftime(&t_mnav);
grc_mnav ( _dgfile.cprj, &_dgfile.kxd, &_dgfile.kyd, &rglt[0], &rgln[0],
&rglt[1], &rgln[1], &ag1, &ag2, &ag3, &angflg, tnav, &ier );
ftime(&t_current);
/*
* Check the current navigation against the saved navigation.
* If they are different, then set the navigation flag to False.
*/
navsz = LLNNAV;
ftime(&t_cnav);
grc_cnav ( tnav, _dgfile.snav, &navsz, &navflg, &ier );
ftime(&t_current);
/*
* Save the current navigation.
*/
for ( k = 0; k < LLNNAV; k++ ) {
_dgfile.snav[k] = tnav[k];
}
db_retsubgcrs (_dgfile.cprj, _dgfile.kxd, _dgfile.kyd, rglt[0], rgln[0],
rglt[1], rgln[1],ag1, ag2, ag3,&ier);
/*
* Set the constant of the cone for various projections (code
* duplicated from UPDCON.FOR in GEMPLT).
*/
_dgfile.anglr1 = ag1 * DTR;
_dgfile.anglr2 = ag2 * DTR;
_dgfile.anglr3 = ag3 * DTR;
ftime(&t_cone);
dg_cone ( _dgfile.cprj, &_dgfile.anglr1, &_dgfile.anglr3,
&_dgfile.concon, iret );
ftime(&t_current);
/*
* Set lat/lon, map scale factor, and rotation matrix
* internal grid pointers to zero.
*/
_dgfile.idglat = 0;
_dgfile.idglon = 0;
_mapscl.ixmscl = 0;
_mapscl.iymscl = 0;
_mapscl.ixmsdy = 0;
_mapscl.iymsdx = 0;
_dgrtwd.irtcos = 0;
_dgrtwd.irtsin = 0;
_dglndc.lndsea = 0;
/*
* Initialize orientation angle.
*/
_dgovec.ornang = RMISSD;
/*
* Free all existing grids since navigation is changed.
*/
if ( navflg == G_FALSE ) {
dg_fall ( &ier );
}
/*
* Initialize the origin for M calculation.
*/
_dgorig.orglat = RMISSD;
_dgorig.orglon = RMISSD;
_dgorig.orgxpt = RMISSD;
_dgorig.orgypt = RMISSD;
/*
* Since there were no errors, set flag saying dg package has
* been initialized.
*/
_dgfile.dgset = G_TRUE;
/*
* Initialize the pointer in the internal grid arrays.
*/
_dggrid.idglst = 0;
return;
}
void gdgwrt ( const float *grid, const char *time1, const char *time2,
const int *level1, const int *level2, const int *ivcord,
const char *parm, const char *grdnam, const char *gpack,
const int *ihzrmp, const int *idrct, int *iret )
/************************************************************************
* gdgwrt *
* *
* This subrutine writes a warning message if a grid is already in *
* the file. The grid identifier is written and the user is prompted *
* to accept the grid, change the parameter name or exit. *
* *
* gdgwrt ( grid, time1, time2, level1, level2, ivcord, parm, grdnam, *
* gpack, ihzrmp, idrct, iret ) *
* *
* Input parameters: *
* *grid const float Grid of data *
* *time1 const char Grid date/time *
* *time2 const char Grid date/time *
* *level1 const int Grid levels *
* *level2 const int Grid levels *
* *ivcord const int Grid vertical coordinate *
* *parm const char Grid parameter name *
* *grdnam const char User specified grid name *
* *gpack const char Grid packing information *
* *ihzrmp const int Horizontal remapping *
* *idrct const int Directional flag *
* *
* Output parameters: *
* *iret int Return code *
* 2 = user entered EXIT *
* 0 = normal return *
* -7 = error writing grid *
** *
* Log: *
* M. Goodman/RDS 10/85 *
* M. desJardins/GSFC 7/87 Rewritten *
* M. desJardins/GSFC 8/88 GEMPAK 4 *
* S. Schotz/GSC 6/90 Get respnd locally from IP_RESP *
* K. Brill/NMC 02/91 Added in-line parameters *
* K. Brill/NMC 07/92 Change gname to upper case (J. Whistler)*
* K. Brill/NMC 07/92 Added % in-line parameter *
* K. Brill/EMC 11/97 Fixed in-line parm: i->ii in DO ii loop *
* M. Li/SAIC 04/04 Added ihzrmp, and idrct *
* R. Tian/SAIC 1/05 Modified for time/file management *
* T. Lee/SAIC 12/05 Initialized ighdr *
* R. Tian/SAIC 9/06 Recoded from Fortran *
************************************************************************/
{
char gname[13], gtime[21], glevl[13], gcord[13], answer[13], vparm[13],
timout1[21], timout2[21], gdnbuf[LLMXLN+1], *pchr;
int respnd, exist, tltflg, pagflg, newln, rplc;
int ighdr[LLGDHD], levout1, levout2, ivcout;
int dowhat, inam, ihat, iaat, ipct, len, zero, ii, ier;
/*----------------------------------------------------------------------*/
*iret = 0;
tltflg = G_TRUE;
pagflg = G_FALSE;
newln = G_FALSE;
rplc = G_TRUE;
zero = 0;
inam = 0;
ihat = 0;
iaat = 0;
ipct = 0;
/*
* Get name of grid to use along with in-line parameters.
*/
if ( strlen(grdnam) > 0 ) {
dowhat = DONAM;
cst_lcuc ( (char *)grdnam, gdnbuf, &ier );
for ( pchr = gdnbuf; *pchr != '\0'; pchr++ ) {
if ( *pchr == '^' ) dowhat = DOHAT;
if ( *pchr == '@' ) dowhat = DOAAT;
if ( *pchr == '%' ) dowhat = DOPCT;
switch ( dowhat ) {
/*
* Retrieve grid name.
*/
case DONAM:
gname[inam++] = *pchr;
break;
/*
* Retrieve in-line time.
*/
case DOHAT:
if ( *pchr == '^' ) continue;
gtime[ihat++] = *pchr;
break;
/*
* Retrieve in-line level.
*/
case DOAAT:
if ( *pchr == '@' ) continue;
glevl[iaat++] = *pchr;
break;
/*
* Retrieve in-line vertical coordinate.
*/
case DOPCT:
if ( *pchr == '%' ) continue;
gcord[ipct++] = *pchr;
break;
}
}
gname[inam] = '\0';
gtime[ihat] = '\0';
glevl[iaat] = '\0';
gcord[ipct] = '\0';
}
if ( inam == 0 ) strcpy ( gname, parm );
if ( ihat > 0 ) {
strcpy ( timout1, gtime );
timout2[0] = '\0';
} else {
strcpy ( timout1, time1 );
strcpy ( timout2, time2 );
}
if ( iaat > 0 ) {
cst_numb ( glevl, &levout1, &ier );
levout2 = -1;
} else {
levout1 = *level1;
levout2 = *level2;
}
if ( ipct > 0 ) {
clv_cord ( gcord, vparm, &ivcout, &ier );
} else {
ivcout = *ivcord;
}
/*
* Check if the grid already exists in the grid file.
* Write message that grid will be replaced.
*/
cst_lcuc ( gname, gname, &ier );
dgc_qgrd ( timout1, timout2, &levout1, &levout2, &ivcout, gname,
&exist, &ier );
if ( ier == 0 && exist == G_TRUE ) {
printf ( " This grid is already in file. It will be replaced.\n" );
}
/*
* Write the grid identifiers.
*/
printf ( "\n" );
grc_wtrm ( stdout, &tltflg, &zero, timout1, timout2, &levout1,
&levout2, &ivcout, gname, &ier );
/*
* Allow user to enter a new parameter name.
*/
ip_resp ( &respnd, &ier );
if ( respnd == G_TRUE ) {
tm_str ( "Enter a new grid parameter name, <cr> to accept",
&pagflg, &newln, answer, iret,
strlen("Enter a new grid parameter name, <cr> to accept"), 13 );
st_null ( answer, answer, &len, &ier, 13, 13 );
/*
* Return if the user typed EXIT.
*/
if ( *iret == 2 ) return;
/*
* Check if user entered new name.
*/
if ( *iret == 0 ) strcpy ( gname, answer );
}
/*
* Write out the grid and check for errors.
*/
for ( ii = 0; ii < LLGDHD; ii++ ) ighdr[ii] = 0;
if ( *ihzrmp != IMISSD ) ighdr[0] = *ihzrmp;
if ( *idrct != IMISSD ) ighdr[1] = *idrct;
dgc_nwdt ( grid, timout1, timout2, &levout1, &levout2, &ivcout, gname,
ighdr, gpack, &rplc, iret );
if ( *iret != 0 ) {
er_wmsg ( "DG", iret, " ", &ier, strlen("DG"), strlen(" ") );
*iret = -7;
}
return;
}
void db_getduri ( char *queryType, char *source, char *model,
char *dattim, char *vcord, char *parm, char *evtname,
int *level, int *level2,
char *dataURI, int *lDataURI, int *iret )
/************************************************************************
* *
* db_getduri *
* *
* m.gamazaychikov/SAIC 11/08 Created *
************************************************************************/
{
int ier, ier1, ier2, iplgn = 129;
char queryText[320];
char errStr[100], plgn[iplgn-1];
struct timeb t_callback, t_current;
/*---------------------------------------------------------------------*/
if ( duriClbkPtr == NULL ) {
ier = -17;
er_wmsg ( "DB", &ier, "db_getgduri", &ier1, 2, strlen("db_getgduri") );
}
/*
* Initialization
*/
*iret = 0;
dataURI[0] = '\0';
queryText[0] = '\0';
*lDataURI = 0;
/*
* Populate the query strings
*/
db_getparm ( plgn, &ier2, iplgn);
if ( ier2 != 0 ) {
*iret = -1;
return;
}
if (strcmp ( queryType, "dataURI" ) == 0 ) {
if ( strcmp ( source, "GRID") == 0 ) {
sprintf (ePlugIn, "%s", plgn);
sprintf (eSrc, "%s", source);
sprintf (eMdl, "%s", model);
sprintf (gDattim, "%s", dattim);
sprintf (gEventName, "%s", evtname);
sprintf (gCord, "%s", vcord);
if ( *level2 == -1 )
sprintf (gLevel, "%d", *level);
else
sprintf (gLevel, "%d:%d", *level, *level2);
sprintf (gParm, "%s", parm);
sprintf (eLibClass, "%s", "GempakDataURIRequest");
}
else {
ier = -9;
sprintf (errStr, "%s+", queryType);
strcat (errStr, source);
er_wmsg ( "DB", &ier, errStr, &ier1, 2, strlen(errStr) );
*iret = -1;
return;
}
}
else {
ier = -8;
er_wmsg ( "DB", &ier, queryType, &ier1, 2, strlen(queryType) );
*iret = -1;
return;
}
/*
* Get the query text
*/
sprintf (queryText, "%s|%s|%s|%s|%s|%s", model, evtname, parm, vcord, gLevel, gDattim);
/*
db_getQueryText ( queryType, queryText, &ier);
if ( ier !=0 ) {
ier = -3;
er_wmsg ( "DB", &ier, NULL, &ier1, 2, 0 );
*iret = -1;
return;
}
*/
/*
* Execute the callback to get the datauri
*/
//ftime(&t_callback);
duriClbkPtr(queryText);
//ftime(&t_current);
if ( duriStrLength > 0 && duriStrBack != NULL ) {
if ( strstr(duriStrBack, "Error") == NULL ) {
strcpy (dataURI, duriStrBack);
*lDataURI = strlen(dataURI);
G_FREE( duriStrBack, char );
}
else {
*iret = -1;
return;
}
}
else {
ier = -18;
er_wmsg ( "DB", &ier, "dataURI", &ier1, 2, strlen("dataURI") );
*iret = -1;
return;
}
return;
}
void spf_open ( char *filnam, Boolean crt, FILE **fptr, int *flen, int *iret )
/************************************************************************
* spf_open *
* *
* This function opens an SPF file for update. If the file doesn't *
* exist and flag "crt" is TRUE, then it will be created. If the file *
* suffix is not ".spf", it will be added. If the user has only read *
* permission to the SPF file, it will be opened as "read-only". *
* *
* spf_open ( filnam, crt, fptr, flen, iret ) *
* *
* Input parameters: *
* *filnam char File name with full path *
* crt Boolean Flag, create a new file or not *
* *
* Output parameters: *
* **fptr FILE Pointer to a file pointer *
* *flen int File size *
* *iret int Return code *
* 1 - File opened as READ_ONLY *
* 0 - Normal *
* -1 - File does not exist *
* -2 - File cannot be opened *
* -3 - Failure to create SPF file *
* *
** *
* Log: *
* J. Wu/GSC 6/01 create *
* J. Wu/GSC 6/01 use cst_srch() *
* J. Wu/GSC 7/01 allow access to read-only SPF files *
* E. Safford/SAIC 02/06 fix cfl_inqr call, make 3rd param long *
***********************************************************************/
{
int ipos, ier, ierr;
char newfil[FILE_FULLSZ];
char filepart[MXFLSZ], pathpart[LLPATH];
long localFlen;
/*---------------------------------------------------------------------*/
*iret = G_NORMAL;
*flen = 0;
/*
* Check if the file suffix is ".spf". If not, add it.
*/
cfl_path ( filnam, pathpart, filepart, &ier ) ;
cst_srch ( 0, strlen(filepart), ".spf", filepart, &ipos, &ier );
if ( ier == -4 ) {
strcat (filnam, ".spf");
}
/*
* Check the file status, if it exists, open it; otherwise, create
* it if authorized.
*/
cfl_inqr( filnam, NULL, &localFlen, newfil, &ier );
*flen = ( int ) localFlen;
if ( ier == 0 ) {
*fptr = cfl_aopn( filnam, &ierr );
if ( *fptr == NULL ) {
*fptr = cfl_ropn( filnam, NULL, &ierr );
if ( *fptr == NULL ) {
*iret = -2;
er_wmsg ( "CFL", &ierr, filnam, &ier, 3, strlen( filnam ) );
}
else {
*iret = 1;
}
}
}
else {
*iret = -1;
if ( crt == TRUE ) {
*fptr = ( FILE *) spf_create( filnam, flen, iret );
}
}
}
void aodtv64_runautomode ( int fcsttype, char *fcstfile, char *imagefile,
float *cenlat, float *cenlon, int *posm )
/***********************************************************************
* aodtv64_runautomode *
* *
* This function will get an initial storm center from a given forecast *
* file, and then use the given IR image to calculate the storm *
* center position. *
* *
* void aodtv64_runautomode ( fcsttype, fcstfile, imagefile, cenlat, *
* cenlon, posm ) *
* *
* Input parameters: *
* fcsttype int Forecast file type *
* *fcstfile char Forecast file *
* *imagefile char Image file *
* Output parameters: *
* *cenlat float latitude of storm center *
* *cenlon float longitude of storm center *
* *posm int positioning method *
* *
* Log: *
* M. Li/SAIC 01/07 Created *
* S. Gilbert/NCEP 01/07 Removed recalculation of lat/lons *
***********************************************************************/
{
int indx;
int iaodt, ier, ier2, pos, tpos;
int radius, irad, ii, jj, numx, numy;
size_t ifl, ipr;
float flat, flon, wlat, wlon;
float *ftmps, *flats, *flons, cenlon2, tlat, tlon;
float **temps, **lats, **lons;
char atcftype[80];
/*---------------------------------------------------------------------*/
/*
* Set forecast file in AODT
*/
strcpy(atcftype, "OFCL");
iaodt=aodtv64_setforecastfile(fcstfile,fcsttype,atcftype);
/*
* determine initial auto-center position estimate
*/
iaodt=aodtv64_runautomode1(&flat,&flon,&pos);
/*
* Set center location in AODT
*/
iaodt=aodtv64_setlocation(flat,flon,pos);
/*
* Read in IR image from imagefile
*/
radius = 500;
cenlon2 = -1.0 * flon;
irad = radius/4 + 5;
numx = numy = irad*2 + 1;
ftmps = (float *)malloc( (size_t)((numx)*(numy))* sizeof(float) );
flats = (float *)malloc( (size_t)((numx)*(numy)) * sizeof(float) );
flons = (float *)malloc( (size_t)((numx)*(numy)) * sizeof(float) );
im_gtmp ( imagefile, "dset", sys_M, &flat, &cenlon2, &irad,
&numx, &numy, ftmps, flats, flons, &ier2,
strlen(imagefile), strlen("dset"), strlen(sys_M) );
if ( ier2 != 0 ) {
er_wmsg ( "IM", &ier2, " ", &ier, strlen("IM"), strlen(" ") );
exit (0);
}
ifl = sizeof(float);
ipr = sizeof(float*);
temps = (float **)calloc((size_t)numy, ipr);
lats = (float **)calloc((size_t)numy, ipr);
lons = (float **)calloc((size_t)numy, ipr);
for ( jj = 0; jj < numy; jj++ ) {
temps[jj] = (float *)calloc((size_t)numx, ifl);
lats[jj] = (float *)calloc((size_t)numx, ifl);
lons[jj] = (float *)calloc((size_t)numx, ifl);
}
for ( jj = 0; jj < (numy); jj++ ) {
for ( ii = 0; ii < (numx); ii++ ) {
indx = jj*(numy)+ii;
temps[jj][ii] = ftmps[indx];
lats[jj][ii] = flats[indx];
lons[jj][ii] = flons[indx] *= -1.0F;
}
}
free ( flons );
free ( flats );
free ( ftmps );
/*
* Load the IR image information in AODT
*/
iaodt = aodtv64_loadIRimage ( temps, lats, lons, numx, numy );
for ( jj = 0; jj < numy; jj++ ) {
free ( temps[jj] );
free ( lats[jj] );
free ( lons[jj] );
}
free( lons );
free( lats );
free( temps );
/*
* Set warmest pixel temp value in AODT
*/
iaodt=aodtv64_getwarmeyetemplocation(&wlat, &wlon);
/*
* determine "best" automated position
*/
iaodt=aodtv64_runautomode2(flat, flon, &tlat, &tlon, &tpos);
*cenlat = tlat;
*cenlon = tlon;
*posm = tpos;
}
void na_gtbl ( const char *cpyfil, char *name, char *proj, int *nxgd,
int *nygd, float *garea, float *rnvblk, float *anlblk,
int *iret )
/************************************************************************
* na_gtbl *
* *
* This subroutine finds grid INNAME (a numerical or character *
* identifier prefaced by '#') in a grid navigation table, then makes *
* the navigation and analysis blocks. The grid navigation is set up *
* in GEMPLT in order to check its validity. *
* *
* na_gtbl ( cpyfil, name, proj, nxgd, nygd, garea, rnvblk, anlblk, *
* iret ) *
* *
* Input parameters: *
* *cpyfil const char Input for CPYFIL *
* *
* Output parameters: *
* *name char Name of selected grid *
* *proj char Grid projection *
* *nxgd int Number of points in x dir *
* *nygd int Number of points in y dir *
* *garea float Grid corners *
* *rnvblk float Grid navigation block *
* *anlblk float Grid analysis block *
* *iret int Return code *
* +1 = EXIT entered *
* 0 = normal return *
* -4 = invalid navigation *
* -9 = grid not found in table *
** *
* Log: *
* S. Jacobs/EAI 7/93 Copied from GDCTBL *
* D. Keiser/GSC 12/95 Changed FL_TOPN to FL_TBOP *
* R. Tian/SAIC 7/06 Recoded from Fortran *
* S. Gilbert/NCEP 10/06 Added call to GR_VNAV *
************************************************************************/
{
char gntrec[81], namgd[5], c2name[9], buffer[LLMXLN];
float angl1, angl2, angl3, dbnds[4], deln;
int angflg, found, valid;
int iebnds[4], ingrdn, numgd, extnd, ier, ier1, iernum, navsz, i;
FILE *lungrd;
/*----------------------------------------------------------------------*/
*iret = 0;
name[0] = '\0';
/*
* Get the grid number (INGRDN) out of NAME; a conversion error
* sets IERNUM .ne. 0 and it is assumed that NAME is a type.
*/
cst_lcuc ( (char *)cpyfil, c2name, &ier );
strcpy ( name, &c2name[1] );
cst_numb ( name, &ingrdn, &iernum );
/*
* Open the table of valid grid types.
*/
lungrd = cfl_tbop ( "grdnav.tbl", "grid", &ier );
if ( ier != 0 ) {
er_wmsg ( "CFL", &ier, "grdnav.tbl", &ier1,
strlen("CFL"), strlen("grdnav.tbl") );
*iret = -9;
return;
}
/*
* List the table contents for the user, if requested.
*/
if ( strcmp ( name, "LIST" ) == 0 ) {
while ( ! feof ( lungrd) ) {
cfl_trln ( lungrd, sizeof(gntrec), gntrec, &ier );
if ( ier != 0 ) break;
printf ( "%-79.79s\n", gntrec );
}
/*
* Rewind the table file.
*/
cfl_seek ( lungrd, 0, SEEK_SET, &ier );
/*
* Prompt user for grid choice.
*/
printf ( "Enter grid id or number or type EXIT: " );
scanf ( " %s", name );
if ( name[0] == 'e' || name[0] == 'E' ) {
*iret = +1;
return;
}
cst_lcuc ( name, name, &ier );
cst_numb ( name, &ingrdn, &iernum );
}
/*
* Read through the list of valid grid types/numbers to get
* navigation/analysis information.
*/
found = G_FALSE;
while ( ! feof ( lungrd ) ) {
cfl_trln ( lungrd, sizeof(buffer), buffer, &ier );
if ( ier != 0 ) break;
sscanf ( buffer, "%s %d %s %f %f %f %f %f %f %f %d %d %f %d",
namgd, &numgd, proj, &angl1, &angl2, &angl3,
&garea[0], &garea[1], &garea[2], &garea[3],
nxgd, nygd, &deln, &extnd );
if ( strcmp ( name, namgd ) == 0 || ingrdn == numgd ) {
found = G_TRUE;
break;
}
}
cfl_clos ( lungrd, &ier );
/*
* Bail out if NAME wasn't found in the table.
*/
if ( found == G_FALSE ) {
*iret = -9;
return;
}
/*
* Fill navigation block.
*/
angflg = G_TRUE;
gr_vnav ( proj, nxgd, nygd, &garea[0], &garea[1],
&garea[2], &garea[3], &angl1, &angl2, &angl3,
&angflg, &valid, &ier, strlen(proj) );
if ( ier == 0 )
grc_mnav ( proj, nxgd, nygd, &garea[0], &garea[1],
&garea[2], &garea[3], &angl1, &angl2, &angl3,
&angflg, rnvblk, &ier );
else {
*iret = -2;
return;
}
/*
* Set up navigation in GEMPLT to check validity.
*/
navsz = 13;
grc_snav ( &navsz, rnvblk, &ier );
if ( ier != 0 ) {
*iret = -4;
return;
}
/*
* Make an analysis block.
*/
for ( i = 0; i < 4; i++ ) {
iebnds[i] = extnd;
dbnds [i] = RMISSD;
}
grc_mbn2 ( &deln, iebnds, dbnds, rnvblk, anlblk, &ier );
return;
}
void de_swsprd ( const char *uarg, char *stprm, int *iret )
/************************************************************************
* de_swsprd *
* *
* This subroutine computes the weighted ensemble spread of its scalar *
* argument. *
* *
* de_swsprd ( uarg, stprm, iret ) *
* *
* Input and parameters: *
* *uarg const char Function argument string *
* *
* Output parameters: *
* *stprm char Substitution string *
* *iret int Return code *
* 0 = normal return *
* -8 = cannot parse argument *
* -9 = ensemble cannot computed *
** *
* Log: *
* m.gamazaychikov/SAIC 01/08 From de_ssprd *
* m.gamazaychikov/SAIC 01/08 Fixed the calculation problem *
* S. Jacobs/NCEP 8/09 Use double arrays internally *
* K. Brill/HPC 11/10 Set any negative sqrt argument to zero *
************************************************************************/
{
char tname[13], pdum[13], time1[21], time2[21];
char **argu;
int ns, ns2, num, kxd, kyd, ksub1, ksub2, level1, level2, ivcord,
nina, one, zero, i, j, ier, narg, numw, nsw;
float *gns, *gnum, *gwgt, *gnumw;
double *dgns, *dgns2, d1, d2, d3, d4;
/*----------------------------------------------------------------------*/
*iret = 0;
one = 1;
zero = 0;
dg_ssub ( iret );
/*
* Get new grid numbers.
*/
dg_nxts ( &ns, iret );
if ( *iret != 0 ) return;
dg_nxts ( &ns2, iret );
if ( *iret != 0 ) return;
/*
* Initialize the output grid.
*/
dg_getg ( &ns, &gns, &kxd, &kyd, &ksub1, &ksub2, iret );
G_MALLOC(dgns, double, kxd*kyd, "DE_SWSPRD");
G_MALLOC(dgns2, double, kxd*kyd, "DE_SWSPRD");
for ( i = ksub1 - 1; i < ksub2; i++ ) {
gns[i] = 0.;
dgns[i] = 0.;
dgns2[i] = 0.;
}
/*
* Set the number of input arguments. There could be two arguments.
*/
for ( i = 0; i < MXARGS; i++ ) {
_ensdiag.allarg[i][0] = '\0';
}
nina = 2;
argu = (char **)cmm_malloc2d ( 2, LLMXLN, sizeof(char), &ier );
cst_clst ( (char *)uarg, '&', " ", nina, LLMXLN, argu, &narg, &ier );
for ( i = 0; i < narg; i++ ) {
strcpy ( _ensdiag.allarg[i], argu[i] );
if ( i > 0 && strcmp(argu[i], " ") == 0 ) {
cst_rlch ( RMISSD, 1, _ensdiag.allarg[i], &ier );
}
}
cmm_free2d ( (void **) argu, &ier );
if ( narg < 1 ) {
*iret = -15;
return;
}
else if ( narg == 1 ) {
cst_rlch ( RMISSD, 1, _ensdiag.allarg[1], &ier );
}
else if ( narg == 2 ) {
dg_nxts ( &nsw, iret );
if ( *iret != 0 ) return;
dg_getg ( &nsw, &gwgt, &kxd, &kyd, &ksub1, &ksub2, iret );
for ( i = ksub1 - 1; i < ksub2; i++ ) {
gwgt[i] = 0.;
}
}
/*
* Scan the allarg array.
*/
de_scan ( &narg, iret );
if ( *iret != 0 ) return;
/*
* Loop over number of members set by DE_SCAN.
*/
for ( i = 0; i < _ensdiag.nummbr; i++ ) {
if ( narg == 2 ) {
de_mset ( &i, iret );
/*
* Compute weight grid and retrieve it from the stack.
*/
dg_pfun ( _ensdiag.allarg[1], iret );
if ( *iret != 0 ) {
er_wmsg ( "DG", iret, " ", &ier, strlen("DG"), strlen(" ") );
*iret = -8;
return;
}
dg_driv ( &one, iret );
if ( *iret != 0 ) {
er_wmsg ( "DG", iret, _ensdiag.allarg[1], &ier,
strlen("DG"), strlen(_ensdiag.allarg[1]) );
*iret = -9;
return;
}
dg_tops ( tname, &numw, time1, time2, &level1, &level2,
&ivcord, pdum, iret );
dg_getg ( &numw, &gnumw, &kxd, &kyd, &ksub1, &ksub2, iret );
/*
* Compute field grid and retrieve it from the stack.
*/
dg_pfun ( _ensdiag.allarg[0], iret );
if ( *iret != 0 ) {
er_wmsg ( "DG", iret, " ", &ier, strlen("DG"), strlen(" ") );
*iret = -8;
return;
}
dg_driv( &one, iret );
if ( *iret != 0 ) {
er_wmsg ( "DG", iret, _ensdiag.allarg[0], &ier,
strlen("DG"), strlen(_ensdiag.allarg[0]) );
*iret = -9;
return;
}
/*
* Retrieve the output grid from the stack. Check that the
* output is a scalar.
*/
dg_tops ( tname, &num, time1, time2, &level1, &level2,
&ivcord, pdum, iret );
dg_getg ( &num, &gnum, &kxd, &kyd, &ksub1, &ksub2, iret );
for ( j = ksub1 - 1; j < ksub2; j++ ) {
d1 = gnum[j];
d2 = dgns[j];
d3 = dgns2[j];
d4 = gnumw[j];
if ( ERMISS ( d1 ) || ERMISS ( d2 ) ||
ERMISS ( d3 ) || ERMISS ( d4 ) ) {
dgns[j] = RMISSD;
dgns2[j] = RMISSD;
gwgt[j] = RMISSD;
} else {
dgns[j] += d1 * d4;
dgns2[j] += d1 * d1 * d4;
gwgt[j] += d4;
}
}
dg_frig ( &numw, &ier );
dg_frig ( &num, &ier );
} else if ( narg == 1 ) {
de_mset ( &i, iret );
dg_pfun ( _ensdiag.allarg[0], iret );
if ( *iret != 0 ) {
er_wmsg ( "DG", iret, " ", &ier, strlen("DG"), strlen(" ") );
*iret = -8;
return;
}
dg_driv( &one, iret );
if ( *iret != 0 ) {
er_wmsg ( "DG", iret, _ensdiag.allarg[0], &ier,
strlen("DG"), strlen(_ensdiag.allarg[0]) );
*iret = -9;
return;
}
/*
* Retrieve the output grid from the stack. Check that the
* output is a scalar.
*/
dg_tops ( tname, &num, time1, time2, &level1, &level2,
&ivcord, pdum, iret );
dg_getg ( &num, &gnum, &kxd, &kyd, &ksub1, &ksub2, iret );
for ( j = ksub1 - 1; j < ksub2; j++ ) {
d1 = gnum[j];
d2 = dgns[j];
d3 = dgns2[j];
if ( ERMISS ( d1 ) || ERMISS ( d2 ) || ERMISS ( d3 ) ) {
dgns[j] = RMISSD;
dgns2[j] = RMISSD;;
} else {
dgns[j] += d1 * _ensdiag.enswts[i];
dgns2[j] += d1 * d1 * _ensdiag.enswts[i];
}
}
dg_frig ( &num, &ier );
}
}
/*
* Compute Variance.
*/
for ( i = ksub1 - 1; i < ksub2; i++ ) {
d2 = dgns[i];
d3 = dgns2[i];
if ( ERMISS ( d2 ) || ERMISS ( d3 ) ) {
dgns[i] = RMISSD;
} else {
if ( narg == 2) {
d1 = gwgt[i];
if ( ERMISS ( d1 ) ) {
dgns[i] = RMISSD;
} else {
dgns[i] = dgns[i]/gwgt[i];
dgns[i] = dgns2[i]/gwgt[i] - dgns[i] * dgns[i];
}
} else if ( narg == 1 ) {
dgns[i] = dgns2[i] - dgns[i] * dgns[i];
}
}
}
/*
* Compute spread (standard deviation).
*/
for ( i = ksub1 - 1; i < ksub2; i++ ) {
d2 = dgns[i];
if ( ERMISS ( d2 ) ) {
dgns[i] = RMISSD;
} else {
if ( dgns[i] < 0.0 ) {
dgns[i] = 0.0;
}
dgns[i] = sqrt ( dgns[i] );
}
}
/*
* Assign the result to the output array and free the internal arrays.
*/
for ( i = ksub1 - 1; i < ksub2; i++ ) {
gns[i] = (float)dgns[i];
}
G_FREE(dgns, double);
G_FREE(dgns2, double);
/*
* Reset DGCMN.CMN and set internal grid identifier.
*/
de_rset ( iret );
dg_udig ( "EXX_", &ns, &zero, &_ensdiag.idgens, stprm, iret );
dg_esub ( &ns, &zero, &zero, &zero, &ier );
if ( ier != 0 ) *iret = ier;
return;
}
void dg_tadc ( int *iret )
/************************************************************************
* dg_tadc *
* *
* This subroutine determines if an added column is required for the *
* transfer navigation. *
* *
* This subroutine sets the adcltg and gwrptg flags in the HINTRP block *
* of DGCMN.CMN *
* *
* The transfer navigation is assumed to be set in GPLT. *
* *
* dg_tadc ( iret ) *
* *
* Input parameters: *
* *
* Output parameters: *
* *iret int Return code *
* 0 = normal return *
** *
* Log: *
* K. Brill/HPC 3/04 Created from DG_ADCL *
* R. Tian/SAIC 2/06 Recoded from Fortran *
* K. Brill/HPC 11/11 Remove check for exceeding LLMXTG *
************************************************************************/
{
char gprj[5];
float rgx[2], rgy[2];
int mx, my, two, ier, ier2;
/*----------------------------------------------------------------------*/
*iret = 0;
two = 2;
_hintrp.gwrptg = G_FALSE;
_hintrp.adcltg = G_FALSE;
grc_rnav ( _hintrp.tfrnav, gprj, &mx, &my, &ier );
if ( strcmp ( gprj, "MER" ) == 0 || strcmp ( gprj, "CED" ) == 0 ) {
/* if ( ( my * (mx+1) ) > LLMXTG ) return; */
rgx[0] = 1.;
rgy[0] = 1.;
rgx[1] = (float)( mx + 1 );
rgy[1] = 1.;
gtrans ( sys_G, sys_M, &two, rgx, rgy, rgx, rgy, &ier,
strlen(sys_G), strlen(sys_M) );
if ( G_ABS ( rgy[0] - rgy[1] ) < 0.005 ||
( G_ABS ( rgy[0] + 180. ) < 0.005 &&
G_ABS ( rgy[1] - 180. ) < 0.005 ) ) {
mx += 1;
gsgprj ( gprj, &_hintrp.tfrnav[10], &_hintrp.tfrnav[11],
&_hintrp.tfrnav[12], &mx, &my, &_hintrp.tfrnav[6],
&_hintrp.tfrnav[7], &_hintrp.tfrnav[8], &_hintrp.tfrnav[7],
&ier, strlen(gprj) );
if ( ier != 0 ) {
er_wmsg ( "GEMPLT", &ier, " ", &ier2,
strlen("GEMPLT"), strlen(" " ) );
*iret = -7;
}
_hintrp.adcltg = G_TRUE;
_hintrp.gwrptg = G_TRUE;
return;
} else {
_hintrp.adcltg = G_FALSE;
}
}
if ( ( strcmp ( gprj, "MER" ) == 0 ) || ( strcmp ( gprj, "MCD" ) == 0 ) ||
( strcmp ( gprj, "CED" ) == 0 ) ) {
/*
* Set GWRAPG flag for globe wrapping grid.
*/
rgx[0] = 1.;
rgy[0] = 1.;
rgx[1] = (float)mx;
rgy[1] = 1.;
gtrans ( sys_G, sys_M, &two, rgx, rgy, rgx, rgy, &ier,
strlen(sys_G), strlen(sys_M) );
if ( G_ABS ( rgy[0] - rgy[1] ) < 0.005 ||
( G_ABS ( rgy[0] + 180. ) < 0.005 &&
G_ABS ( rgy[1] - 180. ) < 0.005 ) ) _hintrp.gwrptg = G_TRUE;
}
return;
}
void de_ssum ( const char *uarg, char *stprm, int *iret )
/************************************************************************
* de_ssum *
* *
* This subroutine computes the sum over the ensemble of a scalar. *
* *
* de_ssum ( uarg, stprm, iret ) *
* *
* Input and parameters: *
* *uarg const char Function argument string *
* *
* Output parameters: *
* *stprm char Substitution string *
* *iret int Return code *
* 0 = normal return *
* -8 = cannot parse argument *
* -9 = ensemble cannot computed *
** *
* Log: *
* K. Brill/HPC 08/10 Created from de_ssprd *
************************************************************************/
{
char tname[13], pdum[13], time1[21], time2[21];
int ns, num, kxd, kyd, ksub1, ksub2, level1, level2, ivcord,
nina, one, zero, i, j, ier;
float *gns, *gnum;
double *dgns, d1, d2;
/*----------------------------------------------------------------------*/
*iret = 0;
one = 1;
zero = 0;
dg_ssub ( iret );
/*
* Get a new grid number.
*/
dg_nxts ( &ns, iret );
if ( *iret != 0 ) return;
/*
* Initialize the output grid.
* Allocate internal double arrays.
*/
dg_getg ( &ns, &gns, &kxd, &kyd, &ksub1, &ksub2, iret );
G_MALLOC(dgns, double, kxd*kyd, "DE_SSUM");
for ( i = ksub1 - 1; i < ksub2; i++ ) {
gns[i] = 0.;
dgns[i] = 0.;
}
/*
* Set the number of input arguments. There is only one argument
* for DE_SSUM.
*/
nina = 1;
for ( i = 0; i < MXARGS; i++ ) {
_ensdiag.allarg[i][0] = '\0';
}
strcpy ( _ensdiag.allarg[0], uarg );
/*
* Scan the allarg array.
*/
de_scan ( &nina, iret );
if ( *iret != 0 ) return;
/*
* Loop over number of members set by DE_SCAN.
*/
for ( i = 0; i < _ensdiag.nummbr; i++ ) {
de_mset ( &i, iret );
dg_pfun ( _ensdiag.allarg[0], iret );
if ( *iret != 0 ) {
er_wmsg ( "DG", iret, " ", &ier, strlen("DG"), strlen(" ") );
*iret = -8;
return;
}
dg_driv( &one, iret );
if ( *iret != 0 ) {
er_wmsg ( "DG", iret, _ensdiag.allarg[0], &ier,
strlen("DG"), strlen(_ensdiag.allarg[0]) );
*iret = -9;
return;
}
/*
* Retrieve the output grid from the stack. Check that the
* output is a scalar.
*/
dg_tops ( tname, &num, time1, time2, &level1, &level2,
&ivcord, pdum, iret );
dg_getg ( &num, &gnum, &kxd, &kyd, &ksub1, &ksub2, iret );
for ( j = ksub1 - 1; j < ksub2; j++ ) {
d1 = gnum[j];
d2 = dgns[j];
if ( ERMISS ( d1 ) || ERMISS ( d2 ) ) {
dgns[j] = RMISSD;
} else {
dgns[j] += gnum[j];
}
}
dg_frig ( &num, &ier );
}
/*
* Assign the result to the output array and free the internal arrays.
*/
for ( i = ksub1 - 1; i < ksub2; i++ ) {
gns[i] = (float)dgns[i];
}
G_FREE(dgns, double);
/*
* Reset DGCMN.CMN and set internal grid identifier.
*/
de_rset ( iret );
dg_udig ( "EXX_", &ns, &zero, &_ensdiag.idgens, stprm, iret );
dg_esub ( &ns, &zero, &zero, &zero, &ier );
if ( ier != 0 ) *iret = ier;
return;
}
void pglpfw_loadLPF ( int *iret )
/************************************************************************
* pglpfw_loadLPF *
* *
* This function opens a LP file and load the VG files into different *
* layers by the specified color, fill modes, and group types. If the *
* the VG file does not exist, it will be created. *
* *
* void pglpfw_loadLPF ( iret ) *
* *
* Input parameters: *
* Output parameters: *
* *iret int 0 = normal *
* -1 = no file name *
* -2 = error on read *
* Return parameters: *
* NONE *
* *
** *
* Log: *
* T. Lee/SAIC 04/02 *
* T. Lee/SAIC 05/02 added layer display mode *
* E. Safford/SAIC 06/02 param change to ctb_lygetname *
* J. Wu/SAIC 12/02 fix the crashing from multi-exposures *
* H. Zeng/XTRIA 03/03 removed one call to pglayer_setDefGrp() *
* E. Safford/SAIC 04/04 ChngMade flag TRUE if outfile specified *
***********************************************************************/
{
Widget curwid;
char fname[FILE_FULLSZ], vfile[FILE_FULLSZ];
char outfile[FILE_FULLSZ];
char path[LLPATH];
char gtype[10], ugtype[10], laynam[10], mode[4], umode[4];
char cmode[5], ucmode[5], *cptr;
int ipos, ier, ier1, ntop, icolr, layer_num;
int ii, grpid;
Boolean can_open, outfile_ok;
/*---------------------------------------------------------------------*/
*iret = 0;
can_open = FALSE;
outfile_ok = FALSE;
if ( strlen(_fileName) <= (size_t)0 ) {
*iret = -1;
return;
}
else {
strcpy (fname, _dirPath);
strcat (fname, _fileName);
cst_srch ( 0, strlen(fname), ".lpf", fname, &ipos, &ier );
if ( ier == -4 ) {
strcat(fname, ".lpf");
}
}
/*
* Open the layer product file.
*/
ctb_lyrd ( fname, &ntop, &ier );
if ( ntop < 0 || ier < 0 ) {
er_wmsg ( "CTB", &ier, fname, &ier1, 3, strlen(fname) );
NxmErr_update();
pglayer_setChngMade ( 0, FALSE );
*iret = -2;
return;
}
/*
* Prompt error message if default is used.
*/
else if ( ier > 0 ) {
er_wmsg ( "CTB", &ier, " ", &ier1, 3, 1 );
NxmErr_update();
}
/*
* Delete all records and clear drawing area
*/
pgpalw_deleteAll();
/*
* Store the LPF into layer structure.
*/
ntop = G_MIN ( ntop, MAX_LAYERS );
curwid = pgpalw_getOperWid ( FUNC_LAYER );
pgpalw_setCurOper ( curwid );
pgpalw_actvLayer ( False );
for ( ii = 0; ii < ntop; ii++ ) {
/*
* Set color mode.
*/
ctb_lygetcmode ( ii, cmode, &ier );
cst_lcuc ( cmode, ucmode, &ier1 );
if ( strcmp ( ucmode, "MONO" ) == 0 ) {
pglayer_setDsplClr ( ii, FALSE );
}
else {
pglayer_setDsplClr ( ii, TRUE );
}
/*
* Set color ID.
*/
ctb_lygetcolor ( ii, &icolr, &ier );
if ( ier == 0 ) {
pglayer_setMonoClr ( ii, icolr );
}
else {
icolr = 19;
pglayer_setMonoClr ( ii, icolr );
}
/*
* Get the output VG file name
*/
outfile_ok = FALSE;
ctb_lygetoutfile( ii, outfile, &ier );
if ( strlen( outfile ) > (size_t)0 ) {
/*
* Check if the outfile is valid VG file. If the file does not exist,
* create it. If the file is invalid, an error message is generated.
*
* The outfile_ok flag signals a good outfile condition. Otherwise
* we have no outfile available.
*/
cvg_valid ( outfile, &ier );
if ( ier >= 0 ) {
outfile_ok = TRUE;
if ( ier > 0 ) {
cvg_crvgf( outfile, &ier );
ier = 2;
er_wmsg( "CVG", &ier, outfile, &ier1, 3, strlen(outfile) );
NxmErr_update();
}
}
else {
er_wmsg ( "CVG", &ier, outfile, &ier1, 3, strlen(vfile));
NxmErr_update();
}
}
/*
* Set input VG file name.
*/
ctb_lygetfile ( ii, vfile, &ier );
/*
* Check if this is a valid VG file.
*
* If the file does not exist, and we did not find a file and there,
* is no specified output file, then create one. If the file is
* invalid, an error message is written out.
*/
cvg_valid ( vfile, &ier );
if ( ier >= 0 ) {
can_open = TRUE;
if ( ier > 0 && !outfile_ok ) {
cvg_crvgf ( vfile, &ier );
ier = 2;
er_wmsg ( "CVG", &ier, vfile, &ier1, 3, strlen(vfile));
NxmErr_update();
}
}
else {
can_open = FALSE;
er_wmsg ( "CVG", &ier, vfile, &ier1, 3, strlen(vfile));
NxmErr_update();
}
if ( (cptr = strrchr (vfile, '/') ) == (char *) NULL) {
pglayer_setFileName ( ii, vfile );
strcpy (path, "./");
}
else {
cptr++;
pglayer_setFileName ( ii, cptr );
cptr[0] = '\0';
strcpy ( path, vfile );
}
pglayer_setFilePath ( ii, path );
/*
* Set group type.
*/
ctb_lygetgrptyp ( ii, gtype, &ier );
cst_lcuc ( gtype, ugtype, &ier1 );
if ( ier == 0 ) {
ces_gtgid ( ugtype, &grpid, &ier1 );
if ( ier1 == 0 ) {
pglayer_setDefGrp ( ii, grpid );
}
}
/*
* Set fill mode.
*/
ctb_lygetfmode ( ii, mode, &ier );
cst_lcuc ( mode, umode, &ier1 );
if ( strcmp (umode, "OFF") == 0 ) {
pglayer_setFill ( ii, FALSE );
}
else {
pglayer_setFill ( ii, TRUE );
}
/*
* Set display mode.
*/
ctb_lygetdsply ( ii, mode, &ier );
cst_lcuc ( mode, umode, &ier1 );
if ( strcmp (umode, "OFF") == 0 ) {
pglayer_setDsplOn ( ii, FALSE );
}
else {
pglayer_setDsplOn ( ii, TRUE );
}
/*
* Set layer name.
*/
ctb_lygetname ( ii, sizeof(laynam), laynam, &ier );
if ( ier == 0 ) {
pglayer_setName ( ii, laynam );
}
/*
* Prepare to draw in a new layer.
*/
pglpfw_prepLPF ( ii );
/*
* Reset flags for change mode.
*/
pglayer_setChngMade ( ii, FALSE );
/*
* Load VG files.
*/
if ( can_open ) {
pgfilw_openVGF (FALSE, &ier);
}
/*
* If the outfile_ok is true, then reset the file name for the layer.
*
* Also, since there is a specified output file in the lpf, set the
* save flag so any save to it is done without the initial Save As.
*/
if ( outfile_ok ) {
if ( (cptr = strrchr (outfile, '/') ) == (char *) NULL) {
pglayer_setFileName ( ii, outfile );
strcpy (path, "./");
}
else {
cptr++;
pglayer_setFileName ( ii, cptr );
cptr[0] = '\0';
strcpy ( path, outfile );
}
pglayer_setFilePath ( ii, path );
pglayer_setChngMade ( ii, TRUE );
pglayer_setFileSaved( ii, True );
}
}
/*
* If reaching MAX_LAYERS, set "ADD LAYER" button insensitive.
*/
layer_num = pglayer_getNumLayers();
if ( layer_num == MAX_LAYERS ) {
pgpalw_setBtnSntv ( FUNC_LAYER, FALSE );
}
/*
* Bring up the layering window.
*/
pglayrw_manageLayers ();
}
void dgc_nwdt ( const float *grid, const char *time1, const char *time2,
const int *level1, const int *level2, const int *ivcord,
const char *parm, const int *igdhdr, const char *gpack,
const int *rplc, int *iret )
/************************************************************************
* dgc_nwdt *
* *
* This subroutine writes a packed grid. *
* *
* dgc_nwdt ( grid, time1, time2, level1, level2, ivcord, parm, igdhdr, *
* gpack, rplc, iret ) *
* *
* Input parameters: *
* *grid const float Grid to write out *
* *time1 const char GEMPAK times *
* *time2 const char GEMPAK times *
* *level1 const int GEMPAK grid levle *
* *level2 const int GEMPAK grid levle *
* *ivcord const int Vertical coordinate *
* *parm const char GEMPAK parameter name *
* *igdhdr const int Grid header *
* *gpack const char Grid packing from user input *
* *rplc const int Flag to replace existing grid *
* *
* Output parameters: *
* *iret int Return code *
* 0 = normal return *
* -61 = grid file open failed *
** *
* Log: *
* R. Tian/SAIC 3/04 *
* R. Tian/SAIC 1/05 Changed LLNANV to LLNNAV *
* R. Tian/SAIC 5/05 Added outflg checking *
* D.W.Plummer/NCEP 5/05 Add calls to ER_WMSG *
* R. Tian/SAIC 3/06 Recoded from Fortran *
************************************************************************/
{
char filnam[MXFLSZ+1], fullnm[MXFLSZ+1];
float rnvblk[LLNNAV], adum1;
int same;
int iout, ifn, mxgd, ipktyp, nbits, navsz, zero, i, ier, ierr;
/*----------------------------------------------------------------------*/
*iret = 0;
navsz = LLNNAV;
zero = 0;
iout = -1;
for ( i = 0; i < NGDFLS; i++ ) {
if ( _nfile.outflg[i] == G_TRUE ) {
iout = i;
break;
}
}
if ( iout == -1 ) {
*iret = -61;
return;
}
/*
* Open the output file
*/
if ( _nfile.ntmplt[iout][0] != '\0' ) {
/*
* This entry is a template
*/
cfl_mnam ( (char *)time1, _nfile.ntmplt[iout], filnam, &ier );
strcpy ( fullnm, _nfile.gflpth[iout] );
strcat ( fullnm, "/" );
strcat ( fullnm, filnam );
} else {
/*
* This entry is an actual file
*/
strcpy ( fullnm, _nfile.crtfnm[iout] );
}
gd_open ( fullnm , &_nfile.outflg[iout], &zero, &navsz, &ifn, &adum1,
rnvblk, &mxgd, &ier, strlen(fullnm) );
if ( ier != 0 ) {
er_wmsg ( "GD", &ier, " ", &ierr, strlen("GD"), strlen(" ") );
*iret = -61;
return;
}
/*
* Compare the returned navigation with the internal navigation
*/
grc_cnav ( rnvblk, _dgfile.snav, &navsz, &same, &ier );
if ( ier != 0 ) {
er_wmsg ( "GR", &ier, " ", &ierr, strlen("GD"), strlen(" ") );
}
if ( same == G_FALSE ) {
*iret = -64;
return;
}
/*
* Write the packed grid
*/
grc_pack ( gpack, &ipktyp, &nbits, &ier );
cgd_wpgd ( &ifn, grid, &_dgfile.kxd, &_dgfile.kyd, igdhdr, time1, time2,
level1, level2, ivcord, parm, rplc, &ipktyp, &nbits, &ier );
if ( ier != 0 ) {
er_wmsg ( "GD", &ier, " ", &ierr, strlen("GD"), strlen(" ") );
*iret = -65;
return;
}
return;
}
void gb2_vcrd ( char *wmolvltbl, char *lcllvltbl, Gribmsg *cmsg,
int *levels, int *vcord, char *unit, int *iret )
/************************************************************************
* gb2_vcrd *
* *
* This routine computes the vertical coordinate level/layer values *
* from the GRIB2 PDS. Also, the GEMPAK vertical coordinate type is *
* obtained from the appropriate GRIB2 vertical coordinate table. *
* *
* If either wmolvltbl or lcllvltbl are NULL, the default tables are *
* read. *
* *
* gb2_vcrd ( wmolvltbl, lcllvltbl, cmsg, levels, vcord, iret ) *
* *
* Input parameters: *
* *wmolvltbl char WMO vertical coordinate table *
* *lcllvltbl char Local vertical coordinate table *
* *cmsg struct Gribmsg GRIB2 message structure *
* *
* Output parameters: *
* levels[2] int lower/upper level/layer values *
* *vcord int GEMPAK vertical goordinate type *
* *iret int return code *
* -27 = Unrecognized PDT number *
** *
* Log: *
* S. Gilbert/NCEP 11/04 *
* S. Gilbert/NCEP 10/05 Use new routines to read tables *
***********************************************************************/
{
int ret, ier, lvl1, lvl2, iver, lclver, ilen;
G2level g2lev;
G2lvls *g2lvltbl;
char vparm[12], ctemp[20];
float rlevel[2];
double sfact;
/*---------------------------------------------------------------------*/
*iret = 0;
/*
* Get Level into from vertical coordinate table(s).
*/
iver=cmsg->gfld->idsect[2];
lclver=cmsg->gfld->idsect[3];
lvl1=cmsg->gfld->ipdtmpl[9];
lvl2=cmsg->gfld->ipdtmpl[12];
if ( ( lvl1 < 192 || lvl1 == 255 ) &&
( lvl2 < 192 || lvl2 == 255 ) ) {
/*
* Get WMO vertical coordinate table.
*/
gb2_gtwmolvltbl( wmolvltbl, iver, &g2lvltbl, &ier);
if ( ier == 0 ) {
/*
* Get Level into from WMO vertical coordinate table.
*/
gb2_sklvl( lvl1, lvl2, g2lvltbl, &g2lev, &ier);
}
}
else {
/*
* Get Local vertical coordinate table.
*/
gb2_gtlcllvltbl( lcllvltbl, cmsg->origcntr, lclver, &g2lvltbl, &ier);
if ( ier == 0 ) {
/*
* Get Level into from Local vertical coordinate table.
*/
gb2_sklvl( lvl1, lvl2, g2lvltbl, &g2lev, &ier);
}
}
if ( ier != 0 ) {
*iret=ier;
if ( ier == -30 ) {
sprintf(ctemp,"%d|%d", lvl1, lvl2);
er_wmsg("GB",&ier,ctemp,&ret,2,strlen(ctemp));
}
return;
}
/*
* Calculate GEMPAK vertical coordinate type
*/
lv_cord ( g2lev.abbrev, vparm, vcord, &ier, 4, 12);
if ( ier != 0 ) {
*iret=-7;
return;
}
/*cst_lstr ( g2lev.unit, &ilen, &ier );*/
cst_rmbl ( g2lev.unit, unit, &ilen, &ier );
if ( ( strcmp(unit,"Pa") == 0 ) && ( g2lev.scale == -2 ) )
sprintf ( unit, "hPa\0" );
/*else
strncat( unit, g2lev.unit, ilen);*/
/*
* Extract vertical coordinate levels from GRIB2 PDS
*/
gb2_vlev ( cmsg->gfld, rlevel, &ier );
if ( ier != 0 ) {
*iret=ier;
return;
}
/*
* Scale level values by scale factor found in vertical
* coordinate table.
*/
sfact=pow((double)10.0,g2lev.scale);
levels[0] = (int)rint( rlevel[0] * sfact );
if ( rlevel[1] == -1.0 ) {
levels[1] = -1;
}
else {
levels[1] = (int)rint( rlevel[1] * sfact );
}
if ( lvl1 == 1 ) { /* Surface */
levels[0] = 0;
levels[1] = -1;
}
}
void de_prcntl ( const char *uarg, char *stprm, int *iret )
/************************************************************************
* de_prcntl *
* *
* This subroutine returns a value at each grid point such that the *
* value returned is greater than or equal to the value found at the *
* same grid point in P% of the weighted members of an ensemble. The *
* value of P ranges between 0 and 100 and may vary from grid point to *
* point. *
* *
* The relationship between the percentile value, p, and the index, k, *
* in the order statistics of count N is *
* *
* ( k - 1 ) / ( N - 1 ) = p (1) *
* *
* Rewriting this in terms of equally weighted order statistics *
* (multiplying both sides by (N-1)/N) yields *
* *
* (k-1)*(1/N) = p - p*(1/N) (2) *
* *
* Since k can have a fractional value, the weights may vary, and the *
* (1/N) subtracted on both sides of (2) must be the first weight value *
* (w(1)), the problem is one of finding integer K and residual weight *
* wr such that *
* *
* K *
* wr + SUM w(i) = p ( 1 - w(1) ) (3) *
* i=2 *
* *
* The value of wr is easily obtained by solving (3) after summing the *
* weights up to the point in the order statistics where adding on one *
* more weight exceeds the value of the R.H.S of (3). The value of wr *
* establishes the position in the weight summation to which to *
* interpolate the values of the order statistics, x, according to the *
* following linear relationship: *
* *
* wr / [ W(K+1) - W(K) ] = [ x - x(K) ] / [ x(K+1) - x(K) ] (4) *
* *
* In (4), W(K) is the summation of the weights from i=2 to K. The *
* percentile value is found by solving (4) for x. Since the denom- *
* inator on the L.H.S of (4) is just w(K+1), the value of x is *
* *
* x = x(K) + [ wr / w(K+1) ] * [ x(K+1) - x(K) ] (5) *
* *
* *
* de_prcntl ( uarg, stprm, iret ) *
* *
* Input and parameters: *
* *uarg const char Function argument string *
* *
* Output parameters: *
* *stprm char Substitution string *
* *iret int Return code *
* +3 = Percentile < 0 *
* +1 = Percentile > 100 *
* 0 = normal return *
* -8 = cannot parse argument *
* -9 = ensemble cannot computed *
* -15 = Incorrect # of arguments *
** *
* Log: *
* T. Lee/SAIC 01/05 *
* R. Tian/SAIC 1/06 Translated from Fortran *
* T. Piper/SAIC 08/06 Added G_DIFF *
* K. Brill/HPC 08/06 Fix to remove low bias; document eqtns *
* m.gamazaychikov/SAIC 01/08 Add ability to use weights *
************************************************************************/
{
char tname[13], pdum[13], time1[21], time2[21];
char **argu;
int igo, igp, num, kxd, kyd, ksub1, ksub2, nina, narg, level1, level2,
ivcord, zero, one, three, ii, jj, kk, ll, ier;
int wmesg, nmesg, iswflg, istop, iwpntr;
int nsw, numw;
float *gigo, *gigp, *gnum, data, swpbuf, pntt, psum, smw, wr,
*gnumw, *gwgt, d1;
/*----------------------------------------------------------------------*/
*iret = 0;
zero = 0;
one = 1;
three = 3;
dg_ssub ( iret );
/*
* Get a new grid number.
*/
dg_nxts ( &igo, iret );
if ( *iret != 0 ) return;
/*
* Initialize the output grid.
*/
dg_getg ( &igo, &gigo, &kxd, &kyd, &ksub1, &ksub2, iret );
for ( ii = ksub1 - 1; ii < ksub2; ii++ ) {
gigo[ii] = RMISSD;
}
/*
* Set the number of input arguments. There are two arguments
* for DE_PRCNTL.
*/
for ( ii = 0; ii < MXARGS; ii++ ) {
_ensdiag.allarg[ii][0] = '\0';
}
nina = 3;
argu = (char **)cmm_malloc2d ( 3, MXFLSZ+1, sizeof(char), &ier );
cst_clst ( (char *)uarg, '&', " ", nina, MXFLSZ, argu, &narg, &ier );
for ( ii = 0; ii < narg; ii++ ) {
strcpy ( _ensdiag.allarg[ii], argu[ii] );
}
/*
* If weight grid is provided get new grid number
* for sum-weight grid and initialize it
*/
if ( narg == 3 ) {
dg_nxts ( &nsw, iret );
if ( *iret != 0 ) return;
dg_getg ( &nsw, &gwgt, &kxd, &kyd, &ksub1, &ksub2, iret );
for ( ii = ksub1 - 1; ii < ksub2; ii++ ) {
gwgt[ii] = 0.;
}
}
cmm_free2d ( (void **) argu, &ier );
if ( narg < 2 ) {
*iret = -15;
return;
}
/*
* Scan the allarg array.
*/
de_scan ( &narg, iret );
if ( *iret != 0 ) return;
/*
* Evaluate the static argument defined by the second entry in
* uarg or allarg (2).
*/
dg_pfun ( _ensdiag.allarg[1], iret );
if ( *iret != 0 ) {
er_wmsg ( "DG", iret, " ", &ier, strlen("DG"), strlen(" ") );
*iret = -8;
return;
}
dg_driv ( &one, iret );
if ( *iret != 0 ) {
er_wmsg ( "DG", iret, _ensdiag.allarg[1], &ier,
strlen("DG"), strlen(_ensdiag.allarg[1]) );
*iret = -9;
return;
}
/*
* Retrieve the output grid from the stack. Check that the
* output is a scalar.
*/
dg_tops ( tname, &igp, time1, time2, &level1, &level2,
&ivcord, pdum, iret );
dg_getg ( &igp, &gigp, &kxd, &kyd, &ksub1, &ksub2, iret );
/*
* Loop over number of members set by DE_SCAN.
*/
for ( ii = 0; ii < _ensdiag.nummbr; ii++ ) {
de_mset ( &ii, iret );
dg_pfun ( _ensdiag.allarg[0], iret );
if ( *iret != 0 ) {
er_wmsg ( "DG", iret, " ", &ier, strlen("DG"), strlen(" ") );
*iret = -8;
return;
}
dg_driv ( &one, iret );
if ( *iret != 0 ) {
er_wmsg ( "DG", iret, _ensdiag.allarg[0], &ier,
strlen("DG"), strlen(_ensdiag.allarg[0]) );
*iret = -9;
return;
}
/*
* Retrieve the output grid from the stack and store the
* grid number.
*/
dg_tops ( tname, &num, time1, time2, &level1, &level2,
&ivcord, pdum, iret );
_ensdiag.iglist[ii] = num;
/*
* If the weight grid present store the starting index
* of the weight grid.
*/
if ( narg == 3 ) {
dg_pfun ( _ensdiag.allarg[2], iret );
if ( *iret != 0 ) {
er_wmsg ( "DG", iret, " ", &ier, strlen("DG"), strlen(" ") );
*iret = -8;
return;
}
dg_driv ( &one, iret );
if ( *iret != 0 ) {
er_wmsg ( "DG", iret, _ensdiag.allarg[2], &ier,
strlen("DG"), strlen(_ensdiag.allarg[2]) );
*iret = -9;
return;
}
dg_tops ( tname, &numw, time1, time2, &level1, &level2,
&ivcord, pdum, iret );
dg_getg ( &numw, &gnumw, &kxd, &kyd, &ksub1, &ksub2, iret );
_ensdiag.iwlist[ii] = numw;
/*
* the weight summing grid
*/
for ( jj = ksub1 - 1; jj < ksub2; jj++ ) {
d1 = gnumw[jj];
if ( ERMISS ( d1 ) || ERMISS ( gwgt[jj] ) ) {
gwgt[jj] = RMISSD;
} else {
gwgt[jj] += gnumw[jj];
}
}
}
}
wmesg = G_FALSE;
nmesg = G_FALSE;
for ( ll = ksub1 - 1; ll < ksub2; ll++ ) {
for ( ii = 0; ii < _ensdiag.nummbr; ii++ ) {
num = _ensdiag.iglist[ii];
dg_getg ( &num, &gnum, &kxd, &kyd, &ksub1, &ksub2, iret );
data = gnum[ll];
/*
* Fill out the weight array and normalize by the sum of weights
*/
if ( narg == 3 ) {
numw = _ensdiag.iwlist[ii];
dg_getg ( &numw, &gnumw, &kxd, &kyd, &ksub1, &ksub2, iret );
_ensdiag.ewtval[ii] = gnumw[ll] / gwgt[ll];
}
if ( ! ERMISS ( data ) ) {
_ensdiag.emvalu[ii] = data;
_ensdiag.igpntr[ii] = ii;
if ( ii == _ensdiag.nummbr - 1 ) {
/*
* Bubble sorting the grid values in emvalu with
* emvalue (1) lowest and emvalu (nummbr) highest.
*/
iswflg = 1;
istop = _ensdiag.nummbr - 1;
while ( iswflg != 0 && istop >= 0 ) {
iswflg = 0;
for ( kk = 0; kk < istop; kk++ ) {
if ( _ensdiag.emvalu[kk] > _ensdiag.emvalu[kk+1] ) {
iswflg = 1;
swpbuf = _ensdiag.emvalu[kk];
iwpntr = _ensdiag.igpntr[kk];
_ensdiag.emvalu[kk] = _ensdiag.emvalu[kk+1];
_ensdiag.igpntr[kk] = _ensdiag.igpntr[kk+1];
_ensdiag.emvalu[kk+1] = swpbuf;
_ensdiag.igpntr[kk+1] = iwpntr;
}
}
istop--;
}
/*
* Set normalized target percentile.
*/
pntt = gigp[ll] / 100.0F;
if ( pntt >= 1. ) {
gigo[ll] = _ensdiag.emvalu[_ensdiag.nummbr-1];
if ( pntt > 1.0F && wmesg == G_FALSE ) {
er_wmsg ( "DE", &one, " ", &ier,
strlen("DE"), strlen(" ") );
wmesg = G_TRUE;
}
} else if ( pntt <= 0. ) {
gigo[ll] = _ensdiag.emvalu[0];
if ( pntt < 0.0F && nmesg == G_FALSE ) {
er_wmsg ( "DE", &three, " ", &ier,
strlen("DE"), strlen(" ") );
nmesg = G_TRUE;
}
} else {
jj = 0;
psum = 0.0;
if ( narg == 3 ) {
pntt = pntt * ( 1.0F - _ensdiag.ewtval[_ensdiag.igpntr[0]] );
}
else {
pntt = pntt * ( 1.0F - _ensdiag.enswts[_ensdiag.igpntr[0]] );
}
while (jj < _ensdiag.nummbr - 1 && psum < pntt ) {
jj++;
/*
* The 1st weight ([0]) must be omitted from the
* summation.
*/
if ( narg == 3 ) {
psum += _ensdiag.ewtval[_ensdiag.igpntr[jj]];
}
else {
psum += _ensdiag.enswts[_ensdiag.igpntr[jj]];
}
}
/*
* Compute the percentile value for the output grid.
*/
if ( G_DIFF(psum, pntt) ) {
gigo[ll] = _ensdiag.emvalu[jj];
} else {
if ( narg == 3 ) {
smw = psum - _ensdiag.ewtval[_ensdiag.igpntr[jj]];
wr = pntt - smw;
if ( G_DIFF (_ensdiag.ewtval[_ensdiag.igpntr[jj]], 0.0F) ) {
gigo[ll] = RMISSD;
} else {
gigo[ll] = _ensdiag.emvalu[jj-1] +
( wr / _ensdiag.ewtval[_ensdiag.igpntr[jj]] ) *
(_ensdiag.emvalu[jj]-_ensdiag.emvalu[jj-1]);
}
}
else {
smw = psum - _ensdiag.enswts[_ensdiag.igpntr[jj]];
wr = pntt - smw;
if ( G_DIFF (_ensdiag.enswts[_ensdiag.igpntr[jj]], 0.0F) ) {
gigo[ll] = RMISSD;
} else {
gigo[ll] = _ensdiag.emvalu[jj-1] +
( wr / _ensdiag.enswts[_ensdiag.igpntr[jj]] ) *
(_ensdiag.emvalu[jj]-_ensdiag.emvalu[jj-1]);
}
}
}
}
}
}
}
}
/*
* Reset DGCMN.CMN and set internal grid identifier.
*/
de_rset ( iret );
dg_udig ( "EXX_", &igo, &zero, &_ensdiag.idgens, stprm, iret );
dg_esub ( &igo, &zero, &zero, &zero, &ier );
if ( ier != 0 ) *iret = ier;
return;
}
int guitst_gmpkInit ( Widget w )
/************************************************************************
* guitst_gmpkInit *
* *
* This function initializes GEMPAK variables. *
* *
* int guitst_gmpkInit(w) *
* *
* Input parameters: *
* w Widget widget ID *
* *
* Output parameters: *
* NONE *
* *
* Return parameters: *
* G_NORMAL successful *
* -1 error occured *
* *
** *
* Log: *
* C. Lin/EAI 02/93 *
* S. Wang/GSC 10/97 modified for guitst *
* S. Jacobs/NCEP 9/02 Updated to support 16 and 24 bit graphic*
***********************************************************************/
{
int gemscreen, iret=0, mode, ignore, respond;
char msg[]="Fatal Error: no graphic colors. Exit guitst.\n";
/*---------------------------------------------------------------------*/
/*
* Get root, colormap, visual, depth
*/
gemdisplay = XtDisplay(w);
gemscreen = DefaultScreen((XtPointer)gemdisplay);
root = DefaultRootWindow((XtPointer)gemdisplay);
gemmap = DefaultColormap((XtPointer)gemdisplay, gemscreen);
gemvis = DefaultVisual((XtPointer)gemdisplay, gemscreen);
/*
* Initialize the global color bank structure
*/
xgbank(gemdisplay, &iret);
if ( iret != 0 ) return(-1);
/*
* allocate read and write color cells for
* graphics
*/
xcaloc( GraphCid, &iret );
if ( iret == G_NCLRAL ) {
er_wmsg("gemplt", &iret, NULL, &ignore,
strlen("gemplt"), 0 );
return(-1);
}
else {
if ( iret == G_ZEROCB ) {
printf(msg);
return(-1);
}
}
xscint ( &iret );
/*
* initialize GEMPAK common blocks other than graphics
*/
ip_init( &respond, &iret );
/*
* initialize GEMPAK plotting package
*/
mode = 1;
gg_init( &mode, &iret );
return(G_NORMAL);
}
void gb2_gtwmolvltbl( char *wmolvltbl, int iver, G2lvls **g2levtbl, int *iret)
/************************************************************************
* gb2_gtwmolvltbl *
* *
* This function reads the WMO GRIB2 level/layer table from *
* specified file and returns a structure containing the table *
* entries *
* *
* If wmolvltbl is NULL, the default table is read. *
* *
* gb2_gtwmolvltbl ( wmolvltbl, iver, g2levtbl, iret ) *
* *
* Input parameters: *
* *wmolvltbl char WMO vertical coordinate table *
* iver int WMO Table version number *
* *
* Output parameters: *
* **g2levtbl G2lvls struct for level table entries *
* *iret int Return code *
* -29 = Error reading table *
** *
* Log: *
* S. Gilbert/NCEP 08/2005 *
***********************************************************************/
{
char tmpname[LLMXLN];
int ier;
static char currtable[LLMXLN];
static G2lvls currlvltbl={0,0};
/*---------------------------------------------------------------------*/
*iret = 0;
/*
* Check if user supplied table. If not, use default.
*/
if ( strlen(wmolvltbl) == (size_t)0 ) {
sprintf( tmpname,"g2vcrdwmo%d.tbl", iver );
}
else {
strcpy( tmpname, wmolvltbl );
}
/*
* Check if table has already been read in.
* If different table, read new one in.
*/
if ( strcmp( tmpname, currtable ) != 0 ) {
if ( currlvltbl.info != 0 ) {
free(currlvltbl.info);
currlvltbl.info=0;
currlvltbl.nlines=0;
}
printf(" Opening WMO GRIB2 Vertical Coordinate Table %s...\n",tmpname);
ctb_g2rdlvl( tmpname, &currlvltbl, &ier );
if ( ier != 0 ) {
currlvltbl.nlines=0;
*iret=-29;
er_wmsg("GB",iret,tmpname,&ier,2,strlen(tmpname));
*g2levtbl = &currlvltbl;
return;
}
}
strcpy( currtable, tmpname );
*g2levtbl = &currlvltbl;
}
