int mer_num ( g2int *gdtmpl, g2int gdtlen)
{
int kx, ky, try_quick;
float angl[3], llt, lln, ult, uln, basic_angle=1.0e6;
static char _proj[] = "MER";
nav_list *q;
static nav_list *lastmatch=NULL;
if ( gdtlen < 19 ) return(255);
/*for ( i=0;i<gdtlen;i++)
printf("gdtmpl %d %d\n",i,gdtmpl[i]);*/
kx = gdtmpl[7];
ky = gdtmpl[8];
llt = gdtmpl[9] / basic_angle;
lln = gdtmpl[10] / basic_angle; while ( lln > 180.0 ) lln = lln - 360.0;
ult = gdtmpl[13] / basic_angle;
uln = gdtmpl[14] / basic_angle; while ( uln > 180.0 ) uln = uln - 360.0;
if ( lastmatch != NULL ) {
q = lastmatch;
try_quick = 1;
}
else {
q = nav_head;
try_quick = 0;
}
while ( q != NULL ) {
if ( ( strcmp(_proj,q->proj ) == 0 ) &&
( kx == q->kx ) && ( ky == q->ky ) &&
( ( G_DIFFT( llt, q->llt, .001) && G_DIFFT( ult, q->ult, .001) ) ||
( G_DIFFT( ult, q->llt, .001) && G_DIFFT( llt, q->ult, .001) ) ) &&
G_DIFFT( lln, q->lln, .001) &&
G_DIFFT( uln, q->uln, .001) ) {
lastmatch = q;
return(q->gnum);
}
if ( try_quick ) {
q = nav_head;
try_quick = 0;
}
else
q = q->next;
}
return ( 255 );
}
/* convenience routine to get grid number for grib2
*/
int ced_num ( g2int *gdtmpl, g2int gdtlen)
{
int kx, ky, try_quick, loglev, numerr, ier;
float angl[3], llt, lln, ult, uln, basic_angle;
static char _proj[] = "CED";
char errgrp[20], errstr[81];
nav_list *q;
static nav_list *lastmatch=NULL;
if ( gdtlen < 18 ) return(255);
/*for ( i=0;i<gdtlen;i++)
printf("gdtmpl %d %d\n",i,gdtmpl[i]);*/
kx = gdtmpl[7];
ky = gdtmpl[8];
/* 1.0e6 assumes gdtmpl[9] = 0 or 1 for ratio of degree to 1.0e6 */
if ( ( gdtmpl[9] == 0 ) || ( gdtmpl[9] == 1 ) )
basic_angle = 1.0e6;
else
basic_angle = 1.0e6 * gdtmpl[9] / gdtmpl[10];
llt = gdtmpl[11] / basic_angle;
lln = gdtmpl[12] / basic_angle; while ( lln > 180.0 ) lln = lln - 360.0;
ult = gdtmpl[14] / basic_angle;
uln = gdtmpl[15] / basic_angle; while ( uln > 180.0 ) uln = uln - 360.0;
if ( lastmatch != NULL ) {
q = lastmatch;
try_quick = 1;
}
else {
q = nav_head;
try_quick = 0;
}
while ( q != NULL ) {
if ( ( strcmp(_proj,q->proj ) == 0 ) &&
( kx == q->kx ) && ( ky == q->ky ) &&
( ( G_DIFFT( llt, q->llt, .001) && G_DIFFT( ult, q->ult, .001) ) ||
( G_DIFFT( ult, q->llt, .001) && G_DIFFT( llt, q->ult, .001) ) ) &&
G_DIFFT( lln, q->lln, .001) &&
G_DIFFT( uln, q->uln, .001) ) {
lastmatch = q;
return(q->gnum);
}
if ( try_quick ) {
q = nav_head;
try_quick = 0;
}
else
q = q->next;
}
/*loglev = 2;
numerr = -1;
sprintf(errgrp,"%s_GNUM\0",_proj);
sprintf(errstr,"No GID KXKY [%d %d] LL [%f %f] UR [%f %f]\n",kx,ky,llt,lln, ult, uln);
dc_wclg(loglev,errgrp,numerr,errstr,&ier);*/
/*if ( ( gdtmpl[7] == 720 ) && ( gdtmpl[8] == 361 ) &&
( gdtmpl[11] == 90000000 ) && ( gdtmpl[12] == 0 ) &&
( gdtmpl[14] == -90000000 ) && ( gdtmpl[15] == 359500000 ) &&
( gdtmpl[16] == 500000 ) && ( gdtmpl[17] == 500000 ) )
return ( 4 );*/
return ( 255 );
}
int str_num ( g2int *gdtmpl, g2int gdtlen)
{
int kx, ky, try_quick, loglev, numerr, ier;
float angl[3], llt, lln, ult=RMISSD, uln=RMISSD;
static char _proj[] = "STR";
char errgrp[20], errstr[81];
nav_list *q;
static nav_list *lastmatch=NULL;
if ( gdtlen < 18 ) return(255);
kx = gdtmpl[7];
ky = gdtmpl[8];
llt = gdtmpl[9] / 1.0e6;
lln = gdtmpl[10] / 1.0e6; while ( lln > 180.0 ) lln = lln - 360.0;
if ( gdtmpl[16] & 64 )
angl[0] = -90.0;
else
angl[0] = 90.0;
angl[1] = gdtmpl[13] / 1.0e6; while ( angl[1] > 180.0 ) angl[1] = angl[1] - 360.0;
angl[2] = 0;
/*for ( i=0;i<gdtlen;i++)
printf("gdtmpl %d %d\n",i,gdtmpl[i]);*/
if ( lastmatch != NULL ) {
q = lastmatch;
try_quick = 1;
}
else {
q = nav_head;
try_quick = 0;
}
while ( q != NULL ) {
if ( ( strcmp(_proj,q->proj ) == 0 ) &&
( kx == q->kx ) && ( ky == q->ky ) &&
( angl[0] == q->angle[0] ) && ( angl[1] == q->angle[1] ) &&
( G_DIFFT( llt, q->llt, .001) ) &&
( G_DIFFT( lln, q->lln, .001) ) ) {
lastmatch = q;
return(q->gnum);
}
if ( try_quick ) {
q = nav_head;
try_quick = 0;
}
else
q = q->next;
}
/*loglev = 2;
numerr = -1;
sprintf(errgrp,"%s_GNUM\0",_proj);
sprintf(errstr,"No GID KXKY [%d %d] LL [%f %f] ANGL [%f %f %f]\n",kx,ky,llt,lln, angl[0],angl[1], angl[2]);
dc_wclg(loglev,errgrp,numerr,errstr,&ier);*/
/*
if ( ( gdtmpl[7] == 377 ) && ( gdtmpl[8] == 237 ) &&
( gdtmpl[9] == 44196000 ) && ( gdtmpl[10] == 174759000 ) &&
( gdtmpl[12] == 60000000 ) && ( gdtmpl[13] == 203000000 ) &&
( gdtmpl[14] == 11945000 ) && ( gdtmpl[15] == 11945000 ) )
return ( 186 );
if ( ( gdtmpl[7] == 553 ) && ( gdtmpl[8] == 425 ) &&
( gdtmpl[9] == 30000000 ) && ( gdtmpl[10] == 187000000 ) &&
( gdtmpl[12] == 60000000 ) && ( gdtmpl[13] == 225000000 ) &&
( gdtmpl[14] == 11250000 ) && ( gdtmpl[15] == 11250000 ) )
return ( 242 );*/
return ( 255 );
}
int lcc_num ( g2int *gdtmpl, g2int gdtlen)
{
int kx, ky, try_quick, loglev, numerr, ier;
float angl[3], llt, lln, ult=RMISSD, uln=RMISSD;
static char _proj[] = "LCC";
char errgrp[20], errstr[81];
nav_list *q;
static nav_list *lastmatch=NULL;
if ( gdtlen < 21 ) return(255);
kx = gdtmpl[7];
ky = gdtmpl[8];
llt = gdtmpl[9] / 1.0e6;
lln = gdtmpl[10] / 1.0e6; while ( lln > 180.0 ) lln = lln - 360.0;
angl[0] = gdtmpl[18] / 1.0e6;
angl[1] = gdtmpl[13] / 1.0e6; while ( angl[1] > 180.0 ) angl[1] = angl[1] - 360.0;
angl[2] = gdtmpl[19] / 1.0e6;
/*for ( i=0;i<gdtlen;i++)
printf("gdtmpl %d %d\n",i,gdtmpl[i]);*/
if ( lastmatch != NULL ) {
q = lastmatch;
try_quick = 1;
}
else {
q = nav_head;
try_quick = 0;
}
while ( q != NULL ) {
/* TODO: need to use either Dx and DY or ult, uln comparison */
if ( ( strcmp(_proj,q->proj ) == 0 ) &&
( kx == q->kx ) && ( ky == q->ky ) &&
( G_DIFFT( llt, q->llt, .001) ) &&
( G_DIFFT( lln, q->lln, .001) ) ) {
lastmatch = q;
return(q->gnum);
}
if ( try_quick ) {
q = nav_head;
try_quick = 0;
}
else
q = q->next;
}
/*if ( ( gdtmpl[7] == 491 ) && ( gdtmpl[8] == 303 ) &&
( gdtmpl[9] == 19943000 ) && ( gdtmpl[10] == 234907000 ) &&
( gdtmpl[12] == 40000000 ) && ( gdtmpl[13] == 262000000 ) &&
( gdtmpl[14] == 12000000 ) && ( gdtmpl[15] == 12000000 ) )
return ( 185 );
if ( ( gdtmpl[7] == 185 ) && ( gdtmpl[8] == 129 ) &&
( gdtmpl[9] == 12190000 ) && ( gdtmpl[10] == 226541000 ) &&
( gdtmpl[12] == 25000000 ) && ( gdtmpl[13] == 265000000 ) &&
( gdtmpl[14] == 12190000 ) && ( gdtmpl[15] == 12190000 ) )
return ( 212 );
if ( ( gdtmpl[7] == 614 ) && ( gdtmpl[8] == 428 ) &&
( gdtmpl[9] == 12190000 ) && ( gdtmpl[10] == 226541000 ) &&
( gdtmpl[12] == 25000000 ) && ( gdtmpl[13] == 265000000 ) &&
( gdtmpl[14] == 12191000 ) && ( gdtmpl[15] == 12191000 ) )
return ( 218 );*/
/*loglev = 2;
numerr = -1;
sprintf(errgrp,"%s_GNUM\0",_proj);
sprintf(errstr,"No GID KXKY [%d %d] LL [%f %f] ANGL [%f %f %f]\n",kx,ky,llt,lln, angl[0],angl[1], angl[2]);
dc_wclg(loglev,errgrp,numerr,errstr,&ier);*/
return ( 255 );
}
void cgr_concave(int points, const float *x, const float *y,
int *concave, int *iret)
/*****************************************************************************
* cgr_concave
*
* With the set of points defined, determine if any angle described in the
* set is concave. The points are expected to be listed in a CCW direction
* and the 'right' side of the line is considered the outside. Note that
* all coordinates are assumed to be in the same cartesian coordinate system,
* not earth coordinates. Also, a polygon should be CLOSED (the first and last
* points should be identical).
*
* The method used to determine if an angle ABC is convex/concave comes from
* Comp.Graphics.Algorithms FAQ, Section 2.07 which describes the method for
* determining the orientaition as computing the signed area of a polygon,
* and if it is negative, then the polygon is concave. If we just deal with
* 3 points in sequence at a time, can can connect A and C to make a triangle,
* and compute its signed area. If the value is negative, ABC is concave.
*
* Input parameters:
* points int number of coordinates for the object
* *x float x coordinates of the object
* *y float y coordinates of the object
*
* Output parameters:
* *concave int Result: 1 concave, 0 not concave
* *iret int Return code
* 0 = Function successful
* -5 = Invalid pointer in arguments
* -7 = Too few points to determine if concave.
**
* Log:
* S.Danz/AWC 2/06 Created
****************************************************************************/
{
int prev, next, curr, finish, ispoly;
float area;
/*---------------------------------------------------------------------*/
if (!x || !y || !concave) {
*iret = -5;
return;
}
*concave = 0;
if (points < 3) {
*iret = -7;
return;
}
/*
* Check if a polygon, stop one earlier for a line since we don't
* wrap around for that
*/
if (((points > 2) && ( G_DIFFT(x[0], x[points-1], GDIFFD) )
&& ( G_DIFFT(y[0], y[points-1], GDIFFD) ))) {
finish = points;
ispoly = 1;
} else {
finish = points-1;
ispoly = 0;
}
*iret = 0;
for (curr = 1; !*concave && curr < finish; curr++) {
prev = curr - 1;
/*
* For a polygon, since the first point is repeated we
* need to use two back from the last for the first test
*/
if (ispoly && curr == finish-1) {
next = 1;
} else {
next = curr + 1;
}
/*
* Test if the angle ABC is convex/concave. If concave, we need to
* to 'flip' the bisecting line over since it will be pointing the
* wrong way. From the Comp.Graphics.Algorithms FAQ, Section 2.07
* the orientaition can be determined by computing the signed area
* of a polygon, and if it is negative it is concave. Since we
* are only dealing with 3 points on a line, can can connect A and
* C to make a triangle, and compute its signed area. If the value
* is negative, ABC is concave.
*/
area = x[curr]*y[next] -
x[next]*y[curr] +
x[prev]*y[curr] -
x[curr]*y[prev] +
x[next]*y[prev] -
x[prev]*y[next];
if (area < 0) {
*concave = 1;
}
}
return;
}
void df_not ( int *iret )
/************************************************************************
* df_not *
* *
* This function is invoked as NOT ( S ). It returns 1 if S == 0; *
* otherwise 0. *
* *
* df_not ( 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, num, kxd, kyd, ksub1, ksub2, i, im1, zero, ier;
float *gnum1, *gnum, dg1;
/*----------------------------------------------------------------------*/
*iret = 0;
zero = 0;
dg_ssub ( iret );
/*
* Get ONE grid from the stack.
*/
dg_gets ( &num1, iret );
if ( *iret != 0 ) return;
/*
* Get a new grid number for the output grid.
*/
dg_nxts ( &num, iret );
if ( *iret != 0 ) return;
dg_getg ( &num1, &gnum1, &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];
if ( ERMISS ( dg1 ) ) {
gnum[im1] = RMISSD;
} else {
if( G_DIFFT(dg1, 0.0F, GDIFFD) ) {
gnum[im1] = 1.0F;
} else {
gnum[im1] = 0.0F;
}
}
}
/*
* Get a name of the form 'NOT'//S1/ and update header;
* update stack.
*/
dg_updh ( "NOT", &num, &num1, &zero, iret );
dg_puts ( &num, iret );
dg_esub ( &num, &zero, &zero, &zero, &ier );
if ( ier != 0 ) *iret = ier;
return;
}
void df_atn2 ( int *iret )
/************************************************************************
* df_atn2 *
* *
* This subroutine computes the arc tangent of the quotient of two *
* scalar grids: *
* *
* ATAN2 (S1, S2) = ATAN2 ( S1 / S2 ) *
* *
* df_atn2 ( iret ) *
* *
* Output parameters: *
* *iret int Return code *
* As for DG_GETS *
** *
* Log: *
* M. Goodman/RDS 11/85 *
* W. Skillman/GSFC 5/88 Added new stack subroutines *
* G. Huffman/GSC 8/88 Correct answer at infinity *
* G. Huffman/GSC 9/88 Error messages *
* G. Huffman/GSC 4/89 Correct first infinity test to denom. *
* K. Brill/GSC 8/89 Subsetting *
* K. Brill/GSC 10/89 Subsetting *
* T. Lee/GSC 4/96 Single dimension for dgg *
* K. Tyle/GSC 5/96 Moved IGDPT outside do-loop *
* T. Piper/GSC 11/98 Updated prolog *
* 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 10/05 Translated from Fortran *
************************************************************************/
{
int num1, num2, num, kxd, kyd, ksub1, ksub2, fidx, cidx, zero, ier;
float *gnum1, *gnum2, *gnum, dg1, dg2;
/*----------------------------------------------------------------------*/
*iret = 0;
zero = 0;
dg_ssub ( iret );
/*
* Get the two grids from the stack.
*/
dg_gets ( &num1, iret );
if ( *iret != 0 ) return;
dg_gets ( &num2, iret );
if ( *iret != 0 ) return;
/*
* Get a new grid.
*/
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 ( &num, &gnum, &kxd, &kyd, &ksub1, &ksub2, iret );
/*
* Compute the arc tangent.
*/
for ( fidx = ksub1; fidx <= ksub2; fidx++ ) {
cidx = fidx - 1;
dg1 = gnum1[cidx];
dg2 = gnum2[cidx];
/*
* Cases are error, non-zero denom., zero denom. with neg.
* numerator, zero denom. with non-neg. numerator.
*/
if ( ERMISS ( dg1 ) || ERMISS ( dg2 ) ) {
gnum[cidx] = RMISSD;
} else if ( !G_DIFFT(dg2, 0.0F, GDIFFD) ) {
gnum[cidx] = atan2 ( dg1, dg2 );
} else if ( dg1 < 0.0F ) {
gnum[cidx] = -HALFPI;
} else {
gnum[cidx] = HALFPI;
}
}
/*
* Get a name of the form 'ATAN'//S1//S2 and update header;
* update stack.
*/
dg_updh ( "ATAN", &num, &num1, &num2, iret );
dg_puts ( &num, iret );
dg_esub ( &num, &zero, &zero, &zero, &ier );
if ( ier != 0 ) *iret = ier;
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;
}
static void aspc_gamma ( Point *p )
/************************************************************************
* aspc_gamma *
* *
* This routine caculates the point value from the point index *
* *
* aspc_gamma ( p ) *
* *
* Input parameters: *
* *p Point A point *
* Output parameters: *
* None *
* Log: *
* R. Tian/SAIC 7/02 *
* S. Jacobs/NCEP 12/02 Changed computation of X and Y for pts *
* S. Jacobs/NCEP 12/02 Added check for crossing the dateline *
* S. Jacobs/NCEP 12/02 Added check on the array index value *
***********************************************************************/
{
int index;
float fr, tlon;
/*---------------------------------------------------------------------*/
index = (int) T(p);
fr = T(p) - index;
if ( G_DIFFT(fr, 0.0F, GDIFFD) ) {
fr = 1.0;
}
else {
index += 1;
}
if ( G_DIFFT(T(p), 0.0F, GDIFFD) ) {
X(p) = xinpts[index];
Y(p) = yinpts[index];
}
else {
/*
* Check for crossing the international dateline.
*/
if ( ( -180.0F <= yinpts[index-1] &&
yinpts[index-1] <= -150.0F ) &&
( 150.0F <= yinpts[index] &&
yinpts[index] <= 180.0F ) ) {
tlon = yinpts[index-1] + 360.0F;
X(p) = xinpts[index-1] + (xinpts[index] - xinpts[index-1]) * fr;
Y(p) = tlon + (yinpts[index] - tlon) * fr;
}
else if ( ( -180.0F <= yinpts[index] &&
yinpts[index] <= -150.0F ) &&
( 150.0F <= yinpts[index-1] &&
yinpts[index-1] <= 180.0F ) ) {
tlon = yinpts[index] + 360.0F;
X(p) = xinpts[index-1] + (xinpts[index] - xinpts[index-1]) * fr;
Y(p) = yinpts[index-1] + (tlon - yinpts[index-1]) * fr;
}
else {
X(p) = xinpts[index-1] + (xinpts[index] - xinpts[index-1]) * fr;
Y(p) = yinpts[index-1] + (yinpts[index] - yinpts[index-1]) * fr;
}
}
}
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 dv_rich ( int *iret )
/************************************************************************
* dv_rich *
* *
* This subroutine computes the Richardson stability number in a layer: *
* *
* RICH ( V ) = GRAVTY * DZ * LDF (THTA) / *
* [ LAV (THTA) * MAG ( VLDF (V) ) ** 2 ] *
* *
* Where: DZ = change in height across the layer *
* = -( RDGAS / GRAVTY ) * LAV (THTA) * *
* ( LAV (PRES) / 1000 ) ** KAPPA * *
* LDF (PRES) / LAV (PRES) *
* in THTA coordinates *
* *
* RICH generates a scalar grid. *
* *
* dv_rich ( iret ) *
* *
* Output parameters: *
* *iret int Return code *
* As for DG_GETV *
** *
* Log: *
* M. Goodman/RDS 12/85 *
* M. desJardins/GSFC 10/86 Added parameter statement for RKAPPA *
* G. Huffman/GSC 9/88 New stack functions *
* G. Huffman/GSC 9/88 Error messages *
* K. Brill/GSC 8/89 Subsetting *
* K. Brill/GSC 10/89 Subsetting *
* K. Brill/GSC 12/89 Compute dz from p,T when HGHT is missing*
* M. desJardins/NMC 7/93 Changed update scheme *
* T. Lee/GSC 4/96 Single dimension for dgg *
* T. Lee/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 *
* S. Gilbert/NCEP 11/05 Translation from Fortran *
************************************************************************/
{
int i, ier, kxd, kyd, ksub1, ksub2, nval, zero=0, tmp;
int nu, nv, nvldfu, nvldfv, nmag, idlun;
int ndz, ndp, npbar, ntbar, npav;
float *grdz, *grdp, *grpbar, *grtbar, *grpav;
int ndth, nath, nwsq, nrich;
float *grdth, *grath, *grwsq, *grrich;
float dp, tbar, pbar, avthta, cnst, dz, deltht, ath, dth;
float dwsq, pav, avtht;
char gp[13], wname[13], gdum[13], pdum[13];
char time1[21], time2[21], errst[1024];
int level1, level2, ivcord;
/*------------------------------------------------------------------------*/
*iret = 0;
dg_ssub ( iret );
/*
* Read the wind vector name, level, and vertical coordinate.
* Compute the wind shear in the layer and read the grid number
* of the result.
*/
dg_topv ( wname, &nu, &nv, time1, time2, &level1, &level2,
&ivcord, pdum, iret );
if ( *iret != 0 ) return;
dv_vldf ( iret );
if ( *iret != 0 ) return;
dg_topv ( gdum, &nvldfu, &nvldfv, time1, time2, &level1,
&level2, &ivcord, pdum, iret );
if ( *iret != 0 ) return;
/*
* Compute the magnitude of the wind shear and square it (by
* reading the grid number of the result, putting another copy
* on the stack, and multiplying). Read the grid number of the
* result.
*/
dv_mag ( iret );
if ( *iret != 0 ) return;
dg_tops ( gdum, &nmag, time1, time2, &level1, &level2,
&ivcord, pdum, iret );
if ( *iret != 0 ) return;
dg_puts ( &nmag, iret );
if ( *iret != 0 ) return;
df_mul ( iret );
if ( *iret != 0 ) return;
dg_tops ( gdum, &nwsq, time1, time2, &level1, &level2,
&ivcord, pdum, iret );
if ( *iret != 0 ) return;
/*
* Compute a grid of delta height depending upon the coordinate
* system.
*/
if ( ivcord == 1 ) {
/*
* Pressure coordinate system.
* Replace the top of the stack with HGHT (preserving in-line
* parameters), compute LDF, and read the grid number of the
* result.
*/
dg_rpls ( "HGHT", &zero, iret );
if ( *iret != 0 ) return;
df_ldf ( iret );
if ( *iret != 0 ) {
/*
* Compute dz from p and T.
*/
dg_rpls ( "PRES", &zero, iret );
if ( *iret != 0 ) return;
df_lav ( iret );
if ( *iret != 0 ) return;
dg_tops ( gdum, &npbar, time1, time2, &level1, &level2,
&ivcord, pdum, iret );
if ( *iret != 0 ) return;
dg_rpls ( "TMPK", &zero, iret );
if ( *iret != 0 ) return;
df_lav ( iret );
if ( *iret != 0 ) return;
dg_tops ( gdum, &ntbar, time1, time2, &level1, &level2,
&ivcord, pdum, iret );
if ( *iret != 0 ) return;
dg_rpls ( "PRES", &zero, iret );
if ( *iret != 0 ) return;
df_ldf ( iret );
if ( *iret != 0 ) return;
dg_tops ( gdum, &ndp, time1, time2, &level1, &level2,
&ivcord, pdum, iret );
if ( *iret != 0 ) return;
dg_nxts ( &ndz, iret );
if ( *iret != 0 ) return;
dg_getg ( &ndp, &grdp, &kxd, &kyd, &ksub1, &ksub2, iret );
dg_getg ( &ndz, &grdz, &kxd, &kyd, &ksub1, &ksub2, iret );
dg_getg ( &ntbar, &grtbar, &kxd, &kyd, &ksub1, &ksub2, iret );
dg_getg ( &npbar, &grpbar, &kxd, &kyd, &ksub1, &ksub2, iret );
for ( i = ksub1 - 1; i < ksub2; i++ ) {
dp = grdp[i];
tbar = grtbar[i];
pbar = grpbar[i];
if ( ERMISS ( dp ) || ERMISS ( tbar ) || ERMISS ( pbar ) )
grdz[i] = RMISSD;
else
grdz[i] = -RKAP * tbar * dp / pbar;
}
}
else {
dg_tops ( gdum, &ndz, time1, time2, &level1, &level2,
&ivcord, pdum, iret );
if ( *iret != 0 ) return;
}
}
else if ( ivcord == 2 ) {
/*
* Isentropic coordinate system.
* Compute the height differences as documented in the header.
* The PRES operations preserve access to in-line parameters.
*/
avthta = (level1 + level2) / 2.;
cnst = -avthta * RKAP;
dg_rpls ( "PRES", &zero, iret );
if ( *iret != 0 ) return;
df_lav ( iret );
if ( *iret != 0 ) return;
dg_tops ( gdum, &npav, time1, time2, &level1, &level2,
&ivcord, pdum, iret );
if ( *iret != 0 ) return;
dg_rpls ( "PRES", &zero, iret );
if ( *iret != 0 ) return;
df_ldf ( iret );
if ( *iret != 0 ) return;
dg_tops ( gdum, &ndp, time1, time2, &level1, &level2,
&ivcord, pdum, iret );
if ( *iret != 0 ) return;
/*
* Get a new grid number for the height field.
*/
dg_nxts ( &ndz, iret );
if ( *iret != 0 ) return;
dg_getg ( &ndp, &grdp, &kxd, &kyd, &ksub1, &ksub2, iret );
dg_getg ( &ndz, &grdz, &kxd, &kyd, &ksub1, &ksub2, iret );
dg_getg ( &npav, &grpav, &kxd, &kyd, &ksub1, &ksub2, iret );
for ( i = ksub1 - 1; i < ksub2; i++ ) {
if ( ( G_DIFFT(grpav[i], 0.0F, GDIFFD) ) ||
ERMISS ( grpav[i] ) || ERMISS ( grdp[i] ) )
grdz[i] = RMISSD;
else {
dp = grdp[i];
pav = grpav[i];
grdz[i] = cnst * pow ( ( pav / 1000. ), RKAPPA )
* ( dp / pav );
}
}
}
else if ( ivcord == 3 ) {
/*
* Height coordinate system.
* Generate a (constant) grid of height difference. No stack
* operations occur.
*/
dg_nxts ( &ndz, iret );
if ( *iret != 0 ) return;
dz = level1 - level2;
dg_real ( &dz, &ndz, iret );
}
else {
/*
* "No" or unrecognized coordinate system. This is an error.
*/
*iret = -24;
tmp = -1;
dg_merr ( "", "", "", &tmp, &tmp, &ivcord, errst, &ier );
dg_cset ( "ERRST", errst, iret );
return;
}
/*
* Compute the average THTA and THTA difference in the layer
* depending upon the coordinate system. Stack operations are
* designed to preserve access to in-line parameters.
*/
if (( ivcord == 1 ) || ( ivcord == 3)) {
/*
* Pressure or height coordinate system.
* Compute the delta THTA in the layer.
*/
dg_rpls ( "THTA", &zero, iret );
if ( *iret != 0 ) return;
df_ldf ( iret );
if ( *iret != 0 ) return;
dg_tops ( gdum, &ndth, time1, time2, &level1, &level2,
&ivcord, pdum, iret );
if ( *iret != 0 ) return;
/*
* Compute the average THTA in the layer.
*/
dg_rpls ( "THTA", &zero, iret );
if ( *iret != 0 ) return;
df_lav ( iret );
if ( *iret != 0 ) return;
dg_tops ( gdum, &nath, time1, time2, &level1, &level2,
&ivcord, pdum, iret );
if ( *iret != 0 ) return;
}
else if ( ivcord == 2 ) {
/*
* Isentropic coordinate system.
* Constant values are put into new grids (no stack operations).
* Compute the average THTA in the layer.
*/
dg_nxts ( &nath, iret );
if ( *iret != 0 ) return;
avtht = (level1 + level2) / 2.;
dg_real ( &avtht, &nath, iret );
/*
* Compute the THTA difference in the layer.
*/
dg_nxts ( &ndth, iret );
if ( *iret != 0 ) return;
deltht = level1 - level2;
dg_real ( &deltht, &ndth, iret );
}
/*
* No test for other values of IVCORD was needed because they
* were kicked out in the IF for DZ. Get a new grid for the
* Richardson number and compute it.
*/
dg_nxts ( &nrich, iret );
if ( *iret != 0 ) return;
dg_getg ( &ndz, &grdz, &kxd, &kyd, &ksub1, &ksub2, iret );
dg_getg ( &ndth, &grdth, &kxd, &kyd, &ksub1, &ksub2, iret );
dg_getg ( &nath, &grath, &kxd, &kyd, &ksub1, &ksub2, iret );
dg_getg ( &nwsq, &grwsq, &kxd, &kyd, &ksub1, &ksub2, iret );
dg_getg ( &nrich, &grrich, &kxd, &kyd, &ksub1, &ksub2, iret );
for ( i = ksub1 - 1; i < ksub2; i++ ) {
ath = grath[i];
dth = grdth[i];
dz = grdz[i];
dwsq = grwsq[i];
if ( ERMISS (ath ) || G_DIFFT(ath, 0.0F, GDIFFD) ||
ERMISS (dwsq) || G_DIFFT(dwsq, 0.0F, GDIFFD) ||
ERMISS (dth ) || ERMISS (dz ) )
grrich[i] = RMISSD;
else
grrich[i] = ( GRAVTY * dz / ath) * ( dth / dwsq );
}
/*
* Make a name of the form 'RICH'//V and update header;
* update the stack.
*/
dg_mnam ( "RICH", wname, "", gp, iret );
nval = 1;
dg_iget ( "IDLUN", &nval, &idlun, iret);
dg_upsg ( time1, time2, &level1, &level2, &ivcord, &idlun, gp,
&nrich, iret );
dg_rpls ( "", &nrich, iret );
dg_esub ( &nrich, &zero, &zero, &zero, &ier );
if ( ier != 0 ) *iret = ier;
return;
}
