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

Go to the documentation of this file.
00001 //--- // // This file is part of sedflux.
00002 //
00003 // sedflux is free software; you can redistribute it and/or modify
00004 // it under the terms of the GNU General Public License as published by
00005 // the Free Software Foundation; either version 2 of the License, or
00006 // (at your option) any later version.
00007 //
00008 // sedflux is distributed in the hope that it will be useful,
00009 // but WITHOUT ANY WARRANTY; without even the implied warranty of
00010 // MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
00011 // GNU General Public License for more details.
00012 //
00013 // You should have received a copy of the GNU General Public License
00014 // along with sedflux; if not, write to the Free Software
00015 // Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
00016 //
00017 //---
00018 
00019 #include <stdio.h>
00020 #include <math.h>
00021 #include <utils/utils.h>
00022 #include "sakura_local.h"
00023 #include "sakura.h"
00024 
00025 Sakura_sediment*
00026 sakura_sediment_new( gint n_grains )
00027 {
00028    Sakura_sediment* s = NULL;
00029 
00030    if ( n_grains>0 )
00031    {
00032       s = eh_new( Sakura_sediment , 1 );
00033       s->rho_grain  = eh_new0( double , n_grains );
00034       s->rho_dep    = eh_new0( double , n_grains );
00035       s->u_settling = eh_new0( double , n_grains );
00036 
00037       s->len = n_grains;
00038    }
00039 
00040    return s;
00041 }
00042 
00043 Sakura_sediment*
00044 sakura_sediment_destroy( Sakura_sediment* s )
00045 {
00046    if ( s )
00047    {
00048       eh_free( s->rho_grain  );
00049       eh_free( s->rho_dep    );
00050       eh_free( s->u_settling );
00051       eh_free( s );
00052    }
00053    return NULL;
00054 }
00055 
00056 Sakura_sediment*
00057 sakura_sediment_set_rho_grain( Sakura_sediment* s , double* x )
00058 {
00059    if ( s && x )
00060    {
00061       eh_dbl_array_copy( s->rho_grain , x , s->len );
00062    }
00063    return s;
00064 }
00065 
00066 Sakura_sediment*
00067 sakura_sediment_set_rho_dep( Sakura_sediment* s , double* x )
00068 {
00069    if ( s && x )
00070    {
00071       eh_dbl_array_copy( s->rho_dep , x , s->len );
00072    }
00073    return s;
00074 }
00075 
00076 Sakura_sediment*
00077 sakura_sediment_set_u_settling( Sakura_sediment* s , double* x )
00078 {
00079    if ( s && x )
00080    {
00081       eh_dbl_array_copy( s->u_settling , x , s->len );
00082    }
00083    return s;
00084 }
00085 
00086 Sakura_array*
00087 sakura_array_new( gint len , gint n_grain )
00088 {
00089    Sakura_array* a = NULL;
00090 
00091    if ( len>0 )
00092    {
00093       gint n_nodes = len + 4;
00094       gint i;
00095 
00096       a = eh_new( Sakura_array , 1 );
00097 
00098       a->x = eh_new0( double , n_nodes ) + 2;
00099       a->w = eh_new0( double , n_nodes ) + 2;
00100       a->h = eh_new0( double , n_nodes ) + 2;
00101       a->u = eh_new0( double , n_nodes ) + 2;
00102       a->c = eh_new0( double , n_nodes ) + 2;
00103 
00104       a->c_grain     = eh_new0( double* , n_nodes ) + 2;
00105       a->c_grain[-2] = eh_new0( double  , n_nodes*n_grain );
00106       for ( i=-1 ; i<len+2 ; i ++ )
00107          a->c_grain[i] = a->c_grain[i-1] + n_grain;
00108 
00109       a->d     = eh_new0( double* , n_nodes ) + 2;
00110       a->d[-2] = eh_new0( double  , n_nodes*n_grain );
00111       for ( i=-1 ; i<len+2 ; i ++ )
00112          a->d[i] = a->d[i-1] + n_grain;
00113 
00114       a->e     = eh_new0( double* , n_nodes ) + 2;
00115       a->e[-2] = eh_new0( double  , n_nodes*n_grain );
00116       for ( i=-1 ; i<len+2 ; i ++ )
00117          a->e[i] = a->e[i-1] + n_grain;
00118 
00119       a->len     = len;
00120       a->n_grain = n_grain;
00121    }
00122 
00123    return a;
00124 }
00125 
00126 Sakura_array*
00127 sakura_array_destroy( Sakura_array* a )
00128 {
00129    if ( a )
00130    {
00131       a->x -= 2;
00132       a->w -= 2;
00133       a->h -= 2;
00134       a->u -= 2;
00135       a->c -= 2;
00136 
00137       eh_free( a->x );
00138       eh_free( a->w );
00139       eh_free( a->h );
00140       eh_free( a->u );
00141       eh_free( a->c );
00142 
00143       a->c_grain -= 2;
00144       a->d       -= 2;
00145       a->e       -= 2;
00146 
00147       eh_free( a->c_grain[0] );
00148       eh_free( a->c_grain    );
00149       eh_free( a->d[0]       );
00150       eh_free( a->d          );
00151       eh_free( a->e[0]       );
00152       eh_free( a->e          );
00153 
00154       eh_free( a );
00155    }
00156    return NULL;
00157 }
00158 
00159 Sakura_array*
00160 sakura_array_copy( Sakura_array* d , Sakura_array* s )
00161 {
00162    if ( s )
00163    {
00164       if ( !d )
00165          d = sakura_array_new( s->len , s->n_grain );
00166 
00167       eh_dbl_array_copy( d->x-2 , s->x-2 , s->len+4 );
00168       eh_dbl_array_copy( d->w-2 , s->w-2 , s->len+4 );
00169       eh_dbl_array_copy( d->h-2 , s->h-2 , s->len+4 );
00170       eh_dbl_array_copy( d->u-2 , s->u-2 , s->len+4 );
00171       eh_dbl_array_copy( d->c-2 , s->c-2 , s->len+4 );
00172 
00173       eh_dbl_array_copy( d->c_grain[-2] , s->c_grain[-2] , (s->len+4)*s->n_grain );
00174       eh_dbl_array_copy( d->d[-2]       , s->d[-2]       , (s->len+4)*s->n_grain );
00175       eh_dbl_array_copy( d->e[-2]       , s->e[-2]       , (s->len+4)*s->n_grain );
00176    }
00177 
00178    return d;
00179 }
00180 
00181 Sakura_array*
00182 sakura_array_set_x( Sakura_array* a , double* x )
00183 {
00184    eh_require( a    );
00185    eh_require( a->x );
00186    eh_require( x    );
00187 
00188    if ( a && x )
00189    {
00190       double dx;
00191 
00192       eh_dbl_array_copy( a->x , x , a->len );
00193 
00194       dx = x[1] - x[0];
00195 
00196       eh_require( dx>0 );
00197 
00198       a->x[-1] = x[0] - dx;
00199       a->x[-2] = x[0] - dx*2.;
00200 
00201       dx = x[a->len-1] - x[a->len-2];
00202 
00203       eh_require( dx>0 );
00204 
00205       a->x[a->len  ] = x[a->len-1] + dx;
00206       a->x[a->len+1] = x[a->len-1] + dx*2.;
00207    }
00208 
00209    return a;
00210 }
00211 
00212 Sakura_array*
00213 sakura_array_set_w( Sakura_array* a , double* w )
00214 {
00215    eh_require( a    );
00216    eh_require( a->w );
00217    eh_require( w    );
00218 
00219    if ( a && w )
00220    {
00221       eh_dbl_array_copy( a->w , w , a->len );
00222 
00223       a->w[-1] = w[0];
00224       a->w[-2] = w[0];
00225 
00226       a->w[a->len  ] = w[a->len-1];
00227       a->w[a->len+1] = w[a->len-1];
00228    }
00229 
00230    return a;
00231 }
00232 
00233 Sakura_array*
00234 sakura_array_set_bc( Sakura_array* a , Sakura_node* inflow , Sakura_node* outflow )
00235 {
00236    if ( a )
00237    {
00238       const gint len = a->len;
00239 
00240       a->u[0]     = inflow->u;
00241       a->u[-1]    = inflow->u;
00242       a->u[-2]    = inflow->u;
00243 
00244       a->c[-1]    = inflow->c;
00245       a->c[-2]    = inflow->c;
00246 
00247       eh_dbl_array_copy( a->c_grain[-1] , inflow->c_grain , a->n_grain );
00248       eh_dbl_array_copy( a->c_grain[-2] , inflow->c_grain , a->n_grain );
00249 
00250       a->h[-1]    = inflow->h;
00251       a->h[-2]    = inflow->h;
00252 
00253       a->u[len]   = outflow->u;
00254       a->u[len+1] = outflow->u;
00255 
00256       a->c[len]   = outflow->c;
00257       a->c[len+1] = outflow->c;
00258 
00259       eh_dbl_array_copy( a->c_grain[len]   , outflow->c_grain , a->n_grain );
00260       eh_dbl_array_copy( a->c_grain[len+1] , outflow->c_grain , a->n_grain );
00261 
00262       a->h[len]   = outflow->h;
00263       a->h[len+1] = outflow->h;
00264    }
00265    return a;
00266 }
00267 
00268 double
00269 sakura_array_mass_in_susp( Sakura_array* a , Sakura_sediment* s )
00270 {
00271    double mass = 0.;
00272 
00273    eh_require( a );
00274    eh_require( s );
00275 
00276    if ( a && s )
00277    {
00278       gint   i;
00279       gint   n;
00280       double vol_w;
00281 
00282       for ( i=0 ; i<a->len+1 ; i++ )
00283       {
00284          vol_w = a->h[i]*a->w[i]*(a->x[i+1]-a->x[i]);
00285          for ( n=0 ; n<s->len ; n++ )
00286             mass += vol_w*a->c_grain[i][n]*s->rho_grain[n];
00287       }
00288    }
00289 
00290    return mass;
00291 }
00292 
00293 double
00294 sakura_array_mass_lost( Sakura_array* a , Sakura_sediment* s , double dt )
00295 {
00296    double mass = 0.;
00297 
00298    eh_require( a );
00299    eh_require( s );
00300 
00301    if ( a && s )
00302    {
00303       gint   i = a->len-2;
00304       gint   n;
00305       double flux_water = 0;
00306       double flux_sed   = 0;
00307 
00308       flux_water = a->h[i]*a->w[i]*a->u[i];
00309       for ( n=0 ; n<s->len ; n++ )
00310          flux_sed += flux_water*a->c_grain[i][n]*s->rho_grain[n];
00311       mass = flux_sed * dt;
00312    }
00313 
00314    return mass;
00315 }
00316 
00317 double
00318 sakura_array_mass_eroded( Sakura_array* a , Sakura_sediment* s )
00319 {
00320    double mass = 0.;
00321 
00322    eh_require( a );
00323    eh_require( s );
00324 
00325    if ( a && s )
00326    {
00327       gint   i;
00328       gint   n;
00329 
00330       for ( i=0 ; i<a->len ; i++ )
00331          for ( n=0 ; n<s->len ; n++ )
00332             mass += a->e[i][n]*s->rho_grain[n];
00333    }
00334 
00335    return mass;
00336 }
00337 
00338 double
00339 sakura_array_mass_deposited( Sakura_array* a , Sakura_sediment* s )
00340 {
00341    double mass = 0.;
00342 
00343    eh_require( a );
00344    eh_require( s );
00345 
00346    if ( a && s )
00347    {
00348       gint   i;
00349       gint   n;
00350 
00351       for ( i=0 ; i<a->len+1 ; i++ )
00352          for ( n=0 ; n<s->len ; n++ )
00353             mass += a->d[i][n]*s->rho_grain[n];
00354    }
00355 
00356    return mass;
00357 }
00358 
00359 gint
00360 sakura_array_print_data( Sakura_array* a , Sakura_const_st* c )
00361 {
00362    gint n = 0;
00363 
00364    if ( c->data_fp && c->data_id )
00365    {
00366       gint          i;
00367       gint*         id;
00368       double*       data = NULL;
00369       FILE*         fp   = c->data_fp;
00370       const gint    len  = a->len;
00371       
00372       for ( id=c->data_id ; *id>=0 ; id++ )
00373       {
00374          switch ( *id )
00375          {
00376             case 0: data = a->u; break;
00377             case 1: data = a->h; break;
00378             case 2: data = a->c; break;
00379             default: eh_require_not_reached();
00380          }
00381 
00382          n += fprintf( fp , "%f" , data[0] );
00383          for ( i=1 ; i<len ; i++ )
00384             n += fprintf( fp , "; %f" , data[i] );
00385          n += fprintf( fp , "\n" );
00386       }
00387    }
00388 
00389    return n;
00390 }
00391 
00392 Sakura_node*
00393 sakura_node_new( double u , double c , double h , double* c_grain , gint len )
00394 {
00395    return sakura_node_set( NULL , u , c , h , c_grain , len );
00396 }
00397 
00398 Sakura_node*
00399 sakura_node_destroy( Sakura_node* x )
00400 {
00401    if ( x )
00402    {
00403       eh_free( x->c_grain );
00404       eh_free( x );
00405    }
00406    return NULL;
00407 }
00408 
00409 Sakura_node*
00410 sakura_node_set( Sakura_node* x , double u , double c , double h , double* c_grain , gint len )
00411 {
00412    if ( !x ) x = eh_new( Sakura_node , 1 );
00413 
00414    if ( x )
00415    {
00416       x->u = u;
00417       x->c = c;
00418       x->h = h;
00419 
00420       if ( len!=x->n_grain )
00421       {
00422          eh_free( x->c_grain );
00423          x->c_grain = NULL;
00424       }
00425 
00426       if      ( c_grain    ) x->c_grain = eh_dbl_array_copy( x->c_grain , c_grain , len );
00427       else if ( x->c_grain ) x->c_grain = eh_dbl_array_set ( x->c_grain , len , 0. );
00428       else                   x->c_grain = eh_new0          ( double , len );
00429 
00430       x->n_grain = len;
00431 
00432    }
00433 
00434    return x;
00435 }
00436       
00437 gboolean
00438 sakura_set_outflow( Sakura_node* out , Sakura_array* a , double x_head , double dt , double dx )
00439 {
00440    gboolean success = TRUE;
00441 
00442    eh_require( out );
00443    eh_require( a   );
00444 
00445    if ( out && a )
00446    {
00447       gint   n_grains  = a->n_grain;
00448       gint   n_nodes   = a->len;
00449       double  u = 0.; // Free outflow at downstream end
00450       double  c = 0.;
00451       double  h = 0.;
00452       double* c_grain = eh_new0( double , n_grains );
00453 
00454       //if ( x_head > basin_len+dx )
00455       if ( x_head > a->x[a->len-1]+dx )
00456       {
00457          u = a->u[n_nodes-1];
00458          h = a->h[n_nodes-2];
00459          c = a->c[n_nodes-2];
00460          eh_dbl_array_copy( c_grain , a->c_grain[n_nodes-2] , n_grains );
00461       }
00462       //else if ( x_head > basin_len )
00463       else if ( x_head > a->x[a->len-1] )
00464       {
00465          u = 0; 
00466          h = out->h + a->h[n_nodes-2] * a->u[n_nodes-1] * dt/dx;
00467          c = a->c[n_nodes-2];
00468          eh_dbl_array_copy( out->c_grain , a->c_grain[n_nodes-2] , n_grains );
00469       }
00470 
00471       sakura_node_set( out , u , c , h , c_grain , n_grains );
00472 
00473       eh_free( c_grain );
00474    }
00475 
00476    return success;
00477 }
00478 
00479 double
00480 sakura_get_sin_slope( Sakura_get_func f , gpointer data , Sakura_array* a , gint i )
00481 {
00482    double s = 0;
00483 
00484    eh_require( f );
00485 if ( i<1 ) i=1;
00486 
00487    if ( f )
00488    {
00489       double depth_0 = f( data , a->x[i-1] );
00490       double depth_1 = f( data , a->x[i]   );
00491       double dx      = a->x[i] - a->x[i-1];
00492 
00493       s = -sin( atan( (depth_1-depth_0)/dx ) );
00494    }
00495    return s;
00496 }
00497 
00498 // This is step 1
00499 gboolean
00500 calculate_mid_vel( Sakura_array* a_mid , Sakura_array* a , gint ind_head , Sakura_const_st* con )
00501 {
00502    gboolean success = TRUE;
00503 
00504    eh_require( a_mid );
00505    eh_require( a     );
00506    eh_require( con   );
00507 
00508    if ( a_mid && a && con )
00509    {
00510       gint i;
00511       double dx = a->x[1] - a->x[0];
00512       //double u_star;
00513       //double u_head;
00514       double u_0, ul, ull, ur, urr;
00515       double cl, cm, cr, hl, hm, hr;
00516       double s;
00517       double du_dt;
00518       const double    dt             = con->dt;
00519       //Sakura_get_func get_depth_func = con->get_depth;
00520       //double *x     = a->x;
00521       double *u     = a->u;
00522       double *h     = a->h;
00523       double *c     = a->c;
00524       double *u_new = a_mid->u;
00525 
00526       // STEP 1: calculate tentative velocity at t + 0.5Dt
00527       // start from node =1 because velocity is given at upstream end (node=0)
00528       // calculate only within the flow (behind the head position)
00529       ind_head = eh_min( ind_head , a_mid->len-1);
00530 
00531       for ( i=1 ; i<=ind_head && success ; i++ )
00532       {
00533          u_0   = u[i];
00534 
00535          // get the depths of the i-1 and i nodes from the sakura architecture
00536          // so that we can calculate the slope.
00537          s = sakura_get_sin_slope( con->get_depth , con->depth_data , a , i );
00538 /*
00539          depth_0 = get_depth_func( Const->depth_data , x[i-1] );
00540          depth_1 = get_depth_func( Const->depth_data , x[i]   );
00541          s       = - sin( atan( (depth_1-depth_0)/dx ) );
00542 */
00543 
00544          ull = u[i-2];
00545          ul  = u[i-1]; 
00546          ur  = u[i+1];
00547          urr = u[i+2];
00548 
00549          cl  = c[i-1]; 
00550          cr  = c[i];
00551 
00552          hl  = h[i-1]; 
00553          hr  = h[i];
00554 
00555          // value at the node calculated from those at midpoints
00556          cm = 0.5 * ( cl + cr );
00557          hm = 0.5 * ( hl + hr );
00558          
00559          if ( hm>0 && hm<HMIN )
00560          {
00561             eh_warning( "hm too small in STEP 1 at node = %d" , i );
00562             success = FALSE;
00563          }
00564          du_dt = dudt( u_0 , ul , ur     , ull , urr       , hl    ,
00565                        hr  , hm , cl     , cr  , cm        , -9999 ,
00566                        s   , -9 , -99999 , dx  , con->c_drag , con->mu_water );
00567          // tentative variables with dt = 0.5 Dt 
00568          u_new[i] = u_0 + du_dt * dt * .5;
00569 
00570          if ( u_new[i] < 0 )
00571          {
00572             eh_message( "calculate_mid_vel: Negative flow velocity (i=%d): %f" , i , u_new[i] );
00573             success = FALSE;
00574          }
00575 
00576       } // end of STEP1
00577 
00578    }
00579    else
00580       success = FALSE;
00581 
00582    return success;
00583 }
00584 
00585 // This is step 3
00586 gboolean
00587 calculate_next_vel( Sakura_array* a_last , Sakura_array* a_mid , Sakura_array* a_next , gint ind_head , Sakura_const_st* Const )
00588 {
00589    gboolean success = TRUE;
00590 
00591    eh_require( a_last );
00592    eh_require( a_mid  );
00593    eh_require( a_next );
00594 
00595    if ( a_last && a_mid && a_next )
00596    {
00597       const double dx = a_last->x[1] - a_last->x[0];
00598       const double dt = Const->dt;
00599       gint i;
00600       //double u_star;
00601       double u_0, ul, ull, ur, urr;
00602       double cl, cm, cr, hl, hm, hr;
00603       double* u_mid  = a_mid->u;
00604       double* c_mid  = a_mid->c;
00605       double* h_mid  = a_mid->h;
00606       double* u_last = a_last->u;
00607       double* u_next = a_next->u;
00608       double s;
00609 
00610       ind_head = eh_min( ind_head , a_last->len-1 );
00611 
00612       /* STEP3: calculate new velocity*/
00613       /* trying to use variables at t + 0.5 Dt */
00614       for ( i=1 ; i<=ind_head ; i++ )
00615       {
00616          // get the depths of the i-1 and i nodes from the sakura architecture
00617          // so that we can calculate the slope.
00618 /*
00619          depth_0 = get_depth_func( Const->depth_data , a_last->x[i-1] );
00620          depth_1 = get_depth_func( Const->depth_data , a_last->x[i]   );
00621          s       = - sin( atan( (depth_1-depth_0)/dx ) );
00622 */
00623 
00624          s = sakura_get_sin_slope( Const->get_depth , Const->depth_data , a_last , i );
00625 
00626 // u_temp is at t+.5dt
00627          ull = u_mid[i-2];
00628          ul  = u_mid[i-1]; 
00629          u_0 = u_mid[i];
00630          ur  = u_mid[i+1];
00631          urr = u_mid[i+2];
00632 
00633 // c is at t?
00634 // c_new is at t+dt?
00635          cl  = c_mid[i-1];
00636          cr  = c_mid[i];
00637 
00638          hl  = h_mid[i-1];
00639          hr  = h_mid[i];
00640 
00641          cm = 0.5 * ( cl + cr );
00642          hm = 0.5 * ( hl + hr );
00643          
00644 // U is at t?
00645          u_next[i] = u_last[i]
00646                    + dudt( u_0, ul, ur, ull, urr,
00647                            hl, hr, hm,
00648                            cl, cr, cm,
00649                            -999 , s, -999 , -999 , dx, Const->c_drag, Const->mu_water) * dt;
00650 
00651          eh_require( fabs(u_next[i])<=UPPERLIMIT );
00652 
00653          if (fabs(u_next[i]) > UPPERLIMIT)
00654          {
00655             eh_message( "calculate_next_vel: Extreme flow velocity (i=%d): %f" , i , u_next[i] );
00656             success = FALSE;
00657          }
00658 
00659          if ( u_next[i] < 0 )
00660          {
00661             eh_message( "calculate_next_vel: Negative flow velocity (i=%d): %f" , i , u_next[i] );
00662             success = FALSE;
00663          }
00664       }
00665 /*
00666       if (x_head <= basin_len) u_new[n_nodes-1]  = 0;
00667       else                     u_new[n_nodes-1] -= dt/dx*u_new[n_nodes-2] * (u_new[n_nodes-1] - u_new[n_nodes-2]);
00668 
00669       // velocity at flow head boundary
00670       x_head   += u_head * dt;
00671       ind_head  = (int)floor(x_head/dx);
00672       if ( ind_head == n_nodes-1)
00673       {
00674          //fprintf(stderr,"flow reaches downstream end\n");
00675          stopnumber = 0;
00676       }
00677 */
00678    }
00679    else
00680       success = FALSE;
00681 
00682    return success;
00683 }
00684 
00685 
00686 double
00687 sakura_erode_depth( double rho_f , double u , double dt , double sua , double sub , double c_drag )
00688 {
00689    double e = 0;
00690 
00691    eh_require( rho_f>=0 );
00692 //   eh_require( u>=0     );
00693    eh_require( dt>0     );
00694 
00695    if ( dt>0 )
00696    {
00697       // Amount of erosion in m
00698       e = ( c_drag * rho_f * u*u - sub ) / sua * ( dt * S_DAYS_PER_SECOND );
00699 
00700       if ( e<0 ) e = 0;
00701    }
00702 
00703    return e;
00704 }
00705 
00706 Sakura_array*
00707 sakura_next_c_grain( Sakura_array* a_next , Sakura_array* a_last , double* u , gint i , double dt , Sakura_sediment* sed )
00708 {
00709    eh_require( a_next );
00710    eh_require( a_last );
00711    eh_require( sed    );
00712 
00713    if ( a_next && a_last && sed )
00714    {
00715       gint n;
00716       double cll, cl, c_0, cr, crr;
00717       double ul, ur;
00718       double wl, wr;
00719       double hll, hl, h_0, hr, hrr;
00720       double small_h;
00721       double c_grain_new;
00722       double df_dt;
00723       const gint   n_grain = a_last->n_grain;
00724       const double dx      = a_last->x[i+1] - a_last->x[i];
00725 
00726       ul = u[i];
00727       ur = u[i+1];
00728 
00729       wl = a_last->w[i];
00730       wr = a_last->w[i+1]; 
00731 
00732       hll = a_last->h[i-2];
00733       hl  = a_last->h[i-1];
00734       h_0 = a_last->h[i  ];
00735       hr  = a_last->h[i+1];
00736       hrr = a_last->h[i+2];
00737 
00738       for ( n = 0 ; n<n_grain ; n++)
00739       {
00740          small_h = sed->u_settling[n] * dt * Ro;
00741 
00742          cll = a_last->c_grain[i-2][n];
00743          cl  = a_last->c_grain[i-1][n];
00744          c_0 = a_last->c_grain[i  ][n];
00745          cr  = a_last->c_grain[i+1][n];
00746          crr = a_last->c_grain[i+2][n];
00747 
00748          eh_require( a_next->h[i]>=HMIN );
00749             
00750          if ( a_next->h[i]<HMIN )
00751          {
00752                c_grain_new = 0;
00753                //stopnumber = 1;
00754          }
00755          else
00756          {
00757             df_dt = dfdt(ul, ur, wl, wr, hl*cl, hr*cr, hll*cll, hrr*crr, h_0*c_0, dx, 0);
00758             c_grain_new = (c_0 * h_0 + dt * df_dt )/a_next->h[i];
00759 
00760             if ( c_grain_new < -HMIN)
00761             {
00762                eh_warning("negative new CC: node= %d, i= %d", i, n);
00763                eh_warning("cnew= %f, cold=%f", c_grain_new, c_0);
00764                c_grain_new = 0;
00765             }
00766          } //cnewi is the new concentration due to sediment transport by the flow
00767 
00768          a_next->c_grain[i][n] = c_grain_new;
00769       }
00770 
00771       a_next->c[i] = eh_dbl_array_sum( a_next->c_grain[i] , n_grain );
00772 
00773    }
00774    else
00775       a_next = NULL;
00776 
00777    return a_next;
00778 }
00779 
00780 double
00781 sakura_rho_flow( double* c_grain , double* rho_grain , gint n_grains , double rho_water )
00782 {
00783    double rho_f = 0;
00784 
00785    {
00786       gint n;
00787       for ( n=0 ; n<n_grains ; n++ )
00788          rho_f += c_grain[n]*rho_grain[n];
00789 
00790       rho_f += rho_water;
00791    }
00792 
00793    return rho_f;
00794 }
00795 
00796 double
00797 sakura_erode( Sakura_array* a , Sakura_sediment* sed , double* u , gint i , double dt , Sakura_const_st* c )
00798 {
00799    double ero = 0;
00800 
00801    eh_require( a    );
00802    eh_require( sed  );
00803    eh_require( c    );
00804    eh_require( dt>0 );
00805 
00806    if ( a && sed && c && dt>0 )
00807    {
00808       gint           n;
00809       const gint     n_grains   = sed->len;
00810       const double   dx         = a->x[i+1] - a->x[i];
00811       double*        phe_bottom = eh_new( double , n_grains );
00812       const double   vol_w      = dx*a->w[i]*a->h[i];
00813       double         rho_f;
00814       double         e_tot;
00815       double         e_grain;
00816       double         p;
00817       Sakura_cell_st sediment;
00818       Sakura_phe_st  phe_data;
00819 
00820       // Density of the flow
00821       rho_f      = sakura_rho_flow( a->c_grain[i] , sed->rho_grain , n_grains , c->rho_sea_water );
00822 
00823       // Total erosion depth (in meters of sediment plus water) over the time step
00824       e_tot      = sakura_erode_depth( rho_f , .5*(u[i]+u[i+1]) , dt , c->sua , c->sub , c->c_drag );
00825 
00826       // Cubic meters of eroded sediment plus water
00827       phe_data.val      = e_tot*dx*a->w[i];
00828       phe_data.phe      = phe_bottom;
00829       phe_data.n_grains = n_grains;
00830 
00831       c->get_phe( c->get_phe_data , a->x[i] , &phe_data );
00832 
00833       // get_phe_func may have changed the erosion depth if there wasn't enough sediment.
00834       // meters of sediment plus water
00835       e_tot = phe_data.val/(dx*a->w[i]);
00836 
00837       for ( n=0 ; n<n_grains ; n++ )
00838       {
00839 //         porosity = ( sed->rho_grain[n] - sed->rho_dep[n] ) / ( sed->rho_grain[n] - rho_sea_water );
00840 //         e_grain = e_tot*phe_bottom[n]*(1.-porosity);
00841 
00842          p = ( sed->rho_grain[n] - sed->rho_dep[n] ) / ( sed->rho_grain[n] - c->rho_sea_water );
00843 
00844          // Meters of sediment plus water
00845          e_grain = e_tot*phe_bottom[n];
00846 
00847          // Cubic meters of sediment plus water
00848          sediment.id = n;
00849          sediment.t  = e_grain*dx*a->w[i];
00850 
00851          if ( e_grain > 0 ) e_grain = c->remove( c->remove_data , a->x[i] , &sediment );
00852          if ( e_grain > 0 )
00853          {
00854             // Cubic meters of sediment
00855             e_grain *= (1-p);
00856 
00857 //         if (a->h[i] < HMIN) a->c_grain[i][n]  = 0;
00858 //         else                a->c_grain[i][n] += e_grain * dt / a->h[i];
00859 
00860             if ( a->h[i]>=HMIN ) a->c_grain[i][n] += e_grain / vol_w;
00861 
00862             eh_require( a->c_grain[i][n]>=0 );
00863 
00864             if ( a->c_grain[i][n]<0 ) a->c_grain[i][n] = 0.;
00865          }
00866          else
00867             e_grain = 0;
00868 
00869          ero        += e_grain;
00870          a->e[i][n] += e_grain;
00871       }
00872 
00873       eh_free( phe_bottom );
00874    }
00875    return ero;
00876 }
00877 
00878 double
00879 sakura_deposit( Sakura_array* a , Sakura_sediment* sed , gint i , double dt , Sakura_const_st* c )
00880 {
00881    double dep = 0;
00882 
00883    eh_require( a    );
00884    eh_require( sed  );
00885    eh_require( dt>0 );
00886 
00887    if ( a && sed && dt>0 )
00888    {
00889       if ( a->x[i] > c->dep_start )
00890       {
00891          gint           n;
00892          const gint     n_grains = sed->len;
00893          const double   dx       = a->x[i+1] - a->x[i];
00894          const double   vol_w    = dx*a->w[i]*a->h[i];
00895          Sakura_cell_st sediment;
00896          double         d_grain;
00897          double         p;
00898          double         small_h;
00899          double         avail;
00900 
00901          for ( n=0 ; n<n_grains ; n++ )
00902          {
00903             small_h = sed->u_settling[n] * dt * Ro;
00904 
00905             // Meters of sediment
00906             if ( a->h[i] <= small_h ) d_grain = a->h[i]/dt           *a->c_grain[i][n];
00907             else                      d_grain = sed->u_settling[n]*Ro*a->c_grain[i][n];
00908 
00909             p = ( sed->rho_grain[n] - sed->rho_dep[n] ) / ( sed->rho_grain[n] - c->rho_sea_water );
00910 
00911             // Meters of sediment plus water
00912             d_grain /= (1-p);
00913 
00914             // Cubic meters of sediment plus water
00915             sediment.id = n;
00916             sediment.t  = d_grain*dx*a->w[i]*dt;
00917 
00918             if ( d_grain > 0 ) d_grain = c->add( c->add_data , a->x[i] , &sediment );
00919 
00920             // Cubic meters of sediment
00921             d_grain *= (1-p);
00922 
00923 //            if (a->h[i] < HMIN) a->c_grain[i][n]  = 0;
00924 //            else                a->c_grain[i][n] -= d_grain * dt / (dx*a->w[i]*a->h[i]);
00925 
00926             avail = a->c_grain[i][n]*vol_w;
00927 
00928             if ( d_grain > avail ) d_grain = avail;
00929 
00930             a->c_grain[i][n] -= d_grain / vol_w;
00931 
00932             eh_require( a->c_grain[i][n]>=-1e-10 );
00933 
00934             if ( a->c_grain[i][n]<0 ) a->c_grain[i][n] = 0.;
00935 
00936             dep        += d_grain;
00937             a->d[i][n] += d_grain;
00938          }
00939       }
00940    }
00941 
00942    return dep;
00943 }
00944 
00945 double
00946 sakura_deposit_all( Sakura_array* a , Sakura_sediment* sed , Sakura_const_st* c )
00947 {
00948    double dep = 0;
00949 
00950    eh_require( a    );
00951    eh_require( sed  );
00952 
00953    if ( a && sed )
00954    {
00955       gint           i, n;
00956       const gint     n_grains   = sed->len;
00957       double*        f_sed      = eh_new( double , n_grains );
00958       double         vol_w;
00959       double         vol_grain;
00960       Sakura_cell_st sediment;
00961 
00962       /* 1 minus porosity (sediment volume over total volume) */
00963       for ( n=0 ; n<n_grains ; n++ )
00964          f_sed[n] = 1. - ( sed->rho_grain[n] - sed->rho_dep[n] ) / ( sed->rho_grain[n] - c->rho_sea_water );
00965 
00966       for ( i=0 ; i<a->len ; i++ )
00967       {
00968          vol_w = a->h[i]*a->w[i]*(a->x[i+1]-a->x[i]);
00969          for ( n=0 ; n<n_grains ; n++ )
00970          {
00971             // Meters of sediment plus water
00972             vol_grain = vol_w*a->c_grain[i][n] / f_sed[n];
00973 
00974             // Cubic meters of sediment plus water
00975             sediment.id = n;
00976             sediment.t  = vol_grain;
00977 
00978             if ( vol_grain > 0 ) vol_grain = c->add( c->add_data , a->x[i] , &sediment );
00979 
00980             // Cubic meters of sediment
00981             dep       += vol_grain*f_sed[n];
00982          }
00983       }
00984 
00985       eh_free( f_sed );
00986    }
00987 
00988    return dep;
00989 }
00990 
00991 gboolean
00992 compute_c_grain_new( Sakura_array* a , Sakura_array* a_last , double* u , gint i , double dt , Sakura_const_st* c , Sakura_sediment* sed )
00993 {
00994    gboolean success = TRUE;
00995 
00996    eh_require( a      );
00997    eh_require( a_last );
00998    eh_require( u      );
00999    eh_require( c      );
01000    eh_require( sed    );
01001 
01002    if ( dt>0 )
01003    {
01004       sakura_next_c_grain( a , a_last , u , i , dt , sed );
01005       sakura_erode       ( a , sed , u , i , dt , c );
01006       sakura_deposit     ( a , sed , i , dt , c );
01007    }
01008    return success;
01009 }
01010 
01011 // output c_new, sed_rate, CCMULTI_new
01012 // input
01013 gboolean
01014 compute_c_grain( Sakura_array* a , Sakura_array* a_last , double* u , gint i , double dx , Sakura_const_st* Const , Sakura_sediment* sed )
01015 {
01016    gboolean success = TRUE;
01017 
01018    eh_require( a        );
01019    eh_require( a_last   );
01020    eh_require( i>=0     );
01021    eh_require( i<a->len );
01022 
01023    if ( a && a_last )
01024    {
01025       gint   n;
01026       double sed_rate;
01027       double c_new;
01028       double h_0;
01029       double cll, cl, c_0, cr, crr;
01030       double ul, um, ur;
01031       double wl, wr;
01032       double hll, hl, hr, hrr;
01033       double small_h;
01034       double dh;
01035       double c_grain_new;
01036       double erode_depth;
01037       double depth_node;
01038       double porosity;
01039       double flux_at_bed;
01040       double rho_avg;
01041       double rho_bottom;
01042       double df_dt;
01043       const double    init_h         = a_last->h[-1];
01044       const double    dt             = Const->dt;
01045       const gint      n_grain        = a->n_grain;
01046       double*         phe_bottom     = eh_new( double , n_grain );
01047       double*         erosion        = eh_new( double , n_grain );
01048       Sakura_phe_func get_phe_func   = Const->get_phe;
01049       Sakura_add_func add_func       = Const->add;
01050       Sakura_add_func remove_func    = Const->remove;
01051       Sakura_get_func get_depth_func = Const->get_depth;
01052       Sakura_phe_st   phe_data;
01053       Sakura_cell_st  sediment;
01054 
01055 
01056       ul = u[i];
01057       ur = u[i+1];
01058 
01059       wl = a_last->w[i];
01060       wr = a_last->w[i+1]; 
01061 
01062       um = 0.5 * ( ul + ur );
01063 
01064       hll = a_last->h[i-2];
01065       hl  = a_last->h[i-1];
01066       h_0 = a_last->h[i  ];
01067       hr  = a_last->h[i+1];
01068       hrr = a_last->h[i+2];
01069 
01070       // compute CCMULTI for each grain size fraction
01071       for ( n = 0, sed_rate = 0, c_new = 0; n<n_grain ; n++)
01072       {
01073 
01074          small_h = sed->u_settling[n] * dt * Ro;
01075 
01076          cll = a_last->c_grain[i-2][n];
01077          cl  = a_last->c_grain[i-1][n];
01078          c_0 = a_last->c_grain[i  ][n];
01079          cr  = a_last->c_grain[i+1][n];
01080          crr = a_last->c_grain[i+2][n];
01081 
01082          eh_require( a->h[i]>=HMIN );
01083             
01084          if ( a->h[i]<HMIN )
01085          {
01086             c_grain_new = 0;
01087             //stopnumber = 1;
01088          }
01089          else
01090          {
01091             df_dt = dfdt(ul, ur, wl, wr, hl*cl, hr*cr, hll*cll, hrr*crr, h_0*c_0, dx, 0);
01092             c_grain_new = (c_0 * h_0 + dt * df_dt )/a->h[i];
01093 
01094             if ( c_grain_new < -HMIN)
01095             {
01096                eh_warning("negative new CC: node= %d, i= %d", i, n);
01097                eh_warning("cnew= %f, cold=%f", c_grain_new, c_0);
01098                c_grain_new = 0;
01099             }
01100          } //cnewi is the new concentration due to sediment transport by the flow
01101 
01102          // here we get the PheBottom at the node location.
01103 //         erode_depth     = ( Const->c_drag * (1+c_grain_new*R)*Const->rho_sea_water * um*um - Const->sub );
01104 
01105          // amount of erosion in a time step
01106          erode_depth     = ( Const->c_drag * (1+c_grain_new*R)*Const->rho_sea_water * um*um - Const->sub )
01107                          / Const->sua * ( dt * S_DAYS_PER_SECOND );
01108 
01109 //         phe_data.val      = erode_depth*dx;
01110          phe_data.val      = erode_depth*dx*a->w[i]; // Eroded volume
01111          phe_data.phe      = phe_bottom;
01112          phe_data.n_grains = a->n_grain;
01113 
01114          get_phe_func( Const->get_phe_data , a->x[i] , &phe_data );
01115 
01116          // get_phe_func may have changed the erosion depth if there wasn't enough sediment.
01117 //         erode_depth = phe_data.val/dx;
01118          erode_depth = phe_data.val/(dx*a->w[i]);
01119 
01120          // Update the shear strength at the surface
01121          //a->sub[i] += Const->sua*erode_depth;
01122 
01123          rho_avg    = eh_dbl_array_mean_weighted( sed->rho_grain , a->n_grain , phe_bottom );
01124          rho_bottom = eh_dbl_array_mean_weighted( sed->rho_dep   , a->n_grain , phe_bottom );
01125 
01126          eh_require( rho_avg   >0 );
01127          eh_require( rho_bottom>0 );
01128 
01129          porosity = 1.0 - rho_bottom/rho_avg;
01130 
01131 //         erosion[n] = erode_depth
01132 //                    * phe_bottom[n]*(1.-porosity)
01133 //                    / (Const->sua*S_SECONDS_PER_DAY);
01134 
01135          erosion[n] = erode_depth*phe_bottom[n]*(1.-porosity);
01136 
01137          if ( a->h[i] <= small_h) flux_at_bed = a->h[i]/dt              * c_grain_new - eh_max( 0 , erosion[n] ); 
01138          else                     flux_at_bed = sed->u_settling[n] * Ro * c_grain_new - eh_max( 0 , erosion[n] );
01139 
01140          if ( a->x[i] < Const->dep_start ) flux_at_bed = 0.0;
01141 
01142          depth_node = get_depth_func( Const->depth_data , a->x[i] );
01143 
01144          if ( depth_node + flux_at_bed*dt/porosity/phe_bottom[n] > -init_h )
01145          //if ( depth_node + flux_at_bed*dt/porosity/phe_bottom[n] > 0 )
01146             flux_at_bed = 0.0;
01147 
01148          dh = flux_at_bed*dt/porosity;
01149 
01150          // Keep track of volume eroded/deposited at each node and for each grain size
01151          sediment.t  = dh*dx*a->w[i];
01152          sediment.id = n;
01153          if ( dh<0 ) a->e[i][n] += remove_func( Const->remove_data , a->x[i] , &sediment );
01154          else        a->d[i][n] += add_func   ( Const->add_data    , a->x[i] , &sediment );
01155 
01156 //         SEDMULTI[i][n] += flux_at_bed * dt / porosity;
01157 
01158          if (a->h[i] < HMIN) a->c_grain[i][n] = 0;
01159          else                a->c_grain[i][n] = c_grain_new - flux_at_bed * dt/ a->h[i];
01160 
01161          eh_require( a->c_grain[i][n] >= -HMIN );
01162 
01163          if (a->c_grain[i][n] < -HMIN)
01164          {
01165             eh_warning("negative CCMULTInew: node=%d, grain=%d",i,n);
01166             eh_warning("cnew=%f, cold=%f, hnew=%f", a->c_grain[i][n], c_grain_new , a->h[i]);
01167          }
01168          else if ( a->c_grain[i][n] < 0)
01169             a->c_grain[i][n] = 0.0;
01170 
01171          a->c_grain[i][n] = eh_max( 0 , a->c_grain[i][n] );
01172 
01173          c_new    += a->c_grain[i][n];
01174          sed_rate += flux_at_bed;
01175       } //end of CCMULTI
01176 
01177       a->c[i]     = c_new;
01178 //      a->s[i]    += dt*sed_rate;
01179 //      a->r[i]    += sed_rate;
01180 
01181       eh_free( phe_bottom );
01182       eh_free( erosion    );
01183 /*
01184       max_c       = eh_max( max_c , c_new );
01185       total_susp += c_new * a->h[i];
01186 
01187       if ( max_c<=HMIN || total_susp<=HMIN )
01188       {
01189          eh_warning("maxc=%f, totalsusp=%f", max_c, total_susp);
01190          eh_warning("ccmultinew=%f, hew=%f",a->c_grain[i-1][n-1], a->h[i-1]);
01191          eh_watch_int( node );
01192          eh_watch_dbl( HMIN );
01193          stopnumber = 1;
01194       }
01195 */
01196       
01197    }
01198    else
01199       success = FALSE;
01200 
01201    return success;
01202 }
01203 
01204 gboolean
01205 compute_next_h( Sakura_array* a_new , Sakura_array* a_last , double* u_temp , gint ind_head , Sakura_const_st* c )
01206 {
01207    gboolean success = TRUE;
01208 
01209    if ( a_new && a_last )
01210    {
01211       const double dt    = c->dt;
01212       const gint   top_i = a_new->len-2;
01213       const double dx    = a_new->x[1] - a_new->x[0];
01214       gint i;
01215       double hll, hl, h_0, hr, hrr;
01216       double ul, um, ur;
01217       double wl, wr;
01218       double c_0;
01219       double Ew, Ri;
01220       double df_dt;
01221 
01222       ind_head = eh_min( ind_head , a_last->len-1 );
01223 
01224       // START STEP2: calculate new flow thickness and sediment concentration
01225       // calculations at node midpoint for HH, CC and SED
01226       //  uses Utemp to get HHnew and CCnew
01227       for ( i=0 ; i<=ind_head && i<=top_i && success ; i++ )
01228       {
01229          h_0 = a_last->h[i];
01230          c_0 = a_last->c[i];
01231          
01232          ul = u_temp[i];
01233          ur = u_temp[i+1];
01234 
01235          wl = a_last->w[i];
01236          wr = a_last->w[i+1]; 
01237 
01238          um = 0.5 * ( ul + ur );
01239 
01240          hll = a_last->h[i-2];
01241          hl  = a_last->h[i-1];
01242          hr  = a_last->h[i+1];
01243          hrr = a_last->h[i+2];
01244          
01245          // compute water entrainment 
01246          if ( eh_compare_dbl( um , 0.0 , 1e-12 ) )
01247          {
01248             Ew = 0.0;
01249             Ri = 0.0;
01250          }
01251          else
01252          //if (um != 0.0)
01253          {
01254             Ri = R * G * c_0 * h_0 / eh_sqr(um);
01255             Ew = c->e_a / (c->e_b + Ri);
01256          }
01257 
01258          df_dt = dfdt(ul, ur, wl, wr, hl, hr, hll, hrr, h_0, dx, Ew*fabs(um));
01259          
01260          // compute new HH
01261          a_new->h[i] = h_0 + dt * df_dt;
01262 
01263          eh_require( a_new->h[i]>=0 );
01264 
01265          if (a_new->h[i] < 0 || eh_isnan(a_new->h[i]) )
01266          {
01267             //eh_warning( "HHnew negative but cancelled at the %d-th node" ,i);
01268             //eh_warning( "ul:%f, ur:%f, hl:%f, h:%f, hr:%f", ul,ur,hl,h_0,hr);
01269             //a_new->h[i] = 0;
01270             eh_watch_dbl( ul );
01271             eh_watch_dbl( ur );
01272             eh_watch_dbl( wl );
01273             eh_watch_dbl( wr );
01274             eh_watch_dbl( hll );
01275             eh_watch_dbl( hl );
01276             eh_watch_dbl( h_0 );
01277             eh_watch_dbl( hr );
01278             eh_watch_dbl( hrr );
01279             eh_watch_dbl( dx );
01280             eh_watch_dbl( Ew );
01281             eh_watch_dbl( fabs(um) );
01282 
01283             eh_watch_int( i );
01284             eh_watch_int( a_last->len );
01285             eh_watch_dbl( a_last->w[i] );
01286             eh_watch_dbl( a_last->w[i+1] );
01287 
01288             eh_warning( "compute_next_h: Negative flow height (i=%d): %f", i , a_new->h[i] );
01289             success = FALSE;
01290          }
01291       }
01292    }
01293 
01294    return success;
01295 }
01296 
01297 gboolean
01298 compute_next_c( Sakura_array* a_new , Sakura_array* a_last , double* u_temp , gint ind_head , Sakura_const_st* c , Sakura_sediment* sed )
01299 {
01300    gboolean success = TRUE;
01301 
01302    if ( a_new && a_last )
01303    {
01304       gint         i;
01305       const gint   top_i = a_new->len-2;
01306       const double dt    = c->dt;
01307 
01308       ind_head = eh_min( ind_head , a_last->len-1 );
01309 
01310       for ( i=0 ; i<=ind_head && i<=top_i ; i++ )
01311       {
01312          sakura_next_c_grain( a_new , a_last , u_temp , i , dt , sed );
01313          sakura_erode       ( a_new , sed , u_temp  , i , dt , c );
01314          sakura_deposit     ( a_new , sed , i , dt , c );
01315       }
01316    }
01317 
01318    return success;
01319 }
01320 
01321 // output HH_new, CC_new, and SED_new at t+dt
01322 // input HH, CC, Wx
01323 gboolean
01324 calculate_next_c_and_h( Sakura_array* a_new , Sakura_array* a_last , double* u_temp , gint ind_head , Sakura_const_st* Const , Sakura_sediment* sed )
01325 {
01326    gboolean success = TRUE;
01327 
01328    if ( a_new && a_last )
01329    {
01330       const double dt    = Const->dt;
01331       const gint   top_i = a_new->len-2;
01332       const double dx    = a_new->x[1] - a_new->x[0];
01333       gint i;
01334       double hll, hl, h_0, hr, hrr;
01335       double ul, um, ur;
01336       double wl, wr;
01337       double c_0;
01338       double Ew, Ri;
01339       double df_dt;
01340 
01341       // START STEP2: calculate new flow thickness and sediment concentration
01342       // calculations at node midpoint for HH, CC and SED
01343       //  uses Utemp to get HHnew and CCnew
01344       for ( i=0 ; i<=ind_head && i<=top_i ; i++ )
01345       {
01346          h_0 = a_last->h[i];
01347          c_0 = a_last->c[i];
01348          
01349          ul = u_temp[i];
01350          ur = u_temp[i+1];
01351 
01352          wl = a_last->w[i];
01353          wr = a_last->w[i+1]; 
01354 
01355          um = 0.5 * ( ul + ur );
01356 
01357          hll = a_last->h[i-2];
01358          hl  = a_last->h[i-1];
01359          hr  = a_last->h[i+1];
01360          hrr = a_last->h[i+2];
01361          
01362          // compute water entrainment 
01363          if ( eh_compare_dbl( um , 0.0 , 1e-12 ) )
01364          {
01365             Ew = 0.0;
01366             Ri = 0.0;
01367          }
01368          else
01369          //if (um != 0.0)
01370          {
01371             Ri = R * G * c_0 * h_0 / eh_sqr(um);
01372             Ew = Const->e_a / (Const->e_b + Ri);
01373          }
01374 
01375          df_dt = dfdt(ul, ur, wl, wr, hl, hr, hll, hrr, h_0, dx, Ew*fabs(um));
01376          
01377          // compute new HH
01378          a_new->h[i] = h_0 + dt * df_dt;
01379 
01380          eh_require( a_new->h[i]>=0 );
01381 
01382          if (a_new->h[i] < 0 )
01383          {
01384             eh_warning( "HHnew negative but cancelled at the %d-th node" ,i);
01385 /*
01386             eh_warning( "old=%f, new=%f, dfdt=%f, left=%f, right=%f"      ,h,HHnew[node],dfdt(ul,ur,wl,wr,hl,hr,hll,hrr,h,Dx,Ew*um),tvdleft(ul,h,hl,hr,hll,hrr),tvdright(ur,h,hl,hr,hll,hrr));
01387 */
01388             eh_warning( "ul:%f, ur:%f, hl:%f, h:%f, hr:%f", ul,ur,hl,h_0,hr);
01389             a_new->h[i] = 0;
01390          }
01391 
01392 //                     if (HHnew[node] > LARGER(InitH, fabs(DEPTH[node])) )
01393  //                        HHnew[node] = -DEPTH[node];
01394 
01395          // compute CCMULTI for each grain size fraction
01396          compute_c_grain_new( a_new , a_last , u_temp , i , dx , Const , sed );
01397 
01398          //a->c[i]     = c_new;
01399          //a->s[i]    += dt*sed_rate;
01400          //a->r[i]    += sed_rate;
01401 
01402          //max_c       = eh_max( max_c , c_new );
01403          //total_susp += c_new * a->h[i];
01404       } /*end STEP2*/
01405    }
01406    else
01407       success = FALSE;
01408 
01409    return success;
01410 }
01411 
01412 gboolean
01413 calculate_mid_c_and_h( Sakura_array* a_mid , Sakura_array* a_last , Sakura_array* a_next )
01414 {
01415    gboolean success = TRUE;
01416 
01417    if ( a_mid && a_last && a_next )
01418    {
01419       gint i;
01420       gint top_i = a_mid->len+2;
01421 
01422       for ( i=-2 ; i<top_i ; i++ )
01423       {
01424          a_mid->c[i] = .5*( a_last->c[i] + a_next->c[i] );
01425          a_mid->h[i] = .5*( a_last->h[i] + a_next->h[i] );
01426       }
01427    }
01428    return success;
01429 }
01430 
01431 gint
01432 calculate_head_index( Sakura_array* a , double* u , gint ind_head , double dx , double dt , double* x_head )
01433 {
01434    gint new_ind = -1;
01435 
01436    eh_require( a );
01437    eh_require( u );
01438 
01439    if ( a && u )
01440    {
01441       eh_require( ind_head>=0     );
01442 if ( ind_head<0 )
01443    eh_watch_int( ind_head );
01444 
01445       if ( ind_head<a->len )
01446       {
01447          double u_head = eh_max( u[ind_head] , u[ind_head-1] );
01448 
01449          if      ( ind_head<=0 ) u_head = u[0];
01450          else if ( u_head   >0 ) u_head = eh_min( u_head , 1.5*pow( G*R*a->c[ind_head-1]*a->h[ind_head-1] ,1./3.) );
01451          else                    u_head = eh_max( u[ind_head] , u[ind_head-1] );
01452 
01453          *x_head += u_head * dt;
01454          new_ind  = floor( (*x_head-a->x[0]) / dx );
01455       }
01456       else
01457          new_ind = ind_head;
01458 
01459       eh_require( new_ind>=0     );
01460 if ( new_ind<0 )
01461 {
01462    eh_watch_int( new_ind );
01463    eh_watch_int( ind_head );
01464    eh_watch_int( a->len );
01465    eh_watch_dbl( u[ind_head] );
01466    eh_watch_dbl( u[ind_head-1] );
01467    eh_exit(0);
01468 }
01469    }
01470 
01471    return new_ind;
01472 }
01473 
01503 /*
01504 gboolean
01505 sakura( double dx          , double dt              , double basin_len ,
01506         int n_nodes        , int n_grains           , double Xx[]      ,
01507         double Zz[]        , double Wx[]            , double u_init[]  ,
01508         double c_init[]    , double *Lambda         , double* u_settling ,
01509         double *Rey        , double *rho_grain      , double h_init    ,
01510         double supply_time , double DepositionStart , double *fraction ,
01511         double *bottom_f   , double* rho_dep        , double OutTime   ,
01512         Sakura_const_st* c , double **Deposit       , FILE *fp_data )
01513 */
01534 double**
01535 sakura( double  u_riv     , double  c_riv    , double  h_riv  , double* f_riv    ,
01536         double  dt        , double  duration ,
01537         double* x         , double* z        , double* w      , gint    n_nodes  ,
01538         double* rho_grain , double* rho_dep  , double* u_fall , gint    n_grains ,
01539         Sakura_const_st* c )
01540 {
01541    double** deposit = NULL;
01542    gboolean success = TRUE;
01543 
01544    eh_require( u_riv>0    );
01545    eh_require( c_riv>0    );
01546    eh_require( h_riv>0    );
01547    eh_require( f_riv      );
01548    eh_require( dt>0       );
01549    eh_require( duration>0 );
01550    eh_require( x          );
01551    eh_require( z          );
01552    eh_require( w          );
01553    eh_require( n_nodes>0  );
01554    eh_require( rho_grain  );
01555    eh_require( rho_dep    );
01556    eh_require( u_fall     );
01557    eh_require( n_grains>0 );
01558    eh_require( c          );
01559 
01560    if ( TRUE || g_getenv( "SAKURA_DEBUG" ) )
01561    {
01562          double       mass_in        = 0;
01563          const double vol_w          = u_riv*h_riv*w[0]*duration;
01564          gint n;
01565 eh_watch_dbl( duration );
01566 eh_watch_dbl( u_riv );
01567 eh_watch_dbl( c_riv );
01568 eh_watch_dbl( h_riv );
01569          // c_riv is now volume concentration
01570          for ( n=0,mass_in=0 ; n<n_grains ; n++ )
01571          {
01572             mass_in += c_riv*f_riv[n]*vol_w;
01573 eh_watch_dbl( f_riv[n] );
01574 eh_watch_dbl( rho_dep[n] );
01575 eh_watch_dbl( rho_grain[n] );
01576 eh_watch_dbl( u_fall[n] );
01577          }
01578 
01579          for ( n=0 ; n<n_nodes ; n++ )
01580             fprintf( stderr , "%f ; %f ; %f\n" , x[n] , z[n] , w[n] );
01581 
01582 eh_watch_dbl( c->dt );
01583 eh_watch_dbl( c->e_a );
01584 eh_watch_dbl( c->e_b );
01585 eh_watch_dbl( c->sua );
01586 eh_watch_dbl( c->sub );
01587 eh_watch_dbl( c->c_drag );
01588 eh_watch_dbl( c->rho_river_water );
01589 eh_watch_dbl( c->rho_sea_water );
01590 eh_watch_dbl( c->tan_phi );
01591 eh_watch_dbl( c->mu_water );
01592 eh_watch_dbl( c->channel_width );
01593 eh_watch_dbl( c->channel_len );
01594 eh_watch_dbl( c->dep_start );
01595    }
01596 
01597    if ( dt>0 )
01598    { // Run the model for positive time steps
01599       Sakura_array*    a_next  = sakura_array_new( n_nodes , n_grains );
01600       Sakura_array*    a_mid   = sakura_array_new( n_nodes , n_grains );
01601       Sakura_array*    a_last  = sakura_array_new( n_nodes , n_grains );
01602       Sakura_node*     inflow  = NULL;
01603       Sakura_node*     outflow = NULL;
01604       Sakura_sediment* sed     = sakura_sediment_new( n_grains );
01605       double           mass_lost = 0;
01606 
01607       { // Set the inflow and outflow conditions
01608          gint    n;
01609          double* c_grain = eh_dbl_array_dup( f_riv , n_grains );
01610 
01611          for ( n=0 ; n<n_grains ; n++ )
01612             c_grain[n] = (c_riv*f_riv[n])/rho_grain[n];
01613 
01614          // Convert river concentration to volume concentration
01615          c_riv = eh_dbl_array_sum( c_grain , n_grains );
01616 
01617          inflow  = sakura_node_new( u_riv , c_riv , h_riv , c_grain , n_grains );
01618 
01619          c_grain = eh_dbl_array_set( c_grain , n_grains , 0. );
01620          outflow = sakura_node_new( 0. , 0. , 0. , c_grain , n_grains );
01621 
01622          eh_free( c_grain );
01623       }
01624 
01625       { // Initialize arrays
01626          sakura_array_set_x( a_next , x );
01627          sakura_array_set_x( a_mid  , x );
01628          sakura_array_set_x( a_last , x );
01629          sakura_array_set_w( a_next , w );
01630          sakura_array_set_w( a_mid  , w );
01631          sakura_array_set_w( a_last , w );
01632       }
01633 
01634       { // Initialize sediment
01635          sakura_sediment_set_rho_dep   ( sed , rho_dep   );
01636          sakura_sediment_set_rho_grain ( sed , rho_grain );
01637          sakura_sediment_set_u_settling( sed , u_fall    );
01638       }
01639 
01640       c->sua       *= 1e3;
01641       c->sub       *= 1e3;
01642       c->dep_start += x[0];
01643 
01644       if ( TRUE || g_getenv( "SAKURA_DEBUG" ) )
01645       { // Print input variables for debugging
01646          gint n;
01647 
01648          eh_debug( "Supply time        : %f" , duration     );
01649          eh_debug( "Init velocity      : %f" , inflow->u    );
01650          eh_debug( "Init concentration : %f" , inflow->c    );
01651          eh_debug( "Init height        : %f" , inflow->h    );
01652          eh_debug( "Time step          : %f" , dt           );
01653          eh_debug( "Number of nodes    : %d" , n_nodes      );
01654          eh_debug( "Number of grains   : %d" , n_grains     );
01655    
01656          for ( n=0 ; n<n_grains ; n++ )
01657          {
01658             eh_debug( "Grain Type: %d" , n );
01659             eh_debug( "   Settling velocity (m/d)  : %f" , u_fall[n]*S_SECONDS_PER_DAY );
01660             eh_debug( "   Grain density (kg/m^3)   : %f" , rho_grain[n] );
01661             eh_debug( "   Deposit density (kg/m^3) : %f" , rho_dep[n] );
01662             eh_debug( "   Fraction                 : %f" , f_riv[n] );
01663          }
01664    
01665          eh_debug( "c->dt  : %f" , c->dt  );
01666          eh_debug( "c->sua : %f" , c->sua );
01667          eh_debug( "c->sub : %f" , c->sub );
01668          eh_debug( "c->e_a : %f" , c->e_a );
01669          eh_debug( "c->e_b : %f" , c->e_b );
01670          eh_debug( "c->c_drag : %f" , c->c_drag );
01671          eh_debug( "c->mu_water : %f" , c->mu_water );
01672          eh_debug( "c->rho_sea_water : %f" , c->rho_sea_water );
01673          eh_debug( "c->dep_start : %f" , c->dep_start );
01674       }
01675    
01676       { // Run the model
01677          const double dx       = a_last->x[1] - a_last->x[0];
01678          double       x_head   = HMIN + a_last->x[0];
01679          gint         ind_head = floor( (x_head-a_last->x[0])/dx );
01680          const double total_t = 2.*duration;
01681          double       t;
01682          gint         n;
01683    
01684          eh_require( x_head>0         );
01685          eh_require( ind_head>=0      );
01686          eh_require( ind_head<n_nodes );
01687    
01688          for ( t=0.,n=0 ; t<=total_t && success ; t+=dt,n++ )
01689          { // Run the flow for each time step
01690             fprintf( stdout , "SAKURA time: %f s (%f s)\r" , t , total_t );
01691 
01692             if ( t>duration )
01693             {
01694                inflow->u = 0;
01695                inflow->c = 0;
01696                inflow->h = 0;
01697             }
01698    
01699             sakura_set_outflow ( outflow , a_last , x_head  , dt , dx );
01700             sakura_array_set_bc( a_last  , inflow , outflow );
01701             sakura_array_set_bc( a_mid   , inflow , outflow );
01702    
01703             // Calculate u at t+dt/2.  The rest of a_mid is invalid.  a_mid->u is u_temp.
01704             // This also calculates u at the head of the flow
01705             if ( success ) success = calculate_mid_vel( a_mid  , a_last , ind_head , c );
01706    
01707             // Calculate c, and h at t+dt.  This is a_next.  a_next->u is not valid.
01708             if ( success ) success = compute_next_h( a_next , a_last , a_mid->u , ind_head , c );
01709             if ( success ) success = compute_next_c( a_next , a_last , a_mid->u , ind_head , c , sed );
01710    
01711             // Set new boundary conditions
01712             sakura_set_outflow ( outflow , a_last , x_head , dt , dx );
01713             sakura_array_set_bc( a_next  , inflow , outflow );
01714 
01715             // Calculate c, and h at t+dt/2.  This is in a_mid and an average of a_last and a_next
01716             if ( success ) success = calculate_mid_c_and_h( a_mid , a_last , a_next );
01717    
01718             // Calculate u at t+dt.  This is a_next->u.
01719             if ( success ) success = calculate_next_vel( a_last , a_mid , a_next , ind_head , c );
01720    
01721             ind_head = calculate_head_index( a_last , a_mid->u , ind_head , dx , dt , &x_head );
01722    
01723             // Update variables
01724             sakura_array_copy( a_last , a_next );
01725 
01726             if ( n%c->data_int==0 ) sakura_array_print_data( a_last , c );
01727 
01728             mass_lost += sakura_array_mass_lost( a_last , sed , dt );
01729          }
01730 
01731          if ( !success )
01732          { /* If no success, deposit everything in suspension */
01733             if ( t<duration )
01734             { /* What hasn't left the river yet */
01735                eh_warning( "Time remaining (seconds): %f" , duration - t );
01736             }
01737             sakura_deposit_all( a_last , sed , c );
01738          }
01739       }
01740 
01741       if ( TRUE || g_getenv( "SAKURA_DEBUG" ) )
01742       { // Mass balance check
01743          gint         n;
01744          double       mass_in        = 0;
01745          double       mass_out       = 0;
01746          double       mass_bal       = 0;
01747          const double mass_in_susp   = sakura_array_mass_in_susp  ( a_last , sed );
01748          const double mass_eroded    = sakura_array_mass_eroded   ( a_last , sed );
01749          const double mass_deposited = sakura_array_mass_deposited( a_last , sed );
01750          const double vol_w          = u_riv*h_riv*w[0]*duration;
01751 
01752          // c_riv is now volume concentration
01753          for ( n=0,mass_in=0 ; n<n_grains ; n++ )
01754             mass_in += c_riv*f_riv[n]*vol_w*rho_grain[n];
01755 
01756          mass_bal = mass_in + mass_eroded - mass_deposited - mass_in_susp - mass_lost;
01757 
01758          fprintf( stdout , "\n\n" );
01759          fprintf( stdout , "Mass in (kg)             : %g\n" , mass_in        );
01760          fprintf( stdout , "Mass eroded (kg)         : %g\n" , mass_eroded    );
01761          fprintf( stdout , "Mass deposited (kg)      : %g\n" , mass_deposited );
01762          fprintf( stdout , "Mass in suspension (kg)  : %g\n" , mass_in_susp   );
01763          fprintf( stdout , "Mass lost (kg)           : %g\n" , mass_lost      );
01764          fprintf( stdout , "----------------------------------------------\n" );
01765          fprintf( stdout , "Mass balance (kg)        : %g\n" , mass_bal       );
01766          fprintf( stdout , "\n\n" );
01767 
01768          if ( mass_bal > 0 ) eh_message( "Relative error (-)       : %g (lost)"   , mass_bal / mass_in );
01769          else                eh_message( "Relative error (-)       : %g (gained)" , mass_bal / mass_in );
01770 
01771          //mass_in  += sakura_array_mass_eroded( a_last , sed );
01772          //mass_out  = sakura_array_mass_in_susp  ( a_last , sed )
01773          //          + sakura_array_mass_deposited( a_last , sed )
01774          //          + mass_lost
01775          //          - mass_eroded;
01776 
01777 
01778          //if ( !eh_compare_dbl(mass_in,mass_out,.01) )
01779          if ( !eh_compare_dbl(mass_bal,0.,.01) )
01780             eh_warning( "Mass balance check failed" );
01781       }
01782 
01783       if ( TRUE )
01784       {
01785          gint i, n;
01786          deposit = eh_new_2( double , n_grains , n_nodes );
01787 
01788          for ( n=0 ; n<n_grains ; n++ )
01789             for ( i=0 ; i<n_nodes ; i++ )
01790                deposit[n][i] = a_last->d[i][n]*rho_grain[n]/rho_dep[n];
01791       }
01792 
01793 
01794       { // de-allocate memory
01795          sakura_array_destroy( a_next );
01796          sakura_array_destroy( a_mid  );
01797          sakura_array_destroy( a_last );
01798    
01799          sakura_sediment_destroy( sed );
01800    
01801          sakura_node_destroy( inflow  );
01802          sakura_node_destroy( outflow );
01803       }
01804 
01805       c->sua       /= 1e3;
01806       c->sub       /= 1e3;
01807       c->dep_start -= x[0];
01808    }
01809 
01810    return deposit;
01811 }
01812 

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