/Users/huttone/Devel/sedflux-new/sedflux/trunk/ew/hydrotrend/hydrohypsom.c

Go to the documentation of this file.
00001 /*
00002  *  HydroHypsom.c
00003  *
00004  *  Calculates/converts the hypsometric integral data onto a
00005  *  regular grid (in elevation).  Then calculates the daily
00006  *  temperature for each altitude/area bin based on the lapse
00007  *  rate and the hypsometric integral.  This is used later to
00008  *  determine snow/glacial melt and accumulation.
00009  *
00010  *      Author:    M.D. Morehead  (Oct 1998)
00011  *      Author2:   S.D. Peckham   (Jan 2002)
00012  *  Author3:   A.J. Kettner   (October 2002)
00013  *
00014  *  Variable    Def.Location    Type    Units   Usage
00015  *  --------    ------------    ----    -----   -----
00016  *  dumdbl              various                 double  -               temporary double
00017  *  err                 various                 int             -               error flag, halts program
00018  *  ii                  various                 int             -               temporary loop counter
00019  *  kk                  various                 int             -               temporary loop counter
00020  *  noldelevbinsHydroHypsom.c   int             -               number of elev bins from previous epoch
00021  *  totarea             HydroHypsom.c   double  m^2             total basin area summed from areabins
00022  *  tst                 HydroHypsom.c   int             -               error checking flag
00023  *
00024  */
00025 
00026 #include <stdlib.h>
00027 #include <stdio.h>
00028 #include "hydroparams.h"
00029 #include "hydroclimate.h"
00030 #include "hydrotimeser.h"
00031 #include "hydroalloc_mem.h"
00032 #include "hydrofree_mem.h"
00033 
00034 #ifdef DBG
00035 #include "hydroinout.h"
00036 #endif
00037 
00038 /*------------------------
00039  *  Start of HydroHypsom
00040  *------------------------*/
00041 int hydrohypsom()
00042 {
00043 #ifdef DBG
00044 FILE *fid;
00045 #endif
00046 
00047 int err;
00048 int kk, ii, noldelevbins, tst;
00049 double totarea, dumdbl, *cumarea;
00050 
00051 err = 0;
00052 noldelevbins = 0;
00053 
00054 cumarea = malloc1d ( nhypts[ep], double );
00055 
00056 /*-----------------------------------------
00057  *  Check for FloodExceedence
00058  *  If exceeded just refill the Snowarray
00059  *  with last years leftover snow
00060  *-----------------------------------------*/
00061 if (floodtry == 0) {
00062 
00063    /*-------------------------------
00064     *  Remember the old array size
00065     *-------------------------------*/
00066    if (yr > syear[0])
00067       noldelevbins = nelevbins;
00068 
00069    /*----------------------------------------
00070     *  Find the new number of altitude bins
00071     *----------------------------------------*/
00072    if (yr == syear[ep])
00073        nelevbins = (int)floor( (maxalt[ep]/elevbinsize) + 1 );
00074    if (yr == syear[0])
00075        noldelevbins = nelevbins;
00076 
00077    /*----------------------------------
00078     *  Free the snow carry over array
00079     *----------------------------------*/
00080    if( ep > 0 && yr == syear[ep] )
00081       free(Snowcarry);
00082 
00083    /*--------------------------------------
00084     *  Allocate the snow carry over array
00085     *--------------------------------------*/
00086    if( yr == syear[ep] )
00087        if( (Snowcarry = (double *) calloc(nelevbins,sizeof(double)))==NULL ) {
00088                fprintf(stderr," PlumeArray ERROR: memory allocation failed \n");
00089                fprintf(stderr,"    failed on Snowcarry \n");
00090                exit(1);
00091        }
00092 
00093       /*
00094        *        Fill the snow carry over array
00095        *        (still need the old areas at this point)
00096        *
00097        *        old < new
00098        *                new     1 2 3 4 5 6
00099        *                          ^ ^ ^ ^ ^
00100        *                old       1 2 3 4 5
00101        *
00102        *        old = new
00103        *                new     1 2 3 4 5
00104        *                        ^ ^ ^ ^ ^
00105        *                old     1 2 3 4 5
00106        *
00107        *        old > new
00108        *                new     1 1 2 3 4 5
00109        *                        ^ ^ ^ ^ ^ ^
00110        *                old     1 2 3 4 5 6
00111        *
00112        *        reasons for this method:
00113        *        1) keeps the snow at the high altitudes for first two cases
00114        *        2) does not pile up a bunch of snow at high altitude for last case
00115        *                therefore it is more likely to melt in the summer
00116        */
00117    if( yr == syear[0] )
00118        for(kk=0; kk<noldelevbins; kk++ )
00119                Snowcarry[kk] = 0.0;
00120    else {
00121        if( noldelevbins <= nelevbins )
00122            for( kk=0; kk<noldelevbins; kk++ )
00123                Snowcarry[kk+(nelevbins-noldelevbins)] = \
00124                              Snowelevday[kk][daysiy-1]*areabins[kk];
00125        else {
00126            for( kk=0; kk<nelevbins; kk++ )                                      /* zero the array */
00127                Snowcarry[kk] = 0.0;
00128            for( kk=0; kk<(noldelevbins-nelevbins); kk++ )       /* add the lowest bins together */
00129                Snowcarry[0] += Snowelevday[kk][daysiy-1]*areabins[kk];
00130            for( kk=0; kk<nelevbins; kk++ )                                      /* add the rest of the bins */
00131                Snowcarry[kk] += \
00132                      Snowelevday[kk+(noldelevbins-nelevbins)][daysiy-1]*areabins[kk];
00133        }
00134    }    /* endifelse filling snow carry over array */
00135 
00136    /*--------------------------------------------------
00137     *  Calculate the Hypsometric integral information
00138     *  allocate the elevation related arrays
00139     *--------------------------------------------------*/
00140    if( yr == syear[ep] ) {
00141 
00142       /*---------------------------------------------------
00143        *  Free up the old arrays before creating new ones
00144        *---------------------------------------------------*/
00145        if( ep > 0 ) {
00146            free(elevbins);
00147            free(distbins);
00148            free(areabins);
00149            free_dmatrix(Televday,0,noldelevbins,0,daysiy);
00150            free_dmatrix(Snowelevday,0,noldelevbins,0,daysiy);
00151        }
00152 
00153       /*------------------------------------------------------------------------
00154        *  Allocate memory for Altitude bins, area bins, snow bins, and T array
00155        *------------------------------------------------------------------------*/
00156        if( ( elevbins = (double *) calloc( nelevbins, sizeof(double))) == NULL ||
00157              ( distbins =    (int *) calloc( nelevbins, sizeof(int)))    == NULL ||
00158              ( areabins = (double *) calloc( nelevbins, sizeof(double))) == NULL ) {
00159                fprintf(stderr," PlumeArray ERROR: memory allocation failed \n");
00160                fprintf(stderr,"    failed on elevbins, distbins, or areabins \n");
00161                exit(1);
00162        }
00163        Televday    = dmatrix(0,nelevbins,0,daysiy);
00164        Snowelevday = dmatrix(0,nelevbins,0,daysiy);
00165 
00166       /*-------------------------------
00167        *  Calculate the Altitude bins
00168        *-------------------------------*/
00169        for (kk = 0; kk<nelevbins; kk++){
00170                elevbins[kk] = 0 + kk*elevbinsize;
00171        }
00172        
00173       /*-----------------------------------------------
00174        *  Create the area/elevation relationship
00175        *  Use digitized data and linear interpolation
00176        *-----------------------------------------------*/
00177 
00178          /*----------------------------
00179           *  Find the cumulative area
00180           *----------------------------*/
00181        cumarea[0] = hypsarea[ep][0];
00182            for (kk=1; kk<nelevbins-1; kk++) {
00183                tst = 0;
00184                for (ii=1; ii<nhypts[ep]; ii++)
00185                    if (elevbins[kk]>hypselev[ep][ii-1] && elevbins[kk]<=hypselev[ep][ii]) {
00186                        cumarea[kk] = hypsarea[ep][ii-1]                         \
00187                              + ( (elevbins[kk]-hypselev[ep][ii-1])      \
00188                          / (hypselev[ep][ii]-hypselev[ep][ii-1]) )      \
00189                          * (hypsarea[ep][ii]-hypsarea[ep][ii-1]);
00190                        tst = 1;
00191                    }
00192                if( tst == 0 ) {
00193                    fprintf(stderr," HydroHypsom ERROR: \n" );
00194                    fprintf(stderr,"\t Hypsometric elevation not interpolated. \n");
00195                    fprintf(stderr,"\t kk = %d, elevbins[kk] = %f \n", kk, elevbins[kk] );
00196                    err++;
00197                }
00198            }
00199        cumarea[nelevbins-1] = totalarea[ep];
00200        areabins[0] = cumarea[0];
00201        totarea = areabins[0];
00202        for( kk=1; kk<nelevbins; kk++ ) {
00203            areabins[kk] = cumarea[kk] - cumarea[kk-1];
00204                totarea += areabins[kk];
00205            }
00206 
00207       /*------------------------
00208        *  Check the total area
00209        *------------------------*/
00210        if (fabs(totarea - totalarea[ep]) > 0.001) {
00211            fprintf(stderr, " ERROR in HydroHypsom, totarea != totalarea in ep=%d \n", ep+1);
00212            fprintf(stderr, "\t totarea    = %f \n", totarea   );
00213            fprintf(stderr, "\t totalarea  = %f \n", totalarea[ep] );
00214            fprintf(stderr, "\t totarea-totalarea  = %f \n", totarea-totalarea[ep] );
00215            err = 1;
00216        }
00217 
00218       /*-----------------------------------------------------------
00219        *  Create the distance relationship; distbins (days).
00220        *  This scales the total distance by the area relationship
00221        *  and allows an approximation of flow duration from each
00222        *  altitude bin to give a first approximation of routing.
00223        *-----------------------------------------------------------*/
00224        dumdbl = 0.0;
00225        for (kk=0; kk<nelevbins; kk++) {
00226            dumdbl += areabins[kk];
00227            distbins[kk] = (int)((basinlength[ep]/(avgvel[ep]*dTOs))*(dumdbl/totalarea[ep]));
00228        }
00229 
00230       /*-----------------------------------------------------------
00231        *  Are there enough overflow days (maxday) for the basin ?
00232        *-----------------------------------------------------------*/
00233        if (distbins[nelevbins-1]+daysiy > maxday) {
00234            fprintf(stderr, " ERROR in HydroHypsom: \n");
00235            fprintf(stderr, "\t The number of overflow days/year is too small, \n" );
00236            fprintf(stderr, "\t or the length relationship for the basin failed.\n" );
00237            fprintf(stderr, "\t\t distbins[nelevbins-1]+daysiy > maxday \n" );
00238            fprintf(stderr, "\t\t maxday = %d \n", maxday );
00239            fprintf(stderr, "\t\t daysiy = %d \n", daysiy );
00240            fprintf(stderr, "\t\t distbins[nelevbins-1] = %d \n", distbins[nelevbins-1] );
00241            err = 1;
00242        }
00243 
00244 #ifdef DBG
00245     fprintf(fidlog, " HydroHypsom: \t totarea    = %f (km^2) \n", totarea/1e6   );
00246     fprintf(fidlog, " \t\t totalarea  = %f (km^2) \n\n", totalarea[ep]/1e6 );
00247 #endif
00248     }   /* endif create Hypsometric Info */
00249 }       /* end the flood exceedance check */
00250 
00251 /*-----------------------------
00252  *  Initialize the Snow array
00253  *-----------------------------*/
00254 for( kk=0; kk<nelevbins; kk++ )
00255     for( ii=0; ii<daysiy; ii++ )
00256         Snowelevday[kk][ii] = 0.0;
00257 
00258 /*---------------------------------------------
00259  *  Fill in the snow left over from last year
00260  *---------------------------------------------*/
00261 for( kk=0; kk<nelevbins; kk++ )
00262     Snowelevday[kk][0] = Snowcarry[kk]/areabins[kk];
00263 
00264 /*---------------------------------------------------
00265  *  Set the FLAindex for each day to 9999
00266  *  This indicates no freezing in basin on that day
00267  *---------------------------------------------------*/
00268 for (ii=0; ii<daysiy; ii++)
00269     FLAindex[ii] = FLAflag;
00270 
00271 /*-----------------------------------------------------------------
00272  *  For each day of the year calculate the T in each altitude bin
00273  *  Televday(nelevbins,365days)
00274  *  Also Flag the FLA, the lowest bin with freezing temperatures
00275  *-----------------------------------------------------------------*/
00276 for( kk = 0; kk<nelevbins; kk++ )
00277     for( ii = 0; ii<daysiy; ii++ ) {
00278         Televday[kk][ii] = Tdaily[ii] - lapserate[ep]*elevbins[kk];
00279        
00280         if( Televday[kk][ii] < 0.0 && FLAindex[ii] == FLAflag ){
00281             FLAindex[ii] = kk;
00282         }
00283     }
00284 
00285 #ifdef DBG
00286   /*-----------------------------------
00287    *  Print out Televday for checking
00288    *-----------------------------------*/
00289     if( tblstart[ep] <= yr && yr <= tblend[ep] ) {
00290         if( (fid = fopen("hydro.tt","a+")) == NULL) {
00291             printf("  HydroHypsom ERROR: Unable to open the temperature file hydro.tt \n");
00292             printf("     non-fatal error, continuing. \n\n");
00293         }
00294         else {
00295             for(kk=0; kk<nelevbins; kk++) {
00296                 fprintf( fid,"%%\n%%\n%%HydroHypsom: Daily predicted temperatures for epoch %d, year %d, elevation %f \n%%\n", ep+1, yr, elevbins[kk] );
00297                 fprintf( fid,"%%Elev \t Day \t Temperature \n", yr );
00298                 fprintf( fid,"%%---- \t --- \t ----------- \n", yr );
00299                 for(ii=0; ii<daysiy; ii++ )
00300                     fprintf( fid,"%7.1f \t %d \t %f \n", elevbins[kk], ii+1, Televday[kk][ii]);
00301             }
00302             fclose(fid);
00303         }
00304     }
00305 #endif
00306 
00307 #ifdef DBG
00308   /*--------------------------------------------
00309    *  Print out Hypsometric Areas for checking
00310    *--------------------------------------------*/
00311     if( tblstart[ep] <= yr && yr <= tblend[ep] ) {
00312         if( (fid = fopen("hydro.hp","a+")) == NULL) {
00313             printf("  HydroHypsom ERROR: Unable to open the hypsometry file hydro.hp \n");
00314             printf("     non-fatal error, continuing. \n\n");
00315         }
00316         else {
00317             fprintf( fid,"\n\nHydroHypsom: Area bins for epoch %d, year %d \n\n", ep+1, yr );
00318             fprintf( fid,"   Elev \t    Area \t Time-Distance \n" );
00319             fprintf( fid,"   ---- \t  --------- \t ------------ \n" );
00320             for(kk=0; kk<nelevbins; kk++)
00321                fprintf( fid,"%7.1f \t %e \t %d \n", elevbins[kk], areabins[kk], distbins[kk] );
00322             fprintf( fid,"\nTotal Area = \t %e, Basin length = %e, AvgVel = %f \n", totalarea[ep], basinlength[ep], avgvel[ep] );
00323             fclose(fid);
00324         }
00325     }
00326 #endif
00327 
00328 freematrix1D( (void*)cumarea);
00329 return(err);
00330 }  /* end of HydroHypsom */

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