00001
00002
00003
00004
00005
00006
00007
00008
00009
00010
00011
00012
00013
00014
00015
00016
00017
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
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
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
00377
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
00385
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
00398
00399
00400 if ( average_non_events )
00401 {
00402
00403
00404
00405
00406
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
00573
00574
00575
00576
00577
00578
00579
00580 wave_period = pow(10,beaufort_storm/10);
00581 wave_length = 25.*wave_height;
00582
00583
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
00773 return pow(wave_height_in_meters/.00195,1/2.5)*.245;
00774
00775
00776
00777
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