void df_acos ( int *iret )
/************************************************************************
* df_acos *
* *
* This subroutine computes the arc cosine of a scalar grid: *
* *
* ACOS (S) *
* *
* where S is in radians. *
* *
* df_acos ( 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 9/88 Error messages *
* 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 *
* 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 Recoded from Fortran *
************************************************************************/
{
int num1, num, kxd, kyd, ksub1, ksub2, fidx, cidx, zero, ier;
float *gnum1, *gnum, dg1;
/*----------------------------------------------------------------------*/
*iret = 0;
zero = 0;
dg_ssub ( iret );
/*
* Get the grid from the stack.
*/
dg_gets ( &num1, 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 ( &num, &gnum, &kxd, &kyd, &ksub1, &ksub2, iret );
/*
* Compute the arc cosine.
*/
for ( fidx = ksub1; fidx <= ksub2; fidx++ ) {
cidx = fidx - 1;
dg1 = gnum1[cidx];
if ( ( dg1 < -1. ) || ( dg1 > 1. ) ) {
gnum[cidx] = RMISSD;
} else {
gnum[cidx] = acos ( dg1 );
}
}
/*
* Get a name of the form 'ACOS'//S and update header;
* update stack.
*/
dg_updh ( "ACOS", &num, &num1, &zero, iret );
dg_puts ( &num, iret );
dg_esub ( &num, &zero,&zero, &zero, &ier );
if ( ier != 0 ) *iret = ier;
return;
}
void df_sub ( int *iret )
/************************************************************************
* df_sub *
* *
* This subroutine subtracts two scalar grids: *
* *
* SUB (S1, S2) = S1 - S2 *
* *
* df_sub ( iret ) *
* *
* Output parameters: *
* *iret int Return code *
* As for DG_GETS *
** *
* Log: *
* M. desJardins/GSFC 10/85 *
* M. desJardins/GSFC 5/88 Added new stack subroutines *
* G. Huffman/GSC 9/88 Error messages *
* 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 *
* 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 *
************************************************************************/
{
int num1, num2, num, kxd, kyd, ksub1, ksub2, i, im1, ier, zero;
float *gnum1, *gnum2, *gnum, dg1, dg2;
/*----------------------------------------------------------------------*/
*iret = 0;
zero = 0;
dg_ssub ( iret );
/*
* Get 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 number and subtract 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 ( &num, &gnum, &kxd, &kyd, &ksub1, &ksub2, iret );
for ( i = ksub1; i <= ksub2; i++ ) {
im1 = i - 1;
dg1 = gnum1[im1];
dg2 = gnum2[im1];
if ( ERMISS ( dg1 ) || ERMISS ( dg2 ) ) {
gnum[im1] = RMISSD;
} else {
gnum[im1] = dg1 - dg2;
}
}
/*
* Make a name of the form 'SUB'//S1//S2 and update header;
* update stack.
*/
dg_updh ( "SUB", &num, &num1, &num2, iret );
dg_puts ( &num, iret );
dg_esub ( &num, &zero, &zero, &zero, &ier );
if ( ier != 0 ) *iret = ier;
return;
}
void df_hilo ( const int *hi, const int *lo, int *iret )
/************************************************************************
* df_hilo *
* *
* This subroutine finds the relative extrema over a grid. *
* *
* df_hilo ( hi, lo, iret ) *
* *
* Input parameters: *
* *hi const int Flag for finding highs *
* *lo const int Flag for finding lows *
* *
* Output parameters: *
* *iret int Return code *
* As for DG_GETS *
** *
* Log: *
* K. Brill/NMC 5/93 *
* D. Keiser/GSC 7/95 Changed DC_HILO to DG_HILO *
* D. Keiser/GSC 10/95 Add call to write error message after *
* call to DG_HILO *
* 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 11/05 Recoded from Fortran *
************************************************************************/
{
int num1, num2, no, nx, kxd, kyd, kxyd, ksub1, ksub2;
int krad, nmax, nmin, ixmx, iymx, ivmx, ixmn, iymn, ivmn, intflg,
nummx, nummn, ii, i, j, nxi,nxj, nxv, index, ier, ier2, izero;
float *gnum1, *gnum2, *gno, *gnx, fzero;
char namout[5];
/*----------------------------------------------------------------------*/
*iret = 0;
izero = 0;
fzero = 0.0;
dg_ssub ( iret );
strcpy ( namout, "HILO" );
/*
* Get the grid to be searched from the stack.
*/
dg_gets ( &num1, iret );
if ( *iret != 0 ) return;
dg_getg ( &num1, &gnum1, &kxd, &kyd, &ksub1, &ksub2, iret );
/*
* Get the radius value.
*/
dg_gets ( &num2, iret );
if ( *iret != 0 ) return;
dg_getg ( &num2, &gnum2, &kxd, &kyd, &ksub1, &ksub2, iret );
krad = G_NINT ( gnum2[0] );
/*
* Get a new grid number for the output highs and lows.
*/
dg_nxts ( &no, iret );
if ( *iret != 0 ) return;
dg_getg ( &no, &gno, &kxd, &kyd, &ksub1, &ksub2, iret );
kxyd = kxd * kyd;
nmax = kxyd / 6;
nmin = nmax;
/*
* Store the HILO information in the NX grid.
*/
dg_nxts ( &nx, iret );
if ( *iret != 0 ) return;
dg_getg ( &nx, &gnx, &kxd, &kyd, &ksub1, &ksub2, iret );
ixmx = 1;
iymx = 1 + nmax;
ivmx = iymx + nmax;
ixmn = ivmx + nmin;
iymn = ixmn + nmin;
ivmn = iymn + nmin;
if ( *hi == G_FALSE ) nmax = 0;
if ( *lo == G_FALSE ) nmin = 0;
intflg = G_FALSE;
dg_hilo ( gnum1, &kxd, &kyd, &krad, &intflg, &nmax, &nmin,
&fzero, &fzero, &fzero, &fzero,
&nummx, &gnx[ixmx-1], &gnx[iymx-1], &gnx[ivmx-1],
&nummn, &gnx[ixmn-1], &gnx[iymn-1], &gnx[ivmn-1], iret );
if ( *iret < 0 ) return;
/*
* Write out error message regarding internal buffers in DG_HILO.
*/
if ( *iret != 0 ) {
er_wmsg ( "DG", iret, " ", &ier2, strlen("DG"), strlen(" ") );
}
/*
* Set all grid values to missing.
*/
for ( ii = ksub1; ii <= ksub2; ii++ ) {
gno[ii-1] = RMISSD;
}
if ( *hi == G_TRUE ) {
if ( *lo == G_FALSE ) strcpy ( namout, "HIGH" );
/*
* Put the maxima on the grid.
*/
for ( ii = 1, nxi = ixmx-1, nxj = iymx-1, nxv = ivmx-1;
ii <= nummx;
ii++, nxi++, nxj++, nxv++ ) {
i = G_NINT ( gnx[nxi] );
j = G_NINT ( gnx[nxj] );
index = ( j - 1 ) * kxd + i;
gno[index-1] = gnx[nxv];
}
}
if ( *lo == G_TRUE ) {
if ( *hi == G_FALSE ) strcpy ( namout, "LOWS" );
/*
*Put the minima on the grid.
*/
for ( ii = 1, nxi = ixmn-1, nxj = iymn-1, nxv = ivmn-1;
ii <= nummn;
ii++, nxi++, nxj++, nxv++ ) {
i = G_NINT ( gnx[nxi] );
j = G_NINT ( gnx[nxj] );
index = ( j - 1 ) * kxd + i;
gno[index-1] = gnx[nxv];
}
}
/*
* Get a name of the form NAMOUT //S and update header;
* update stack.
*/
dg_updh ( namout, &no, &num1, &izero, iret );
dg_puts ( &no, iret );
dg_esub ( &no, &izero, &izero, &izero, &ier );
if ( ier != 0 ) *iret = ier;
return;
}
void dg_temp ( const char *time1, const char *time2, const int *level1,
const int *level2, const int *ivcord, const char *parm,
int *num, int *iret )
/************************************************************************
* dg_temp *
* *
* This subroutine checks for alternate ways to compute temperature. *
* The grid will be found in the grid location pointed to by NUM. If *
* NUM = 0 on input, the next grid location will be used and returned. *
* If NUM > 0, the grid will be found at NUM. *
* *
* dg_temp ( time1, time2, level1, level2, ivcord, parm, num, iret ) *
* *
* Input parameters: *
* *time1 const char Date/time *
* *time2 const char Date/time *
* *level1 const int Level *
* *level2 const int Level *
* *ivcord const int Vertical coordinate *
* *parm const char Parameter name *
* *
* Input and output parameters: *
* *num int Location of grid *
* *
* Output parameters: *
* *iret int Return code *
* 0 = normal return *
* -7 = grid cannot be found *
* -8 = grid is the wrong size *
** *
* Log: *
* M. desJardins/GSFC 2/90 *
* K. Brill/NMC 9/90 Fix to get DWPC label on rtrn *
* J. Whistler/SSAI 5/91 Added DG_MXNT to find MIXR *
* K. Brill/NMC 12/91 Reset SCALE for DWPC from MIXR or MIXS *
* M. desJardins/NMC 3/92 Reorganize; eliminate DWPx here *
* M. desJardins/NMC 3/93 Update file number *
* T. Lee/GSC 4/96 Single dimension for dgg *
* K. Brill/HPC 11/02 Eliminate use of the SUBA logical array *
* R. Tian/SAIC 2/06 Recoded from Fortran *
************************************************************************/
{
char ppp[5], ptmp[5];
int np, nm, lenp, ier;
/*----------------------------------------------------------------------*/
*iret = -7;
/*
* Check that the input string length is 4.
*/
cst_lstr ( (char *)parm, &lenp, &ier );
if ( lenp != 4 ) return;
/*
* Check that this is temperature.
*/
if ( ( strcmp ( parm, "TEMP" ) == 0 ) ||
( strcmp ( parm, "TMPC" ) == 0 ) ||
( strcmp ( parm, "TMPK" ) == 0 ) ||
( strcmp ( parm, "TMPF" ) == 0 ) ) {
strcpy ( ppp, parm );
} else {
return;
}
/*
* Check file for grid stored in K, C or F.
*/
dg_gtmp ( time1, time2, level1, level2, ivcord, ppp, num, iret );
if ( *iret == 0 ) return;
/*
* Try alternate methods for temperature.
* Compute temperature from THTA and PRES.
*/
strcpy ( ptmp, "THTA" );
dg_gtmp ( time1, time2, level1, level2, ivcord, ptmp, num, iret );
if ( *iret == 0 ) {
strcpy ( ptmp, "PRES" );
dg_nxts ( &np, &ier );
dg_vcrd ( time1, time2, level1, level2, ivcord, ptmp, &np, iret );
if ( *iret == 0 ) {
pd_tmpk ( _dggrid.dgg[np-1].grid, _dggrid.dgg[(*num)-1].grid,
&_dgfile.kxyd, _dggrid.dgg[(*num)-1].grid, &ier );
dg_cdeg ( "TMPK", parm, num, iret );
}
dg_frig ( &np, &ier );
}
/*
* Compute temperature from MIXS and PRES.
*/
if ( *iret != 0 ) {
strcpy ( ptmp, "MIXS" );
dg_nxts ( &nm, &ier );
dg_mxnt ( time1, time2, level1, level2, ivcord, ptmp, &nm, iret );
if ( *iret == 0 ) {
strcpy ( ptmp, "PRES" );
dg_vcrd ( time1, time2, level1, level2, ivcord, ptmp, num, iret );
if ( *iret == 0 ) {
pd_dwpt ( _dggrid.dgg[nm-1].grid, _dggrid.dgg[(*num)-1].grid,
&_dgfile.kxyd, _dggrid.dgg[(*num)-1].grid, &ier );
dg_cdeg ( "TMPC", parm, num, iret );
}
}
dg_frig ( &nm, &ier );
}
/*
* Exit if the temperature was not found.
*/
if ( *iret != 0 ) return;
/*
* Put correct name in label.
*/
dg_upsg ( time1, time2, level1, level2, ivcord, &_dgfile.idlun,
parm, num, &ier );
return;
}
void df_sm9s ( int *iret )
/************************************************************************
* df_sm9s *
* *
* This subroutine uses a 9 point smoother to smooth a scalar grid. *
* *
* df_sm9s ( iret ) *
* *
* Output parameters: *
* *iret int Return code *
* As for DG_GETS *
** *
* Log: *
* C.L. Shie/SSAI 12/93 Modified from DF_SM5S *
* T. Lee/GSC 4/96 Single dimension for dgg *
* K. Tyle/GSC 5/96 Moved IGDPT outside do-loop; rearranged *
* K. Brill/HPC 1/02 CALL DG_SSUB and DG_ESUB *
* R. Tian/SAIC 11/05 Recoded from Fortran *
************************************************************************/
{
int ni, no, jgymin, jgymax, jgxmin, jgxmax, kxd, kyd, ksub1, ksub2;
int i, j, ii, ip1, im1, jp1, jm1, imjm, ipjm, imjp, ipjp, ier, zero;
float *gni, *gno, dsum, wsum, wt, wtc, wt4;
float dip1, dim1, djp1, djm1, dimjm, dipjm, dimjp, dipjp;
/*----------------------------------------------------------------------*/
*iret = 0;
zero = 0;
dg_ssub ( iret );
/*
* Set filter weight for Diamond points weight
*/
wt = 2.0;
/*
* Corner points weight
*/
wtc = 1.0;
/*
* Center point weight
*/
wt4 = 4.0;
/*
* Get the grid number.
*/
dg_gets ( &ni, iret );
if ( *iret != 0 ) return;
/*
* Get a new grid number and do the smoothing.
*/
dg_nxts ( &no, iret );
if ( *iret != 0 ) return;
/*
* Grid number to grid.
*/
dg_getg ( &ni, &gni, &kxd, &kyd, &ksub1, &ksub2, iret );
dg_getg ( &no, &gno, &kxd, &kyd, &ksub1, &ksub2, iret );
/*
* Apply nine-point variable smoother over subset grid.
*/
dg_qbnd ( &jgxmin, &jgxmax, &jgymin, &jgymax, iret );
for ( j = jgymin; j <= jgymax; j++ ) {
for ( i = jgxmin; i <= jgxmax; i++ ) {
ii = ( j - 1 ) * kxd + i;
if ( ERMISS ( gni[ii-1] ) ) {
/*
* Check for missing data.
*/
gno[ii-1] = RMISSD;
} else {
ip1 = ii + 1;
if ( i+1 > jgxmax ) {
dip1 = RMISSD;
} else {
dip1 = gni[ip1-1];
}
im1 = ii - 1;
if ( i-1 < jgxmin ) {
dim1 = RMISSD;
} else {
dim1 = gni[im1-1];
}
jp1 = ii + kxd;
if ( j+1 > jgymax ) {
djp1 = RMISSD;
} else {
djp1 = gni[jp1-1];
}
jm1 = ii - kxd;
if ( j-1 < jgymin ) {
djm1 = RMISSD;
} else {
djm1 = gni[jm1-1];
}
imjm = jm1 - 1;
if ( ( j-1 < jgymin ) || ( i-1 < jgxmin ) ) {
dimjm = RMISSD;
} else {
dimjm = gni[imjm-1];
}
ipjm = jm1 + 1;
if ( ( j-1 < jgymin ) || ( i+1 > jgxmax ) ) {
dipjm = RMISSD;
} else {
dipjm = gni[ipjm-1];
}
imjp = jp1 - 1;
if ( ( j+1 > jgymax ) || ( i-1 < jgxmin ) ) {
dimjp = RMISSD;
} else {
dimjp = gni[imjp-1];
}
ipjp = jp1 + 1;
if ( ( j+1 > jgymax ) || ( i+1 > jgxmax ) ) {
dipjp = RMISSD;
} else {
dipjp = gni[ipjp-1];
}
dsum = gni[ii-1] * wt4;
wsum = wt4;
if ( ! ERMISS ( dip1 ) ) {
dsum += dip1 * wt;
wsum += wt;
} else {
dsum += gni[ii-1] * wt;
wsum += wt;
}
if ( ! ERMISS ( dim1 ) ) {
dsum += dim1 * wt;
wsum += wt;
} else {
dsum += gni[ii-1] * wt;
wsum += wt;
}
if ( ! ERMISS ( djp1 ) ) {
dsum += djp1 * wt;
wsum += wt;
} else {
dsum += gni[ii-1] * wt;
wsum += wt;
}
if ( ! ERMISS ( djm1 ) ) {
dsum += djm1 * wt;
wsum += wt;
} else {
dsum += gni[ii-1] * wt;
wsum += wt;
}
if ( ! ERMISS ( dimjm ) ) {
dsum += dimjm * wtc;
wsum += wtc;
} else {
dsum += gni[ii-1] * wtc;
wsum += wtc;
}
if ( ! ERMISS ( dipjm ) ) {
dsum += dipjm * wtc;
wsum += wtc;
} else {
dsum += gni[ii-1] * wtc;
wsum += wtc;
}
if ( ! ERMISS ( dimjp ) ) {
dsum += dimjp * wtc;
wsum += wtc;
} else {
dsum += gni[ii-1] * wtc;
wsum += wtc;
}
if ( ! ERMISS ( dipjp ) ) {
dsum += dipjp * wtc;
wsum += wtc;
} else {
dsum += gni[ii-1] * wtc;
wsum += wtc;
}
gno[ii-1] = dsum/wsum ;
}
}
}
/*
* Make a name of the form 'SM9'//S and update header;
* update stack.
*/
dg_updh ( "SM9", &no, &ni, &zero, iret );
dg_puts ( &no, iret );
dg_esub ( &no, &zero, &zero, &zero, &ier );
if ( ier != 0 ) *iret = ier;
return;
}
void df_nmin ( int *iret )
/************************************************************************
* df_nmin *
* *
* This subroutine computes NMIN (S,ROI), the neigborhood minimum *
* value of a scalar field (S) within some radius of influence *
* (ROI; meters). Masking could be used [e.g., SGT(S1,S2)] to subset *
* and filter the grid beforehand to allow for faster processing. *
* *
* df_nmin ( iret ) *
* *
* Output parameters: *
* *iret int Return code *
* As for DG_GETS *
** *
* Log: *
* C. Melick/SPC 06/12 *
* C. Melick/SPC 08/13 Correction to gnumn for missing data *
************************************************************************/
{
int num1, num2, num3, num, kxd, kyd, ksub1, ksub2, zero, indx, ier;
int ixmscl, iymscl, jgymin, jgymax, jgxmin, jgxmax, idglat, idglon;
int row, col, ibeg, iend, jbeg, jend, ibox, jbox, boxindx, nval;
float gddx, gddy, gdspdx, gdspdy, radius;
float *gnum1, *gnumn, *gkxms, *gkyms, *gnumroi, *glat, *glon, *dist;
/*----------------------------------------------------------------------*/
*iret = 0;
zero = 0;
dg_ssub ( iret );
/*
* Compute map scale factors.
*/
dg_mscl ( iret );
if ( *iret != 0 ) return;
/*
* Query DGCMN.CMN idglat/idglon.
*/
nval = 1;
dg_iget ( "IDGLAT", &nval, &idglat, iret );
if ( *iret != 0 ) return;
dg_iget ( "IDGLON", &nval, &idglon, iret );
if ( *iret != 0 ) return;
/*
* Get the grids from the stack.
*/
dg_gets ( &num1, iret );
if ( *iret != 0 ) return;
dg_gets ( &num2, iret );
if ( *iret != 0 ) return;
/*
* Get a new grid number.
*/
dg_nxts ( &num3, iret );
if ( *iret != 0 ) return;
dg_nxts ( &num, iret );
if ( *iret != 0 ) return;
dg_qmsl ( &ixmscl, &iymscl, &gddx, &gddy, &ier );
dg_qbnd ( &jgxmin, &jgxmax, &jgymin, &jgymax, &ier );
dg_getg ( &num1, &gnum1, &kxd, &kyd, &ksub1, &ksub2, &ier );
dg_getg ( &num, &gnumn, &kxd, &kyd, &ksub1, &ksub2, &ier );
dg_getg ( &ixmscl, &gkxms, &kxd, &kyd, &ksub1, &ksub2, &ier );
dg_getg ( &iymscl, &gkyms, &kxd, &kyd, &ksub1, &ksub2, &ier );
dg_getg ( &num2, &gnumroi, &kxd, &kyd, &ksub1, &ksub2, &ier );
dg_getg ( &idglat, &glat, &kxd, &kyd, &ksub1, &ksub2, &ier );
dg_getg ( &idglon, &glon, &kxd, &kyd, &ksub1, &ksub2, &ier );
dg_getg ( &num3, &dist, &kxd, &kyd, &ksub1, &ksub2, &ier );
radius = gnumroi[0];
/* QC check on lower and upper bounds of radius of influence. */
if ( radius < 0 ) {
radius = 0.0;
printf ("\n WARNING : RADIUS value less than zero. "
"Resetting to zero.\n");
}
if ( radius > 0.5*gddx*(float)(kxd)) {
radius = 0.5*gddx*(float)(kxd);
printf ("\n WARNING : RADIUS value too high. "
"Resetting to half the distance in X (%f meters).\n",radius);
}
/*
* Loop over all grid points to initialize output grid.
*/
for ( row = jgymin; row <= jgymax; row++ ) {
for ( col = jgxmin; col <= jgxmax; col++ ) {
indx=(row-1)*kxd+(col-1);
if ( ERMISS ( gnum1[indx] ) ) {
gnumn[indx] = RMISSD;
} else {
gnumn[indx] = gnum1[indx];
}
}
}
/*
* Loop over all grid points to determine neighborhood minimum for each grid point.
*/
for ( row = jgymin; row <= jgymax; row++ ) {
for ( col = jgxmin; col <= jgxmax; col++ ) {
indx=(row-1)*kxd+(col-1);
if ( ! ERMISS ( gnum1[indx] ) ) {
gdspdx= gddx / gkxms[indx];
gdspdy= gddy / gkyms[indx];
/* Constructing box for each grid point */
ibeg = col- G_NINT(radius / gdspdx);
iend = col+ G_NINT(radius / gdspdx);
jbeg = row- G_NINT(radius / gdspdy);
jend = row+ G_NINT(radius / gdspdy);
if (ibeg < jgxmin) {
ibeg = jgxmin;
}
if (iend > jgxmax) {
iend = jgxmax;
}
if (jbeg < jgymin) {
jbeg = jgymin;
}
if (jend > jgymax) {
jend = jgymax;
}
for ( ibox = ibeg; ibox <= iend; ibox++ ) {
for ( jbox = jbeg; jbox <= jend; jbox++ ) {
boxindx=(jbox-1)*kxd+(ibox-1);
if ((glat[indx] == glat[boxindx]) && (glon[indx] == glon[boxindx])) {
dist[boxindx]=0.0;
} else {
/* Great Circle Distance calculation */
dist[boxindx] = acos(sin(glat[boxindx])*sin(glat[indx]) + cos(glat[boxindx])*cos(glat[indx])*cos((glon[boxindx])-(glon[indx])));
dist[boxindx] = RADIUS * dist[boxindx];
}
/* Check minimum value if neighboring point is defined and within radius of influence. */
if ( (dist[boxindx] <= radius) && (! ERMISS ( gnum1[boxindx] ) ) ) {
if ( gnum1[boxindx] < gnumn[indx] ) {
gnumn[indx] = gnum1[boxindx];
}
}
}
}
for ( ibox = ibeg; ibox <= iend; ibox++ ) {
for ( jbox = jbeg; jbox <= jend; jbox++ ) {
boxindx=(jbox-1)*kxd+(ibox-1);
/* Spreading the response around to surrounding undefined values */
if ( ERMISS ( gnum1[boxindx] ) ) {
if (dist[boxindx] <= radius) {
if ( ERMISS ( gnumn[boxindx] ) ) {
/* gnumn[boxindx] = gnumn[indx]; */
gnumn[boxindx] = gnum1[indx];
} else if ( gnum1[indx] < gnumn[boxindx] ) {
gnumn[boxindx] = gnum1[indx];
}
}
}
}
}
}
}
}
/*
* Make a name of the form 'NMIN'//S and update header;
* update stack.
*/
dg_updh ( "NMIN", &num, &num1, &num2, iret );
dg_puts ( &num, iret );
dg_esub ( &num, &zero, &zero, &zero, &ier );
if ( ier != 0 ) *iret = ier;
return;
}
