void df_nmax ( int *iret ) /************************************************************************ * df_nmax * * * * This subroutine computes NMAX (S,ROI), the neigborhood maximum * * 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_nmax ( iret ) * * * * Output parameters: * * *iret int Return code * * As for DG_GETS * ** * * Log: * * C. Melick/SPC 06/12 * ************************************************************************/ { 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 maximum 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 maximum 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]; } else if ( gnum1[indx] > gnumn[boxindx] ) { gnumn[boxindx] = gnum1[indx]; } } } } } } } } /* * Make a name of the form 'NMAX'//S and update header; * update stack. */ dg_updh ( "NMAX", &num, &num1, &num2, iret ); dg_puts ( &num, iret ); dg_esub ( &num, &zero, &zero, &zero, &ier ); if ( ier != 0 ) *iret = ier; return; }
void df_rdfs ( int *iret ) /************************************************************************ * DF_RDFS (Resolution Dependent Filter for Scalar) * * * * This subroutine smoothes a scalar grid using a moving average * * low-pass filter whose weights are determined by the normal * * (Gaussian) probability distribution function for two dimensions. * * The weight given to any grid point within the area covered by the * * moving average for a target grid point is proportional to * * * * EXP [ -( D ** 2 ) ], * * * * where D is the distance from that point to the target point divided * * by the standard deviation of the normal distribution. The value of * * the standard deviation is determined by the degree of filtering * * requested. The degree of filtering is specified by giving an * * effective resolution in km for the output grid. From this value, * * an integer required as the input for the GWFS function is computed. * * * * See the documentation for the GWFS function for more details. * * * * When this function is invoked, the first argument is the grid to be * * smoothed, the second is the effective resolution as described above: * * * * RDFS ( S, dx ) * * * * where dx > 0. If the value of dx is less than the grid spacing * * on the internal grid, no filtering is done. * * * * DF_RDFS ( IRET ) * * * * Output parameters: * * IRET INTEGER Return code * * As for DG_GETS * ** * * Log: * * K. Brill/HPC 05/12 Developed from DF_GWFS * ************************************************************************/ { int nnw, kxd, kyd, ksub1, ksub2, zero, ier; int jj, ii, indx; int ixm, iym, ni, no; float *gnnw, *gnost; float gdx, gdy, dsg, eres, swl; /*----------------------------------------------------------------------*/ *iret = 0; zero = 0; dg_ssub ( iret ); /* * Compute map scale factors and grid increments. */ dg_mscl ( iret ); if ( *iret != 0 ) return; /* * Get the grid spacing values: */ dg_qmsl ( &ixm, &iym, &gdx, &gdy, iret ); if ( *iret != 0 ) return; if ( gdx > gdy ) { dsg = gdx; } else { dsg = gdy; } dsg = dsg / 1000.0; /*printf (" dsg = %f\n", dsg ); */ /* * Get the input grid number. */ dg_gets ( &ni, iret ); if ( *iret != 0 ) return; /* * Get the user specified effective resolution (km). */ dg_gets ( &nnw, iret ); if ( *iret != 0 ) return; dg_getg ( &nnw, &gnnw, &kxd, &kyd, &ksub1, &ksub2, iret ); eres = gnnw[0]; if ( eres < dsg ) { /*printf ( " No smoothing\n" );*/ /* * Do nothing -- return original grid without smoothing. */ /* * Make a name of the form 'RDF'//S and update header; * update stack. */ dg_updh ( "RDF", &ni, &ni, &zero, iret ); dg_puts ( &ni, iret ); dg_esub ( &ni, &zero, &zero, &zero, &ier ); if ( ier != 0 ) *iret = ier; return; } else { /* * Call the GWFS program to smooth the grid. The smoother footprint is chosen so as so suppress the 2 delta X wave on the coarse grid to 1/e of the original amplitude. */ swl = (float)G_NINT ( ( eres / dsg ) * 2.0 ); /*printf (" Smooth with footprint = %f\n", swl);*/ /* * Get a new grid number for the output. */ dg_nxts ( &no, iret ); if ( *iret != 0 ) return; dg_getg ( &no, &gnost, &kxd, &kyd, &ksub1, &ksub2, iret ); for ( jj = 1; jj <= kyd; jj++ ) { for ( ii = 1; ii <= kxd; ii++ ) { indx = ( jj - 1 ) * kxd + ii; gnost[indx-1] = swl; } } /* * Put two grids on the stack for the Gaussing weighted filter. */ dg_puts ( &no, iret ); if ( *iret != 0 ) return; dg_puts ( &ni, iret ); if ( *iret != 0 ) return; df_gwfs ( iret ); } return; }
void dv_nrmv ( int *iret ) /************************************************************************ * dv_nrmv * * * * This subroutine computes the vector component of a vector field (V) * * normal to the orientation vector whose direction is specified in * * COMMON / DGOVEC /. * * * * NORMV = ( ( -k cross V ) dot ( normalized orientation vector ) ) * * times ( normalized orientation vector ) * * * * NORMV generates a vector field. * * * * dv_nrmv ( iret ) * * * * Output parameters: * * *iret int Return code * * As for DG_GETV or DG_MSCL * * -28 = no orientation vector * ** * * Log: * * K. Brill/GSC 7/89 * * K. Brill/GSC 8/89 Subsetting * * K. Brill/GSC 10/89 Subsetting * * K. Brill/NMC 4/92 Nonconformal case reused ORNTV->error * * 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 5/02 Eliminate LLMXGD declarations in DGCMN * * by using internal grids for scl fctrs * * K. Brill/HPC 11/02 Eliminate use of the SUBA logical array * * S. Gilbert/NCEP 11/05 Translation from Fortran * ************************************************************************/ { int i, ier, nval, kxd, kyd, ksub1, ksub2, zero=0; int numu, numv, numu1, numv1, ixmscl, iymscl; float *gru, *grv, *gru1, *grv1, *grxms, *gryms; float orntv[2], ornang, du1, dv1, orn1, orn2; float du2, dv2, rnm; /*------------------------------------------------------------------------*/ *iret = 0; dg_ssub ( iret ); dg_nxtv ( &numu, &numv, iret ); if ( *iret != 0 ) return; dg_getg ( &numu, &gru, &kxd, &kyd, &ksub1, &ksub2, iret ); dg_getg ( &numv, &grv, &kxd, &kyd, &ksub1, &ksub2, iret ); nval = 1; dg_fget ( "ORNANG", &nval, &ornang, iret ); if ( ERMISS ( ornang ) ) { for ( i = ksub1 - 1; i < ksub2; i++ ) { gru[i] = RMISSD; grv[i] = RMISSD; } *iret = -28; return; } /* * Compute the unit tangent vector components. */ orntv [ 0 ] = - sin ( ornang ); orntv [ 1 ] = - cos ( ornang ); /* * Compute the map scale factors just in case the grid is not * conformal. */ dg_mscl ( iret ); if ( *iret != 0 ) return; /* * Get the vector. */ dg_getv ( &numu1, &numv1, iret ); if ( *iret != 0 ) return; /* * Compute the normal component. */ dg_getg ( &numu1, &gru1, &kxd, &kyd, &ksub1, &ksub2, iret ); dg_getg ( &numv1, &grv1, &kxd, &kyd, &ksub1, &ksub2, iret ); nval = 1; dg_iget ( "IXMSCL", &nval, &ixmscl, iret ); dg_iget ( "IYMSCL", &nval, &iymscl, iret ); dg_getg ( &ixmscl, &grxms, &kxd, &kyd, &ksub1, &ksub2, iret ); dg_getg ( &iymscl, &gryms, &kxd, &kyd, &ksub1, &ksub2, iret ); for ( i = ksub1 - 1; i < ksub2; i++ ) { du1 = gru1[i]; dv1 = grv1[i]; if ( ERMISS (du1) || ERMISS (dv1) ) { gru[i] = RMISSD; grv[i] = RMISSD; } else if ( G_DIFF(grxms[i], gryms[i]) ) { gru[i] = ( du1 * orntv [ 1 ] - dv1 * orntv [ 0 ] ) * orntv [ 1 ] ; grv[i] = ( -du1 * orntv [ 1 ] + dv1 * orntv [ 0 ] ) * orntv [ 0 ] ; } else { /* * Treat the case when the grid map projection is * nonconformal. * * Scale the grid relative orientation vector and normalize * it. */ du2 = orntv [ 0 ] / grxms[i]; dv2 = orntv [ 1 ] / gryms[i]; rnm = sqrt ( du2 * du2 + dv2 * dv2 ); orn1 = du2 / rnm; orn2 = dv2 / rnm; gru[i] = ( du1 * orn2 - dv1 * orn1 ) * orn2 ; grv[i] = ( -du1 * orn2 + dv1 * orn1 ) * orn1; } } /* * Make a name of the form 'NORMV'//u,v and update header; * update stack. */ dg_updv ( "NORMV", &numu, &numv, &numu1, &numv1, iret ); dg_putv ( &numu, &numv, iret ); dg_esub ( &numu, &numv, &zero, &zero, &ier ); if ( ier != 0 ) *iret = ier; return; }