7f90924706
Former-commit-id:7fa9dbd5fb[formerly4bfbdad17d] [formerly9f8cb727a5] [formerly7fa9dbd5fb[formerly4bfbdad17d] [formerly9f8cb727a5] [formerly8485b90ff8[formerly9f8cb727a5[formerly bf53d06834caa780226121334ac1bcf0534c3f16]]]] Former-commit-id:8485b90ff8Former-commit-id:40aa780b3d[formerly33a67cdd82] [formerly 73930fb29d0c1e91204e76e6ebfdbe757414f319 [formerlya28d70b5c5]] Former-commit-id: a16a1b4dd44fc344ee709abbe262aeed58a8339b [formerlye5543a0e86] Former-commit-id:0c25458510
310 lines
9.7 KiB
C
310 lines
9.7 KiB
C
#include "geminc.h"
|
|
#include "gemprm.h"
|
|
#include "dbcmn.h"
|
|
|
|
#include "dg.h"
|
|
|
|
void dgc_grid ( const char *gdattm, const char *glevel, const char *gvcord,
|
|
const char *gfunc, char *pfunc, float *grid, int *igx,
|
|
int *igy, char *time1, char *time2, int *level1,
|
|
int *level2, int *ivcord, char *parm, int *iret )
|
|
/************************************************************************
|
|
* dgc_grid *
|
|
* *
|
|
* This subroutine computes a grid diagnostic scalar quantity. The *
|
|
* inputs for GDATTM, GLEVEL, GVCORD and GFUNC should be the values *
|
|
* input by the user. *
|
|
* *
|
|
* dgc_grid ( gdattm, glevel, gvcord, gfunc, pfunc, grid, igx, igy, *
|
|
* time1, time2, level1, level2, ivcord, parm, iret ) *
|
|
* *
|
|
* Input parameters: *
|
|
* *gdattm const char Input date/time *
|
|
* *glevel const char Input level *
|
|
* *gvcord const char Input vertical coordinate *
|
|
* *gfunc const char Diagnostic function *
|
|
* *
|
|
* Output parameters: *
|
|
* *pfunc char Diagnostic error string *
|
|
* *grid float Output scalar grid *
|
|
* *igx int Number of points in x dir *
|
|
* *igy int Number of points in y dir *
|
|
* *time1 char Output date/time *
|
|
* *time2 char Output date/time *
|
|
* *level1 int Output level *
|
|
* *level2 int Output level *
|
|
* *ivcord int Output vertical coordinate *
|
|
* *parm char Output parameter name *
|
|
* *iret int Return code *
|
|
* 3 = user typed EXIT *
|
|
* 0 = normal return *
|
|
* -3 = GFUNC is blank *
|
|
* -4 = output grid not a scalar *
|
|
* -6 = wrong number of operands *
|
|
* -7 = grid cannot be found *
|
|
* -8 = grid is the wrong size *
|
|
* -9 = incorrect operands *
|
|
* -10 = internal grid list full *
|
|
* -11 = operand must be a vector *
|
|
* -12 = operand must be a scalar *
|
|
* -13 = operand must be from grid *
|
|
* -14 = DG_INIT not initialized *
|
|
* -15 = polar center invalid *
|
|
* -16 = map proj is invalid *
|
|
* -17 = LEVEL must be a layer *
|
|
* -18 = TIME must be a range *
|
|
* -19 = invalid operator *
|
|
* -20 = stack is full *
|
|
* -21 = stack is empty *
|
|
* -22 = TIME is invalid *
|
|
* -23 = LEVEL is invalid *
|
|
* -24 = IVCORD is invalid *
|
|
* -26 = layer of layers invalid *
|
|
* -27 = time range layer invalid *
|
|
* -47 = internal grid is too big *
|
|
* -70 = cannot computer ensemble *
|
|
* -71 = cannot computer layer *
|
|
** *
|
|
* Log: *
|
|
* M. desJardins/GSFC 10/85 *
|
|
* M. desJardins/GSFC 4/86 Cleaned up errors; add GR_FIND *
|
|
* M. desJardins/GSFC 5/88 Documentation *
|
|
* G. Huffman/GSC 9/88 Error messages *
|
|
* S. Schotz/GSC 6/90 Removed respnd flag *
|
|
* M. desJardins/NMC 3/92 Change scaling for MIXR,... *
|
|
* K. Brill/NMC 4/93 Remove initialization of idglst *
|
|
* K. Brill/NMC 4/93 Initialize the grid-in-use flag *
|
|
* L. Sager/NMC 5/93 Scale grid only when required *
|
|
* L. Sager/NMC 5/93 Allow grid rename *
|
|
* K. Brill/NMC 5/93 CALL ST_LCUC for gvcord *
|
|
* M. desJardins/NMC 7/93 Eliminate ; as separator for name *
|
|
* T. Lee/GSC 4/96 Changed NDGRD to maxdgg; single *
|
|
* dimension for dgg *
|
|
* K. Tyle/GSC 5/96 Moved IGDPT outside do-loop *
|
|
* K. Brill/HPC 11/01 Change for IUSESV replacing USEFLG *
|
|
* K. Brill/HPC 12/01 Initialize ISUBID *
|
|
* K. Brill/HPC 11/02 Check for KXYD > LLMXGD *
|
|
* K. Brill/HPC 5/03 Falsify SAVFLG for previous grids saved *
|
|
* with the same name using // *
|
|
* T. Lee/SAIC 12/04 Added ensemble function *
|
|
* T. Lee/SAIC 3/05 Added layer diagnostics *
|
|
* R. Tian/SAIC 2/06 Recoded from Fortran *
|
|
* S. Gilbert/NCEP 7/07 Removed LLMXGD check *
|
|
************************************************************************/
|
|
{
|
|
char ppp[133], gvc[13], gf[133], carr1[133], carr2[13], glv[LLMXLN+1];
|
|
char *savptr;
|
|
double gscale;
|
|
int len, zero=0, itype, num, ier, i;
|
|
int ierm;
|
|
char diagMessage[720];
|
|
/*----------------------------------------------------------------------*/
|
|
/*
|
|
* Initialize output parameters.
|
|
*/
|
|
pfunc[0] = '\0';
|
|
*igx = 0;
|
|
*igy = 0;
|
|
time1[0] = '\0';
|
|
time2[0] = '\0';
|
|
*level1 = 0;
|
|
*level2 = 0;
|
|
*ivcord = 0;
|
|
parm[0] = '\0';
|
|
|
|
/*
|
|
* Check that the diagnostic package has been initialized.
|
|
*/
|
|
if ( _dgfile.dgset == G_FALSE) {
|
|
*iret = -14;
|
|
return;
|
|
} else {
|
|
*iret = 0;
|
|
}
|
|
sprintf (diagMessage, "%s %s", "gdfunc =", (char *)gfunc);
|
|
db_msgcave ("dgc_grid", "debug", diagMessage, &ierm);
|
|
|
|
/*
|
|
* If GFUNC includes both layer and ensemble diagnostics,
|
|
* return with an error for now.
|
|
*/
|
|
cst_rmbl ( (char *)gfunc, gf, &len, &ier );
|
|
cst_lcuc ( gf, gf, &ier );
|
|
if ( strstr ( gf, "ENS_" ) && strstr ( gf, "LYR_") ) {
|
|
*iret = -72;
|
|
return;
|
|
}
|
|
|
|
/*
|
|
* Break gfunc into two strings separated at //.
|
|
*/
|
|
savptr = strstr ( gf, "//" );
|
|
if ( ! savptr ) {
|
|
strcpy ( carr1, gf );
|
|
carr2[0] = '\0';
|
|
} else {
|
|
len = (int)(savptr - gf );
|
|
strncpy ( carr1, gf, len );
|
|
carr1[len] = '\0';
|
|
strcpy ( carr2, savptr + 2 );
|
|
}
|
|
|
|
/*
|
|
* Initialize subroutine ID # & the grid-in-use flag.
|
|
*/
|
|
_dggrid.isubid = 0;
|
|
for ( i = 0; i < _dggrid.maxdgg; i++ ) {
|
|
_dggrid.iusesv[i] = 0;
|
|
}
|
|
|
|
/*
|
|
* Increment subroutine ID.
|
|
*/
|
|
dg_ssub ( &ier );
|
|
// printf (" dgc_grid after dg_ssub ier=%d\n", ier);
|
|
sprintf (diagMessage, "%s %d", "after dg_ssub ier=", ier);
|
|
db_msgcave ("dgc_grid", "debug", diagMessage, &ierm);
|
|
|
|
/*
|
|
* Save date/time, level and vertical coordinate in common.
|
|
*/
|
|
cst_lcuc ( (char *)gvcord, gvc, &ier );
|
|
cst_lcuc ( (char *)glevel, glv, &ier );
|
|
dg_stlv ( gdattm, glv, gvc, "GFUNC", carr1, iret );
|
|
if ( *iret != 0 ) {
|
|
dg_esub ( &zero, &zero, &zero, &zero, &ier );
|
|
return;
|
|
}
|
|
/*
|
|
* Compute the layer function.
|
|
*/
|
|
dl_driv ( carr1, iret );
|
|
// printf (" dgc_grid after dl_driv iret=%d\n", *iret);
|
|
sprintf (diagMessage, "%s %d", "after dl_driv iret=", *iret);
|
|
db_msgcave ("dgc_grid", "debug", diagMessage, &ierm);
|
|
if ( *iret != 0 ) {
|
|
dg_esub ( &zero, &zero, &zero, &zero, &ier );
|
|
*iret = -71;
|
|
return;
|
|
}
|
|
|
|
/*
|
|
* Compute the ensemble function.
|
|
*/
|
|
// printf ("DGC_GRID before de_driv _nfile.ntmplt[0]=%s\n", _nfile.ntmplt[0]);
|
|
// printf ("DGC_GRID calling de_driv\n");
|
|
sprintf (diagMessage, "%s %s", "before de_driv _nfile.ntmplt[0]=", _nfile.ntmplt[0]);
|
|
db_msgcave ("dgc_grid", "debug", diagMessage, &ierm);
|
|
de_driv ( carr1, iret );
|
|
// printf (" dgc_grid after de_driv iret=%d\n", *iret);
|
|
// printf (" dgc_grid after de_driv _nfile.ntmplt[0]=%s\n", _nfile.ntmplt[0]);
|
|
sprintf (diagMessage, "%s %s %s %d", "before de_driv _nfile.ntmplt[0]=", _nfile.ntmplt[0], "iret=", *iret);
|
|
db_msgcave ("dgc_grid", "debug", diagMessage, &ierm);
|
|
if ( *iret < 0 ) {
|
|
dg_esub ( &zero, &zero, &zero, &zero, &ier );
|
|
*iret = -70;
|
|
return;
|
|
}
|
|
|
|
/*
|
|
* Parse the input function.
|
|
*/
|
|
dg_pfun ( carr1, iret );
|
|
if ( *iret != 0 ) {
|
|
dg_esub ( &zero, &zero, &zero, &zero, &ier );
|
|
return;
|
|
}
|
|
|
|
/*
|
|
* Compute the output grid.
|
|
*/
|
|
itype = 1;
|
|
// printf ("DGC_GRID calling dg_driv\n");
|
|
sprintf (diagMessage, "%s", "calling dg_driv");
|
|
db_msgcave ("dgc_grid", "debug", diagMessage, &ierm);
|
|
dg_driv ( &itype, iret );
|
|
sprintf (diagMessage, "%s %d", "after dg_driv iret=", *iret);
|
|
db_msgcave ("dgc_grid", "debug", diagMessage, &ierm);
|
|
if ( *iret != 0 ) {
|
|
strcpy ( pfunc, _dgerr.errst );
|
|
dg_esub ( &zero, &zero, &zero, &zero, &ier );
|
|
return;
|
|
}
|
|
|
|
/*
|
|
* Retrieve the output grid from the stack.
|
|
* Check that the output is a scalar.
|
|
*/
|
|
num = _dgstck.istack[0];
|
|
sprintf (diagMessage, "%s %d", "retrieving output grid from the stack num=", num);
|
|
db_msgcave ("dgc_grid", "debug", diagMessage, &ierm);
|
|
if ( ( _dgstck.itop != 0 ) || ( num <= 0 ) || ( num >= 100 ) ) {
|
|
*iret = -4;
|
|
dg_esub ( &zero, &zero, &zero, &zero, &ier );
|
|
return;
|
|
}
|
|
|
|
if ( carr2[0] != '\0' ) {
|
|
/*
|
|
* Falsify the SAVFLG for grids also having the name
|
|
* stored in CARR2, and free them.
|
|
*/
|
|
sprintf (diagMessage, "%s", "falsifying the SAVFLG for grids");
|
|
db_msgcave ("dgc_grid", "debug", diagMessage, &ierm);
|
|
for ( i = 1; i <= _dggrid.maxdgg; i++ ) {
|
|
if ( strcmp ( _dggrid.gparmd[i-1], carr2 ) == 0 ) {
|
|
_dggrid.savflg[i-1] = G_FALSE;
|
|
}
|
|
}
|
|
strcpy ( _dggrid.gparmd[num-1], carr2 );
|
|
_dggrid.savflg[num-1] = G_TRUE;
|
|
}
|
|
|
|
/*
|
|
* Move the grid to the output grid array. Scale the mixing ratio
|
|
* and Montgomery stream function data.
|
|
*/
|
|
cst_rmbl ( carr1, ppp, &len, &ier );
|
|
if ( ( strncmp ( ppp, "MIXR", 4 ) == 0 ) ||
|
|
( strncmp ( ppp, "MIXS", 4 ) == 0 ) ||
|
|
( strncmp ( ppp, "SMXR", 4 ) == 0 ) ||
|
|
( strncmp ( ppp, "SMXS", 4 ) == 0 ) ) {
|
|
gscale = 1000.0;
|
|
} else if ( strncmp ( ppp, "PSYM", 4 ) == 0 ) {
|
|
gscale = 0.01;
|
|
} else {
|
|
gscale = 1.0;
|
|
}
|
|
|
|
if ( G_DIFF(gscale, 1.0) ) {
|
|
for ( i = 0; i < _dgfile.kxyd; i++ ) {
|
|
grid[i] = _dggrid.dgg[num-1].grid[i];
|
|
}
|
|
} else {
|
|
for ( i = 0; i < _dgfile.kxyd; i++ ) {
|
|
if ( ERMISS ( _dggrid.dgg[num-1].grid[i] ) ) {
|
|
grid[i] = RMISSD;
|
|
} else {
|
|
grid[i] = _dggrid.dgg[num-1].grid[i] * gscale;
|
|
}
|
|
}
|
|
}
|
|
|
|
sprintf (diagMessage, "%s %f", "returning this grid[0]=",grid[0]);
|
|
db_msgcave ("dgc_grid", "debug", diagMessage, &ierm);
|
|
/*
|
|
* Get output variables.
|
|
*/
|
|
*igx = _dgfile.kxd;
|
|
*igy = _dgfile.kyd;
|
|
strcpy ( time1, _dggrid.dttimd1[num-1] );
|
|
strcpy ( time2, _dggrid.dttimd2[num-1] );
|
|
*level1 = _dggrid.leveld1[num-1];
|
|
*level2 = _dggrid.leveld2[num-1];
|
|
*ivcord = _dggrid.ivcrdd[num-1];
|
|
strcpy ( parm, _dggrid.gparmd[num-1] );
|
|
|
|
dg_esub ( &zero, &zero, &zero, &zero, &ier );
|
|
|
|
return;
|
|
}
|