/Users/huttone/Devel/sedflux-new/sedflux/trunk/ew/sedflux/run_storm.c

Go to the documentation of this file.
00001 //---
00002 //
00003 // This file is part of sedflux.
00004 //
00005 // sedflux is free software; you can redistribute it and/or modify
00006 // it under the terms of the GNU General Public License as published by
00007 // the Free Software Foundation; either version 2 of the License, or
00008 // (at your option) any later version.
00009 //
00010 // sedflux is distributed in the hope that it will be useful,
00011 // but WITHOUT ANY WARRANTY; without even the implied warranty of
00012 // MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
00013 // GNU General Public License for more details.
00014 //
00015 // You should have received a copy of the GNU General Public License
00016 // along with sedflux; if not, write to the Free Software
00017 // Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
00018 //
00019 //---
00020 
00021 #define SED_STORM_PROC_NAME "storms"
00022 #define EH_LOG_DOMAIN SED_STORM_PROC_NAME
00023 
00024 #include <stdio.h>
00025 #include "my_processes.h"
00026 #include <utils/eh_rand.h>
00027 
00028 #include "sedflux.h"
00029 
00030 typedef struct
00031 {
00032    Eh_input_val h;
00033    double       t;
00034 }
00035 User_storm_data;
00036 
00037 GSList *get_equivalent_storm( GFunc    get_storm          ,
00038                               gpointer user_data          ,
00039                               double   n_days             ,
00040                               double   sig_event_fraction ,
00041                               gboolean average_non_events );
00042 void storm_func_user( double *ans , User_storm_data* user_data );
00043 
00044 double *get_wave_from_beaufort_scale_power_law( double beaufort_storm ,
00045                                                 double *wave );
00046 double get_wind_from_beaufort_scale( double beaufort_storm );
00047 double get_wave_length_from_wind( double wind_speed_in_mps );
00048 double get_wave_period_from_wind( double wind_speed_in_mps );
00049 double get_wave_height_from_wind( double wind_speed_in_mps );
00050 
00051 double *get_wave_from_beaufort_scale( double beaufort_storm , double *wave );
00052 double get_height_from_beaufort_scale( double beaufort_storm );
00053 double get_beaufort_scale_from_height( double wave_height );
00054 double get_wave_length_from_height( double wave_height );
00055 double get_wave_period_from_height( double wave_height_in_meters );
00056 
00057 gboolean init_storm_data( Sed_process proc , Sed_cube prof , GError** error );
00058 
00059 Sed_process_info
00060 run_storm( Sed_process proc , Sed_cube prof )
00061 {
00062    Storm_t*         data = sed_process_user_data(proc);
00063    Sed_process_info info = SED_EMPTY_INFO;
00064    GSList*          storm_list;
00065    double           n_days;
00066    double           time_step;
00067    double           start_time;
00068 
00069    if ( sed_process_run_count(proc)==0 )
00070       init_storm_data( proc , prof , NULL );
00071 
00072    // average the requested number of days.
00073    start_time      = data->last_time;
00074    time_step       = sed_cube_age_in_years( prof ) - data->last_time;
00075    data->last_time = sed_cube_age_in_years( prof );
00076    n_days          = time_step*S_DAYS_PER_YEAR;
00077 
00078    if ( time_step > 1e-6 )
00079    {
00080       if ( TRUE )
00081       {
00082          User_storm_data user_data;
00083 
00084          user_data.h = data->wave_height;
00085          user_data.t = start_time;
00086 
00087          storm_list = get_equivalent_storm( (GFunc)storm_func_user ,
00088                                             &user_data             ,
00089                                             n_days         ,
00090                                             data->fraction ,
00091                                             data->average_non_events );
00092       }
00093    }
00094    else
00095       return info;
00096 
00097    sed_cube_set_storm_list( prof , storm_list );
00098 
00099    {
00100       GSList *this_link;
00101       Sed_ocean_storm this_storm;
00102       gint   n = g_slist_length( storm_list );
00103       gint   i = 0;
00104       double this_time = start_time;
00105       double significant_storm = G_MINDOUBLE;
00106 
00107       for ( this_link=storm_list ; this_link ; this_link=this_link->next )
00108       {
00109          this_storm = this_link->data;
00110 
00111          eh_dbl_set_max( significant_storm , sed_ocean_storm_wave_height( this_storm ) );
00112 
00113          eh_message( "time        : %f" , this_time            );
00114          eh_message( "time step   : %f" , sed_ocean_storm_duration(this_storm) );
00115          eh_message( "storm number: %d" , i++                  );
00116          eh_message( "total number: %d" , n                    );
00117          eh_message( "wave height : %f" ,
00118                      sed_ocean_storm_wave_height(this_storm) );
00119          eh_message( "wave period : %f" ,
00120                      sed_ocean_storm_wave_period(this_storm) );
00121          eh_message( "wave length : %f" ,
00122                      sed_ocean_storm_wave_length(this_storm) );
00123 
00124          this_time  += sed_ocean_storm_duration(this_storm)*S_YEARS_PER_DAY;
00125 
00126       }
00127 
00128       if ( n>0 )
00129       {
00130          significant_storm = get_beaufort_scale_from_height( significant_storm );
00131          sed_cube_set_storm( prof , significant_storm );
00132       }
00133       else
00134          sed_cube_set_storm( prof , 0. );
00135 
00136    }
00137 
00138    return info;
00139 }
00140 
00141 #include <time.h>
00142 
00146 
00147 #define STORM_KEY_STORM_LENGTH    "average length of a storm"
00149 #define STORM_KEY_STORM_MAGNITUDE "wave height of 100 year storm"
00151 #define STORM_KEY_STORM_VARIANCE  "variance of 100 year storm"
00153 #define STORM_KEY_SCALE_PARAMETER "scale parameter for pdf"
00155 #define STORM_KEY_SHAPE_PARAMETER "shape parameter for pdf"
00158 #define STORM_KEY_WAVE_HEIGHT     "wave height"
00160 #define STORM_KEY_SEED            "seed for random number generator"
00162 #define STORM_KEY_FRACTION        "fraction of events to model"
00164 #define STORM_KEY_NON_EVENTS      "average non-events?"
00165 
00167 static gchar* storm_req_labels[] =
00168 {
00169    STORM_KEY_FRACTION    ,
00170    STORM_KEY_NON_EVENTS  ,
00171    STORM_KEY_WAVE_HEIGHT ,
00172    STORM_KEY_SEED        ,
00173    NULL
00174 };
00175 
00184 gboolean
00185 init_storm( Sed_process p , Eh_symbol_table tab , GError** error )
00186 {
00187    Storm_t* data    = sed_process_new_user_data( p , Storm_t );
00188    GError*  tmp_err = NULL;
00189    gchar**  err_s   = NULL;
00190    gboolean is_ok   = TRUE;
00191 
00192    eh_return_val_if_fail( error==NULL || *error==NULL , FALSE );
00193 
00194    data->rand               = NULL;
00195    data->last_time          = 0.;
00196 
00197    eh_symbol_table_require_labels( tab , storm_req_labels , &tmp_err );
00198 
00199    if ( !tmp_err )
00200    {
00201       data->wave_height        = eh_symbol_table_input_value( tab , STORM_KEY_WAVE_HEIGHT , &tmp_err );
00202       data->fraction           = eh_symbol_table_dbl_value  ( tab , STORM_KEY_FRACTION   );
00203       data->average_non_events = eh_symbol_table_bool_value ( tab , STORM_KEY_NON_EVENTS );
00204       data->rand_seed          = eh_symbol_table_int_value  ( tab , STORM_KEY_SEED       );
00205 
00206       eh_check_to_s( data->fraction>=0. , "Event fraction between 0 and 1" , &err_s );
00207       eh_check_to_s( data->fraction<=1. , "Event fraction between 0 and 1" , &err_s );
00208 
00209       if ( !tmp_err && err_s )
00210          eh_set_error_strv( &tmp_err , SEDFLUX_ERROR , SEDFLUX_ERROR_BAD_PARAM , err_s );
00211    }
00212 
00213    if ( tmp_err )
00214    {
00215       g_propagate_error( error , tmp_err );
00216       is_ok = FALSE;
00217    }
00218 
00219    return is_ok;
00220 }
00221 
00222 gboolean
00223 init_storm_data( Sed_process proc , Sed_cube prof , GError** error )
00224 {
00225    Storm_t* data = sed_process_user_data( proc );
00226 
00227    if ( data )
00228    {
00229       if ( data->rand_seed>0 ) data->rand = g_rand_new_with_seed( data->rand_seed );
00230       else                     data->rand = g_rand_new( );
00231       data->last_time = sed_cube_age_in_years( prof );
00232    }
00233 
00234    return TRUE;
00235 }
00236 
00237 gboolean
00238 destroy_storm( Sed_process p )
00239 {
00240    if ( p )
00241    {
00242       Storm_t* data = sed_process_user_data( p );
00243       
00244       if ( data )
00245       {
00246          g_rand_free         ( data->rand        );
00247          eh_input_val_destroy( data->wave_height );
00248          eh_free             ( data              );
00249       }
00250    }
00251 
00252    return TRUE;
00253 }
00254 
00273 double
00274 storm( GRand *rand , double storm_length, double average_storm, double variance , double last_storm)
00275 {
00276    double alpha,f,a;
00277    static long seed[1];
00278 
00279    alpha=last_storm;
00280 
00281    f=1.-1./storm_length;
00282    a=exp(-1/average_storm);
00283 
00284    if ( eh_ran1(seed) > f )
00285       alpha = eh_max_log_normal( rand , average_storm , variance , 1./365./1. );
00286  
00287    return alpha;
00288 }
00289 
00290 void set_ocean_storm_wave( Sed_ocean_storm s , gpointer user_data );
00291 Sed_ocean_storm average_storms( GSList *storms );
00292 void free_link_data( gpointer data , gpointer user_data );
00293 gint cmp_storm_size( Sed_ocean_storm a , Sed_ocean_storm b );
00294 gint cmp_storm_time( Sed_ocean_storm a , Sed_ocean_storm b );
00295 void print_ocean_storm_list( GSList *list );
00296 void print_ocean_storm( Sed_ocean_storm this_storm , gpointer user_data );
00297 
00298 struct weibull_storm_data
00299 {
00300    double sigma;
00301    double mu;
00302    GRand* rand;
00303 };
00304 
00305 void storm_func_weibull( double* ans , struct weibull_storm_data* user_data )
00306 {
00307    double variance      = user_data->sigma;
00308    double average_storm = user_data->mu;
00309    GRand* rand          = user_data->rand;
00310 
00311    *ans = eh_rand_max_weibull( rand          ,
00312                                average_storm ,
00313                                variance      ,
00314                                1./365. );
00315 }
00316 
00317 void storm_func_user( double *ans , User_storm_data* user_data )
00318 {
00319    Eh_input_val wave_height = user_data->h;
00320    double time              = user_data->t;
00321    *ans = eh_input_val_eval( wave_height , time );
00322 }
00323 
00324 GSList *get_equivalent_storm( GFunc get_storm           ,
00325                               gpointer user_data        ,
00326                               double n_days             ,
00327                               double sig_event_fraction ,
00328                               gboolean average_non_events )
00329 {
00330    GSList *all_storms = NULL;
00331    GSList *big_storms = NULL, *little_storms;
00332    GSList *calm_period = NULL;
00333    GSList *final_list = NULL;
00334    GSList *this_link, *prev_link;
00335    gssize n_sig_events;
00336    Sed_ocean_storm this_storm, prev_storm;
00337    gssize i;
00338    gboolean sort_high_to_low;
00339    double storm_value;
00340 
00341    if ( sig_event_fraction < 0 )
00342       sort_high_to_low = FALSE;
00343    else
00344       sort_high_to_low = TRUE;
00345 
00346    sig_event_fraction = fabs(sig_event_fraction);
00347 
00348    n_sig_events = n_days*sig_event_fraction;
00349 
00350    {
00351       double n_events;
00352       double fraction = modf( n_days*sig_event_fraction , &n_events );
00353 
00354       if ( g_random_double_range( 0 , 1. ) < fraction )
00355          n_sig_events++;
00356    }
00357 
00358    //---
00359    // Create a list of ocean storm events for every day of the period.
00360    //---
00361    for ( i=0 ; i<n_days ; i++ )
00362    {
00363       this_storm = sed_ocean_storm_new();
00364 
00365       sed_ocean_storm_set_index   ( this_storm , i );
00366       sed_ocean_storm_set_duration( this_storm , 1. );
00367 
00368       get_storm( &storm_value , user_data );
00369 
00370       sed_ocean_storm_set_val( this_storm , storm_value );
00371 
00372       all_storms = g_slist_prepend( all_storms , this_storm );
00373    }
00374 
00375    //---
00376    // Sort the storms from largest to smallest.  We'll model the top storms
00377    // and average the rest.
00378    //---
00379    all_storms = g_slist_sort( all_storms , (GCompareFunc)cmp_storm_size );
00380    if ( sort_high_to_low )
00381       all_storms = g_slist_reverse( all_storms );
00382 
00383    //---
00384    // Break the sorted list into two.  One list will contain the big storms,
00385    // while the other contains the little storms.
00386    //---
00387    little_storms = g_slist_nth( all_storms , n_sig_events );
00388    if ( n_sig_events>0 )
00389    {
00390       big_storms = all_storms;
00391       g_slist_nth( big_storms , n_sig_events-1 )->next = NULL;
00392    }
00393    else
00394       big_storms = NULL;
00395 
00396    //---
00397    // Average the storms for each of the calm periods.  We are given the
00398    // option to either average the non-events or to ignore them completely.
00399    //---
00400    if ( average_non_events )
00401    {
00402 
00403       //---
00404       // Sort the list of small storms by time.  Break this list into smaller
00405       // lists of consecutive storms.  There will be some breaks because the
00406       // largest storms were removed.
00407       //---
00408       little_storms = g_slist_sort( little_storms ,
00409                                     (GCompareFunc)cmp_storm_time );
00410 
00411       calm_period = g_slist_append( calm_period , little_storms );
00412       prev_link = little_storms;
00413       for ( this_link = little_storms->next ;
00414             this_link ;
00415             this_link = this_link->next )
00416       {
00417          this_storm = this_link->data;
00418          prev_storm = prev_link->data;
00419 
00420          if ( sed_ocean_storm_index(prev_storm)+1 != sed_ocean_storm_index(this_storm) )
00421          {
00422             prev_link->next = NULL;
00423             calm_period = g_slist_append( calm_period , this_link );
00424          }
00425 
00426          prev_link = this_link;
00427       }
00428 
00429       for ( this_link=calm_period ; this_link ; this_link=this_link->next )
00430       {
00431          this_storm = average_storms( this_link->data );
00432          final_list = g_slist_append( final_list , this_storm );
00433 
00434          g_slist_foreach( this_link->data , &free_link_data , NULL );
00435          g_slist_free( this_link->data );
00436       }
00437       g_slist_free( calm_period );
00438 
00439    }
00440    else
00441    {
00442       g_slist_foreach( little_storms , &free_link_data , NULL );
00443       g_slist_free( little_storms );
00444       little_storms = NULL;
00445    }
00446 
00447    final_list = g_slist_concat( final_list , big_storms );
00448    final_list = g_slist_sort( final_list , (GCompareFunc)cmp_storm_time );
00449    g_slist_foreach( final_list , (GFunc)&set_ocean_storm_wave , NULL );
00450 
00451    return final_list;
00452 }
00453 
00454 void set_ocean_storm_wave( Sed_ocean_storm s , gpointer user_data )
00455 {
00456    double height = sed_ocean_storm_val(s);
00457    double freq   = 2.*G_PI/get_wave_period_from_height( height );
00458    double number = pow(freq,2)/sed_gravity();
00459    Sed_wave new_wave = sed_wave_new( height , number , freq );
00460 
00461    sed_ocean_storm_set_wave( s , new_wave );
00462 }
00463 
00464 void print_ocean_storm_list( GSList *list )
00465 {
00466    GSList *this_link;
00467 
00468    for ( this_link=list ; this_link ; this_link=this_link->next )
00469       sed_ocean_storm_fprint( stderr , (Sed_ocean_storm)(this_link->data) );
00470 }
00471 
00472 Sed_ocean_storm average_storms( GSList *storm_list )
00473 {
00474    Sed_ocean_storm this_storm = NULL;
00475 
00476    if ( storm_list )
00477    {
00478       GSList *this_link;
00479       double duration  = 0.;
00480       double storm_val = 0.;
00481       gssize time_ind;
00482 
00483       for ( this_link = storm_list ; this_link ; this_link = this_link->next )
00484       {
00485          this_storm = this_link->data;
00486 
00487          duration  += sed_ocean_storm_duration(this_storm);
00488          storm_val += pow(sed_ocean_storm_val(this_storm),2.5)*sed_ocean_storm_duration(this_storm);
00489          time_ind   = sed_ocean_storm_index(this_storm);
00490       }
00491       storm_val /= duration;
00492 
00493       storm_val = pow( storm_val , 0.4 );
00494 
00495       this_storm = sed_ocean_storm_new();
00496    
00497       sed_ocean_storm_set_val     ( this_storm , storm_val );
00498       sed_ocean_storm_set_duration( this_storm , duration  );
00499       sed_ocean_storm_set_index   ( this_storm , time_ind  );
00500    }
00501 
00502    return this_storm;
00503 }
00504 
00505 void free_link_data( gpointer data , gpointer user_data )
00506 {
00507    eh_free( data );
00508 }
00509 
00510 gint cmp_storm_size( Sed_ocean_storm a , Sed_ocean_storm b )
00511 {
00512    double val_a = sed_ocean_storm_val( a );
00513    double val_b = sed_ocean_storm_val( b );
00514 
00515    if ( val_a < val_b )
00516       return -1;
00517    else if ( val_a > val_b )
00518       return 1;
00519    else
00520       return 0;
00521 }
00522 
00523 gint cmp_storm_time( Sed_ocean_storm a , Sed_ocean_storm b )
00524 {
00525    gssize val_a = sed_ocean_storm_index(a);
00526    gssize val_b = sed_ocean_storm_index(b);
00527 
00528    if ( val_a < val_b )
00529       return -1;
00530    else if ( val_a > val_b )
00531       return 1;
00532    else
00533       return 0;
00534 }
00535 
00557 double *get_wave_from_beaufort_scale_old( double beaufort_storm , double *wave )
00558 {
00559    double wave_height, wave_period, wave_length;
00560    double beaufort_tab[2][18] = {
00561       {0, 1, 2, 3,4,5,6,7,8,9,10,11  ,12,13,14,15,16,17},
00562       {0,.1,.3,1,1.5,2.5,4,5.5,7.5,10,12.5,16,18,20,22,24,26,28} };
00563 
00564    eh_require( beaufort_storm>0   );
00565    eh_require( beaufort_storm<=17 );
00566 
00567    if ( !wave )
00568       wave = eh_new( double , 3 );
00569 
00570    interpolate(  beaufort_tab[0] ,  beaufort_tab[1] , 18 ,
00571                 &beaufort_storm  , &wave_height     , 1 );
00572 //   wave_height = exp(0.252*beaufort_storm) - 1.;
00573 /*
00574    do
00575    {
00576       wave_period = eh_get_fuzzy_dbl_norm( pow(10,beaufort_storm/4.) , pow(10,beaufort_storm/4.)/10. );
00577    }
00578    while ( wave_period<0. );
00579 */
00580    wave_period = pow(10,beaufort_storm/10);
00581    wave_length = 25.*wave_height;
00582 /*
00583    wave_length = 5.*sed_gravity()*pow(wave[2]*sinh(M_PI/10)/M_PI,2.));
00584 */
00585 
00586    wave[0] = wave_height;
00587    wave[1] = wave_period;
00588    wave[2] = wave_length;
00589 
00590    return wave;
00591 }
00592 
00612 double *get_wave_from_beaufort_scale_power_law( double beaufort_storm ,
00613                                                 double *wave )
00614 {
00615    double wind_speed;
00616 
00617    eh_require( beaufort_storm>=0  );
00618    eh_require( beaufort_storm<=17 );
00619 
00620    if ( !wave )
00621       wave = eh_new( double , 3 );
00622 
00623    wind_speed = get_wind_from_beaufort_scale( beaufort_storm );
00624 
00625    wave[0] = get_wave_height_from_wind( wind_speed );
00626    wave[1] = get_wave_period_from_wind( wind_speed );
00627    wave[2] = get_wave_length_from_wind( wind_speed );
00628 
00629    return wave;
00630 }
00631 
00645 double get_wind_from_beaufort_scale( double beaufort_storm )
00646 {
00647    double wind;
00648    double beaufort_tab[2][18] = {
00649       {0,1,2,3, 4, 5, 6, 7, 8, 9,10,11,12,13,14,15, 16, 17},
00650       {0,1,4,7,11,17,22,28,34,41,48,56,64,72,81,90,100,109} };
00651 
00652    eh_require( beaufort_storm>=0  );
00653    eh_require( beaufort_storm<=17 );
00654 
00655    interpolate(  beaufort_tab[0] ,  beaufort_tab[1] , 18 ,
00656                 &beaufort_storm  , &wind            , 1 );
00657 
00658    return wind*S_MPS_PER_KNOT;
00659 }
00660 
00680 double *get_wave_from_beaufort_scale( double beaufort_storm , double *wave )
00681 {
00682    double wave_height;
00683 
00684    eh_require( beaufort_storm>=0  );
00685    eh_require( beaufort_storm<=17 );
00686 
00687    if ( !wave )
00688       wave = eh_new( double , 3 );
00689 
00690    wave_height = get_height_from_beaufort_scale( beaufort_storm );
00691 
00692    wave[0] = wave_height;
00693    wave[1] = get_wave_period_from_height( wave_height );
00694    wave[2] = get_wave_length_from_height( wave_height );
00695 
00696    return wave;
00697 }
00698 
00711 double get_height_from_beaufort_scale( double beaufort_storm )
00712 {
00713    double wave_height;
00714    double beaufort_tab[2][18] = {
00715       {0, 1, 2, 3,4,5,6,7,8,9,10,11  ,12,13,14,15,16,17},
00716       {0,.1,.2,.6,1,2,3,4,6,7,9 ,11.5,14,16,18,20,22,24} };
00717 
00718    eh_require( beaufort_storm>=0  );
00719    eh_require( beaufort_storm<=17 );
00720 
00721    interpolate(  beaufort_tab[0] ,  beaufort_tab[1] , 18 ,
00722                 &beaufort_storm  , &wave_height     , 1 );
00723 
00724    return wave_height;
00725 }
00726 
00727 double get_beaufort_scale_from_height( double wave_height )
00728 {
00729    double beaufort_storm;
00730    double beaufort_tab[2][18] = {
00731       {0, 1, 2, 3,4,5,6,7,8,9,10,11  ,12,13,14,15,16,17},
00732       {0,.1,.2,.6,1,2,3,4,6,7,9 ,11.5,14,16,18,20,22,24} };
00733 
00734    eh_require( wave_height>=0  );
00735 
00736    if ( wave_height>beaufort_tab[1][17] )
00737       beaufort_storm = beaufort_tab[0][17];
00738    else
00739       interpolate(  beaufort_tab[1] ,  beaufort_tab[0] , 18 ,
00740                    &wave_height     , &beaufort_storm  , 1 );
00741 
00742    return beaufort_storm;
00743 }
00744 
00757 double get_wave_length_from_height( double wave_height )
00758 {
00759    return wave_height*7;
00760 }
00761 
00770 double get_wave_period_from_height( double wave_height_in_meters )
00771 {
00772 //   return sqrt(get_wave_length_from_height( wave_height_in_meters ))/1.25;
00773    return pow(wave_height_in_meters/.00195,1/2.5)*.245;
00774 
00775 // NOTE: Multiplying by 2 here matches Gulf of Lions data.  May not be correct
00776 // everywhere
00777 //   return pow(wave_height_in_meters/.00195,1/2.5)*.245*2;
00778 }
00779 
00789 double get_wave_length_from_wind( double wind_speed_in_mps )
00790 {
00791    return .3203*pow(wind_speed_in_mps,2);
00792 }
00793 
00803 double get_wave_period_from_wind( double wind_speed_in_mps )
00804 {
00805    return .5481*wind_speed_in_mps;
00806 }
00807 
00817 double get_wave_height_from_wind( double wind_speed_in_mps )
00818 {
00819    return .004449*pow(wind_speed_in_mps,2.5);
00820 }
00821 

Generated on Fri Jan 4 18:04:16 2008 for sedflux by  doxygen 1.5.2