float i_vtmp ( float pres )
/*************************************************************/
/* I_VTMP */
/* John Hart NSSFC KCMO */
/* */
/* Calculates the virtual temperature (C) at pressure */
/* level (pres). */
/* */
/* pres - Level(mb) to compute a virtual temp. */
/*************************************************************/
{
double cta, eps, tk, w;
if( !qc(i_dwpt( pres )))
{
if( !qc( i_temp( pres ))) { return -999.0F; }
return i_temp( pres );
}
cta = 273.15;
eps = .62197;
tk = (double)i_temp(pres) + cta;
w = .001 * (double) mixratio( pres, i_dwpt(pres));
return (float)(tk * (1 + w / eps) / (1 + w) - cta);
}
/*NP*/
float ptype1( void )
/*************************************************************/
/* PTYPE1 */
/* John Hart NSSFC KCMO */
/* */
/* Determines precipitation type using same method as */
/* MESOETA model. */
/* */
/*************************************************************/
{
short i, IWX;
float pmid, T[50], P[50], Q[50], PINT[50], LMH;
float TD[50], TWET[50], LM, PPT;
short pIndex;
pIndex = getParmIndex("PRES");
if (!sndg || pIndex == -1)
return RMISSD;
for (i=0;i<numlvl-1;i++) {
pmid = (sndg[i][pIndex] + sndg[i+1][pIndex]) / 2;
P[i] = pmid;
T[i] = i_temp(pmid, I_PRES);
Q[i] = mixratio(pmid, i_dwpt(pmid, I_PRES));
PINT[i] = sndg[i][pIndex] - sndg[i+1][pIndex];
}
LMH = numlvl;
/* Call M.Baldwin FORTRAN routine to actually compute this stuff */
/* CALWXT(T, Q, P, PINT, TD, TWET, LMH, LM, PPT, IWX); */
printf( "IWX = %d\n", IWX );
}
/*NP*/
void write_file2( char *filename )
/*************************************************************/
/* WRITE_FILE */
/* John Hart NSSFC KCMO */
/* */
/* Writes contents of sndg array into SHARP95 file. */
/*************************************************************/
{
short i, j;
short idx[7];
float sfctemp, sfcdwpt, sfcpres, j1, j2, ix1;
struct _parcel pcl;
char st[80];
FILE *fout;
idx[1] = getParmIndex("PRES");
idx[2] = getParmIndex("HGHT");
idx[3] = getParmIndex("TEMP");
idx[4] = getParmIndex("DWPT");
idx[5] = getParmIndex("DRCT");
idx[6] = getParmIndex("SPED");
fout = fopen( filename, "wt" );
if (fout==NULL)
{
printf("Unable to write output file!\n" );
return;
}
fputs( "%TITLE%\n", fout );
fputs( raobtitle, fout );
fputs( "\n\n", fout );
fprintf( fout, " LEVEL HGHT TEMP DWPT WDIR WSPD\n");
fprintf( fout, "-------------------------------------------------------------------\n");
fputs( "%RAW%\n", fout );
for(i=0; i<numlvl; i++)
{
for(j=1; j<=5; j++) fprintf( fout, "%8.2f, ", sndg[i][idx[j]]);
fprintf( fout, "%8.2f\n", sndg[i][idx[6]]);
}
fputs( "%END%\n\n", fout );
if ((numlvl<4) || (!qc(i_dwpt(700, I_PRES)))) return;
fprintf( fout, "----- Parcel Information-----\n");
/* ----- Calculate Parcel Data ----- */
sfctemp = lplvals.temp;
sfcdwpt = lplvals.dwpt;
sfcpres = lplvals.pres;
strcpy( st, "*** " );
strcat( st, lplvals.desc );
strcat( st, " ***" );
fprintf( fout, "%s\n", st);
ix1 = parcel( -1, -1, sfcpres, sfctemp, sfcdwpt, &pcl);
fprintf( fout, "LPL: P=%.0f T=%.0fF Td=%.0fF\n", sfcpres, ctof(sfctemp), ctof(sfcdwpt));
fprintf( fout, "CAPE: %6.0f J/kg\n", pcl.bplus);
fprintf( fout, "CINH: %6.0f J/kg\n", pcl.bminus);
fprintf( fout, "LI: %6.0f C\n", pcl.li5);
fprintf( fout, "LI(300mb): %6.0f C\n", pcl.li3);
fprintf( fout, "3km Cape: %6.0f J/kg\n", pcl.cape3km);
j1 = pcl.bplus;
j2 = i_hght(pcl.elpres, I_PRES) - i_hght(pcl.lfcpres, I_PRES);
fprintf( fout, "NCAPE: %6.2f m/s2\n\n", j1/j2);
fprintf( fout, "LCL: %6.0fmb %6.0fm\n", pcl.lclpres, agl(i_hght(pcl.lclpres, I_PRES)));
fprintf( fout, "LFC: %6.0fmb %6.0fm\n", pcl.lfcpres, agl(i_hght(pcl.lfcpres, I_PRES)));
fprintf( fout, "EL: %6.0fmb %6.0fm\n", pcl.elpres, agl(i_hght(pcl.elpres, I_PRES)));
fprintf( fout, "MPL: %6.0fmb %6.0fm\n", pcl.mplpres, agl(i_hght(pcl.mplpres, I_PRES)));
fprintf( fout, "All heights AGL\n\n" );
fprintf( fout, "----- Moisture -----\n" );
strcpy( st, qc2( precip_water( &ix1, -1, -1), " in", 2 ));
fprintf( fout, "Precip Water: %s\n", st);
strcpy( st, qc2( mean_mixratio( &ix1, -1, -1 ), " g/Kg", 1 ));
fprintf( fout, "Mean W: %s\n\n", st);
fprintf( fout, "----- Lapse Rates -----\n" );
j1 = delta_t(&ix1);
j2 = lapse_rate( &ix1, 700, 500);
fprintf( fout, "700-500mb %.0f C %.1f C/km\n", j1, j2);
j1 = vert_tot(&ix1);
j2 = lapse_rate( &ix1, 850, 500);
fprintf( fout, "850-500mb %.0f C %.1f C/km\n", j1, j2);
fclose( fout );
}
/*NP*/
char *init_phase(float *plevel, short *phase)
/*************************************************************/
/* INIT_PHASE */
/*************************************************************/
{
short i, ok, avail;
short pIndex, zIndex, tIndex, tdIndex, oIndex;
float rh, p1, pbegin, pos, neg, p, w1;
float p_pres, p_phase, ptop, pbot;
static char st[80];
char pt[80];
*plevel = 0;
*phase = -1;
pIndex = getParmIndex("PRES");
zIndex = getParmIndex("HGHT");
tIndex = getParmIndex("TEMP");
tdIndex = getParmIndex("DWPT");
oIndex = getParmIndex("OMEG");
if (!sndg || pIndex == -1 || zIndex == -1 || tIndex == -1 ||
tdIndex == -1) {
strcpy(st, "N/A");
return st;
}
/* First, determine whether VVELS are available. If they are, */
/* use them to determine level where precipitation will develop. */
avail=0;
if (oIndex != -1) {
for( i = 0; i < numlvl; i++) {
if (qc(sndg[i][oIndex]) && (sndg[i][oIndex] < 1)) avail++;
}
}
if (avail< 5) {
/* No VVELS...must look for saturated level */
/* ----- Find the highest near-saturated 50mb
layer blo 5km agl ---- */
for(i=numlvl-1;i>0;i--) {
ok = 0;
pbegin = -999;
if (agl(sndg[i][zIndex]) < 5000.0) {
rh = mixratio(sndg[i][pIndex], sndg[i][tdIndex]) /
mixratio(sndg[i][pIndex], sndg[i][tIndex]);
if (rh > 0.8) {
p1 = sndg[i][pIndex]+50;
if ((mixratio(p1, i_dwpt(p1, I_PRES)) /
mixratio(p1, i_temp(p1, I_PRES))) > 0.8) {
ok = 1;
pbegin = p1-25.0;
break;
}
}
}
}
}
else {
/* ----- Find the highest near-saturated layer with UVV in
the lowest 5km ----- */
for(i=numlvl-1;i>0;i--) {
ok=0;
pbegin=-999;
if ((agl(sndg[i][zIndex])<5000) &&
(sndg[i][oIndex] <= 0)) {
rh = mixratio(sndg[i][pIndex],
sndg[i][tdIndex]) /
mixratio(sndg[i][pIndex], sndg[i][tIndex]);
if (rh > 0.8) {
p1 = sndg[i][pIndex]+50;
if ((mixratio(p1, i_dwpt(p1, I_PRES)) /
mixratio(p1, i_temp(p1, I_PRES))) > 0.8) {
ok = 1;
pbegin = p1-25;
break;
}
}
}
}
}
if (!ok) {
*plevel = 0;
*phase = -1;
strcpy(st, "N/A");
return st;
}
p1 = i_temp(pbegin, I_PRES);
if(p1>0) {p_phase=0; strcpy(pt, "Rain"); }
if((p1<=0) && (p1 > -5)) {p_phase=1; strcpy(pt, "Freezing Rain"); }
if((p1<=-5) && (p1 > -9)) {p_phase=1; strcpy(pt, "ZR/S Mix" ); }
if(p1 <= -9) {p_phase=3; strcpy(pt, "Snow"); }
*plevel = pbegin;
*phase = p_phase;
return pt;
}
/*NP*/
void posneg_wetbulb(float start, float *pos, float *neg, float *top, float *bot)
/***********************************************************************/
/* POSNEG */
/* Calculates positive and negative areas as related to winter weather */
/* forecasting. Search begins at 500mb, but only returns results if */
/* a positive area is found, overlaying a negative area. */
/* START is the upper limit of search.(default=init_phase) */
/***********************************************************************/
{
float upper, lower, pe1, h1, te1, tp1, totp, totn, pe2, h2, te2,
tp2, tdef1, tdef2;
float lyrlast, lyre, tote, pelast, ptop, pbot, lvl;
short i, lptr, uptr, warmlayer=0, coldlayer=0, phase;
short pIndex, zIndex, tdIndex;
char st[80];
*pos = 0;
*neg = 0;
*top = 0;
*bot = 0;
/* ----- If there is no sounding, do not compute ----- */
if (!qc(i_temp(500, I_PRES)) && !qc(i_temp(850, I_PRES)))
return;
pIndex = getParmIndex("PRES");
zIndex = getParmIndex("HGHT");
tdIndex = getParmIndex("DWPT");
if (!sndg || pIndex == -1 || zIndex == -1 || tdIndex == -1)
return;
/* ----- Find lowest observation in layer ----- */
lower = sndg[sfc()][pIndex];
lptr = sfc();
/* ----- Find highest observation in layer ----- */
if (start=-1) {
strcpy( st, init_phase( &lvl, &phase ));
if (lvl> 0)
{ upper = lvl; }
else
{ upper=500; }
}
else {
upper = start;
}
i=numlvl-1;
while (sndg[i][pIndex] < upper) {
i--;
if (i < 0) {
fprintf(stderr,
"Warning: posneg_wetbulb: Could not find a pressure greater than %.2f\n",
upper);
fprintf(stderr, "Using %.2f as the upper level.\n",
sndg[0][pIndex]);
i = 0;
break;
}
}
uptr = i;
if (sndg[i][pIndex] == upper)
uptr--;
/* ----- Start with top layer ----- */
pe1 = upper;
h1 = i_hght(pe1 , I_PRES);
te1 = wetbulb(pe1, i_temp(pe1, I_PRES), i_dwpt(pe1, I_PRES));
tp1 = 0;
totp = totn = tote = ptop = pbot = 0;
for( i = uptr; i >= lptr; i-- ) {
if (qc(sndg[i][tdIndex])) {
/* ----- Calculate every level that reports a temp ----- */
pe2 = sndg[i][pIndex];
h2 = sndg[i][zIndex];
te2 = wetbulb(pe2, i_temp(pe2, I_PRES), i_dwpt(pe2, I_PRES));
tp2 = 0;
tdef1 = (0 - te1) / (te1 + 273.15);
tdef2 = (0 - te2) / (te2 + 273.15);
lyrlast = lyre;
lyre = 9.8F * (tdef1 + tdef2) / 2.0F * (h2 - h1);
/* Has a warm layer been found yet? */
if (te2>0)
if (warmlayer==0) {
warmlayer=1;
ptop=pe2;
}
/* Has a cold layer been found yet? */
if (te2<0)
if ((warmlayer==1) && (coldlayer==0)) {
coldlayer=1;
pbot=pe2;
}
if (warmlayer>0) {
if (lyre>0) {
totp += lyre;
}
else {
totn += lyre;
}
tote += lyre;
printf("%4.0f - %4.0f E=%6.0f TOT=%6.0f Top=%6.0f Bot=%6.0f\n",
pe1, pe2, lyre, tote, ptop, pbot);
}
pelast = pe1;
pe1 = pe2;
h1 = h2;
te1 = te2;
tp1 = tp2;
}
}
if ((warmlayer==1) && (coldlayer==1)) {
*pos = totp;
*neg = totn;
*top = ptop;
*bot = pbot;
printf("Tot= %.0f J/kg Pos= %.0f J/kg Neg= %.0f J/kg\n",
tote, totp, totn);
printf("Top= %.0f Bot= %.0f\n", ptop, pbot);
}
else {
printf("Warm/Cold Layers not found.\n" );
*pos = 0;
*neg = 0;
*top = 0;
*bot = 0;
}
}
/*NP*/
void plot_thetae(void)
/*************************************************************/
/* PLOT_THETAE */
/* John Hart NSSFC KCMO */
/* */
/* Plots vertical profile of Theta-E (sfc-500mb) */
/*************************************************************/
{
float bothgt, tophgt, h, cthe, ix1;
short x1, y1, x2, y2, i, tlx, tly;
short pIndex, zIndex, tIndex, tdIndex;
char st[10];
pIndex = getParmIndex("PRES");
zIndex = getParmIndex("HGHT");
tIndex = getParmIndex("TEMP");
tdIndex = getParmIndex("DWPT");
if (!sndg || pIndex == -1 || tIndex == -1 || tdIndex == -1 ||
zIndex == -1)
return;
/* tlx = hov.brx - 150;
tly = hov.tly; */
tlx = hov.tlx + 120;
tly = hov.bry;
setcliprgn(tlx, tly, tlx+134, tly+120);
setcolor(0);
setlinestyle( 1, 1 );
rectangle(1,tlx, tly, tlx+134, tly+120);
setcolor(1);
rectangle(0, tlx, tly, tlx+134, tly+120);
/* ----- Set Layer (AGL) ----- */
bothgt = 0;
tophgt = agl(i_hght(500, I_PRES));
/* ----- Plot Label ----- */
setcolor(1);
set_font(4);
outgtext("Theta-E vs", tlx+55, tly+3);
outgtext("Pressure", tlx+55, tly+15);
/* ----- Plot horizontal legend ----- */
if (800 < pIndex < 850){
cthe = (thetae(800, i_temp(800, I_PRES), i_dwpt(800, I_PRES)) +
thetae(650, i_temp(650, I_PRES), i_dwpt(650, I_PRES)) +
thetae(sndg[sfc()][pIndex], sndg[sfc()][tIndex],
sndg[sfc()][tdIndex])) / 3.0;
}
if (750 < pIndex < 800){
cthe = (thetae(750, i_temp(750, I_PRES), i_dwpt(750, I_PRES)) +
thetae(600, i_temp(600, I_PRES), i_dwpt(600, I_PRES)) +
thetae(sndg[sfc()][pIndex], sndg[sfc()][tIndex],
sndg[sfc()][tdIndex])) / 3.0;
}
if (700 < pIndex < 750){
cthe = (thetae(700, i_temp(700, I_PRES), i_dwpt(700, I_PRES)) +
thetae(500, i_temp(500, I_PRES), i_dwpt(500, I_PRES)) +
thetae(sndg[sfc()][pIndex], sndg[sfc()][tIndex],
sndg[sfc()][tdIndex])) / 3.0;
}
if (pIndex >= 850){
cthe = (thetae(850, i_temp(850, I_PRES), i_dwpt(850, I_PRES)) +
thetae(700, i_temp(700, I_PRES), i_dwpt(700, I_PRES)) +
thetae(sndg[sfc()][pIndex], sndg[sfc()][tIndex],
sndg[sfc()][tdIndex])) / 3.0;
}
setcolor(19);
set_font(5);
for(h=cthe - 30.0; h<=cthe + 30.0; h += 10) {
x1 = (short)(tlx + 60 + ((h-cthe)*2.5));
y1 = tly+120;
moveto( x1, y1);
lineto( x1, y1-5);
sprintf(st, "%.0f", h + 273.15);
outgtext(st, x1-6, y1-14);
}
/* ----- Plot vertical theta-e profile ----- */
setlinestyle(1, 2);
setcolor(2);
x2 = 999;
if (sndg[numlvl-1][pIndex] < 500) {
for (i=0; sndg[i][pIndex] >= 500; i++) {
/*printf ("i = %d, PRES = %.1f\n", i, sndg[i][pIndex]);*/
if (qc(sndg[i][tdIndex])) {
x1 = (short)(tlx + 60 + ((thetae(sndg[i][pIndex],
sndg[i][tIndex], sndg[i][tdIndex])-cthe)*2.5));
y1 = vert_coords(agl(sndg[i][zIndex]), tophgt, tly);
if(x2 == 999) { x2=x1; y2=y1; }
moveto(x1, y1);
lineto(x2, y2);
x2=x1;
y2=y1;
}
}
}
/* ----- Plot Vertical Legend ----- */
setlinestyle(1, 1);
setcolor(1);
set_font(5);
x2 = 999;
for(i=1000; i >= 600; i -= 100) {
x1 = tlx;
y1 = vert_coords(agl(i_hght(i, I_PRES)), tophgt, tly);
moveto( x1, y1);
lineto( x1+5, y1);
sprintf(st, "%d", i);
if (i<1000) outgtext(st, x1+6, y1-5);
}
setcliprgn(1, 1, xwdth, xhght);
copytodisplay();
/* plot theta-e index */
setcolor(19);
set_font(4);
sprintf( st, "TEI = %s", qc2( ThetaE_diff(&ix1), "", 0));
outgtext( st, tlx + 80, tly + 50);
}
