void utl_tomin ( float *anclat, float *anclon, float *newlat,
float *newlon, int *iret )
/************************************************************************
* utl_tomin *
* *
* This function converts lat/lon decimal to lat/lon minutes. *
* *
* utl_tomin ( anclat, anclon, newlat, newlon, iret ) *
* *
* Input parameters: *
* *anclat float *
* *anclon float *
* *
* Output parameters: *
* *newlat float *
* *newlon float *
* *iret int Return Code *
* *
* -3 = Latitude not in range *
* -4 = Longitude not in range *
** *
* Log: *
* A. Hardy/NCEP 5/03 Copied from VFTOMIN *
***********************************************************************/
{
int lattmp, lontmp;
/*-------------------------------------------------------------------*/
*iret = 0;
/*
* Check for valid latitude and longitude values.
*/
if ( ( *anclat< -90.0 ) || ( *anclat > 90.0 ) ) {
*iret = -3;
return;
}
if ( ( *anclon < -180.0 ) || ( *anclon > 180.0 ) ) {
*iret = -4;
return;
}
/*
* Convert latitude from decimal to minutes.
*/
lattmp = DDTODM ( G_ABS( *anclat ) );
*newlat = (float)lattmp / 100.0F;
/*
* Convert longitude from decimal to minutes.
*/
lontmp = DDTODM ( G_ABS( *anclon ) );
*newlon = (float)lontmp / 100.0F;
}
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;
}
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 df_ne ( int *iret )
/************************************************************************
* df_ne *
* *
* This function is invoked as NE ( S1, S2, S3 ). It returns 1 *
* if |S1-S2| > S3; otherwise 0. *
* *
* df_ne ( iret ) *
* *
* Input parameters: *
* *
* Output parameters: *
*iret int Return code *
* 0 - normal return *
** *
* Log: *
* m.gamazaychikov/SAIC 09/05 *
* R. Tian/SAIC 11/05 Recoded from Fortran *
************************************************************************/
{
int num1, num2, num3, num, kxd, kyd, ksub1, ksub2, i, im1, zero, ier;
float *gnum1, *gnum2, *gnum3, *gnum, dg1, dg2, dg3;
/*----------------------------------------------------------------------*/
*iret = 0;
dg_ssub ( iret );
/*
* Get three grids from the stack.
*/
dg_gets ( &num1, iret );
if ( *iret != 0 ) return;
dg_gets ( &num2, iret );
if ( *iret != 0 ) return;
dg_gets ( &num3, iret );
if ( *iret != 0 ) return;
/*
* Get a new grid number and check the grids.
*/
dg_nxts ( &num, iret );
if ( *iret != 0 ) return;
/*
* Grid number to grid.
*/
dg_getg ( &num1, &gnum1, &kxd, &kyd, &ksub1, &ksub2, iret );
dg_getg ( &num2, &gnum2, &kxd, &kyd, &ksub1, &ksub2, iret );
dg_getg ( &num3, &gnum3, &kxd, &kyd, &ksub1, &ksub2, iret );
dg_getg ( &num, &gnum, &kxd, &kyd, &ksub1, &ksub2, iret );
for ( i = ksub1; i <= ksub2; i++ ) {
im1 = i - 1;
dg1 = gnum1[im1];
dg2 = gnum2[im1];
dg3 = gnum3[im1];
if ( ERMISS ( dg1 ) || ERMISS ( dg2 ) || ERMISS ( dg3 ) ) {
gnum[im1] = RMISSD;
} else {
if ( G_ABS ( dg1 - dg2 ) > dg3 ) {
gnum[im1] = 1.0;
} else {
gnum[im1] = 0.0;
}
}
}
/*
* Get a name of the form 'NE'//S1//S2 and update header;
* update stack.
*/
dg_updh ( "NE", &num, &num1, &num2, iret );
dg_puts ( &num, iret );
dg_esub ( &num, &zero, &zero, &zero, &ier );
if ( ier != 0 ) *iret = ier;
return;
}
void clo_ddenc ( char *type, int format, float lat, float lon, char *str,
int *iret )
/************************************************************************
* clo_ddenc *
* *
* This function returns gets the string for the seek and location *
* structure indicating which entry matches the input CLO name for the *
* given latitude and longitude. The format code is in a 4-5 digit *
* format (Eg. 5212 or 10212). The columns are formatted as follows : *
* *
* *
* ROUNDING UNITS DIRECTION DISPLAY *
* *
* 5 - nearest 5 0 - omit 0 - omit 0 - degrees *
* 10 - nearest 10 1 - NM 1 - 16 point 1 - decimal/minutes *
* 2 - SM 2 - degrees 2 - 1st column *
* 3 - KM 4 - 3rd column *
* *
* For DISPLAY, the 1st column is usually the station id and the 3rd *
* column is the name of the station, city or county. *
* *
* clo_ddenc ( type, format, lat, lon, str, iret) *
* *
* Input parameters: *
* *type char Name of CLO parameter *
* format int Indicator of format to use *
* lat float Latitude point *
* lon float Longitude point *
* *
* Output parameters: *
* *str char Character string location *
* *iret int Return value *
* = < 0 - String not created *
* *
** *
* Log: *
* A. Hardy/GSC 01/00 Create *
* A. Hardy/GSC 01/00 Added new format display option *
* A. Hardy/GSC 01/00 Added length chk of str;changed rounding*
* A. Hardy/GSC 02/00 modified for all variations of formats *
* A. Hardy/GSC 02/00 reworked string display; city locations *
* D.W.Plummer/NCEP 8/00 changes for clo_ redesign *
* A. Hardy/GSC 8/00 renamed from clo_format *
* T. Piper/GSC 3/01 Fixed IRIX6 compiler warnings *
* D.W.Plummer/NCEP 8/01 Repl clo_bqinfo w/ cst_gtag *
* D.W.Plummer/NCEP 6/05 Tens digit sets # decimals for lat,lon *
***********************************************************************/
{
int idist, icmp, nh, ier;
int ilat, ilon, imnt, imnn, isit, isin;
char stn[80], idx[80], *pidx, sdir[4];
float dist, dir;
int ione, itens, ihund, irnd, which, inlen;
int isln, iwidth, ilftovr;
char sdirc[5], sdist[5];
char info[128], fmt[20];
/*---------------------------------------------------------------------*/
*iret = 0;
strcpy ( str, "NULL" );
iwidth = 16;
/*
* Parse out format into it's components.
*/
ione = format % 10;
itens = (int) (format/10) % 10;
ihund = (int) (format/100) % 10;
irnd = format / 1000;
/*
* Check one's place for lat-lon or deg-min.
*/
if ( ione == 0 ) { /* show lat/lon */
/*
* Tens digit controls the number of decimal digits for the
* lat,lon display. The default is 2 digits.
*/
if ( itens == 0 ) itens = 2;
sprintf(fmt,"%%.%df, %%.%df", itens, itens );
sprintf(str, fmt, lat, lon);
}
else if ( ione == 1 ) { /* show lat/lon as deg-min */
isit = ( lat < 0.0F ) ? '-' : ' ';
ilat = (int) G_ABS ( lat );
imnt = G_NINT ( ( G_ABS(lat) - (float)ilat ) * 60.0F );
if ( imnt >= 60 ) {
imnt = imnt % 60;
ilat += 1;
}
isin = ( lon < 0.0F ) ? '-' : ' ';
ilon = (int) G_ABS ( lon );
imnn = G_NINT ( ( G_ABS(lon) - (float)ilon ) * 60.0F );
if ( imnn >= 60 ) {
imnn = imnn % 60;
ilon += 1;
}
sprintf ( str, "%c%3d:%02d, %c%3d:%02d",
isit, ilat, imnt, isin, ilon, imnn );
}
else { /* show city/county/stn */
which = clo_which ( type );
if ( clo.loc[which].format == 1 ) { /* show bound */
clo_tqbnd ( type, lat, lon, idx, &ier);
pidx = idx;
/*
* Find and save the county FIPS id.
*/
if ( ione == 2) {
if (strcmp ( pidx,"-") != 0 ) {
clo_bginfo ( type, 0, info, &ier );
cst_gtag ( "FIPS", info, "?", str, &ier );
}
else {
cst_split (pidx, ' ', 14, str, &ier);
}
}
if ( ione == 4) { /* Save the bound name */
cst_split (pidx, ' ', 14, str, &ier);
}
}
else {
if ( clo.loc[which].format == 0 ) { /* show station */
/*
* get station ID, distance and direction.
*/
clo_tdirect ( type, lat, lon, stn, &dist, &dir, &ier );
if ( ione == 4 ) {
/*
* Replace station ID w/ station name.
*/
clo_tgnm ( type, 1, sizeof(stn), &nh, stn, &ier );
}
}
if ( ihund == 0 ) {
strcpy ( sdirc, "" );
}
else {
if ( ihund == 1 ) { /* get nautical miles */
dist *= M2NM;
}
else if ( ihund == 2 ) { /* get statute miles */
dist *= M2SM;
}
else if ( ihund == 3 ) { /* get kilometers */
dist /= 1000.0F;
}
if ( irnd > 0 ) {
idist = G_NINT ( dist / (float)irnd ) * irnd;
sprintf ( sdirc, "%i ", idist);
}
else if ( irnd < 0 ) {
irnd = 1;
idist = G_NINT ( dist / (float)irnd ) * irnd;
sprintf ( sdirc, "%i ", idist);
}
else if ( irnd == 0 ) {
strcpy ( sdirc, "" );
}
}
if ( itens == 0 ) { /* omit the direction */
strcpy ( sdist, "" );
}
else {
if ( itens == 1 ) { /* use 16 point dir. */
clo_compass ( &dir, sdir, &icmp, &ier );
sprintf ( sdist, "%s", sdir );
}
else if ( itens == 2 ) { /* use degrees */
sprintf ( sdist, "%.0f", dir );
}
}
sprintf(str, "%s %s",sdirc, sdist);
/*
* If the stn name is longer than 4 chars, print
*/
inlen = (int)strlen(stn);
isln = (int)strlen(str);
ilftovr = iwidth - isln;
if (inlen > 4 ) {
sprintf ( str, "%*s %.*s", isln, str, ilftovr, stn );
}
else {
sprintf ( str, "%s %3s", str, stn );
}
if ( (ihund == 0 ) && ( itens == 0 ) ) {
sprintf ( str, "%.*s", ilftovr, stn );
}
}
}
if ( strcmp ( str, "NULL") != 0 ) *iret = -1;
}
int main ( int argc, char *argv[] )
/************************************************************************
* sigavgf *
* *
* This program reads Significant Weather ASCII files and encodes the *
* information into a VG file format. *
* *
* command line: *
* sigavgf dattim hh *
* dattim GEMPAK date/time string *
* hh Valid time (hours) - must be 18 or 24 *
** *
* Log: *
* A. Hardy/SAIC 3/02 Created *
* A. Hardy/SAIC 5/02 Added optional input file name; changed *
* default input file name *
* M. Li/SAIC 7/04 Removed grpch from sigajet *
* M. Li/SAIC 9/04 Add idcent, chbase and chtop to cas_rdhdr*
* M. Li/SAIC 1/05 Process SWM *
* M. Li/SAIC 10/05 Checked for new format of jet info *
***********************************************************************/
{
int ier, numerr, leverr, pagflg, grpid, iret;
int itime[5], jtime[5], idcent;
float chbase, chtop;
int numtrp, rnum, lnum, hnum, membx, memhi, memlo;
int memcld, memmcld, memfrt, memjet, memstm, memtur, memvlr;
int numcld, nummcld, numfrt, numjet, numstm, numtur, numvlr;
char fhour [3], fname[256], gtstr[12], grpch, chlvl[10];
char errgrp[8], cc[50], casgrp[4];
char path[256];
char newflvl[10];
long size;
cloud_t *ptrc, *head, *ptr2;
mcloud_t *ptrm, *headm, *ptr2m;
jets_t *ptrj, *headj, *ptr2j;
front_t *ptrf, *headf, *ptr2f;
turb_t *ptrb, *headb, *ptr2b;
storm_t *ptrs, *heads, *ptr2s;
volrad_t *ptrv, *headv, *ptr2v;
trop_t *ptrr, *headr, *ptr2r;
trophi_t *ptrh, *headh, *ptr2h;
troplo_t *ptrl, *headl, *ptr2l;
Boolean readflg;
FILE *ifpout;
/*---------------------------------------------------------------------*/
iret = 0;
leverr = 0;
readflg = True;
ifpout = NULL;
strcpy ( errgrp, "SIGAVGF" );
strcpy ( casgrp, "CAS");
strcpy ( cc, " " );
rnum = lnum = hnum = 0;
membx = memhi = memlo = 0;
memcld = memmcld = memfrt = memjet = memstm = memtur = memvlr = 0;
numcld = nummcld = numfrt = numjet = numstm = numtur = numvlr = 0;
ptrc = NULL;
ptrm = NULL;
ptrj = NULL;
ptrf = NULL;
ptrb = NULL;
ptrs = NULL;
ptrv = NULL;
ptrr = NULL;
ptrh = NULL;
ptrl = NULL;
in_bdta ( &ier );
/*
* If the forecast hour is not on the command line, print help
* and exit.
*/
if ( argc < 3 ) {
pagflg = G_FALSE;
ip_help ( errgrp, &pagflg, &ier,
strlen(errgrp) );
numerr = -1;
er_lmsg ( &leverr, errgrp, &numerr, cc, &ier,
strlen(errgrp), strlen(cc) );
exit (1);
}
strcpy ( fhour, argv[2] );
if ( strcmp ( fhour, "24") != 0 ) {
if ( strcmp ( fhour, "18") != 0 ) {
numerr = -2;
er_lmsg ( &leverr, errgrp, &numerr, fhour, &ier,
strlen(errgrp), strlen(fhour) );
exit (1);
}
}
/*
* Check for input file.
*/
if ( argv[3] != NULL ) {
strcpy ( fname, argv[3] );
}
else {
/*
* If an input file is not specified, check for the existence of
* either SIGWXHI.txt or SIGWXMID.txt.
*/
sprintf ( fname, "SIGWXHI.txt" );
cfl_inqr ( fname, NULL, &size, path, &ier );
if ( ier != 0 ) {
sprintf ( fname, "SIGWXMID.txt" );
cfl_inqr ( fname, NULL, &size, path, &ier );
if ( ier != 0 ) {
numerr = -3;
er_lmsg ( &leverr, errgrp, &numerr, fname, &ier,
strlen(errgrp), strlen(fname) );
exit (1);
}
}
}
ifpout = cas_open ( fname, readflg, &ier );
/*
* If input ASCII file failed to open, exit program.
*/
if ( ier != 0 ) {
numerr = -3;
er_lmsg ( &leverr, errgrp, &numerr, fname, &ier,
strlen(errgrp), strlen(fname) );
exit (1);
}
/*
* Read in the input ASCII file into the CAS structures.
*/
cas_rdhdr ( ifpout, itime, jtime, &idcent, &chbase, &chtop, &ier );
rewind (ifpout);
if ( G_ABS ( HI_BASE - chbase ) < 0.5F &&
G_ABS ( HI_TOP - chtop ) < 0.5F ) {
strcpy ( chlvl, "SWH" );
cas_rdcld ( ifpout, &numcld, &ptrc, &memcld, &ier );
} else if ( G_ABS ( MID_BASE - chbase ) < 0.5F &&
G_ABS ( MID_TOP - chtop ) < 0.5F ) {
strcpy ( chlvl, "SWM" );
cas_rdmcld ( ifpout, &nummcld, &ptrm, &memmcld, &ier );
}
rewind (ifpout);
cas_rdjets ( ifpout, &numjet, &ptrj, &memjet, &ier );
rewind (ifpout);
cas_rdturb ( ifpout, &numtur, &ptrb, &memtur, &ier );
rewind (ifpout);
cas_rdfrt ( ifpout, &numfrt, &ptrf, &memfrt, &ier);
rewind (ifpout);
cas_rdtrop ( ifpout, &numtrp, &ptrr, &membx, &rnum,
&ptrl, &memlo, &lnum, &ptrh, &memhi,
&hnum, &ier );
rewind (ifpout);
cas_rdstm ( ifpout, &numstm, &ptrs, &memstm, &ier );
rewind (ifpout);
cas_rdvlrd ( ifpout, &numvlr, &ptrv, &memvlr, &ier );
/*
* Close input file.
*/
cas_clos ( ifpout, &ier );
/*
* If ASCII file failed to close, write error message.
*/
if ( ier != 0 ) {
numerr = -4;
er_lmsg ( &leverr, casgrp, &numerr, fname, &ier,
strlen(casgrp), strlen(fname) );
}
/*
* Initialize the group type table.
*/
ces_gtrtbl ( &iret );
/*
* Call appropriate VG file encoding subroutines.
*
* Create cloud VG file.
*/
strcpy ( gtstr, "CLOUD");
ces_gtgid (gtstr, &grpid, &ier);
grpch = (char) grpid;
if ( strcmp ( chlvl, "SWH" ) == 0 ) {
sigacld ( fhour, numcld, ptrc, itime, grpch, &ier );
}
else {
sigamcld ( fhour, nummcld, ptrm, itime, grpch, &ier );
}
/*
* Create jets VG file.
*/
ctb_rdprf ( "prefs.tbl", "config", "SIGWX_FLIGHT_LEVELS", newflvl, &ier );
sigajet ( fhour, numjet, ptrj, itime, chlvl, newflvl, &ier );
/*
* Create turbulence VG file.
*/
strcpy ( gtstr, "TURB");
ces_gtgid (gtstr, &grpid, &ier);
grpch = (char) grpid;
sigatur ( fhour, numtur, ptrb, itime, grpch, chlvl, &ier );
/*
* Create front VG file.
*/
strcpy ( gtstr, "FRONT");
ces_gtgid (gtstr, &grpid, &ier);
grpch = (char) grpid;
sigafrt ( fhour, numfrt, ptrf, itime, grpch, chlvl, &ier );
/*
* Create tropopause VG file.
*/
sigatrp ( fhour, rnum, ptrr, hnum, ptrh, lnum, ptrl,
itime, chlvl, &ier );
/*
* Create symbol VG file.
*/
strcpy ( gtstr, "LABEL");
ces_gtgid (gtstr, &grpid, &ier);
grpch = (char) grpid;
sigavts ( fhour, numstm, ptrs, numvlr, ptrv,
itime, grpch, chlvl, &ier );
/*
* Free all created linked lists.
*/
/* Free cloud */
if ( memcld ) {
head = ptrc;
ptr2 = head -> next;
while ( ptr2 != NULL ) {
free (head);
head = ptr2;
ptr2 = ptr2 -> next;
}
free ( head );
}
/* Free mcloud */
if ( memmcld ) {
headm = ptrm;
ptr2m = headm -> next;
while ( ptr2m != NULL ) {
free (headm);
headm = ptr2m;
ptr2m = ptr2m -> next;
}
free ( headm );
}
/* Free jet */
if ( memjet ) {
headj = ptrj;
ptr2j = headj -> next;
while ( ptr2j != NULL ) {
free (headj);
headj = ptr2j;
ptr2j = ptr2j -> next;
}
free ( headj );
}
/* Free turb */
if ( memtur ) {
headb = ptrb;
ptr2b = headb -> next;
while ( ptr2b != NULL ) {
free (headb);
headb = ptr2b;
ptr2b = ptr2b -> next;
}
free ( headb );
}
/* Free front*/
if ( memfrt ) {
headf = ptrf;
ptr2f = headf -> next;
while ( ptr2f != NULL ) {
free (headf);
headf = ptr2f;
ptr2f = ptr2f -> next;
}
free ( headf );
}
/* Free trop*/
if ( membx ) {
headr = ptrr;
ptr2r = headr -> next;
while ( ptr2r != NULL ) {
free ( headr );
headr = ptr2r;
ptr2r = ptr2r -> next;
}
free ( headr );
}
if ( memhi ) {
headh = ptrh;
ptr2h = headh -> next;
while ( ptr2h != NULL ) {
free ( headh );
headh = ptr2h;
ptr2h = ptr2h -> next;
}
free ( headh );
}
if ( memlo ) {
headl = ptrl;
ptr2l = headl -> next;
while ( ptr2l != NULL ) {
free ( headl );
headl = ptr2l;
ptr2l = ptr2l -> next;
}
free ( headl );
}
if ( memstm ) {
heads = ptrs;
ptr2s = heads -> next;
while ( ptr2s != NULL ) {
free ( heads );
heads = ptr2s;
ptr2s = ptr2s -> next;
}
free ( heads );
}
if ( memvlr ) {
headv = ptrv;
ptr2v = headv -> next;
while ( ptr2v != NULL ) {
free ( headv );
headv = ptr2v;
ptr2v = ptr2v -> next;
}
free ( headv );
}
return 0;
}
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 clo_from ( int vgtype, int reorder, int npin, int flag, float *lat,
float *lon, int maxchar, char *str, int *iret )
/************************************************************************
* clo_from *
* *
* This function returns a "from" line given a series of lat-lon *
* coordinates. The format of the "from" line is determined by vgtype. *
* The parameter reorder is an indicator whether the points consist of *
* an area which is closed and the points should be re-ordered in a *
* clockwise fashion, if necessary, and that the first point listed in *
* the "from" line is the northernmost point. The flag parameter *
* indicates whether lat-lon coordinates in International SIGMETs are to*
* be formatted with direction prepended (flag==0) or with direction *
* postpended (flag==1) or as VOR (flag==2). *
* *
* clo_from ( vgtype, reorder, npin, flag, lat, lon, maxchar, *
* str, iret ) *
* *
* Input parameters: *
* vgtype int VG type of "from" line *
* reorder int VG reorder of "from" line *
* npin int Number of points *
* flag int Flag for coordinate format *
* *lat float Latitudes *
* *lon float Longitudes *
* maxchar int Maximum number of chars in str *
* *
* Output parameters: *
* *str char "From" line string *
* *iret int Return value *
* = 0 - OK *
* *
** *
* Log: *
* D.W.Plummer/NCEP 7/99 Create *
* D.W.Plummer/NCEP 8/99 Add CONVSIG, NCONVSIG, CONVOLK & AIRMET *
* D.W.Plummer/NCEP 9/99 Sort area types northernmost & clockwise*
* M. Li/GSC 10/99 Modified clo_direct and clo_compass code*
* A. Hardy/GSC 12/99 Added flag for lat/lon *
* D.W.Plummer/NCEP 12/99 Added processing for WSM_ELM vgtype *
* F. J. Yen/NCEP 8/00 Made intl sig lat/lon at least 4 digits *
* D.W.Plummer/NCEP 2/01 Changed units of WSM from NM to SM *
* D.W.Plummer/NCEP 5/01 Simplified conversion of DD to DM *
* D.W.Plummer/NCEP 5/01 Added chk of pt order for SIGTYP_LINE *
* D.W.Plummer/NCEP 6/01 Change criteria for line point ordering *
* D.W.Plummer/NCEP 10/01 Change meaning of flag for intl sigmets *
* from dd or dms to pre or post ordinate *
* m.gamazaychikov/SAIC 9/02 remove portion of the code duplicating *
* function clo_reorder; *
* add call to clo_reorder *
* S. Jacobs/NCEP 10/02 Increased np for area type *
* F. J. Yen/NCEP 1/04 Handled VOR format for intl SIGMETs. *
* Updated and corrected prolog about flag.*
* J. Lewis/AWC 3/05 Added chk for new from line format *
* J. Lewis/AWC 6/05 remove reference to LLMXPT *
* B. Yin/SAIC 6/05 increase indx size by 1 besause of np++ *
* D.W.Plummer/NCEP 7/05 Add NEW_VAA_LATLON_FORMAT and VAA type *
* S. Jacobs/NCEP 9/05 Add break to WSM case before VAA *
* B. Yin/SAIC 10/05 Add separator flags for GFAs *
* B. Yin/SAIC 1/06 remove the space around hyphen *
* D.W.Plummer/NCEP 11/06 Explicit processing for GFAs *
* D.W.Plummer/NCEP 01/07 clo_tmatch for GFAs, not clo_tclosest *
* K. Tyle/UAlbany 11/10 Increased dimension of prefs_tag *
***********************************************************************/
{
int ii, jj, idist, np, ier, icmp;
float dist, dir, minlat, maxlat, dlat;
char tstr[8], id[9], dir16[4], prefs_tag[22];
char vaafmt[20], vaasep[8];
int *indx;
int lattmp, lontmp;
int line_order, reverse, format_type;
Boolean newcoord, newvaacoord;
int n_nms, nclose;
char nm[17];
float GFAtol=GFA_TOL;
/*---------------------------------------------------------------------*/
*iret = 0;
str[0] = '\0';
/*
* Check if the new coordinate format is to be used.
*/
strcpy ( prefs_tag, "NEW_LATLON_FORMAT" );
ctb_pfbool ( prefs_tag, &newcoord, &ier );
strcpy ( prefs_tag, "NEW_VAA_LATLON_FORMAT" );
ctb_pfbool ( prefs_tag, &newvaacoord, &ier );
/*
* Allocate memory.
*/
G_MALLOC ( indx, int, npin + 1, "CLO_FROM" );
np = npin;
for ( jj = 0; jj < np; jj++ ) indx[jj] = jj;
if ( reorder == SIGTYP_AREA ) {
clo_reorder( np, lat, lon, indx, iret );
np++;
}
else if ( reorder == SIGTYP_LINE ) {
/*
* If reorder is a line, re-order processing of
* points to do either west-to-east or north-to-south.
* West-to-east defined as all points within W2ELIM
* degrees of one another.
*/
minlat = lat[0];
maxlat = minlat;
for ( jj = 1; jj < np; jj++ ) {
minlat = G_MIN ( minlat, lat[jj] );
maxlat = G_MAX ( maxlat, lat[jj] );
}
dlat = G_ABS( maxlat - minlat );
line_order = N2S;
if ( dlat <= W2ELIM ) line_order = W2E;
reverse = G_FALSE;
if ( line_order == N2S && lat[0] < lat[np-1] )
reverse = G_TRUE;
if ( line_order == W2E && lon[0] > lon[np-1] )
reverse = G_TRUE;
if ( reverse ) {
for ( jj = 0; jj < np; jj++ ) indx[jj] = np-1-jj;
}
}
/*
* Set format_type.
*/
if ( vgtype == SIGINTL_ELM ) {
/*
* International SIGMET
*/
if ( flag != 2 )
format_type = LATLON;
else
format_type = VOR_FMT;
}
else if ( vgtype == SIGNCON_ELM || vgtype == SIGCONV_ELM ||
vgtype == SIGOUTL_ELM || vgtype == SIGAIRM_ELM )
/*
* Non-Convective SIGMET, Convective SIGMET,
* Convective Outlook
*/
format_type = VOR_FMT;
else if ( vgtype == GFA_ELM )
/*
* AIRMET
*/
format_type = GFA_FMT;
else if ( vgtype == WSM_ELM )
/*
* Watch Status Message
*/
format_type = WSM;
else if ( vgtype == VOLC_ELM || vgtype == ASHCLD_ELM )
/*
* VAA volcano and ash clouds.
*/
format_type = VAA;
else
format_type = IMISSD;
/*
* Loop through all the points using the indx array.
*/
for ( jj = 0; jj < np; jj++ ) {
ii = indx[jj];
switch ( format_type ) {
case LATLON: /* latitude/longitude display */
/* eg., 3913N7705W 4134N8120W */
/* eg., N3913W07705 N4134W08120 */
if ( jj != 0 ) strcat ( str, " " );
if ( flag == 0 ) {
if ( ( newcoord == G_TRUE ) && ( jj != 0 ) ) strcat ( str, "- " );
if ( lat[ii] >= 0.0F )
strcat ( str, "N" );
else
strcat ( str, "S" );
/*
* Convert degree, decimal to degree, minutes.
*/
lattmp = DDTODM ( G_ABS( lat[ii] ) );
sprintf( tstr, "%04d", lattmp );
strcat ( str, tstr );
if ( newcoord == G_TRUE ) strcat ( str, " " );
if ( lon[ii] >= 0.0F )
strcat ( str, "E" );
else
strcat ( str, "W" );
/*
* Convert degree, decimal to degree, minutes.
*/
lontmp = DDTODM ( G_ABS( lon[ii] ) );
sprintf( tstr, "%05d", lontmp );
strcat ( str, tstr );
}
else {
/*
* Convert degree, decimal to degree, minutes.
*/
lattmp = DDTODM ( G_ABS( lat[ii] ) );
sprintf( tstr, "%04d", lattmp );
strcat ( str, tstr );
if ( lat[ii] >= 0.0F )
strcat ( str, "N" );
else
strcat ( str, "S" );
/*
* Convert degree, decimal to degree, minutes.
*/
lontmp = DDTODM ( G_ABS( lon[ii] ) );
sprintf( tstr, "%05d", lontmp );
strcat ( str, tstr );
if ( lon[ii] >= 0.0F )
strcat ( str, "E" );
else
strcat ( str, "W" );
}
break;
case VOR_FMT: /* distance and 16-pt compass */
/* to closest VOR point */
/* eg., 20SSW EMI TO 20ENE CLE */
clo_tdirect( "VOR", lat[ii], lon[ii], id,
&dist, &dir, &ier );
clo_compass ( &dir, dir16, &icmp, &ier );
/*
* Round distance to the nearest 10 nautical miles;
* If convective outlook and less than 30 nm, set to 0.
*/
idist = G_NINT ( dist * M2NM / 10.0F ) * 10;
if ( vgtype == SIGOUTL_ELM && idist < 30 ) idist = 0;
if ( jj > 0 ) {
/*
* Different separators for different products.
*/
if ( vgtype == SIGCONV_ELM || vgtype == SIGOUTL_ELM ||
vgtype == SIGINTL_ELM )
strcat ( str, "-" );
else if ( vgtype == SIGAIRM_ELM || vgtype == SIGNCON_ELM )
strcat ( str, " TO " );
}
if ( idist != 0 ) {
sprintf( tstr, "%d", idist );
strcat ( str, tstr );
if ( vgtype == SIGINTL_ELM ) strcat ( str, " " );
strcat ( str, dir16 );
strcat ( str, " " );
}
strcat ( str, id );
break;
case GFA_FMT: /* closest SNAP point */
/*
* Use clo_tmatch since all points are already snapped
*/
clo_tmatch( "SNAP", lat[ii], lon[ii], GFAtol, &ier );
if ( ier != 0 ) {
nclose = 1;
clo_tclosest( "SNAP", lat[ii], lon[ii], nclose, &ier );
}
clo_tgnm ( "SNAP", 1, (sizeof(nm)-1), &n_nms, nm, &ier );
cst_rpst ( nm, "_", " ", nm, &ier );
if ( jj > 0 ) {
if ( flag == SEPARATOR_TO ) {
strcat ( str, " TO " );
}
else if ( flag == SEPARATOR_DASH ) {
strcat ( str, "-" );
}
}
strcat ( str, nm );
break;
case WSM: /* Watch status messages */
/* SM distance and 16-pt compass*/
/* to closest ANCHOR point */
/* eg., 10 N DCA TO 20 NW HGR */
clo_tdirect( "ANCHOR", lat[ii], lon[ii], id,
&dist, &dir, &ier );
clo_compass ( &dir, dir16, &icmp, &ier );
/*
* Round distance to the nearest 5 statute miles.
*/
idist = G_NINT ( dist * M2SM / 5.0F ) * 5;
if ( jj > 0 ) strcat ( str, " TO " );
if ( idist != 0 ) {
sprintf( tstr, "%d ", idist );
strcat ( str, tstr );
strcat ( str, dir16 );
strcat ( str, " " );
}
strcat ( str, id );
break;
case VAA: /* VAA volcano and ash clouds */
if ( newvaacoord == G_FALSE ) {
strcpy ( vaafmt, "%s%04d%s%05d" );
strcpy ( vaasep, " - " );
}
else if ( newvaacoord == G_TRUE ) {
strcpy ( vaafmt, "%s%04d %s%05d" );
strcpy ( vaasep, " - " );
}
/*
* Convert degree, decimal to degree, minutes.
*/
lattmp = DDTODM ( G_ABS( lat[ii] ) );
lontmp = DDTODM ( G_ABS( lon[ii] ) );
sprintf( tstr, vaafmt,
( lat[ii] >= 0.0F ) ? "N" : "S", lattmp,
( lon[ii] >= 0.0F ) ? "E" : "W", lontmp );
strcat ( str, tstr );
if ( jj < (np-1) ) strcat ( str, vaasep );
break;
}
}
G_FREE ( indx, int );
return;
}
void crg_setsigmet ( VG_DBStruct *el, int joffset, int elnum, int *iret )
/************************************************************************
* crg_setsigmet *
* *
* This function sets the range for a sigmet element. *
* *
* crg_setsigmet ( el, joffset, elnum, iret ) *
* *
* Input parameters: *
* *el VG_DBStruct Element containing circle *
* joffset int File position of the element *
* elnum int Element number *
* *
* Output parameters: *
* *iret int Return code *
** *
* Log: *
* H. Zeng/EAI 07/02 initial coding *
* H. Zeng/EAI 07/02 modified for very large iso. SIGMET *
***********************************************************************/
{
float llx, lly, urx, ury, ccx, ccy, dist, ang1, ang2;
float new_llx, new_lly, new_urx, new_ury, new_ccx, new_ccy;
float lat[MAX_SIGMET*2+3], lon[MAX_SIGMET*2+3];
float s1lat[2], s1lon[2], s2lat[2], s2lon[2];
float x1[2], y1[2], x2[2], y2[2];
float xint, yint, new_dist;
float dirs[]= { 0.0F, 180.0F, 90.0F, 270.0F };
int ii, kk, ier, np, npx, vg_subtype, two, intrsct;
SigmetType *psig;
/*---------------------------------------------------------------------*/
*iret = 0;
psig = &(el->elem.sig);
vg_subtype = psig->info.subtype;
np = psig->info.npts;
dist = psig->info.distance * NM2M;
/*
* get bounds
*/
crg_gbnd (sys_M, sys_D, np, &(psig->latlon[0]),
&(psig->latlon[np]), &llx, &lly, &urx, &ury,
&ccx, &ccy);
/*
* For line or isolated SIGMET, range should be expanded
* because of the distance.
*/
if ( vg_subtype == SIGTYP_ISOL && !G_DIFFT(dist, 0.0F, GDIFFD) ) {
npx = 4;
for ( ii = 0; ii < npx; ii++ ) {
clo_dltln ( &(psig->latlon[0]), &(psig->latlon[np]),
&dist, &(dirs[ii]), &(lat[ii]), &(lon[ii]), &ier );
}
crg_gbnd (sys_M, sys_D, npx, &(lat[0]), &(lon[0]),
&new_llx, &new_lly, &new_urx, &new_ury,
&new_ccx, &new_ccy );
/*
* Calculate the distance between (new_ccx, new_ccy) and
* (new_llx, new_lly).
*/
new_dist = (float)sqrt( (double)((new_ccx - new_llx) * (new_ccx - new_llx)
+ (new_ccy - new_lly) * (new_ccy - new_lly) ) );
/*
* modify the range according to new_dist.
*/
llx = new_ccx - new_dist;
urx = new_ccx + new_dist;
ury = new_ccy + new_dist;
lly = new_ccy - new_dist;
}
else if ( vg_subtype == SIGTYP_LINE && !G_DIFFT(dist, 0.0F, GDIFFD) ) {
switch ( psig->info.sol ) {
case SIGLINE_NOF:
case SIGLINE_SOF:
case SIGLINE_EOF:
case SIGLINE_WOF:
npx = 0;
for ( ii = 0; ii < np; ii++ ) {
clo_dltln ( &(psig->latlon[ii]), &(psig->latlon[ii+np]),
&dist, &(dirs[psig->info.sol-1]),
&(lat[npx]), &(lon[npx]), &ier );
npx++;
}
crg_gbnd (sys_M, sys_D, npx, &(lat[0]), &(lon[0]),
&new_llx, &new_lly, &new_urx, &new_ury,
&new_ccx, &new_ccy );
break;
case SIGLINE_ESOL:
lat[0] = psig->latlon[0];
lon[0] = psig->latlon[np];
clo_direct ( &(psig->latlon[1]), &(psig->latlon[np+1]),
&(psig->latlon[0]), &(psig->latlon[np ]),
&ang1, &ier );
ang1 -= 90.0F;
clo_dltln ( &(psig->latlon[0]), &(psig->latlon[np]), &dist,
&ang1, &(lat[2*np+1]), &(lon[2*np+1]), &ier );
ang1 = ang1 - 180.0F;
clo_dltln ( &(psig->latlon[0]), &(psig->latlon[np]), &dist,
&ang1, &(lat[1]), &(lon[1]), &ier );
ang2 = ang1;
two = 2;
for ( ii = 1; ii < np-1; ii++ ) {
clo_direct ( &(psig->latlon[ii-1]), &(psig->latlon[np+ii-1]),
&(psig->latlon[ii]), &(psig->latlon[np+ii]),
&ang1, &ier );
ang1 = (float)fmod ( ((double)ang1+270.0), 360.0);
clo_dltln ( &(psig->latlon[ii]), &(psig->latlon[np+ii]),
&dist, &ang1, &(s1lat[1]), &(s1lon[1]), &ier );
clo_direct ( &(psig->latlon[ii+1]), &(psig->latlon[np+ii+1]),
&(psig->latlon[ii]), &(psig->latlon[np+ii]),
&ang2, &ier );
ang2 = (float)fmod ( ((double)ang2+90.0), 360.0);
clo_dltln ( &(psig->latlon[ii]), &(psig->latlon[np+ii]),
&dist, &ang2, &(s2lat[0]), &(s2lon[0]), &ier );
if ( G_ABS(ang1-ang2) > 1.F ) {
clo_dltln ( &(psig->latlon[ii-1]), &(psig->latlon[np+ii-1]),
&dist, &ang1, &(s1lat[0]), &(s1lon[0]), &ier );
clo_dltln ( &(psig->latlon[ii+1]), &(psig->latlon[np+ii+1]),
&dist, &ang2, &(s2lat[1]), &(s2lon[1]), &ier );
gtrans ( sys_M, sys_N, &two, s1lat, s1lon, x1, y1,
&ier, strlen(sys_M), strlen(sys_N) );
gtrans ( sys_M, sys_N, &two, s2lat, s2lon, x2, y2,
&ier, strlen(sys_M), strlen(sys_N) );
cgr_segint( sys_N, x1, y1, sys_N, x2, y2,
sys_M, &xint, &yint, &intrsct, &ier );
}
else {
xint = (s1lat[1] + s2lat[0]) / 2.0F;
yint = (s1lon[1] + s2lon[0]) / 2.0F;
}
kk = ii + 1;
lat[kk] = xint;
lon[kk] = yint;
ang1 = (float)fmod ( ((double)ang1+180.0), 360.0 );
ang2 = (float)fmod ( ((double)ang2+180.0), 360.0 );
clo_dltln ( &(psig->latlon[ii]), &(psig->latlon[np+ii]),
&dist, &ang1, &(s1lat[1]), &(s1lon[1]), &ier );
clo_dltln ( &(psig->latlon[ii]), &(psig->latlon[np+ii]),
&dist, &ang2, &(s2lat[0]), &(s2lon[0]), &ier );
if ( G_ABS(ang1-ang2) > 1.F ) {
clo_dltln ( &(psig->latlon[ii-1]), &(psig->latlon[np+ii-1]),
&dist, &ang1, &(s1lat[0]), &(s1lon[0]), &ier );
clo_dltln ( &(psig->latlon[ii+1]), &(psig->latlon[np+ii+1]),
&dist, &ang2, &(s2lat[1]), &(s2lon[1]), &ier );
gtrans ( sys_M, sys_N, &two, s1lat, s1lon, x1, y1,
&ier, strlen(sys_M), strlen(sys_N) );
gtrans ( sys_M, sys_N, &two, s2lat, s2lon, x2, y2,
&ier, strlen(sys_M), strlen(sys_N) );
cgr_segint( sys_N, x1, y1, sys_N, x2, y2,
sys_M, &xint, &yint, &intrsct, &ier );
}
else {
xint = (s1lat[1] + s2lat[0]) / 2.0F;
yint = (s1lon[1] + s2lon[0]) / 2.0F;
}
kk = 2*np - ii + 1;
lat[kk] = xint;
lon[kk] = yint;
ang1 = (float)fmod ( ((double)ang1+180.0), 360.0 );
ang2 = (float)fmod ( ((double)ang2+180.0), 360.0 );
ang1 = ang2;
} /* the end of for (... */
clo_direct ( &(psig->latlon[np-2]), &(psig->latlon[2*np-2]),
&(psig->latlon[np-1]), &(psig->latlon[2*np-1]),
&ang2, &ier );
ang2 -= 90.0F;
clo_dltln ( &(psig->latlon[np-1]), &(psig->latlon[2*np-1]),
&dist, &ang2, &(lat[np]), &(lon[np]), &ier );
ang2 = (float)fmod ( ((double)ang2+180.0), 360.0);
clo_dltln ( &(psig->latlon[np-1]), &(psig->latlon[2*np-1]),
&dist, &ang2, &(lat[np+2]), &(lon[np+2]), &ier );
lat[np+1] = psig->latlon[np-1];
lon[np+1] = psig->latlon[2*np-1];
lat[2*np+2] = lat[0];
lon[2*np+2] = lon[0];
npx = 2*np + 3;
crg_gbnd (sys_M, sys_D, npx, &(lat[0]), &(lon[0]),
&new_llx, &new_lly, &new_urx, &new_ury,
&new_ccx, &new_ccy );
break;
} /* the end of switch ... */
/*
* compare two set of ranges and get the union of them.
*/
llx = ( llx <= new_llx ) ? llx : new_llx;
urx = ( urx >= new_urx ) ? urx : new_urx;
ury = ( ury >= new_ury ) ? ury : new_ury;
lly = ( lly <= new_lly ) ? lly : new_lly;
} /* the end of else if ... */
llx -= (float)EXTRA_SM;
urx += (float)EXTRA_SM;
ury += (float)EXTRA_SM;
lly -= (float)EXTRA_SM;
/*
* Store the device coordinates in the range array.
*/
crg_save(elnum, joffset, llx, lly, urx, ury, &ier);
}
void de_cval ( const char *uarg, char *stprm, int *iret )
/************************************************************************
* de_cval *
* *
* This function determines the value of the function defined by PARM *
* for which the probability is PRB that the observed value is less *
* than or equal to that computed value based on an idealized ensemble *
* forecast. *
* *
* GFUNC syntax: ENS_CVAL ( PARM & PRB & LWRBND & UPRBND ) *
* *
* de_cval ( 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: *
* M. Li/SAIC 10/06 *
* M. Li/SAIC 10/06 Added a check for missing value *
* K. Brill/HPC 20080131 Add intrinsic weight computations; fix *
* eliminate duplicates coding error *
* K. Brill/HPC 20101118 Check for single value order stats case *
************************************************************************/
{
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, ii, jj, kk, ll, mm, nn, ier;
int iswflg, istop;
float *gigo, *gigp, *gnum, data, swpbuf, psum;
float *gilwr, *giupr, *tmpwt, wtbuf, tol;
float *zwts, *zfreq;
float zsum;
float vn, qlt, qrt, fta, cta, aa, bb, cc;
Boolean ibreak;
/*----------------------------------------------------------------------*/
*iret = 0;
zero = 0;
one = 1;
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 up to four arguments
* for DE_CVAL.
*/
for ( ii = 0; ii < MXARGS; ii++ ) {
_ensdiag.allarg[ii][0] = '\0';
}
nina = 4;
argu = (char **)cmm_malloc2d ( 4, 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 ( ii > 0 && strcmp(argu[ii], " ") == 0 ) {
cst_rlch ( RMISSD, 1, _ensdiag.allarg[ii], &ier );
}
}
if ( narg == 2 ) {
cst_rlch ( RMISSD, 1, _ensdiag.allarg[2], &ier );
cst_rlch ( RMISSD, 1, _ensdiag.allarg[3], &ier );
}
if ( narg == 3 ) {
cst_rlch ( RMISSD, 1, _ensdiag.allarg[3], &ier );
}
cmm_free2d ( (void **) argu, &ier );
if ( narg < 2 ) {
*iret = -15;
return;
}
/*
* Scan the allarg array.
*/
de_scan ( &nina, iret );
if ( *iret != 0 ) return;
/*
* Evaluate the static arguments.
*/
for ( ii = 2; ii < nina; ii++ ) {
dg_pfun ( _ensdiag.allarg[ii], iret );
dg_driv ( &one, iret );
dg_tops ( tname, &igp, time1, time2, &level1, &level2,
&ivcord, pdum, iret );
if ( ii == 2 ) {
dg_getg ( &igp, &gilwr, &kxd, &kyd, &ksub1, &ksub2, iret );
}
else {
dg_getg ( &igp, &giupr, &kxd, &kyd, &ksub1, &ksub2, iret );
}
}
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;
}
/*
* Get memory for intrinsic weights (zwts), intrinsic weight
* frequency (zfreq), and temporary weights.
*/
G_MALLOC ( zwts, float, _ensdiag.nummbr+1, "x" );
G_MALLOC ( zfreq, float, _ensdiag.nummbr+1, "x" );
G_MALLOC ( tmpwt, float, _ensdiag.nummbr+2, "x" );
for ( ll = ksub1 - 1; ll < ksub2; ll++ ) {
if ( ERMISS(gigp[ll]) ) continue;
if ( gigp[ll] < 0.0F || gigp[ll] > 1.0F ) continue;
for ( ii = 0; ii < _ensdiag.nummbr; ii++ ) {
ibreak = False;
num = _ensdiag.iglist[ii];
dg_getg ( &num, &gnum, &kxd, &kyd, &ksub1, &ksub2, iret );
data = gnum[ll];
if ( ! ERMISS ( data ) ) {
_ensdiag.emvalu[ii+1] = data;
tmpwt[ii+1] = _ensdiag.enswts[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;
while ( iswflg != 0 && istop > 0 ) {
iswflg = 0;
for ( kk = 1; kk < istop; kk++ ) {
if ( _ensdiag.emvalu[kk] > _ensdiag.emvalu[kk+1] ) {
iswflg = 1;
swpbuf = _ensdiag.emvalu[kk];
wtbuf = tmpwt[kk];
_ensdiag.emvalu[kk] = _ensdiag.emvalu[kk+1];
tmpwt[kk] = tmpwt[kk+1];
_ensdiag.emvalu[kk+1] = swpbuf;
tmpwt[kk+1] = wtbuf;
}
}
istop--;
}
/*
* Check for identical values and compute intrinsic weight
* frequency (zfreq).
*/
mm = _ensdiag.nummbr;
nn = mm;
/*
* Initialize intrinsic weight frequency array.
*/
for (kk = 1; kk <= nn; kk++){
zfreq[kk] = 1.0F;
}
tol = 0.001F * (_ensdiag.emvalu[mm]-_ensdiag.emvalu[1]) / mm;
for (kk = 1; kk < mm; kk++) {
if ( G_ABS(_ensdiag.emvalu[kk] - _ensdiag.emvalu[kk+1]) <= tol ) {
tmpwt[kk] += tmpwt[kk+1];
zfreq[kk] = zfreq[kk] + 1.0F;
mm--;
for (jj = kk+1; jj <= mm; jj++) {
_ensdiag.emvalu[jj] = _ensdiag.emvalu[jj+1];
tmpwt[jj] = tmpwt[jj+1];
}
/* This algorithm was originally coded incorrectly. The value
* of kk must also be held back to correctly eliminate three
* or more identical values.
*/
kk--;
}
}
/*
* Fabricate order statistics if it has collapsed to a single value.
*/
if ( mm == 1 ) {
if ( G_DIFF(_ensdiag.emvalu[1], 0.0F) ) {
_ensdiag.emvalu[1] = -0.00001F;
_ensdiag.emvalu[2] = 0.00001F;
}
else {
_ensdiag.emvalu[2] = _ensdiag.emvalu[1] + 0.00001F * G_ABS(_ensdiag.emvalu[1]);
_ensdiag.emvalu[1] -= 0.00001F * G_ABS(_ensdiag.emvalu[1]);
}
tmpwt[1] = 0.5F;
tmpwt[2] = 0.5F;
mm = 2;
zfreq[1] = 1.0F;
zfreq[2] = 1.0F;
}
/*
*Compute and sum intrinsic weights.
*/
zwts[1] = zfreq[1] / ( _ensdiag.emvalu[2] - _ensdiag.emvalu[1] );
zsum = zwts[1];
for (kk=2; kk < mm; kk++){
zwts[kk] = ( zfreq[kk] * 2.0F ) / ( _ensdiag.emvalu[kk+1] - _ensdiag.emvalu[kk-1] );
zsum = zsum + zwts[kk];
}
zwts[mm] = zfreq[mm] / ( _ensdiag.emvalu[mm] - _ensdiag.emvalu[mm-1] );
zsum = zsum + zwts[mm];
/*
* Scale external weights by normalized intrinsic weights and
* normalize.
*/
psum = 0.0F;
for (kk=1; kk <= mm; kk++ ){
tmpwt[kk] = ( zwts[kk] / zsum ) * tmpwt[kk];
psum = psum + tmpwt[kk];
}
for (kk=1; kk <= mm; kk++ ){
tmpwt[kk] = tmpwt[kk] / psum;
}
} /*End "if" for all members ready check.*/
}
else {
ibreak = True;
break;
} /*End "if" for check for non-missing value.*/
} /*End "for" loop over members.*/
if ( ibreak ) continue;
/*
* Compute Qun, the area; Vn, the normalized value;
* w(), normalized weight; and qlt, qrt.
*/
vn = 0.0F;
for ( kk = 2; kk <= mm; kk++ ) {
vn += 0.5 * (tmpwt[kk] + tmpwt[kk-1]) * (_ensdiag.emvalu[kk] - _ensdiag.emvalu[kk-1]);
}
/*
* If the distribution is a Dirac spike over a single value, then set the result to
* that single value.
*/
if ( G_DIFF ( vn, 0.0 ) ) {
gigo[ll] = _ensdiag.emvalu[1];
continue;
}
vn = vn / (1.0F - 2.0F / (nn+1));
for ( kk = 1; kk <= mm; kk++ ) {
tmpwt[kk] = tmpwt[kk] / vn;
}
qlt = _ensdiag.emvalu[1] - 2.0F / (tmpwt[1] * (nn + 1));
qrt = _ensdiag.emvalu[mm] + 2.0F / (tmpwt[mm] * (nn + 1));
tmpwt[0] = 0.0F;
tmpwt[mm+1] = 0.0F;
_ensdiag.emvalu[0] = qlt;
_ensdiag.emvalu[mm+1] = qrt;
psum = 0.0F;
for ( kk = 1; kk <= mm + 1; kk++ ) {
/*
* Compute CTA.
*/
cta = 0.5F * (tmpwt[kk] + tmpwt[kk-1]) * (_ensdiag.emvalu[kk] - _ensdiag.emvalu[kk-1]);
psum += cta;
if ( kk == mm + 1 ) psum = 1.0F;
/*
* If psum = PRB, assign q[i] to output grid and move on to next grid point.
* (This was coded incorrectly and fixed on 20080205 -KB.)
*/
if ( G_DIFF ( gigp[ll], psum ) ) {
gigo[ll] = _ensdiag.emvalu[kk];
break;
}
/*
* If psum > PRB. Solve the quadratic equation.
*/
if ( psum > gigp[ll] ) {
psum -= cta;
fta = gigp[ll] - psum;
aa = (tmpwt[kk] - tmpwt[kk-1]) / (_ensdiag.emvalu[kk] - _ensdiag.emvalu[kk-1]);
bb = 2.0F * tmpwt[kk-1];
cc = 2.0F * fta;
if ( G_DIFF ( aa, 0.0F ) ) {
gigo[ll] = _ensdiag.emvalu[kk-1] + cc / bb;
}
else {
gigo[ll] = _ensdiag.emvalu[kk-1] + (sqrt(bb * bb + 4 * aa * cc) - bb) / (2 * aa);
}
if ( ! ERMISS(gilwr[ll]) && gigo[ll] < gilwr[ll] ) gigo[ll] = gilwr[ll];
if ( ! ERMISS(giupr[ll]) && gigo[ll] > giupr[ll] ) gigo[ll] = giupr[ll];
break;
}
}
}
G_FREE (tmpwt, float);
G_FREE (zfreq, float);
G_FREE (zwts, float);
/*
* 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;
}
void cgr_centroid ( float x[], float y[], int *np, float *xcent,
float *ycent, float *area, int *iret )
/************************************************************************
* cgr_centroid *
* *
* This function computes the area and centroid (or center of mass) *
* of the given polygon. *
* *
* Reference: *
* Graphics Gems IV, "Centroid of a Polygon", Gerard Bashein and *
* Paul R. Detmer, pp 3-5. *
* *
* cgr_centroid ( x, y, np, xcent, ycent, area, iret ) *
* *
* Input parameters: *
* x [np] float X coordinates of polygon *
* y [np] float Y coordinates of polygon *
* *np int Number of point in polygon *
* *
* Output parameters: *
* *xcent float X coordinate of centroid *
* *ycent float Y coordinate of centroid *
* *area float Area of polygon *
* *iret int Return code *
* -1 = Not enough points *
* -2 = Area is zero *
* *
** *
* S. Jacobs/NCEP 11/01 Created *
* S. Jacobs/NCEP 12/01 Set return values if not enough points *
* M. Li/SAIC 03/04 Prolog change for *area *
* D.W.Plummer/NCEP 03/05 Rm relationship between area and cntrd *
* M. Li/SAIC 04/05 Output positive area *
***********************************************************************/
{
register int i, j;
float ai, atmp = 0.0F, xtmp = 0.0F, ytmp = 0.0F;
/*---------------------------------------------------------------------*/
*iret = 0;
/*
* Check for at least 3 points to make a polygon.
*/
if ( *np < 3 ) {
*iret = -1;
*xcent = RMISSD;
*ycent = RMISSD;
*area = RMISSD;
return;
}
/*
* Compute the summation of the area and the first moments.
*/
for ( i = *(np)-1, j = 0; j < *np; i = j, j++ ) {
ai = x[i] * y[j] - x[j] * y[i];
atmp += ai;
xtmp += ( x[j] + x[i] ) * ai;
ytmp += ( y[j] + y[i] ) * ai;
}
/*
* Compute the area of the polygon.
*/
*area = G_ABS ( atmp / 2.0F );
/*
* Compute the location of the centroid of the polygon.
*/
if ( !G_DIFF(atmp, 0.0F) ) {
*xcent = xtmp / ( 3.0F * atmp );
*ycent = ytmp / ( 3.0F * atmp );
}
else {
*xcent = 0; *ycent = 0;
for ( i = 0; i < *np; i++ ) {
*xcent += x[i]; *ycent += y[i];
}
*xcent /= *np; *ycent /= *np;
*iret = -2;
}
}
void df_mass ( int *iret )
/************************************************************************
* df_mass *
* *
* This subroutine computes MASS, the mass per unit volume in a layer: *
* *
* MASS ( PRES ) = 100 * LDF (PRES) / ( GRAVTY * (level1 - level2) )*
* *
* Where: the 100 converts millibars to Pascals *
* level1, level2 are also converted to *
* Pascals when VCORD=PRES *
* *
* The volume is expressed in units of *
* meters * meters * (units of vert coord). *
* *
* df_mass ( iret ) *
* *
* Output parameters: *
* *iret int Return code *
* As for DG_GETS *
** *
* Log: *
* M. Goodman/RDS 12/85 *
* M. desJardins/GSFC 7/88 Rewritten so layer can be found *
* G. Huffman/GSC 9/88 Error messages *
* K. Brill/GSC 8/89 Subsetting *
* K. Brill/GSC 10/89 Subsetting *
* M. desJardins/NMC 7/93 Changed update scheme *
* T. Lee/GSC 4/96 Single dimension for dgg *
* K. Tyle/GSC 5/96 Moved IGDPT outside do-loop *
* K. Brill/HPC 1/02 CALL DG_SSUB and DG_ESUB *
* K. Brill/HPC 11/02 Eliminate use of the SUBA logical array *
* R. Tian/SAIC 11/05 Recoded from Fortran *
************************************************************************/
{
char time1[21], time2[21], gparm[13], gfunc[13];
int level1, level2, ndp, ivcord, kx, ky, ksub1, ksub2, i, im1, zero,
ier;
float dellev, cnst, *gndp, dg;
/*----------------------------------------------------------------------*/
*iret = 0;
zero = 0;
dg_ssub ( iret );
/*
* Pressure is on the stack. Compute the level difference.
* Note that this function is called by DG_GETS. Therefore,
* it cannot call subroutines which call DG_GETS.
*/
df_ldf ( iret );
if ( *iret != 0 ) return;
/*
* Get information about the pressure difference grid.
*/
dg_tops ( gfunc, &ndp, time1, time2, &level1, &level2,
&ivcord, gparm, iret );
if ( *iret != 0 ) return;
/*
* Compute the layer difference of the vertical coordinate
*/
dellev = (float)( level1 - level2 );
/*
* Convert millibars to pascals when vert. coord. is PRES.
*/
if ( ivcord == 1 ) dellev *= 100.;
/*
* Compute constant for multiplication.
*/
cnst = -1. / GRAVTY;
/*
* Compute the mass grid.
*/
dg_getg ( &ndp, &gndp, &kx, &ky, &ksub1, &ksub2, iret );
for ( i = ksub1; i <= ksub2; i++ ) {
im1 = i - 1;
if ( ERMISS ( gndp[im1] ) ) {
gndp[im1] = RMISSD;
} else {
/*
* Convert pressure from millibars to pascals, then
* compute average mass.
*/
dg = gndp[im1] * 100.;
gndp[im1] = G_ABS ( cnst * dg / dellev );
}
}
/*
* Make a name MASS and update header; the stack is current.
*/
dg_upsg ( time1, time2, &level1, &level2, &ivcord, &zero, "MASS",
&ndp, iret );
dg_esub ( &ndp, &zero, &zero, &zero, &ier );
if ( ier != 0 ) *iret = ier;
return;
}
void df_ncdf ( int *iret )
/************************************************************************
* df_ncdf *
* *
* This subroutine computes the normal cumulative distribution function *
* given a particular value, the mean, and standard deviation: *
* *
* NCDF (S1, S2, S3) = { INTEGRAL [-inf -> Z] EXP ( -u**2 / 2 ) } / *
* SQRT ( 2 * PI ) *
* *
* where u = (z - S2) / S3 and Z = (S1 - S2) / S3 *
* *
* This gives the probability of S <= S1. For the probability of *
* S >= S1, subtract this result from one. For the probability of S *
* between two values, take the absolute value of the difference of *
* this result for each of the two values. *
* *
* The standard normal distribution is described and tabulated in Meyer *
* (1970). The numerical integration algorithm is the Simpson Composite*
* Algorithm described in Burden et. al (1978). *
* *
* References: *
* *
* Burden, R. L., J. D. Faires, and A. C. Reynolds, 1978: NUMERICAL *
* ANALYSIS. Prindle, Weber & Schmidt, ISBN 0-87150-243-7, 579 pp. *
* *
* Meyer, P. L., 1970: INTRODUCTORY PROBABILITY AND STATISTICAL *
* APPLICATIONS. Addison-Wesley Pub. Co., ISBN 0-201-04710-1, *
* 367 pp. *
* *
* df_ncdf ( iret ) *
* *
* Output parameters: *
* *iret int Return code *
* As for DG_GETS *
** *
* Log: *
* K. Brill/HPC 10/02 *
* K. Brill/HPC 11/02 Eliminate use of the SUBA logical array *
* R. Tian/SAIC 11/05 Recoded from Fortran *
************************************************************************/
{
int num1, num2, num3, num, kxd, kyd, ksub1, ksub2, zero, ier;
int i, im1, k, kend, m;
float *gnum1, *gnum2, *gnum3, *gnum, hstep, cnorm, dg1, dg2, dg3;
float zstop, azstp, sign, x, h, sum;
/*----------------------------------------------------------------------*/
*iret = 0;
zero = 0;
dg_ssub ( iret );
/*
* Get the three input grid numbers.
*/
dg_gets ( &num1, iret );
if ( *iret != 0 ) return;
dg_gets ( &num2, iret );
if ( *iret != 0 ) return;
dg_gets ( &num3, iret );
if ( *iret != 0 ) return;
/*
* Get a new grid number.
*/
dg_nxts ( &num, iret );
if ( *iret != 0 ) return;
/*
* Grid number to grid.
*/
dg_getg ( &num1, &gnum1, &kxd, &kyd, &ksub1, &ksub2, iret );
dg_getg ( &num2, &gnum2, &kxd, &kyd, &ksub1, &ksub2, iret );
dg_getg ( &num3, &gnum3, &kxd, &kyd, &ksub1, &ksub2, iret );
dg_getg ( &num, &gnum, &kxd, &kyd, &ksub1, &ksub2, iret );
/*
* Set up integration parameters.
*/
hstep = .05;
cnorm = 1. / ( 3. * sqrt ( 2.0 * PI ) );
/*
* Begin calculation.
*/
for ( i = ksub1; i <= ksub2; i++ ) {
im1 = i - 1;
dg1 = gnum1[im1];
dg2 = gnum2[im1];
dg3 = gnum3[im1];
if ( ERMISS (dg1) || ERMISS (dg2) || ERMISS (dg3) ||
dg3 < 0.00001 ) {
gnum[im1] = RMISSD;
} else {
zstop = ( dg1 - dg2 ) / dg3;
azstp = G_ABS ( zstop );
if ( azstp < 0.0001 ) {
gnum[im1] = .500;
} else if ( zstop > 7. ) {
gnum[im1] = 1.0;
} else if ( zstop < -7. ) {
gnum[im1] = 0.0;
} else {
if ( zstop < 0.0 ) {
sign = -1.0;
} else {
sign = 1.0;
}
m = (int) ( azstp / ( 2. * hstep ) );
if ( m < 4 ) m = 4;
h = azstp / ( 2. * m );
/*
* Perform Simpson's Composite Algorithm to integrate.
*/
x = 0.;
sum = 1.;
kend = 2 * m;
for ( k = 1; k <= kend; k++ ) {
x = x + h;
if ( k == kend ) {
sum += exp ( - x * x / 2. );
} else if ( ( k % 2 ) != 0 ) {
sum += 4. * exp ( - x * x / 2. );
} else {
sum += 2. * exp ( - x * x / 2. );
}
}
sum *= ( h * cnorm );
gnum[im1] = .5 + sign * sum;
}
}
}
/*
* Make a name of the form 'NCDF'//S1//S2 and update header;
* update stack.
*/
dg_updh ( "NCDF", &num, &num1, &num2, iret );
dg_puts ( &num, iret );
dg_esub ( &num, &zero, &zero, &zero, &ier );
if ( ier != 0 ) *iret = ier;
return;
}
void dg_g2gc ( const int *inttyp, const int *glbwi, const int *kxi,
const int *kyi, const float *grdi, const int *kxo,
const int *kyo, float *gixo, float *giyo, float *grdo,
int *iret )
/************************************************************************
* dg_g2gc *
* *
* This subroutine remaps cosines of data from one grid to another grid.*
* *
* A globe-wrapping grid must be configured so that the last column *
* and first column are identical. *
* *
* If INTTYP=0, the code determines automatically whether to use a *
* simple bi-linear interpolation or an area average preserving re- *
* mapping of data. The method is determined locally and may vary *
* across the grid. The transition to area average preserving remap- *
* ping occurs when one output grid box contains approximately four (4) *
* or more input grid boxes. Since bilinear interpolation preserves *
* the area average when grid resolutions are comparable or when the *
* input grid is coarse compared to the output grid, this method always *
* preserves area averages. *
* *
* If INTTYP=1, the code performs nearest neighbor assignment. *
* If INTTYP=2, the code performs only bi-linear interpolation. *
* *
* dg_g2gc ( inttyp, glbwi, kxi, kyi, grdi, kxo, kyo, gixo, giyo, grdo, *
* iret ) *
* *
* Input parameters: *
* *inttyp const int Remapping type *
* = 0 area average preserving *
* = 1 nearest point assignment *
* = 2 bi-linear interpolation *
* *glbwi const int Flg for globe-wrapping input grd*
* *kxi const int Number of x pts on input grid *
* *kyi const int Number of y pts on input grid *
* *grdi const float Input grid *
* *kxo const int Number of x pts on output grid *
* *kyo const int Number of y pts on output grid *
* *gixo flaot Input grd rltv x on output grid *
* *giyo float Input grd rltv y on output grid *
* *
* Output parameters: *
* *grdo float Output grid of results *
* *iret int Return code *
* 0 = normal return *
* -68 = INTTYP is not valid *
* -69 = grid rel position error *
** *
* Log: *
* K. Brill/HPC 3/04 Created from DG_G2GI *
* K. Brill/HPC 4/04 IF (k==0) k=1; add .005 to rad *
* R. Tian/SAIC 2/06 Recoded from Fortran *
************************************************************************/
{
float rkio2, rdtst, xchk, rad2m, dx, dy, d2, x, y, xi, omx, omy,
rad, rad2, radx2, sum, sumw, ri, r2, dr2, dr22, wt, tmp;
int ir[4], jr[4], kio2, ityp, cidx, cidx1, i, j, k, io, jo, in, jn,
idx1, idx2, idx3, idx4, ip, ib, jb, ie, je, ii, jj, jdif, npts;
int rflct;
/*----------------------------------------------------------------------*/
*iret = 0;
if ( (*inttyp) < 0 || (*inttyp) > 2 ) {
*iret = -68;
return;
}
kio2 = (*kxi) / 2;
rkio2 = (float)kio2;
rdtst = 4. / PI;
if ( (*inttyp) == 0 && (*glbwi) == G_TRUE && ( (*kxi) % 2 ) == 1 ) {
/*
* Check to relect points across the pole of a global grid.
* All points along bottom and top rows must be identical.
*/
rflct = G_TRUE;
for ( j = 1; j <= (*kyi); j += (*kyi) - 1 ) {
cidx = (j - 1 ) * (*kxi);
xchk = cos ( grdi[cidx] );
i = 2;
while ( i <= (*kxi) && rflct == G_TRUE ) {
cidx = ( j - 1 ) * (*kxi) + i - 1;
rflct = ( ! ERMISS ( grdi[cidx] ) ) ? G_TRUE : G_FALSE;
if ( rflct == G_TRUE ) {
if ( G_ABS ( xchk - cos ( grdi[cidx] ) ) < RDIFFD ) {
rflct = G_FALSE;
}
}
i++;
}
}
} else {
rflct = G_FALSE;
}
/*
* Loop over all output grid points.
*/
rad2m = -9999.;
for ( jo = 1; jo <= (*kyo); jo++ ) {
for ( io = 1; io <= (*kxo); io++ ) {
cidx = ( jo - 1 ) * (*kxo) + io - 1;
grdo[cidx] = RMISSD;
if ( ERMISS ( gixo[cidx] ) || ERMISS ( giyo[cidx] ) ) {
ityp = 2;
} else if ( (*inttyp) == 1 ) {
/*
* Assign value at nearest point.
*/
ityp = 2;
in = G_NINT ( gixo[cidx] );
if ( (*glbwi) == G_TRUE ) {
if ( in > (*kxi) ) in = in - (*kxi) + 1;
if ( in < 1 ) in = in + (*kxi) - 1;
}
jn = G_NINT ( giyo[cidx] );
if ( in >= 1 && in <= (*kxi) &&
jn >= 1 && jn <= (*kyi) ) {
/*
* Nearest point value assignment.
*/
cidx1 = ( jn - 1 ) * (*kxi) + in - 1;
grdo[cidx] = cos ( grdi[cidx1] );
}
} else if ( (*inttyp) == 2 ) {
ityp = 1;
} else {
ityp = 0;
/*
* Get radius in input grid units of the circle
* circumscribing the the diamond formed by the
* four points closest to the current point on
* the output grid.
*/
rad2 = -1.1E31;
ir[0] = io - 1;
jr[0] = jo;
ir[1] = io;
jr[1] = jo - 1;
ir[2] = io + 1;
jr[2] = jo;
ir[3] = io;
jr[3] = jo + 1;
for ( ip = 0; ip < 4; ip++ ) {
cidx1 = ( jr[ip] - 1 ) * (*kxo) + ir[ip] - 1;
if ( ir[ip] >= 1 && ir[ip] <= (*kxo) &&
jr[ip] >= 1 && jr[ip] <= (*kyo) &&
! ERMISS ( gixo[cidx1] ) &&
! ERMISS ( giyo[cidx1] ) ) {
dx = gixo[cidx1] - gixo[cidx];
if ( (*glbwi) == G_TRUE && G_ABS (dx) > rkio2 ) {
/*
* Skip this point.
*/
} else if ( G_ABS (dx) > rkio2 ) {
*iret = -69;
return;
} else {
dy = giyo[cidx1] - giyo[cidx];
d2 = dx * dx + dy * dy;
rad2 = G_MAX ( d2, rad2 );
}
}
}
/*
* Since RAD2 is the square of the radius of the
* circle circumscribing the output grid diamond
* in input grid units, multiply by .5 to get the
* the square of the radius of the inscribed circle.
* This circle circumscribes the output grid box.
*/
if ( rad2 > -1.0E30 ) {
rad2 *= .5;
/*
* If the radius is much larger than that at the
* adjacent point, then reduce it.
*/
if ( rad2m > 0.0 && rad2 > 1.5 * rad2m ) {
rad2 = 1.5 * rad2m;
}
rad2m = rad2;
} else {
rad2m = -9999.;
}
/*
* If the squared radius of the inscribed circle is
* small enough (4/PI), then there are less than four
* input grid boxes per output grid box and linear
* interpolation will suffice.
*/
if ( rad2 < rdtst ) {
ityp = 1;
}
}
if ( ityp == 1 ) {
/*
* Do bi-linear interpolation.
*/
i = (int)gixo[cidx];
if ( (*glbwi) == G_TRUE ) {
if ( i >= (*kxi) ) {
i = i - (*kxi) + 1;
xi = gixo[cidx] - (float)(*kxi) + 1;
} else if ( i < 1 ) {
i = i + (*kxi) - 1;
xi = gixo[cidx] + (float)(*kxi) - 1;
if ( gixo[cidx] < 0.0 ) i--;
} else {
xi = gixo[cidx];
}
} else {
xi = gixo[cidx];
}
j = (int)giyo[cidx];
if ( i >= 1 && i <= (*kxi) &&
j >= 1 && j <= (*kyi) ) {
if ( i == (*kxi) ) i--;
if ( j == (*kyi) ) j--;
idx1 = ( j - 1 ) * (*kxi) + i - 1;
idx2 = ( j - 1 ) * (*kxi) + i;
idx3 = j * (*kxi) + i - 1;
idx4 = j * (*kxi) + i;
if ( ! ERMISS ( grdi[idx1] ) &&
! ERMISS ( grdi[idx2] ) &&
! ERMISS ( grdi[idx3] ) &&
! ERMISS ( grdi[idx4] ) ) {
x = xi - (float)i;
y = giyo[cidx] - (float)j;
omx = 1. - x;
omy = 1. - y;
grdo[cidx] = ( cos ( grdi[idx1] ) * omx +
cos ( grdi[idx2] ) * x ) * omy +
( cos ( grdi[idx3] ) * omx +
cos ( grdi[idx4] ) * x ) * y;
}
}
} else if ( ityp == 0 ) {
/*
* Do area average preserving interpolation.
*
* This integer truncation acts to pull the
* output grid box circumscribing circle in
* just a bit.
*/
tmp = sqrt ( rad2 );
k = (int)tmp;
if ( k == 0 ) k = 1;
/*
* Reset rad2 accordingly.
*/
rad = (float)k + .005;
rad2 = rad * rad;
radx2 = 1. / ( 2. * rad );
ib = G_NINT ( gixo[cidx] ) - k;
jb = G_NINT ( giyo[cidx] ) - k;
ie = G_NINT ( gixo[cidx] ) + k;
je = G_NINT ( giyo[cidx] ) + k;
sum = 0.0;
sumw = 0.0;
npts = 0;
for ( j = jb; j <= je; j++ ) {
for ( i = ib; i <= ie; i++ ) {
jj = j;
ii = i;
ri = (float)i;
if ( (*glbwi) == G_TRUE ) {
if ( i > (*kxi) ) ii = i - (*kxi) + 1;
if ( i < 1 ) ii = i + (*kxi) - 1;
}
dx = ri - gixo[cidx];
dy = (float)j - giyo[cidx];
r2 = dx * dx + dy * dy;
if ( rflct == G_TRUE ) {
if ( j > (*kyi) ) {
jdif = j - (*kyi);
jj = (*kyi) - jdif;
if ( ii <= kio2 ) {
ii += kio2;
} else {
ii -= kio2;
}
} else if ( j < 1 ) {
jdif = 1 - j;
jj = 1 + jdif;
if ( ii <= kio2 ) {
ii += kio2;
} else {
ii -= kio2;
}
}
}
if ( r2 <= rad2 ) {
if ( ii >= 1 && ii <= (*kxi) &&
jj >= 1 && jj <= (*kyi) ) {
cidx1 = ( jj - 1 ) * (*kxi) + ii - 1;
if ( ! ERMISS (grdi[cidx1] ) ) {
/*
* Compute a weighting factor based
* on an estimate of how much of
* the area of the input grid box
* is contributing to the area
* covered by the output grid box.
* The criterion is (rad-r) < .5.
* Using the approximation that
* rad ~ r, then (rad2-r2) is nearly
* equal to 2*rad(rad-r). Substi-
* tute into above inequality and
* rearrange to get this criterion:
* (rad2-r2)**2<rad2. The weight is
* either 1 or [.5+(rad2-r2)/rad*2].
* The .5 is added on because a
* point on the circle has about
* half of its area inside.
*/
dr2 = rad2 - r2;
dr22 = dr2 * dr2;
if ( dr22 < rad2 ) {
wt = .5 + dr2 * radx2;
} else {
wt = 1.0;
}
sum += wt * cos ( grdi[cidx1] );
sumw += wt;
npts++;
}
}
}
}
}
if ( sumw >= 2.0 && npts >= 4 ) {
/*
* The value 2.0 is used as the criterion here
* because at least 4 points must contribute
* at least a half.
*/
grdo[cidx] = sum / sumw;
} else {
/*
* Perform linear interpolation, which itself
* preserves area averages when grid resolutions
* are comparable.
*/
i = (int)gixo[cidx];
if ( (*glbwi) == G_TRUE ) {
if ( i >= (*kxi) ) {
i = i - (*kxi) + 1;
xi = gixo[cidx] - (float)(*kxi) + 1;
} else if ( i < 1 ) {
i = i + (*kxi) - 1;
xi = gixo[cidx] + (float)(*kxi) - 1;
if ( gixo[cidx] < 0.0 ) i--;
} else {
xi = gixo[cidx];
}
} else {
xi = gixo[cidx];
}
j = (int)giyo[cidx];
if ( i >= 1 && i <= (*kxi) && j >= 1 && j <= (*kyi) ) {
if ( i == (*kxi) ) i--;
if ( j == (*kyi) ) j--;
idx1 = ( j - 1 ) * (*kxi) + i - 1;
idx2 = ( j - 1 ) * (*kxi) + i;
idx3 = j * (*kxi) + i - 1;
idx4 = j * (*kxi) + i;
if ( ! ERMISS ( grdi[idx1] ) &&
! ERMISS ( grdi[idx2] ) &&
! ERMISS ( grdi[idx3] ) &&
! ERMISS ( grdi[idx4] ) ) {
x = xi - (float)i;
y = giyo[cidx] - (float)j;
omx = 1. - x;
omy = 1. - y;
grdo[cidx] = ( cos ( grdi[idx1] ) * omx +
cos ( grdi[idx2] ) * x ) * omy +
( cos ( grdi[idx3] ) * omx +
cos ( grdi[idx4] ) * x ) * y;
}
}
}
}
}
}
return;
}
void xopenw ( char win_name[], int win_index, float xsize,
float ysize, int *ixsize, int *iysize, int *iret )
/************************************************************************
* xopenw *
* *
* This subroutine opens one xw window and sets the initial *
* graphics context along with basic window attributes. *
* *
* xopenw ( win_name, win_index, xsize, ysize, ixsize, iysize, iret ) *
* *
* Input parameters: *
* win_name[] char window name *
* win_index int window index *
* xsize float Right edge of window *
* ysize float Bottom edge of window *
* *
* Output parameters: *
* *ixsize int Right edge of window *
* *iysize int Bottom edge of window *
* *iret int Return code *
* G_NORMAL = normal return *
** *
* Log: *
* A. Hardy/GSC 2/01 Copied from the XW driver and *
* removed size limitations *
***********************************************************************/
{
int dhght, dwdth, gemscreen, xpos, ypos, ier;
unsigned int xwdth, xhght, xbord, xdpth;
char gemname [WNAME_LEN];
Cursor curs;
Window gwin;
GC gemgc;
XGCValues values;
XSizeHints gemhint;
XSetWindowAttributes gemxswa;
XColor cred;
Window_str *cwin;
winloop_t *cloop;
/*---------------------------------------------------------------------*/
*iret = G_NORMAL;
current_window = win_index;
cwin = &(gemwindow[current_window]);
cloop = &(cwin->loop[cwin->curr_loop]);
strcpy(cwin->name, win_name);
strcpy(gemname, win_name);
gemscreen = DefaultScreen( (XtPointer)gemdisplay );
/*
* Determine window height and width.
*/
dwdth = DisplayWidth( (XtPointer)gemdisplay, gemscreen );
dhght = DisplayHeight( (XtPointer)gemdisplay, gemscreen );
if ( G_ABS ( xsize - RMISSD ) < RDIFFD )
gemhint.width = 0.7 * (float) dwdth ;
else if ( ( xsize > 0.0 ) && ( xsize <= 1.0 ) )
gemhint.width = (float) dwdth * xsize ;
else if ( xsize < 100.0 ) gemhint.width = 100 ;
else gemhint.width = (int) xsize ;
if ( G_ABS ( ysize - RMISSD ) < RDIFFD )
gemhint.height = 0.7 * (float) dhght ;
else if ( ( ysize > 0.0 ) && ( ysize <= 1.0 ) )
gemhint.height = (float) dhght * ysize ;
else if ( ysize < 100.0 ) gemhint.height = 100 ;
else gemhint.height = (int) ysize ;
if ( gemhint.width < 100 ) gemhint.width = 100 ;
if ( gemhint.height < 100 ) gemhint.height = 100 ;
/*
* Determine window location.
*/
gemhint.x = dwdth - ( gemhint.width ) - ( current_window * 30 ) - 20;
if ( gemhint.x < 0 ) gemhint.x = 0;
gemhint.y = ( current_window * 30 );
gemhint.flags = USPosition | USSize;
/*
* Create the window and set standard properties and attributes.
*/
gwin = XCreateSimpleWindow( gemdisplay, root, gemhint.x, gemhint.y,
gemhint.width, gemhint.height, 5,
WhitePixel ( (XtPointer)gemdisplay, gemscreen ),
BlackPixel ( (XtPointer)gemdisplay, gemscreen ) );
cwin->window = gwin;
XSetStandardProperties( gemdisplay, gwin, gemname, gemname, None,
NULL, 0, &gemhint );
gemxswa.bit_gravity = CenterGravity;
XChangeWindowAttributes (gemdisplay, gwin, (CWBitGravity), &gemxswa );
/*
* Get the geometry and window size information.
*/
XGetGeometry( gemdisplay, gwin, &root, &xpos,
&ypos, &xwdth, &xhght, &xbord, &xdpth );
cwin->width = xwdth;
cwin->height = xhght;
cwin->depth = xdpth;
/*
* Create graphics contexts.
*/
gemgc = XCreateGC( gemdisplay, gwin, 0, 0 );
/*
* Turn of NoExpose and GraphicsExpose events. They
* don't seem to be needed and were causing many events
* to seen in xxevent().
*/
values.graphics_exposures = False;
XChangeGC( gemdisplay, gemgc, GCGraphicsExposures, &values);
cwin->gc = gemgc;
/*
* Set backgound colors.
*/
XSetBackground( gemdisplay, gemgc,
BlackPixel ( (XtPointer)gemdisplay, gemscreen ) ) ;
/*
* Set fill rule.
*/
XSetFillRule ( gemdisplay, gemgc, EvenOddRule );
/*
* Create one pixmap.
*/
cwin->pxms[cwin->curr_loop][0] =
XCreatePixmap(gemdisplay, root, xwdth, xhght, xdpth);
cwin->curpxm[cwin->curr_loop] = 0;
cloop->pxm_wdth = xwdth;
cloop->pxm_hght = xhght;
cloop->roamflg = 0;
cloop->xoffset = 0;
cloop->yoffset = 0;
cloop->pxm_x = 0;
cloop->pxm_y = 0;
cwin->area_w = xwdth;
cwin->area_h = xhght;
cwin->win_x = 0;
cwin->win_y = 0;
/*
* return device size
*/
*ixsize = xwdth;
*iysize = xhght;
/*
* clear the pixmap,
*/
xclrpxm(&(cwin->curpxm[cwin->curr_loop]), &ier);
/*
* Select the events to be processed.
*/
XSelectInput ( gemdisplay, gwin, ExposureMask );
/*
* Set the cursor to be the customary red arrow.
*/
curs = XCreateFontCursor ( gemdisplay, XC_top_left_arrow );
XDefineCursor ( gemdisplay, gwin, curs );
cred.red = 65535;
cred.blue = 0;
cred.green = 0;
cred.flags = DoRed | DoBlue | DoGreen;
XRecolorCursor ( gemdisplay, curs, &cred, &cred );
}
void cds_sig ( VG_DBStruct *el, int indx, int *iret )
/************************************************************************
* cds_sig *
* *
* This function displays SIGMETs to the output device. *
* *
* cds_sig (el, indx, iret) *
* *
* Input parameters: *
* *el VG_DBStruct Pointer to VG record structure *
* indx int Index into user attribute table *
* *
* Output parameters: *
* *iret int Return code *
* *
** *
* Log: *
* D.W.Plummer/NCEP 7/99 Copied from cds_line *
* D.W.Plummer/NCEP 9/99 Compute circle from element distance; *
* Compute line extension area *
* H. Zeng/EAI 9/99 Preserve plot attributes *
* F. J. Yen/NCEP 10/99 Handled user attribute table *
* M. Li/GSC 10/99 Modified clo_direct and clo_dltln codes *
* D.W.Plummer/NCEP 12/99 Added plotting of sequence number *
* M. Li/GSC 1/00 Used string variables in gtrans *
* S. Law/GSC 05/00 changed to use MAX_SIGMET for lat/lon *
* H. Zeng/EAI 06/00 increased the sizes of lat&lon arrays *
* A. Hardy/GSC 11/00 renamed coordinate system declarations *
* M. Li/SAIC 01/03 delete vgstruct.h *
* T. Piper/SAIC 12/05 redone with new Setting_t structure *
***********************************************************************/
{
int ii, kk, npts, np, intrsct, ier;
int mtype, color, width, lintyp, lthw, lwhw, mkhw, two;
int iltypx, ilthwx, iwidthx, iwhwx, icolrx, imarkx, imkhwx, imkwidx;
char str[4];
float lat[MAX_SIGMET*2+3], lon[MAX_SIGMET*2+3];
float size, dist, dir, ang1, ang2;
float dirs[]={ 0.0F, 180.0F, 90.0F, 270.0F };
float s1lat[2], s1lon[2], s2lat[2], s2lon[2];
float x1[2], y1[2], x2[2], y2[2];
float xint, yint;
float szmarkx;
float lbllat, lbllon, rotat=0.0F;
int ixoff=0, iyoff=2;
int itxfn_s, itxhw_s, itxwid_s, ibrdr_s, irrotn_s, ijust_s;
float sztext_s;
int itxfn, itxhw, itxwid, ibrdr, irrotn, ijust;
float sztext;
SigmetType *psig;
/*---------------------------------------------------------------------*/
*iret = 0;
/*
* Save plot attributes.
*/
gqcolr ( &icolrx, &ier );
gqline ( &iltypx, &ilthwx, &iwidthx, &iwhwx, &ier );
gqmrkr ( &imarkx, &imkhwx, &szmarkx, &imkwidx, &ier );
/*
* setup basic information
*/
psig = &(el->elem.sig);
width = (int) (( ( cdsUattr[indx].info.sig->linwid == 0 ) ?
(float)psig->info.linwid :
(float)cdsUattr[indx].info.sig->linwid) * cdsLineWdth);
lintyp = ( cdsUattr[indx].info.sig->lintyp == 0 ) ?
psig->info.lintyp : cdsUattr[indx].info.sig->lintyp;
lthw = 0;
lwhw = 0;
mtype = 1;
mkhw = 0;
size = 1.0F;
np = psig->info.npts;
gsline (&lintyp, <hw, &width, &lwhw, &ier);
color = (cdsColor == 0) ?
( ( cdsUattr[indx].maj_col == 0 ) ?
el->hdr.maj_col : cdsUattr[indx].maj_col ) : cdsColor;
gscolr (&color, &ier);
switch ( psig->info.subtype ) {
case SIGTYP_ISOL: /* isolated */
/*
* Plot marker w/ surrounding circle
*/
lat[0] = psig->latlon[0];
lon[0] = psig->latlon[np];
gsmrkr ( &mtype, &mkhw, &size, &width, &ier );
gmark ( sys_M, &np, lat, lon, &ier, strlen(sys_M) );
if ( !G_DIFF(psig->info.distance, 0.0F ) ) {
dir = ( lat[0] >= 0.F ) ? 180.F : 0.F;
dist = psig->info.distance * NM2M;
clo_dltln ( &lat[0], &lon[0], &dist, &dir, &(lat[1]), &(lon[1]), &ier );
np = 18;
gcircl ( sys_M, lat, lon, &(lat[1]), &(lon[1]), &np,
&ier, strlen(sys_M) );
}
break;
case SIGTYP_LINE: /* line */
for ( ii = 0; ii < np; ii++ ) {
lat[ii] = psig->latlon[ii];
lon[ii] = psig->latlon[ii+np];
}
gline ( sys_M, &np, lat, lon, &ier, strlen(sys_M) );
if ( !G_DIFF(psig->info.distance, 0.0F) ) {
lintyp = 2;
gsline (&lintyp, <hw, &width, &lwhw, &ier);
dist = psig->info.distance * NM2M;
switch ( psig->info.sol ) {
case SIGLINE_NOF:
case SIGLINE_SOF:
case SIGLINE_EOF:
case SIGLINE_WOF:
npts = 1;
for ( ii = 0; ii < np; ii++ ) {
clo_dltln ( &(psig->latlon[ii]), &(psig->latlon[ii+np]),
&dist, &(dirs[psig->info.sol-1]),
&(lat[npts]), &(lon[npts]), &ier );
npts++;
}
lat[npts] = psig->latlon[np-1];
lon[npts] = psig->latlon[2*np-1];
npts++;
gline ( sys_M, &npts, lat, lon, &ier, strlen(sys_M) );
break;
case SIGLINE_ESOL:
lat[0] = psig->latlon[0];
lon[0] = psig->latlon[np];
clo_direct ( &(psig->latlon[1]), &(psig->latlon[np+1]),
&(psig->latlon[0]), &(psig->latlon[np ]),
&ang1, &ier );
ang1 -= 90.0F;
clo_dltln ( &(psig->latlon[0]), &(psig->latlon[np]), &dist,
&ang1, &(lat[2*np+1]), &(lon[2*np+1]), &ier );
ang1 = ang1 - 180.0F;
clo_dltln ( &(psig->latlon[0]), &(psig->latlon[np]), &dist,
&ang1, &(lat[1]), &(lon[1]), &ier );
ang2 = ang1;
two = 2;
for ( ii = 1; ii < np-1; ii++ ) {
clo_direct ( &(psig->latlon[ii-1]), &(psig->latlon[np+ii-1]),
&(psig->latlon[ii]), &(psig->latlon[np+ii]),
&ang1, &ier );
ang1 = (float)fmod ( ((double)ang1+270.0), 360.0);
clo_dltln ( &(psig->latlon[ii]), &(psig->latlon[np+ii]),
&dist, &ang1, &(s1lat[1]), &(s1lon[1]), &ier );
clo_direct ( &(psig->latlon[ii+1]), &(psig->latlon[np+ii+1]),
&(psig->latlon[ii]), &(psig->latlon[np+ii]),
&ang2, &ier );
ang2 = (float)fmod ( ((double)ang2+90.0), 360.0);
clo_dltln ( &(psig->latlon[ii]), &(psig->latlon[np+ii]),
&dist, &ang2, &(s2lat[0]), &(s2lon[0]), &ier );
if ( G_ABS(ang1-ang2) > 1.F ) {
clo_dltln ( &(psig->latlon[ii-1]), &(psig->latlon[np+ii-1]),
&dist, &ang1, &(s1lat[0]), &(s1lon[0]), &ier );
clo_dltln ( &(psig->latlon[ii+1]), &(psig->latlon[np+ii+1]),
&dist, &ang2, &(s2lat[1]), &(s2lon[1]), &ier );
gtrans ( sys_M, sys_N, &two, s1lat, s1lon, x1, y1,
&ier, strlen(sys_M), strlen(sys_N) );
gtrans ( sys_M, sys_N, &two, s2lat, s2lon, x2, y2,
&ier, strlen(sys_M), strlen(sys_N) );
cgr_segint( sys_N, x1, y1, sys_N, x2, y2,
sys_M, &xint, &yint, &intrsct, &ier );
}
else {
xint = (s1lat[1] + s2lat[0]) / 2.0F;
yint = (s1lon[1] + s2lon[0]) / 2.0F;
}
kk = ii + 1;
lat[kk] = xint;
lon[kk] = yint;
ang1 = (float)fmod ( ((double)ang1+180.0), 360.0 );
ang2 = (float)fmod ( ((double)ang2+180.0), 360.0 );
clo_dltln ( &(psig->latlon[ii]), &(psig->latlon[np+ii]),
&dist, &ang1, &(s1lat[1]), &(s1lon[1]), &ier );
clo_dltln ( &(psig->latlon[ii]), &(psig->latlon[np+ii]),
&dist, &ang2, &(s2lat[0]), &(s2lon[0]), &ier );
if ( G_ABS(ang1-ang2) > 1.F ) {
clo_dltln ( &(psig->latlon[ii-1]), &(psig->latlon[np+ii-1]),
&dist, &ang1, &(s1lat[0]), &(s1lon[0]), &ier );
clo_dltln ( &(psig->latlon[ii+1]), &(psig->latlon[np+ii+1]),
&dist, &ang2, &(s2lat[1]), &(s2lon[1]), &ier );
gtrans ( sys_M, sys_N, &two, s1lat, s1lon, x1, y1,
&ier, strlen(sys_M), strlen(sys_N) );
gtrans ( sys_M, sys_N, &two, s2lat, s2lon, x2, y2,
&ier, strlen(sys_M), strlen(sys_N) );
cgr_segint( sys_N, x1, y1, sys_N, x2, y2,
sys_M, &xint, &yint, &intrsct, &ier );
}
else {
xint = (s1lat[1] + s2lat[0]) / 2.0F;
yint = (s1lon[1] + s2lon[0]) / 2.0F;
}
kk = 2*np - ii + 1;
lat[kk] = xint;
lon[kk] = yint;
ang1 = (float)fmod ( ((double)ang1+180.0), 360.0 );
ang2 = (float)fmod ( ((double)ang2+180.0), 360.0 );
ang1 = ang2;
}
clo_direct ( &(psig->latlon[np-2]), &(psig->latlon[2*np-2]),
&(psig->latlon[np-1]), &(psig->latlon[2*np-1]),
&ang2, &ier );
ang2 -= 90.0F;
clo_dltln ( &(psig->latlon[np-1]), &(psig->latlon[2*np-1]),
&dist, &ang2, &(lat[np]), &(lon[np]), &ier );
ang2 = (float)fmod ( ((double)ang2+180.0), 360.0);
clo_dltln ( &(psig->latlon[np-1]), &(psig->latlon[2*np-1]),
&dist, &ang2, &(lat[np+2]), &(lon[np+2]), &ier );
lat[np+1] = psig->latlon[np-1];
lon[np+1] = psig->latlon[2*np-1];
lat[2*np+2] = lat[0];
lon[2*np+2] = lon[0];
npts = 2*np + 3;
gline ( sys_M, &npts, lat, lon, &ier, strlen(sys_M) );
break;
}
}
break;
case SIGTYP_AREA: /* area */
for ( ii = 0; ii < np; ii++ ) {
lat[ii] = psig->latlon[ii];
lon[ii] = psig->latlon[ii+np];
}
lat[np] = psig->latlon[0];
lon[np] = psig->latlon[np];
np++;
gline ( sys_M, &np, lat, lon, &ier, strlen(sys_M) );
break;
}
if ( el->hdr.vg_type == SIGCONV_ELM || el->hdr.vg_type == SIGOUTL_ELM ) {
if ( el->hdr.vg_type == SIGCONV_ELM )
sprintf( str, "%d%c", psig->info.seqnum, psig->info.msgid[0] );
else if ( el->hdr.vg_type == SIGOUTL_ELM )
sprintf( str, "%d", psig->info.seqnum );
np = psig->info.npts;
lbllat = psig->latlon[0];
lbllon = psig->latlon[np];
for ( ii = 1; ii < np; ii++ ) {
if ( psig->latlon[ii] > lbllat ) {
lbllat = psig->latlon[ii];
lbllon = psig->latlon[ii+np];
}
}
gqtext( &itxfn_s, &itxhw_s, &sztext_s, &itxwid_s, &ibrdr_s,
&irrotn_s, &ijust_s, &ier );
itxfn = 0;
itxhw = 0;
sztext = 1.5F;
itxwid = 0;
ibrdr = 0;
irrotn = 0;
ijust = 2;
gstext( &itxfn, &itxhw, &sztext, &itxwid, &ibrdr, &irrotn, &ijust, &ier );
gtext( sys_M, &lbllat, &lbllon, str, &rotat, &ixoff, &iyoff, &ier,
strlen(sys_M), strlen(str) );
gstext( &itxfn_s, &itxhw_s, &sztext_s, &itxwid_s, &ibrdr_s,
&irrotn_s, &ijust_s, &ier );
}
/*
* Restore the saved plot attribute values
*/
gsmrkr ( &imarkx, &imkhwx, &szmarkx, &imkwidx, &ier );
gsline ( &iltypx, &ilthwx, &iwidthx, &iwhwx, &ier );
gscolr ( &icolrx, &ier );
}
