/* 'C' library for combined sea state and atmospheric boundary layer model Developed by Mark A. Bourassa Based on Original Bourassa-Vincent-Wood combined sea state and atmospheric boundary layer model developed at Purdue University. Several upgrades and options have been added while at the Center for Ocean-Atmospheric Prediction Studies (COAPS) at Florida State University. Dr. Bourassa is currently (Aug. 2003) an Assistant Professor at the Florida State Universiy. Please send comments, suggestions, and requests for added features to Dr. Mark Bourassa Center for Ocean-Atmospheric Prediction Studies Florida State University Tallahassee, FL 32306-2840 Email: bourassa@coaps.fsu.edu Phone: (850) 644-6923 The bulk of 'in code' documentation is in the subroutine pmix_. Documentation is also on the COAPS website: http://coaps.fsu.edu/~bourassa/bvw98_docs.html. */ #include "mft12.h" /* beta-primes are either zero or unity, depending on whether or not their respective type of roughness element exists. Beta's are the weights for the different types of elements. */ /* global variables */ short flux_model_dum, no_capw, no_sfcten, smith88, stab_prm, TQzo_prm, use_dh, wave_stab_intr, zo_prm; double betac[2], betac_prime, betag[2], betag_prime, betas[2], betas_prime, cmin, CP, cp_com, denair, hsig[2], LV, monin_inv, qstar, tstar, u[2], u_orb[2], u_sfc[2], ustar[2], wa[2], wstar2, zz[2], zzq, zzt; /* CENTRY */ int pmix_( int dyn_in_prm, float dyn_in_val, float dyn_in_val2, float CONVECT, float CONV_CRIT, float pressure, int air_moist_prm, float air_moist_val_dum, int sfc_moist_prm, float sfc_moist_val_dum, float salinity, int ss_prm, float ss_val_dum, float t_air, int sst_prm, float t_skin, float ref_ht_wind, float ref_ht_tq, int astab, float Qnet, int warn, int flux_model, int z0_mom_prm, int z0_TQ_prm, int stable_prm, float *shf, float *lhf, float *tau, float *u_star, float *t_star, float *q_star, float *z_over_L, float *wave_age, float *dom_phs_spd, float *h_sig, float *ww_stab, float *zo_m ) /* 'main' subroutine for combined sea state and atmospheric flux model Includes: BVW sea state parameterization, BVW atmospheric boundary layer (roughness length) model (optional), Toba's 2/3 wave relation, Monin-Obhukov atmoshpheric stability parameterization, Godfrey and Beljaar's convective parameterization. Options for dynamic input parameters Most users will want to input wind speeds. However, there is a growing need to convert scatterometer observations of stress or equivalent neutral wind speed to winds and/or stresses. dyn_in_prm Parameter treated as known 0 Wind speed, 1 Friction velocity, 2 Surface stress, 3 Equivalent neutral wind speed. Note 'equivalent neutral' is NOT equivelent to 'neutral'. Options for seastate parameterizations (or parameters): There are three possible seastate assumptions: any one of the following can be treated as known: wind-wave stability parameter, phase speed, or wave age. ss_prm Parameter treated as known 0 Wind-wave stability parameter (set to 1.0 for local equilibrium), 1 Phase speed of the dominant waves [m/s], 2 Wave age the dominant waves (cp/ustar) [], 3 Significant Wave Height [m], 4 Significant slope [], 5 Period of the dominant waves [s], 6 Orbital velocity of dominant waves [m/s]. Options for atmospheric moisture input: Choose the moisture parameter that is easiest for you to deal with: air_moist_prm Parameter for moisture of air 0 Absolute humidity at the reference height of the thermometer and humidity sensor [g vapor / g air], 1 Relative Humidity [fraction], 2 Dew point temperature [C], 3 Wet bulb temperature [C]. Options for surface moisture input: Choose the moisture parameter that is easiest for you to deal with: sfc_moist_prm Parameter for moisture of air 0 Absolute humidity 'at' (near) the surface [g vapor / g air], 1 Relative Humidity [fraction], 2 Dew point temperature [C], 3 Wet bulb temperature [C]. Definitions: Input parameters (passed through call): CON_P Convective parameter (unitless). Recammended value between 0.7 and 1.25. For details see TOGA NOTES #4. CRIT Convergence criterion (unitless fraction). air_moist_prm Moisture parameter index. air_moist_val Value of the parameter corresponding to the above index. press Atmospheric surface pressure (Pa). s Salinity (unitless). ss_prm Seastate parameter index. ss_val Value of the parameter corresponding to the above index. ta Air temperature at the reference height of the thermometer and humidity sensor (degrees C). u Mean wind speed (m/s) at the height (zref) of the annemometer. u_sfc Mean surface current (m/s). zref Height (metres) of the wind observations. zrefq Height (metres) of the humidity observations. See zreft. zreft Height (metres) of the temperature observations. Note: in the current version of the code this must equal to height of the humidity observations. astab Option for atmospheric stability condition: 0) atmospheric stability is assumed to be neutral, 1) assumption of a neutral atmospheric stability is not made. theta_ang Direction of 'dynamic input' (e.g., wind or stress) relative to the direction of propagation of the dominant waves. Other parameters: bstar Component of bouyancy flux (-bstar * ustar). cmin Minimun phase speed of water waves - determined through the phase relation [m/s]. CP Specific heat of air [J/kg]. denair density of air [kg/m^3]. denwat density of water [kg/m^3]. LV Latent heat of vaporization [J/kg]. sfcten suface tension of air-water interface [N/m]. ww Wind-wave stability parameter (unitless). Equal to one for local equilibrium; greater than one for rising seas; less than one (and greater than zero) for falling seas. ww_eql Value of U(Hs)/cp for local wind-wave equilibrium (0.83). zz wind reference height divided by momentum roughness lentgh [], zzq moisture reference height divided by moisture roughness lentgh [], zzt temperature reference height divided by temperature roughness lentgh [], Output parameters: cp dominant phase speed of gravity waves [m/s], hsig significant wave height [m], inv_monin inverse Monin-Obhukov scale length [m^-1], lhf latent heat flux [W/m^2], qstar scaling parameter for moisture [], shf sensible heat flux [W/m^2],[W/m^2], tau stress vector [N/m^2]; tau[0] is parallel the direction of wave propagation, and tau[1] is perpendicular tau[0] in a right handed coordinate system (with the positive vertical axis pointing upward, tstar scaling term for potential temperature [degrees C] ustar friction velocity [m/s], wa wave age, cp/ustar [], zo_m momentum roughness lentgh (two components: parallel and perpendicular direction of wave propagation) [], */ { short fixedcp, fixedwa, neutral, fixed_hsig, fixed_uen, fixed_ustar; int count, z0_prm; float viscosity; double air_moist_val, CON_P, CRIT, cp, denwat, MS, MW, nu, qmixa, qmixw, press, s, sfcten, sfc_moist_val, ss_val, ta, tskin, va, ww, ww_eql, zref, zrefq, zreft, betac_set, betag_set, betas_set, dud; /* definitions for flux model types 0 BVW 1 Smith 1988 */ flux_model_dum = flux_model; smith88 = FALSE; no_capw = FALSE; wave_stab_intr = TRUE; use_dh = FALSE; if ( flux_model < 0 ) { z0_prm = z0_mom_prm; TQzo_prm = z0_TQ_prm; stab_prm = stable_prm; } else { TQzo_prm = 0; stab_prm = 0; switch( flux_model ) { case 0: /* BVW */ z0_prm = 0; break; case 1: /* Smith 1988 */ z0_prm = 0; ss_prm = 2; ss_val_dum = 43.64; dyn_in_val2 = 0.0; smith88 = TRUE; no_capw = TRUE; wave_stab_intr = FALSE; stab_prm = 0; break; case 2: /* BVW without interaction between waves and atmospheric stab */ z0_prm = 0; wave_stab_intr = FALSE; break; case 3: /* BVW with Smith (1988) stability parameterization */ z0_prm = 0; stab_prm = 1; break; case 4: /* BVW without capillary waves */ z0_prm = 0; no_capw = TRUE; break; case 5: /* BVW without sfcten in phase relations */ z0_prm = 0; no_sfcten = TRUE; break; case 6: /* BVW without capillary waves and without sfcten in the phase relation */ z0_prm = 0; no_sfcten = TRUE; no_capw = TRUE; break; case 7: /* Taylor and Yelland (2001) roughness length */ z0_prm = 2; no_sfcten = TRUE; no_capw = TRUE; break; case 8: /* Taylor and Yelland (2001) roughness length + capillary */ z0_prm = 3; break; case 9: /* Bourassa 2006 friction velocity with CFC zot and zoq */ z0_prm = 1; TQzo_prm = 1; break; case 10: /* case 9 with displacement height estimated within the code */ z0_prm = 1; TQzo_prm = 1; use_dh = TRUE; break; case 11: /* Bourassa 2006 friction velocity with Zilitinkevich et al. zot and zoq */ z0_prm = 1; TQzo_prm = 2; break; case 12: /* Bourassa 2006 friction velocity with LKB zot and zoq */ z0_prm = 1; TQzo_prm = 3; break; case 13: /* Bourassa 2006 friction velocity with COARE3.0 zot and zoq */ z0_prm = 1; TQzo_prm = 4; break; case 14: /* Bourassa 2006 friction velocity with wall theory for moisture */ z0_prm = 1; TQzo_prm = 0; break; case 15: /* Bourassa 2006 friction velocity with CFC zot and zoq and oil spill z0m and zero LHF */ z0_prm = 4; TQzo_prm = 1; break; default: printf( "Invalid choice of flux_model parameter: %i\n", flux_model ); exit(1); break; } } /* printf( " flux_model = %i %i %i %i\n", flux_model, z0_prm, TQzo_prm, stab_prm ); */ MS = 58.443000; /* molecular mass of salt [kg/kmol] */ MW = 18.016000; /* molecular mass of water [kg/kmol] */ betag_prime = 1.0; betac_prime = 1.0; if ( no_capw ) betac_prime = 0.0; /* printf( "F1 %f\n", betac_prime ); */ betas_prime = 0.0 + (double)smith88; betas[0] = 1.0; betas[1] = 1.0; ww_eql = 0.345 / KV; CRIT = (double)CONV_CRIT; CON_P = (double)CONVECT; press = (double)pressure; air_moist_val = (double)air_moist_val_dum; sfc_moist_val = (double)sfc_moist_val_dum; s = (double)salinity; ss_val = (double)ss_val_dum; ta = (double)t_air; tskin = (double)t_skin; zref = (double)ref_ht_wind; /* the height of the temperature sensor must be equal to the height of the humidity sensor. */ zrefq = (double)ref_ht_tq; zreft = zrefq; /* printf( "%f %lf %lf %lf\n", wind_spd, wind_spd2, CRIT, CON_P ); printf( "%lf %lf %lf\n", press, air_moist_val, sfc_moist_val ); printf( "%lf %lf %lf %lf\n", s, ss_val, ta, tskin ); printf( "%lf %lf %lf \n", zref, zreft, zrefq ); */ /* setup the knowns and initial gueses for the seastate. */ wa[0] = 20.0; /* initial guess */ wa[1] = 28.0; cp = 4.0; /* initial guess */ fixedcp = FALSE; fixedwa = FALSE; hsig[0] = 0.01; /* initial guess assumes waves exist */ hsig[1] = 0.01; /* initial guess assumes waves exist */ fixedcp = FALSE; fixedwa = FALSE; fixed_hsig = FALSE; ww = 1.0; switch( ss_prm ) { case 0: /* the wind-wave stability parameter is specified */ ww = ss_val; break; case 1: /* phase speed is known */ fixedcp = TRUE; cp = ss_val; break; case 2: /* wave age (ustar/cp) is known */ fixedwa = TRUE; wa[0] = ss_val; break; case 3: /* significant wave height is known */ fixed_hsig = TRUE; hsig[0] = ss_val; break; case 4: /* significant slope is known */ case 5: /* period of the dominant waves is known */ break; case 6: /* Orbital velocity is known */ u_orb[0] = ss_val; break; default: printf( "Invalid choice of ss_prm: %i\n", ss_prm ); exit(1); break; } /* setup the atmospheric stability parameters */ monin_inv = 0.0; switch( astab ) { case 0: neutral = TRUE; break; case 1: neutral = FALSE; break; default: printf( "Invalid atmospheric stability option: astab = %i\n", astab ); printf( "Allowable options are: 0 (neutral), and 1 (non-neutral).\n" ); exit(1); } betag_set = betag_prime; betac_set = betac_prime; betas_set = betas_prime; /* determine the viscosity of air */ nu = 1.3260000e-5 * (1.00000 + 0.006542 * ta + 8.301000E-6 * ta * ta + 4.840000E-9 * ta * ta * ta ); /* determine the surface tension */ sfcten = 7.6100000E-2 - 1.55000E-4 * tskin + 2.77000E-5 * s * MS / MW; /* determine the latent heat of vaporization */ LV = 4186.8 * ( 597.31 - 0.56525 * tskin ); /* use the atmospheric moisture parameter to determine the specific humidity [kg/kg]. */ qmixa = find_q_( air_moist_prm, air_moist_val, press, ta ); if ( qmixa == -1.0 ) printf( "Invalid choice of air_moist_prm: %i\n", air_moist_prm ); /* use the surface moisture parameter to determine the specific humidity [kg/kg]. */ qmixw = find_q_( sfc_moist_prm, sfc_moist_val, press, tskin ); if ( qmixw == -1.0 ) printf( "Invalid choice of sfc_moist_prm: %i\n", sfc_moist_prm ); if ( z0_prm == 4 ) qmixw = qmixa; /* determine the heat capacity at constant pressure */ CP = 1004.0 * ( 1.0 + 0.9 * qmixw ); /* determine the density of the moist air */ denair = press / (R * (ta + 273.14) * (1.00000000 + 0.6100000 * qmixa ) ); /* determine the density of pure water */ denwat = (999.8396 + 18.224944 * tskin - 0.007922210 * tskin * tskin ) / ( 1.0000000 + 0.018159725 * tskin ); /* determine the density of saline water */ va = ( 12.97000 + 0.23400000 * tskin - 4.2100000E-3 * tskin * tskin + 2.8570000E-5 * tskin * tskin * tskin ) * 10.00000E-3 + sqrt( s * denwat * 10.00000E-3 ) * 2.9820000E-3 - 4.9700000E-5 * tskin + 6.0320000E-7 * tskin * tskin; denwat = denwat * ( 1.0000000 + s ) / ( 1.000000 + va * denwat * s / MS ); /*setup known inputs for the dynamic input (typically wind speed) */ fixed_ustar = FALSE; fixed_uen = FALSE; switch( dyn_in_prm ) { case 0: /* wind speed is specified */ /* split the wind into component parallel and perpendicular to the mean direction of wave propagation. */ u[0] = (double)dyn_in_val; u[1] = (double)dyn_in_val2; break; case 1: /* friction velocity is specified */ fixed_ustar = TRUE; /* split the wind into component parallel and perpendicular to the mean direction of wave propagation. */ ustar[0] = (double)dyn_in_val; ustar[1] = (double)dyn_in_val2; if ( fabs( ustar[0] ) < 0.00001 ) ustar[0] = 0.00001; if ( fabs( ustar[1] ) < 0.00001 ) ustar[1] = 0.00001; break; case 2: /* surface stress (magnitude) is known */ fixed_ustar = TRUE; /* split the wind into component parallel and perpendicular to the mean direction of wave propagation. */ ustar[0] = sqrt( (double)dyn_in_val / denair ); ustar[1] = sqrt( (double)dyn_in_val2 / denair ); if ( fabs( ustar[0] ) < 0.00001 ) ustar[0] = 0.00001; if ( fabs( ustar[1] ) < 0.00001 ) ustar[1] = 0.00001; break; case 3: /* equivalent neutral wind speed is known */ fixed_uen = TRUE; /* split the wind into component parallel and perpendicular to the mean direction of wave propagation. */ u[0] = (double)dyn_in_val; u[1] = (double)dyn_in_val2; break; default: printf( "Invalid choice of dyn_in_prm: %i\n", dyn_in_prm ); exit(1); break; } /* One the first pass assume than waves exist */ hsig[1] = 0.01; zz[0] = 10000.0; zz[1] = 10000.0; count = solve( fixedcp, fixedwa, fixed_hsig, fixed_uen, fixed_ustar, neutral, CON_P, cp, CRIT, denwat, nu, qmixa, qmixw, sfcten, ss_prm, ss_val, ta, tskin, Qnet, zref, zreft, zrefq, ww, ww_eql, betag_set, betac_set, betas_set, z0_prm, warn ); if ( count <= 1 || ustar[0] == 10.0 || ustar[1] == 10.0 || ( wa[0] == 1.08 && betag[0] > 0.5 && flux_model != 9 ) || ( wa[0] == 250.0 && betag[0] > 0.5 && flux_model != 9 ) || fabs(monin_inv) == 10.0 ) { count = -1; if ( warn ) printf( "non-conv diags: %i %lf %lf %lf %lf %lf %lf %lf\n", count, ustar[0], ustar[1], tstar, qstar, wa[0], monin_inv, betag[0] ); if ( !warn && ( ustar[0] == 10.0 || ustar[1] == 10.0 ) ) { ustar[0] = 0.0; /* usually a good approximation */ ustar[1] = 0.0; printf( "friction velocity set to zero. \n" ); } } if ( count > 1 || !warn ) { dud = sqrt( ustar[0] * ustar[0] + ustar[1] * ustar[1] ); tau[0] = (float)(denair * dud * ustar[0]); tau[1] = (float)(denair * dud * ustar[1]); *shf = (float)(-denair * CP * dud * tstar); *lhf = (float)(-denair * LV * dud * qstar); u_star[0] = (float)ustar[0]; u_star[1] = (float)ustar[1]; *t_star = (float)tstar; *q_star = (float)qstar; *z_over_L = (float)(!neutral) * (float)( zref * monin_inv ); *wave_age = (float)wa[0]; *dom_phs_spd = (float)( betag[0] * cp_com ); *h_sig = (float)( betag[0] * hsig[0] ); *ww_stab = (float)ww; zo_m[0] = zref / zz[0]; zo_m[1] = zref / zz[1]; } else { /* printf( "Warning: non-convergence" ); */ tau[0] = -9999.0; tau[1] = -9999.0; *shf = -9999.0; *lhf = -9999.0; u_star[0] = (float)ustar[0]; u_star[1] = (float)ustar[1]; *t_star = (float)tstar; *q_star = (float)qstar; *z_over_L = (float)( zref * monin_inv ); *wave_age = (float)wa[0]; *dom_phs_spd = (float)cp_com; *h_sig = (float)hsig[0]; *ww_stab = (float)ww; zo_m[0] = -9999.0; zo_m[1] = -9999.0; } return count; /* end of subroutine pmix_ */ } double find_q_( int moist_prm, double moist_val, double press, double temperature ) { double satvp, spec_hum; /* printf( "Bq%i %f %f %f\n", moist_prm, moist_val, press, temperature ); */ /* use the atmospheric moisture parameter to determine the specific humidity [kg/kg]. */ switch ( moist_prm ) { case 0: /* input is specific humidity */ spec_hum = moist_val; break; case 1: /* relative humidity (fraction) is used as input */ /* determine saturation vapour pressure over a smooth surface of water, at the temperature */ satvp = (1.000700 + 3.460000E-8 * press) * 611.2100 * exp( 17.50200 * temperature / ( 240.97000 + temperature ) ); spec_hum = moist_val * satvp * 0.6220 / ( press - 0.3780 * moist_val * satvp ); /* printf( "%f %f %f %f\n", satvp, spec_hum, temperature, press ); */ break; case 2: /* dew point temperature is used as input */ /* determine the latent heat of vaporization */ satvp = (1.000700 + 3.460000E-8 * press) * 611.2100 * exp( 17.50200 * moist_val / ( 240.97000 + moist_val ) ); spec_hum = 0.6220 * satvp / ( press - 0.3780 * satvp ); break; case 3: /* wet bulb temperature is used as input */ spec_hum = 0.0000066 * ( 1.0 + 0.00115 * moist_val ); /* dummy use of spec_hum */ satvp = (1.000700 + 3.460000E-8 * press) * 611.2100 * exp( 17.50200 * moist_val / ( 240.97000 + moist_val ) ) - spec_hum * press * (temperature - moist_val ); spec_hum = 0.6220 * satvp / ( press - 0.3780 * satvp ); break; default: printf( "Invalid choice of moist_prm: %i\n", moist_prm ); spec_hum = -1.0; } return spec_hum; /* end for subroutine find_q_ */ } int ht_adj_( int dyn_in_prm, float dyn_in_val, float dyn_in_val2, float CONVECT, float CONV_CRIT, float pressure, int air_moist_prm, float air_moist_val, int sfc_moist_prm, float sfc_moist_val, float salinity, int ss_prm, float ss_val, float t_air, int sst_prm, float t_skin, float ref_ht_wind, float ref_ht_tq, float z_wanted, int astab, int eqv_neut_prm, float Qnet, int warn, int flux_model, int z0_mom_prm, int z0_TQ_prm, int stable_prm, float *shf, float *lhf, float *tau, float *u_star, float *t_star, float *q_star, float *z_over_L, float *wave_age, float *dom_phs_spd, float *h_sig, float *ww_stab, float *zo_m, float *u_at_z, float *t_at_z, float *q_at_z ) { int astab_temp, bvw_flag, eqv_neut; float alpha, CP, Dalton, denair, nu, phi_u, phi_Q, phi_T, q_sfc, renewalTime, Stanton, ustar_mag, viscosity, zoN[2], zo_mag; /* printf( "ht_adj.c: %f %f %f %f %f %i %f %i %f %f %i %f %f %f %f %f %i %i %i %f\n", dyn_in_val, dyn_in_val2, CONVECT, CONV_CRIT, pressure, air_moist_prm, air_moist_val, sfc_moist_prm, sfc_moist_val, salinity, ss_prm, ss_val, t_air, t_skin, ref_ht_wind, ref_ht_tq, z_wanted, astab, warn, eqv_neut); */ TQzo_prm = 0; if ( flux_model == 9 || flux_model == 10 ) TQzo_prm = 1; if ( eqv_neut_prm == 2 ) { eqv_neut = FALSE; } else if ( eqv_neut_prm == 1 ) { eqv_neut = TRUE; } else { eqv_neut = FALSE; /* calculate neutral roughness length */ astab_temp = 0; bvw_flag = pmix_( dyn_in_prm, dyn_in_val, dyn_in_val2, CONVECT, CONV_CRIT, pressure, air_moist_prm, air_moist_val, sfc_moist_prm, sfc_moist_val, salinity, ss_prm, ss_val, t_air, sst_prm, t_skin, ref_ht_wind, ref_ht_tq, astab, Qnet, warn, flux_model, z0_mom_prm, z0_TQ_prm, stable_prm, shf, lhf, tau, u_star, t_star, q_star, z_over_L, wave_age, dom_phs_spd, h_sig, ww_stab, zo_m ); /* record neutral roughness length */ zoN[0] = zo_m[0]; zoN[1] = zo_m[1]; } bvw_flag = pmix_( dyn_in_prm, dyn_in_val, dyn_in_val2, CONVECT, CONV_CRIT, pressure, air_moist_prm, air_moist_val, sfc_moist_prm, sfc_moist_val, salinity, ss_prm, ss_val, t_air, sst_prm, t_skin, ref_ht_wind, ref_ht_tq, astab, Qnet, warn, flux_model, z0_mom_prm, z0_TQ_prm, stable_prm, shf, lhf, tau, u_star, t_star, q_star, z_over_L, wave_age, dom_phs_spd, h_sig, ww_stab, zo_m ); /* LV = 4186.8 * ( 597.31 - 0.56525 * t_skin ); */ q_sfc = find_q_( sfc_moist_prm, sfc_moist_val, pressure, t_skin ); /* determine the heat capacity at constant pressure */ CP = 1004.0 * ( 1.0 + 0.9 * q_sfc ); alpha = 1.0/(t_skin+273.15); /* correct to the height of z_wanted */ if ( eqv_neut_prm == 0 ) { phi_u = phi_u_f( z_wanted, z_wanted / zo_m[0] ); nu = 1.3260000e-5 * (1.00000 + 0.006542 * t_skin + 8.301000E-6 * t_skin * t_skin + 4.840000E-9 * t_skin * t_skin * t_skin ); ustar_mag = sqrt( ustar[0]*ustar[0] + ustar[1] * ustar[1] ); zo_mag = sqrt( zo_m[0]*zo_m[0] + zo_m[1] * zo_m[1] ); zo_mag = zo_m[0]; /* test option */ viscosity = 1.4e-5; denair = pressure / (R * ( t_skin + 273.14) * (1.0 + 0.61 * q_sfc ) ); renewalTime = getRenewalTime( zo_mag, ustar_mag, denair, CP, alpha, Qnet, viscosity ); Stanton = getStanton( ustar_mag, renewalTime); Dalton = getDalton( ustar_mag, renewalTime); /* zzt = z_wanted * z_o_zt( ref_ht_wind, ref_ht_tq, nu, zo_mag, Stanton ) / ref_ht_tq; zzq = z_wanted * z_o_zq( ref_ht_wind, ref_ht_tq, nu, zo_mag, Dalton ) / ref_ht_tq; */ zzt = zzt * z_wanted / ref_ht_tq; zzq = zzq * z_wanted / ref_ht_tq; phi_T = phi_T_f( z_wanted, zzt ); phi_Q = phi_Q_f( z_wanted, zzq ); } else if ( eqv_neut_prm == 1 ) { /* Tang and Liu eqv neut winds */ phi_u = 0.0; phi_T = 0.0; phi_Q = 0.0; } else if ( eqv_neut_prm == 2 ) { /* if option was selected, calculate equivalent friction velocities as defined by Geernaert and Katsaros (1986) */ ustar[0] = pow( dyn_in_val / ustar[0] + phi_u / KV - log( zoN[0] / zo_m[0] ) / KV, -1.0 ) * dyn_in_val; ustar[1] = pow( dyn_in_val2 / ustar[1] + phi_u / KV - log( zoN[1] / zo_m[1] ) / KV, -1.0 ) * dyn_in_val2; phi_u = 0.0; } *z_over_L = *z_over_L * z_wanted / ref_ht_wind; *u_at_z = sqrt( pow(ustar[0] * ( log( z_wanted / zo_m[0] ) + phi_u ) / KV, 2.0) + pow(ustar[1] * ( log( z_wanted / zo_m[1] ) + phi_u ) / KV, 2.0) ); *t_at_z = t_skin + Prt * tstar * ( log( zzt ) + phi_T ) / KV; *q_at_z = q_sfc + Sc * qstar * ( log( zzq ) + phi_Q ) / KV; /* printf( "ht_adj.c: %f %f %f %f %f %f %f %f %f %f %f %f %f %f %f %f %f %f %f\n", *shf, *lhf, tau[0], tau[1], u_star[0], u_star[1], *t_star, *q_star, *z_over_L, *wave_age, *dom_phs_spd, *h_sig, *ww_stab, *zo_m, *u_at_z, *t_at_z, *q_at_z, phi_u, phi_T, phi_Q ); printf( "%f %f %f %f %f %f %f\n", z_wanted, zzt, zzq, phi_T, phi_Q, tstar, qstar ); */ /* printf( "%i %f %f %f\n", flux_model, renewalTime, Stanton, Dalton); printf( "%f, %f, %f %f\n", 5.0,-1.0/(Prt*Stanton),5.0,-1.0/(Sc*Dalton)); */ /* printf("In solve: zzt = %f; zzq = %f; phi_Q = %f; phi_T = %f\n", zzt, zzq, phi_Qx, phi_Tx ); printf( "In ht_adj: zzt = %f; zzq = %f; phi_Q = %f; phi_T = %f\n", zzt*ref_ht_tq/z_wanted, zzq*ref_ht_tq/z_wanted, phi_Q, phi_T ); printf( "test2: %f %f %f\n", betas[0], betac[0], betag[0] ); */ return( bvw_flag ); } /* ENDCENTRY */ double f_bstar( short neutral, double qmixa, double ta, double minimum_value ) { double bstar; bstar = (double)(!neutral) * G * ( ( 1.00 + 0.610 * qmixa ) * tstar + 0.6100 * ( ta + 273.15 ) * qstar ) / ( ta + 273.15 * ( 1.0 + 0.610 * qmixa ) ); if ( fabs( bstar ) < minimum_value ) { if ( bstar == 0.0 ) bstar = minimum_value; else bstar = minimum_value * bstar / fabs( bstar ); } return bstar; } int solve( short fixedcp, short fixedwa, short fixed_hsig, short fixed_uen, short fixed_ustar, short neutral, double CON_P, double cp, double CRIT, double denwat, double nu, double qmixa, double qmixw, double sfcten, int ss_prm, double ss_val, double ta, double tskin, float Qnet, double zref, double zreft, double zrefq, double ww, double ww_eql, double betag_set, double betac_set, double betas_set, int z0_prm, int warn ) { short done, first, hsig_known, unreasonable, trouble; int count, count_Lu, count_tqL, i; float alpha, Dalton, renewalTime, Stanton, viscosity, zo_mag; double bstar, delta_q, delta_theta, max, min, monin_inv_old, monin_inv_old2, phi_T, phi_Q, qstar_old, ta_ept, tstar_old, tskin_ept, ustar_mag, ustar_mag_old, ustar_old[2], zeta, wa_old[2], zz_old[2]; /* convert the temperatures to equivalent potential temperature */ /* estimated through the dry static energy */ tskin_ept = tskin; ta_ept = ta + G * zreft / CP; betag_prime = betag_set; betag[0] = betag_prime; betag[1] = betag_prime; betac_prime = betac_set; betac[0] = betac_prime; betac[1] = betac_prime; betas_prime = betas_set; betas[0] = betas_prime; betas[1] = betas_prime; /* intial guess for value of friction velocity (ustar) */ /* component parallel direction of wave motion */ ustar[0] = (double)fixed_ustar * ustar[0] + (double)!fixed_ustar * 0.003; /* component perpendicular direction of wave motion */ ustar[1] = (double)fixed_ustar * ustar[1] + (double)!fixed_ustar * 0.003; tstar = 0.0003 * (ta - tskin); if ( fabs( tstar ) < 0.001 ) tstar = -0.001; qstar = 0.0003 * (qmixa - qmixw); if ( fabs( qstar ) < 0.0001 ) qstar = -0.0001; ustar_old[0] = ustar[0] / 2.00; ustar_old[1] = ustar[1] / 2.00; tstar_old = tstar / 2.00; qstar_old = qstar / 2.00; cmin = sqrt( 2.0 * sqrt( G * sfcten / denwat ) ); u_sfc[0] = 0.0; u_sfc[1] = 0.0; if ( ss_prm != 6 ) { u_orb[0] = 0.0; } else { u_orb[0] = ss_val; } u_orb[1] = 0.0; /*initially assume a neutral atmospheric stability (monin_inv = 0) */ monin_inv = 0.0; unreasonable = TRUE; while ( unreasonable == TRUE ) { /* iterate over atmospheric stability and friction velocity */ monin_inv_old2 = -0.001; ustar_mag_old = 0.0; ustar_mag = sqrt( ustar[0] * ustar[0] + ustar[1] * ustar[1] ); count_Lu = 0; while ( ( fabs( monin_inv - monin_inv_old2 ) > CRIT*fabs( monin_inv_old2 ) || fabs( ustar_mag - ustar_mag_old ) > CRIT * fabs( ustar_mag_old ) || count_Lu < 2 ) && count_Lu < 30 && !( fixed_ustar && count_Lu >= 1 ) ) { count_Lu++; /* determine roughness lengths for heat and moisture profiles */ viscosity = 1.4e-5; alpha = 1.0/(ta+273.15); zo_mag = zref / sqrt( zz[0] * zz[0] + zz[1] * zz[1] ); zo_mag = zref / zz[0]; /* test option */ renewalTime = getRenewalTime( zo_mag, ustar_mag, denair, CP, alpha, Qnet, viscosity ); Stanton = getStanton( ustar_mag, renewalTime); Dalton = getDalton( ustar_mag, renewalTime); zzt = z_o_zt( zref, zreft, nu, zo_mag, Stanton ); zzq = z_o_zq( zref, zrefq, nu, zo_mag, Dalton ); ustar_mag_old = ustar_mag; monin_inv_old2 = monin_inv; /* iterate over solutions to tstar, qstar, and monin_inv */ tstar_old = 0.5 * tstar; qstar_old = 0.5 * qstar; monin_inv_old = monin_inv; count_tqL = 0; while ( ( fabs( tstar - tstar_old ) > CRIT * fabs( tstar_old ) || fabs( qstar - qstar_old ) > CRIT * fabs( qstar_old ) || fabs( monin_inv - monin_inv_old ) > 0.1*CRIT * fabs( monin_inv_old ) || count_tqL < 3 ) && count_tqL < 40 ) { count_tqL++; tstar_old = tstar; qstar_old = qstar; monin_inv_old = monin_inv; /* determine tstar (assuming the current L is correct) */ /* printf( "test2a: %f %f %f\n", (float)tstar, (float)qstar, (float)monin_inv ); printf( "test2c: %f %f %f %f %f\n", (float)delta_theta, (float)KV, (float)( log( zzt+1.0 ), (float)(!neutral) * phi_T ), (float)Prt ); */ if ( ta_ept == tskin_ept ) tstar = 0.0; else { /* determine the eqv. pot. temperature stability term */ phi_T = phi_T_f( zreft, zzt ); delta_theta = ta_ept - tskin_ept; if ( fabs( delta_theta ) < 0.001 ) delta_theta = -0.001; tstar = KV * delta_theta / ( log( zzt+1.0 ) + (double)(!neutral) * phi_T ) / Prt; } /* determine qstar (assuming current L is correct */ /* printf( "test2b: %f %f %f\n", (float)tstar, (float)qstar, (float)monin_inv ); */ if ( qmixa == qmixw ) qstar = 0; else { /* determine the moisture stability term */ phi_Q = phi_Q_f( zreft, zzq ); delta_q = qmixa - qmixw; if ( fabs( delta_q ) < 0.0001 ) delta_q = -0.0001; qstar = KV * ( delta_q ) / ( log( zzq+1.0 ) + (double)(!neutral) * phi_Q ) / Sc; /* printf( "%f %f %f\n", delta_q, zzq, phi_Q ); */ } /* determine the bouyancy flux */ bstar = f_bstar( neutral, qmixa, ta, 0.000001 ); /*!!!!This assumes temperature and humidity are measured at THE SAME HEIGHT */ /* determine the inverse Monin-Obhukov scale length: 1/L */ monin_inv = KV * bstar / ( ustar[0]*ustar[0] + ustar[1] * ustar[1] ); /* insure that 1/L is within reasonable bounds */ max = 1.0; min = 0.0001; if ( fabs(monin_inv) < min ) monin_inv = min * monin_inv / fabs( monin_inv ); if ( fabs( monin_inv ) > max ) monin_inv = max * monin_inv / fabs( monin_inv ); } /* end of iteration on tstar, qstar, and monin_inv */ /* printf( "test3: %f %f %f\n", (float)tstar, (float)qstar, (float)monin_inv ); */ done = FALSE; count = 0; while ( ( done == FALSE || count < 2 ) && count < 100 ) { count++; done = TRUE; wa_old[0] = wa[0]; wa_old[1] = wa[1]; zz_old[0] = zz[0]; zz_old[1] = zz[1]; first = TRUE; /* iteratively solve for u* for non-neutral conditions */ if ( !fixed_ustar ) { find_ustar( first, fixedcp, fixedwa, fixed_hsig, fixed_uen, neutral, count, CON_P, cp, CRIT, denwat, nu, qmixa, sfcten, ta, ww, ww_eql, ss_prm, ss_val, zref, zreft, z0_prm ); /* printf( "test A %f %f %f %f\n", (float)ustar[0], (float)ustar[1], (float)tstar, (float)qstar ); */ } else { i = 0; if ( fixed_hsig && i == 0 ) hsig_known = TRUE; else hsig_known = FALSE; trouble = z_o_z0( fixedcp, fixedwa, neutral, hsig_known, denwat, nu, sfcten, zref, cp, ww, ww_eql, ss_prm, ss_val, count, i, z0_prm ); i = 1; hsig_known = FALSE; trouble = z_o_z0( fixedcp, fixedwa, neutral, hsig_known, denwat, nu, sfcten, zref, cp, ww, ww_eql, ss_prm, ss_val, count, i, z0_prm ); } if ( ( fabs( ( wa[0] - wa_old[0]) / wa[0] ) > CRIT || fabs( ( wa[1] - wa_old[1] ) / wa[1] ) > CRIT || fabs( ( zz[0] - zz_old[0] ) / zz[0] ) > CRIT || fabs( ( zz[1] - zz_old[1] ) / zz[1] ) > CRIT ) && count < 60 ) done = FALSE; } ustar_mag = sqrt( ustar[0] * ustar[0] + ustar[1] * ustar[1] ); } /* end of iteration over friction velocity and atmospheric stability */ /* determine if the phase speed of the dominant waves is physically reasonable. If the phase speed is less than the physical minimum, then assume that no capillary waves are pressent. After the second pass, if phase speed is still unacceptable then assume the surface is smooth. */ /* if ( smith88 && monin_inv > 0 ) printf( "zo = %f %f\n", zref / zz[0], u[0] ); if ( smith88 && monin_inv > 0 ) printf( "1 %f %f %f %f %f %f %f\n", u[0], betas_prime, betac_prime, betag_prime, betas[0], betac[0], betag[0]); */ if ( fixedwa || fixedcp || ( betag[0] != 0.0 && wa[0] * fabs( ustar[0] ) > cmin ) || ( betag[1] != 0.0 && wa[1] * fabs( ustar[1] ) > cmin ) || betas_prime == 1.0 ) { unreasonable = FALSE; } else { if ( betag[0] != 0.0 && betag[1] != 0.0 && betac_prime != 0.0 ) { if ( fabs( u[0] - u_sfc[0] ) > fabs( u[1] - u_sfc[1] ) ) { betag[1] = 0.0; } else { betag[0] = 0.0; } } else if ( betac_prime > 0.0 ) { betag[0] = 1.0; betag[1] = 1.0; betac_prime = 0.0; } else { if ( betag[0] > 0.0 && wa[0] * fabs( ustar[0] ) < cmin ) { betag[0] = 0.0 + (double)smith88; } if ( betag[1] > 0.0 && wa[1] * fabs( ustar[1] ) < cmin ) { betag[1] = 0.0 + (double)smith88; } if ( betag[0] == 0.0 && betag[1] == 0.0 ) { betag_prime = 0.0 + (double)smith88; betas_prime = 1.0; } } } /* if ( smith88 && monin_inv > 0 ) printf( "2 %f %f %f %f %f %f %f\n", u[0], betas_prime, betac_prime, betag_prime, betas[0], betac[0], betag[0]); */ } return count_Lu + fixed_ustar; /* end of subroutine solve */ } double f_ustar( short fixed_uen, short neutral, double bstar, double CON_P, double phi_u, double delta_u, double ww, double zref, double max_value, int i ) { /* The effect of the surface current is considered in "delta_u": delta_u = U(zref) - Usfc This slightly reduces the speed of the algorithm. */ double d_over_zo, delta_u2, hzzg, ustar_test, wstar2; wstar2 = pow( fabs( sqrt( ustar[0] * ustar[0] + ustar[1] * ustar[1] ) * bstar ) * H, 0.6666667); if ( monin_inv >= 0.0 ) wstar2 = 0.0; hzzg = zz[i]; /* in this case hzzg is not related to wave height - it is a dummy variable */ if ( hzzg < 0.00001 ) hzzg = 0.00001; if ( fabs( delta_u ) < 0.000001 ) { ustar_test = 0.0; } else if ( log( hzzg + 1.0 ) + (double)!fixed_uen * (double)!neutral * phi_u > 0.01 ) { delta_u2 = delta_u * delta_u + CON_P * wstar2; if ( fabs( delta_u2 ) < 0.000001 ) delta_u2 = 0.000001; delta_u = sqrt( delta_u2 ) * delta_u / fabs( delta_u ); /* calculate displacement height, multiplied by zero or one depending on whether or not it is used. */ d_over_zo = (float)use_dh * hzzg / zref * hsig[0] * 0.8; ustar_test = KV * delta_u / ( log( hzzg - d_over_zo + 1.0 ) + (double)!fixed_uen * (double)!neutral * phi_u ); /* eliminate the problem of excessive stress: limit friction velocity */ if ( pow( KV / log( ( 10.0 - d_over_zo ) * zz[i] / zref + 1.0), 2.0 ) > 0.01 ) ustar_test = 0.01 * pow( log( ( 10.0 - d_over_zo ) * zz[i] / zref + 1.0) / KV, 2.0 ); if ( ustar_test > 10.0 ) ustar_test = 10.0; } else { ustar_test = 10.0; } /* ustar is not returned because it is a global variable */ return ustar_test; } double phi_u_f( double zref, double zzd ) { double a_bh, b_bh, c_bh, d_bh, phi_u, zeta, zeta0; a_bh = 0.7; b_bh = 0.75; c_bh = 5.0; d_bh = 0.35; /* unstable case */ if ( monin_inv < 0 ) { switch( stab_prm ) { case 0: /* BVW */ /* find zeta( z / L ) and zeta( zo / L ) */ zeta = pow( 1.000 - 15.000 * zref * monin_inv, 0.2500 ); zeta0 = pow( 1.000 - 15.000 * zref / zzd * monin_inv, 0.2500 ); phi_u = log( (zeta0 * zeta0 + 1.0 ) * pow( zeta0 + 1.0, 2.0 ) / ( ( zeta * zeta + 1.0 ) * pow( zeta + 1.0, 2.0 ) ) ) + 2.000000 * ( atan(zeta) - atan(zeta0) ); break; case 1: /* Smith 88 parameterization */ a_bh = sqrt( sqrt( 1.0 - 16.0 * zref * monin_inv ) ); phi_u = -2.0 * log( 0.5 * (1.0 + a_bh) ) - log( 0.5 * (1.0 + a_bh*a_bh) ) + 2.0 * atan( a_bh ) - 3.14159 / 2.0; break; } } else { /* stable case */ switch( stab_prm ) { case 0: /* BVW */ phi_u = a_bh * zref * monin_inv + b_bh * ( zref * monin_inv - c_bh / d_bh ) * exp(-d_bh * zref * monin_inv ) + b_bh * c_bh / d_bh; break; case 1: /* Smith 88 parameterization */ phi_u = 5.0 * zref * monin_inv; break; } } return phi_u; /* end of subroutine phi_u_f */ } double phi_Q_f( double zrefq, double zzq ) { double a_bh, b_bh, c_bh, d_bh, phi_Q, qlamda, q0lamda; a_bh = 1.0; b_bh = 0.667; c_bh = 5.0; d_bh = 0.35; if ( monin_inv < 0 ) { switch( stab_prm ) { case 0: /* BVW */ /* find zeta( z / L ) and zeta( zo / L ) */ qlamda = sqrt( 1.000 - 9.000 * zrefq * monin_inv ); q0lamda = sqrt( 1.000 - 9.000 * zrefq / zzq * monin_inv ); phi_Q = 2.0000 * log( ( q0lamda + 1 ) / ( qlamda + 1 ) ); break; case 1: /* Smith 88 parameterization */ a_bh = sqrt( 1.0 - 16.0 * zrefq * monin_inv ); phi_Q = -2.0 * log( ( 1.0 + a_bh ) / 2.0 ); break; } } else { /* stable case */ switch( stab_prm ) { case 0: /* BVW */ phi_Q = pow( 1.0 + 0.6667 * a_bh * zrefq * monin_inv, 1.5 ) + b_bh * ( zrefq * monin_inv - c_bh / d_bh ) * exp(-d_bh * zrefq * monin_inv ) + b_bh * c_bh / d_bh - 1.0; break; case 1: /* Smith 88 parameterization */ phi_Q = 5.0 * zrefq * monin_inv; break; } } return phi_Q; /* end of subroutine phi_Q_f */ } double phi_T_f( double zreft, double zzt ) { double a_bh, b_bh, c_bh, d_bh, phi_T, tlamda, t0lamda; a_bh = 1.0; b_bh = 0.667; c_bh = 5.0; d_bh = 0.35; if ( monin_inv < 0 ) { switch( stab_prm ) { case 0: /* BVW */ /* find zeta( z / L ) and zeta( zo / L ) */ tlamda = pow( 1.000 - 9.000 * zreft * monin_inv, 0.500); t0lamda = pow( 1.000 - 9.000 * zreft / zzt * monin_inv, 0.500); phi_T = 2.0000 * log( ( t0lamda + 1 ) / ( tlamda + 1 ) ); break; case 1: /* Smith 88 parameterization */ a_bh = sqrt( 1.0 - 16.0 * zreft * monin_inv ); phi_T = -2.0 * log( ( 1.0 + a_bh ) / 2.0 ); break; } } else { /* stable case */ switch( stab_prm ) { case 0: /* BVW */ phi_T = pow( 1.0 + 0.6667 * a_bh * zreft * monin_inv, 1.5 ) + b_bh * ( zreft * monin_inv - c_bh / d_bh ) * exp(-d_bh * zreft * monin_inv ) + b_bh * c_bh / d_bh - 1.0; break; case 1: /* Smith 88 parameterization */ phi_T = 5.0 * zreft * monin_inv; break; } } return phi_T; /* end of subroutine phi_T_f */ } double z_o_zq( double zref, double zrefq, double nu, float zo_mag, float Dalton ) { double betas_temp, const1, const2, Rr, ustar_mag; /* zzq is zref / z0Q */ ustar_mag = sqrt( ustar[0] * ustar[0] + ustar[1] * ustar[1] ); if ( TQzo_prm == 0 ) { /* wall theory */ if ( betas[0] == 0.0 ) betas_temp = 1.0; else betas_temp = betas[0]; zzq = zrefq / ( betas_temp * 0.620 * nu / fabs( ustar_mag ) ); } else if ( TQzo_prm == 1 ) { /* CFC model */ zzq = zrefq / ( zo_mag * exp( KV * ( 5.0 - 1.0 / ( Sc * Dalton ) ) ) ); } else if ( TQzo_prm == 2 ) { /* Zilitinkevich et al. 2001 */ zzq = zrefq / ( zo_mag * exp( -4.0 * sqrt( zo_mag * ustar_mag / nu ) ) ); } else if ( TQzo_prm == 3 ) { /* LKB 1979 */ Rr = zo_mag * ustar_mag / nu; if ( Rr < 0.11 ) { const1 = 0.177; const2 = 0; } else if ( Rr < 0.825 ) { const1 = 1.376; const2 = 0.929; } else if ( Rr < 3. ) { const1 = 1.026; const2 = -0.599; } else if ( Rr < 10.0 ) { const1 = 1.625; const2 = -1.018; } else if ( Rr < 30.0 ) { const1 = 4.661; const2 = -1.475; } else if ( Rr < 100.0 ) { const1 = 34.904; const2 = -2.067; } else { printf( "LKB zoq calculation failed due to large Rr: %f\n", Rr); /* printf( "LKB z0 = %f %f %f; LKB ustar = %f; LKB nu = %f\n", zo_mag, zz[0], zz[1], ustar_mag, nu); */ const1 = 34.904; const2 = -2.067; } zzq = zrefq * ustar_mag * const1 * pow( Rr, const2 ) / nu; } else if ( TQzo_prm == 4 ) { /* COARE3.0 */ zzq = 0.000055 * pow( zo_mag * ustar_mag / nu, -0.6 ); /* zo_q */ if ( zzq < 0.00011 ) zzq = 0.00011; zzq = zrefq / zzq; } else if ( TQzo_prm == 5 ) { /* Modified CFC model */ zzq = zrefq / ( zo_mag * exp( KV * ( 0.5 - 1.0 / ( Sc * Dalton ) ) ) ); } else { printf( "Invalid choice of TQzo_prm: %i\n", TQzo_prm ); exit(0); } return zzq; /* end of subroutine z_o_zq */ } double z_o_zt( double zref, double zreft, double nu, float zo_mag, float Stanton ) { double betas_temp, const1, const2, Rr, ustar_mag; ustar_mag = sqrt( ustar[0] * ustar[0] + ustar[1] * ustar[1] ); if ( TQzo_prm == 0 ) { if ( betas[0] == 0.0 ) betas_temp = 1.0; else betas_temp = betas[0]; /* determine zreft / zT */ zzt = zreft / ( betas_temp * 0.40 * nu / fabs( ustar_mag ) ); } else if ( TQzo_prm == 1 ) { zzt = zreft / ( zo_mag * exp( KV * ( 5.0 - 1.0 / ( Prt*Stanton ) ) ) ); } else if ( TQzo_prm == 2 ) { /* Zilitinkevich et al. 2001 */ zzt = zreft / ( zo_mag * exp( -4.0 * sqrt( zo_mag * ustar_mag / nu ) ) ); } else if ( TQzo_prm == 3 ) { /* LKB 1979 */ Rr = zo_mag * ustar_mag / nu; if ( Rr < 0.11 ) { const1 = 0.292; const2 = 0; } else if ( Rr < 0.825 ) { const1 = 1.808; const2 = 0.826; } else if ( Rr < 3. ) { const1 = 1.393; const2 = -0.528; } else if ( Rr < 10.0 ) { const1 = 1.956; const2 = -0.870; } else if ( Rr < 30.0 ) { const1 = 4.994; const2 = -1.297; } else if ( Rr < 100.0 ) { const1 = 30.790; const2 = -1.845; } else { printf( "LKB zoq calculation failed due to large Rr: %f\n", Rr); const1 = 30.790; const2 = -1.845; } zzt = zreft * ustar_mag * const1 * pow( Rr, const2 ) / nu; } else if ( TQzo_prm == 4 ) { /* COARE3.0 */ zzt = 0.000055 * pow( zo_mag * ustar_mag / nu, -0.6 ); /* zo t */ if ( zzt < 0.00011 ) zzt = 0.00011; zzt = zreft / zzt; } else { printf( "Invalid choice of TQzo_prm: %i\n", TQzo_prm ); exit(0); } return zzt; /* end of subroutine z_o_zt */ } int z_o_z0( short fixedcp, short fixedwa, short neutral, short hsig_known, double denwat, double nu, double sfcten, double zref, double cp, double ww, double ww_eql, int ss_prm, double ss_val, int count, int i, int z0_prm ) { short period_known; int test; double A_Charnock, B_Toba, dum, hzzg, period[2], p1, p2, p3, p4, oil_mod, phi_u, scale, sig_slope, ueff, Uorb, ustar_temp, wave_len, z0; A_Charnock = 0.035; oil_mod = 0.25; /* crude guess for oil spills - not natural oil */ /* A_Charnock = 0.48/ss_val; */ test = 0; ustar_temp = sqrt( ustar[0] * ustar[0] + ustar[1] * ustar[1] ); cmin = sqrt( 2.0 * sqrt( G * sfcten / denwat ) ); ueff = sqrt( ( u[i] - u_sfc[i] + wstar2 ) * ( u[i] - u_sfc[i] ) + wstar2 ); /* For the flux models (i.e., only BVW) that calculate sea state */ if ( z0_prm == 0 || z0_prm == 3 ) { B_Toba = 0.0602; /* the sea state parameter is significant slope */ if ( ss_prm == 4 && i == 0 ) { sig_slope = ss_val; cp = 2.0 * 3.14159 * fabs( ustar[i] ) * B_Toba * B_Toba / sig_slope / sig_slope; wa[i] = cp / fabs( ustar[i] ); if ( wa[i] > 12000.0 ) wa[i] = 12000.0; /* printf( "%lf %lf %lf\n", cp, wa[i], ustar[i] ); */ ueff = sqrt( u[i] * u[i] + wstar2 ); z0 = betas[i] * 0.1100 * nu / fabs( ustar[i] ) + betac[i] * B * sfcten / ( ustar[i] * ustar[i] * denwat ) + betag[i] * 0.016 * ustar[i] * ustar[i] / G; phi_u = phi_u_f( betag[i] * hsig[i], hsig[i] / z0 ); ww = ( log( hsig[i] / z0 + 1.0 ) + phi_u ) / ( KV * ww_eql * wa[i] ); /* determine the wave characteristics */ period[i] = pow( pow( cp * sig_slope / B_Toba, 2.0 ) / ( G * ustar[i] ), 0.333333 ); hsig[i] = B_Toba * sqrt( G * fabs( ustar[i] ) * pow( period[i], 3 ) ); wave_len = cp * period[i]; } /* the sea state parameter is significant wave height OR period */ if ( ( hsig_known || ss_prm == 5 ) && i == 0 ) { if ( ss_prm == 5 ) period_known = TRUE; else period_known = FALSE; period[i] = (double)(!period_known) * pow( hsig[i] * hsig[i] / ( G * fabs( ustar[i] ) * B_Toba*B_Toba ), 0.333333 ) + (double)period_known * ss_val; hsig[i] = (double)period_known * B_Toba * sqrt( G * fabs( ustar[i] ) * pow( period[i], 3 ) ) + (double)(!period_known) * ss_val; p1 = G * period[i] / ( 2.0 * 3.14159 ); p2 = pow( cmin, 4.0); p3 = 0.5 * p2 / p1 + pow( p1, 3.0 ) / 27.0; p4 = 0.25 * p2 * p2 / ( p1 * p1 ) + p1 * p1 * p2 / 27.0; cp = pow( p3 + sqrt( p4 ), 0.333333 ) + pow( p3 - sqrt( p4 ), 0.333333 ) + p1 / 3.0; wa[i] = cp / fabs( ustar[i] ); if ( wa[i] > 12000.0 ) wa[i] = 12000.0; /* determine the wave characteristics */ wave_len = cp * period[i]; ueff = sqrt( u[i] * u[i] + wstar2 ); if ( z0_prm == 0 ) { /* BVW */ zz[i] = zref / ( ( ( betas[i] * 0.1100 * nu / fabs( ustar[i] ) ) + sqrt( pow( betac[i] * B * sfcten / ( ustar_temp * fabs( ustar[i] ) * denwat ), 2.0 ) + pow( betag[i] * 0.48 / wa[i] * ustar_temp * fabs( ustar[i] ) / G, 2.0 ) ) ) ); } else if ( z0_prm == 1 ) { /* Bourassa (2006) */ zz[i] = zref / ( ( ( betas[i] * 0.1100 * nu / fabs( ustar[i] ) ) + sqrt( pow( betac[i] * B * sfcten / ( ustar_temp * fabs( ustar[i] ) * denwat ), 2.0 ) + pow( betag[i] * A_Charnock * ustar_temp * fabs( ustar[i] ) / G, 2.0 ) ) ) ); } else if ( z0_prm == 2 ) { /* BVW with Taylor & Yelland zog */ zz[i] = zref / ( ( betas[i] * 0.1100 * nu / fabs( ustar[i] ) ) + sqrt( pow( betac[i] * B * sfcten / ( ustar_temp * fabs( ustar[i] ) * denwat ), 2.0 ) + pow( betag[i] * hsig[i] * 1200.0 * pow( hsig[i] / wave_len, 4.5 ), 2.0 ) ) ); } else if ( z0_prm == 3 ) { /* Taylor & Yelland */ zz[i] = zref / ( betag[i] * hsig[i] * 1200.0 * pow( hsig[i] / wave_len, 4.5 ) ); } else if ( z0_prm == 4 ) { /* Bourassa (2006) modified for oil slick */ zz[i] = zref / ( ( ( betas[i] * 0.1100 * nu / fabs( ustar[i] ) ) + oil_mod * sqrt( pow( betac[i] * B * sfcten / ( ustar_temp * fabs( ustar[i] ) * denwat ), 2.0 ) + pow( betag[i] * A_Charnock * ustar_temp * fabs( ustar[i] ) / G, 2.0 ) ) ) ); } else if ( z0_prm == 5 ) { /* Smooth surface */ zz[i] = zref / ( 0.1100 * nu / fabs( ustar[i] ) ); } else { printf( "Unreasonable value of z0_prm: %i\n", z0_prm ); } phi_u = phi_u_f( betag[i] * hsig[i], hsig[i] / z0 ); ww = ( log( hsig[i] / z0 + 1.0 ) + phi_u ) / ( KV * ww_eql * wa[i] ); /* printf( "z/z0 T: i = %i; ss_val=%f; period = %f; hsig = %f; wa = %f\n", i, ss_val, period[i], hsig[i], wa[i] ); */ } else { ueff = sqrt( u[i] * u[i] + wstar2 ); if ( z0_prm == 0 ) { /* BVW */ zz[i] = zref / ( ( ( betas[i] * 0.1100 * nu / fabs( ustar[i] ) ) + sqrt( pow( betac[i] * B * sfcten / ( ustar_temp * fabs( ustar[i] ) * denwat ), 2.0 ) + pow( betag[i] * 0.48 / wa[i] * ustar_temp * fabs( ustar[i] ) / G, 2.0 ) ) ) ); } else if ( z0_prm == 1 ) { /* Bourassa (2006) */ zz[i] = zref / ( ( ( betas[i] * 0.1100 * nu / fabs( ustar[i] ) ) + sqrt( pow( betac[i] * B * sfcten / ( ustar_temp * fabs( ustar[i] ) * denwat ), 2.0 ) + pow( betag[i] * A_Charnock * ustar_temp * fabs( ustar[i] ) / G, 2.0 ) ) ) ); } else if ( z0_prm == 2 ) { /* BVW with Taylor & Yelland zog */ zz[i] = zref / ( ( betas[i] * 0.1100 * nu / fabs( ustar[i] ) ) + sqrt( pow( betac[i] * B * sfcten / ( ustar_temp * fabs( ustar[i] ) * denwat ), 2.0 ) + pow( betag[i] * hsig[i] * 1200.0 * pow( hsig[i] / wave_len, 4.5 ), 2.0 ) ) ); } else if ( z0_prm == 3 ) { /* Taylor & Yelland */ zz[i] = zref / ( betag[i] * hsig[i] * 1200.0 * pow( hsig[i] / wave_len, 4.5 ) ); } else if ( z0_prm == 4 ) { /* Bourassa (2006) modified for oil slick */ zz[i] = zref / ( ( ( betas[i] * 0.1100 * nu / fabs( ustar[i] ) ) + oil_mod * sqrt( pow( betac[i] * B * sfcten / ( ustar_temp * fabs( ustar[i] ) * denwat ), 2.0 ) + pow( betag[i] * A_Charnock * ustar_temp * fabs( ustar[i] ) / G, 2.0 ) ) ) ); } else if ( z0_prm == 5 ) { /* Smooth surface */ zz[i] = zref / ( 0.1100 * nu / fabs( ustar[i] ) ); } else { printf( "Unreasonable value of z0_prm: %i\n", z0_prm ); } /* determine the wave characteristics */ if ( betag[i] > 0.1 ) { dum = ustar[i] * ustar[i] * wa[i] * wa[i]; if ( dum > cmin * cmin ) wave_len = 3.14159 * ( dum + ( sqrt( dum * dum - (double)(!no_sfcten) * pow(cmin,4) ) ) ) / G; else wave_len = PI2 * sqrt( sfcten / ( G * denwat ) ); period[i] = wave_len / ( fabs( wa[i] * ustar[i] ) ); /* Toba's relation between wave height, friction velocity and period */ hsig[i] = 0.062 * sqrt( G * fabs( ustar[i] ) * pow( period[i], 3 ) ); /* limit the height of breaking waves */ if ( hsig[i] > 0.137 * wave_len ) hsig[i] = 0.137 * wave_len; } else { hsig[i] = 0.0; period[i] = -9999.9; } } /* printf( "z/z0 Hs: i=%i; hsig=%f; ustar=%f; wa=%f; period=%f\n", i, hsig[i], ustar[i], wa[i], period[i] ); */ } /* end of block estimating seastate for BVW */ /* determine beta-c */ betac[i] = betac_prime; if ( z0_prm != 3 ) { scale = 0.8; hzzg = scale * hsig[i] * zz[i] / zref; /* can't be -ve */ phi_u = phi_u_f( betag[i] * scale * hsig[i], hzzg ); if ( ss_prm == 6 ) { Uorb = u_orb[i]; } else { Uorb = 0.0 * (double)wave_stab_intr * betag[i] * scale * 0.5 * PI2 * hsig[i] / period[i]; } phi_u = phi_u_f( 10.0, hzzg ); ueff = ustar[i] * ( log( zz[i] + 1.0 ) + phi_u ) / KV; if ( z0_prm == 0 ) { if ( ueff < 1.8 ) { betac[i] = 0.0; betag[i] = 0.0; } else { betac[i] = 1.0; betag[i] = 1.0; } } if ( z0_prm == 1 ) { if ( ueff < 1.0 ) { betac[i] = 0.0; betag[i] = 0.0; } else { betac[i] = tanh( pow( 0.4 * ( ueff -1.0 ), 3 ) ) * betac_prime; betag[i] = tanh( pow( 0.3 * ( ueff -1.0 ), 3 ) ) * betag_prime; } } if ( z0_prm == 4 ) { if ( ueff < 7.0 ) { betac[i] = 0.0; } else { betac[i] = tanh( pow( 0.4 * ( ueff -7.0 ), 3 ) ) * betac_prime; betag[i] = tanh( pow( 0.3 * ( ueff -7.0 ), 3 ) ) * betag_prime; } } if ( betac[i] < 0.1 && !no_capw ) { betag[i] = betac[i]; } if ( no_capw ) betac[i] = 0.0; betas[i] = 1.0 - betac[i]; /* printf( "betac: hzzg=%f; phi_u=%f; Uorb=%f\n", hzzg, phi_u, Uorb); */ /* determine wave age */ phi_u = phi_u_f( betag[i] * hsig[i], hsig[i] / z0 ); hzzg = hsig[i] * zz[i] / zref; /* can't be -ve */ if ( hzzg < 0.00001 ) hzzg = 0.00001; if ( ss_prm == 0 || i == 1 ) { /* local equilibrium requires ww = 1 */ wa[i] = ( log( hzzg + 1.0 ) + (double)(!neutral) * phi_u ) / ( (double)( (1.0-i) * ww + i ) * KV * ww_eql ); cp = wa[i] * fabs( ustar[i] ); /* printf( "test1: %i %f %i %f %f %f %f %f\n", i, hzzg, neutral, phi_u, KV, ww, ww_eql, wa[i] ); */ } } /* printf( "test2: %i %f %f %f %f\n", i, ueff, betas[i], betac[i], betag[i] ); */ if ( !fixedwa ) { /* i must equal 0 to reach this point */ /* wave age based on sea state observations (other than wave age) */ if ( fabs( ustar[i] ) > 0.0 ) wa[i] = cp / fabs( ustar[i] ); else wa[i] = 999.0; } else { cp = wa[i] * fabs( ustar[i] ); } /* printf( "z_o_z0: i=%i; u=%f; wa=%f; ustar=%f; hsig=%f; hzzg=%f; phi_u=%f; cp=%f; bc=%f\n", i, u[i], wa[i], ustar[i], hsig[i], hzzg, phi_u, cp, betac[i] ); */ /* insure that wa is not horribly unreasonable */ if ( !( fixedwa || hsig_known || ss_prm == 4 ) && wa[i] > 250.0 ) { wa[i] = 250.0; test = -1; } else test = test - test%2; if ( !fixedwa && wa[i] < 1.08 ) { wa[i] = 1.08; test = test - 2; } else test = test - ( test%4 - test%2 ); if ( !fixedcp ) cp_com = wa[0] * fabs( ustar[0] ); else cp_com = cp; /* printf( "betac & betag: %f %f %f %f\n", betac[0], betag[1], betac[1], betag[1] ); */ /* printf( "betac & betag: %f %f %f %f\n", betac[i], betag[i], betac_prime, betag_prime ); */ /* determine zref / z0 */ if ( z0_prm == 0 ) { /* BVW */ zz[i] = zref / ( ( ( betas[i] * 0.1100 * nu / fabs( ustar[i] ) ) + sqrt( pow( betac[i] * B * sfcten / ( ustar_temp * fabs( ustar[i] ) * denwat ), 2.0 ) + pow( betag[i] * 0.48 / wa[i] * ustar_temp * fabs( ustar[i] ) / G, 2.0 ) ) ) ); /* * exp( -KV * Uorb / fabs( ustar[i] ) */ } else if ( z0_prm == 1 ) { /* Bourassa (2006) */ zz[i] = zref / ( ( ( betas[i] * 0.1100 * nu / fabs( ustar[i] ) ) + sqrt( pow( betac[i] * B * sfcten / ( ustar_temp * fabs( ustar[i] ) * denwat ), 2.0 ) + pow( betag[i] * A_Charnock * ustar_temp * fabs( ustar[i] ) / G, 2.0 ) ) ) ); } else if ( z0_prm == 2 ) { /* BVW with Taylor & Yelland zog */ zz[i] = zref / ( ( betas[i] * 0.1100 * nu / fabs( ustar[i] ) ) + sqrt( pow( betac[i] * B * sfcten / ( ustar_temp * fabs( ustar[i] ) * denwat ), 2.0 ) + pow( betag[i] * hsig[i] * 1200.0 * pow( hsig[i] / wave_len, 4.5 ), 2.0 ) ) ); } else if ( z0_prm == 3 ) { /* Taylor & Yelland */ zz[i] = zref / ( betag[i] * hsig[i] * 1200.0 * pow( hsig[i] / wave_len, 4.5 ) ); } else if ( z0_prm == 4 ) { /* Bourassa (2006) modified for oil slick */ zz[i] = zref / ( ( ( betas[i] * 0.1100 * nu / fabs( ustar[i] ) ) + oil_mod * sqrt( pow( betac[i] * B * sfcten / ( ustar_temp * fabs( ustar[i] ) * denwat ), 2.0 ) + pow( betag[i] * A_Charnock * ustar_temp * fabs( ustar[i] ) / G, 2.0 ) ) ) ); } else if ( z0_prm == 5 ) { /* Smooth surface */ zz[i] = zref / ( 0.1100 * nu / fabs( ustar[i] ) ); } else { printf( "Unreasonable value of z0_prm: %i\n", z0_prm ); } /* insure that the roughness length is not too absurd */ if ( zref > zz[i] * 25 ) { zz[i] = zref / 25.0; test = test - 4; } else test = test - ( test%8 - test%4 - test%2 ); /* printf( "z_o_z0: i=%i; zz=%f; u*=%f; wa=%f; hs=%f\n", i, zz[i], ustar[i], wa[i], hsig[i] ); */ return test; /* returns an error code */ /* end of subroutine z_o_z0 */ } void find_ustar( short first, short fixedcp, short fixedwa, short fixed_hsig, short fixed_uen, short neutral, int count, double CON_P, double cp, double CRIT, double denwat, double nu, double qmixa, double sfcten, double ta, double ww, double ww_eql, int ss_prm, double ss_val, double zref, double zreft, int z0_prm ) { short done, done_outer, hsig_known; int i, max, min, test, ucount; double bstar, phi_u, ustar_old[2], ustar_temp; ustar_temp = sqrt( ustar[0] * ustar[0] + ustar[1] * ustar[1] ); ucount = 0; /* iteratively solve for u* for non-neutral conditions */ /* determine the bouyancy flux */ done_outer = FALSE; while ( !done_outer && ucount < 30 ) { ucount++; for ( i=0; i<2; i++ ) { ustar_old[i] = ustar[i]; /* ustar_temp is ustar squared */ ustar_temp = ustar[0] * ustar[0] + ustar[1] * ustar[1]; if ( fixed_hsig && i == 0 ) hsig_known = TRUE; else hsig_known = FALSE; bstar = f_bstar( neutral, qmixa, ta, 0.000001 ); /* !!!! This assumes temperature and humidity are measured at THE SAME HEIGHT */ /* determine the inverse Monin-Obhukov scale length: 1/L */ monin_inv = KV * bstar / ustar_temp; /* insure that 1/L is within reasonable bounds */ max = 1.0; min = 0.0001; if ( fabs(monin_inv) < min ) monin_inv = min * monin_inv / fabs( monin_inv ); if ( fabs( monin_inv ) > max ) monin_inv = max * monin_inv / fabs( monin_inv ); if ( fabs( u[i] - u_sfc[i] ) < 0.001 ) { ustar[i] = 0.0; } else { if ( !first ) done = FALSE; first = FALSE; test = z_o_z0( fixedcp, fixedwa, neutral, hsig_known, denwat, nu, sfcten, zref, cp, ww, ww_eql, ss_prm, ss_val, count, i, z0_prm ); phi_u = phi_u_f( zref, zz[i] ); /* printf( "A %f %f %f %f\n", (float)ustar[0], (float)ustar[1], (float)tstar, (float)qstar ); */ ustar[i] = f_ustar( fixed_uen, neutral, bstar, CON_P, phi_u, u[i] - u_sfc[i], ww, zref, 10.0, i ); } } if ( ustar[0] <= 0.000001 ) done_outer = fabs( ustar[0] - ustar_old[0] ) < 0.0001; else done_outer = fabs( ( ustar[0] - ustar_old[0] ) / ustar[0] ) < 0.01; if ( ustar[1] <= 0.000001 ) done_outer = done_outer && fabs( ustar[1] - ustar_old[1] ) < 0.0001; else done_outer = done_outer && fabs( ( ustar[1] - ustar_old[1] ) / ustar[1] ) < 0.01; } } float getRenewalTime( float zo_mag, float ustar_mag, float density, float cp, float alpha, float Qnet, float viscosity ) { float renewalTime, Rfcr, Rfo, Cshear, Cconv, shearContribution, convContribution; Rfcr = -2.0e-04; if(density < 50) Rfcr = -2.0e-01; if(density < 50) Cshear = 53.32; else Cshear = 209; /** from Wick thesis **/ if(density < 50) Cconv = 0.80; else Cconv = 3.13; /** from Wick thesis **/ /** get surface Richardson number **/ Rfo=alpha*G*Qnet*viscosity/(density*cp*pow(ustar_mag,4.0)); if(Rfo == fabs(Rfo)) Rfo *= -1.0; /** now get time rate **/ shearContribution = Cshear*sqrt(viscosity*zo_mag/pow(ustar_mag, 3.0)); convContribution = Cconv*sqrt(viscosity*density*cp/(alpha*G*fabs(Qnet))); renewalTime = (convContribution-shearContribution)*exp(-Rfcr/Rfo); renewalTime += shearContribution; return(renewalTime); } float getSolar( float solar ) { /** this just determines the amount of solar radiation is deposited in the skin. Aidong: this isn't needed in new surface skin model**/ float gamma1, gamma2; float R2; float z; float solarAbs; if(waterType == 0) return(0.0); else if(waterType == 1) { R2 = 0.58; gamma1 = 0.35; gamma2 = 23; } else if(waterType == 1.1) { R2 = 0.62; gamma1 = 0.60; gamma2 = 20; } else if(waterType == 1.2) { R2 = 0.67; gamma1 = 1.00; gamma2 = 17; } else if(waterType == 2) { R2 = 0.77; gamma1 = 1.50; gamma2 = 14; } else if(waterType == 3) { R2 = 0.78; gamma1 = 1.40; gamma2 = 7.9; } z = 0.001; solarAbs = solar - solar*(R2*exp(-z/gamma1) + (1-R2)*exp(-z/gamma2)); return(solarAbs); } float getStanton( float ustar_mag, float renewalTime) { float Stanton; Stanton = sqrt(thermalDiff/(ustar_mag * ustar_mag * renewalTime)); return( Stanton ); } float getDalton( float ustar_mag, float renewalTime ) { float Dalton; Dalton = sqrt(molecularDiff/(ustar_mag*ustar_mag*renewalTime)); return(Dalton); } float getSkin( float zo_mag, float ustar_mag, float bulkTemp, float rl, float Hs, float Hl, float rs) { float Qsolar; float Qnet; float roWater; float CpWater; float uStarWater; float roAir; float skinTemperature; float kappawater; float thermalExpansion; float viscosity; float renewalTime; roWater = 1021.7; CpWater = 4002.0; roAir = 1.25; kappawater = 1.4e-07; /** from Gill page 71 **/ thermalExpansion = 3196e-07; /** from Gill Table A3.1 **/ viscosity = 1e-06; /** this is kinematic viscosity (Gill pg. 75) **/ /** get solar radiation absorbed over skin **/ Qsolar = getSolar(rs); /** Get Net Heat Loss from ocean **/ Qnet = rl + Hs + Hl + Qsolar; /** get u* for water **/ uStarWater = sqrt(roAir/roWater)*ustar_mag; /** now get skin temperature **/ renewalTime = getRenewalTime(zo_mag,uStarWater, roWater, CpWater, thermalExpansion, Qnet, viscosity); skinTemperature = sqrt(renewalTime); skinTemperature *= Qnet/(roWater*CpWater*sqrt(kappawater)); skinTemperature = skinTemperature + bulkTemp; return(skinTemperature); }