ADMB Documentation  11.6rc.3352
 All Classes Files Functions Variables Typedefs Friends Defines
newdar.cpp
Go to the documentation of this file.
00001 /*
00002  * $Id$
00003  *
00004  * Author: David Fournier
00005  * Copyright (c) 2008-2012 Regents of the University of California
00006  */
00007 #include "fvar.hpp"
00008 #ifdef __ZTC__
00009   #include <iostream.hpp>
00010 #endif
00011 
00012 #ifdef __TURBOC__
00013   #pragma hdrstop
00014   #pragma options -h-
00015   #include <iostream.h>
00016 #endif
00017 #include <stdlib.h>
00018 #ifndef OPT_LIB
00019   #include <cassert>
00020 #endif
00021 
00022 int num_free_obj=0;
00023 int ad_kill_flag=0;
00024 
00028 arr_link::arr_link()
00029 {
00030   prev = NULL;
00031   next = NULL;
00032   free_prev = NULL;
00033   free_next = NULL;
00034   status = 0;
00035   // free_list_status=0;
00036   size = 0;
00037   offset = 0;
00038 }
00039 
00044 void arr_free_remove(arr_link * tmp)
00045 {
00046   num_free_obj--;
00047   // if this is the last free object reset list pointer
00048   if (!tmp->free_next)
00049   {
00050     gradient_structure::ARR_LIST1->free_last=tmp->free_prev;
00051   }
00052   // This routine removes the link pointed to by tmp
00053   if (tmp->free_next)  // Make the one after it point to tmp->prev
00054   {
00055     tmp->free_next->free_prev = tmp->free_prev;
00056   }
00057 
00058   if (tmp->free_prev)  // Make the one before it point to tmp->next
00059   {
00060     tmp->free_prev->free_next = tmp->free_next;
00061   }
00062 }
00063 
00068 void arr_free_add(arr_link * tmp)
00069 {
00070   num_free_obj++;
00071   // This routine adds the link pointed to by tmp to  the end of the free list
00072   tmp->free_prev = gradient_structure::ARR_LIST1->free_last;
00073   gradient_structure::ARR_LIST1->free_last=tmp;
00074   tmp->free_next = NULL;
00075   if (tmp->free_prev) tmp->free_prev->free_next = tmp;
00076 }
00077 
00082 double_and_int * arr_new(unsigned int sz)
00083 {
00084   if (!gradient_structure::instances)
00085   {
00086     cerr << "Error -- you are trying to create a dvar_vector object"
00087             " when there is " << endl << "no object of type"
00088             " gradient_structure in scope " << endl;
00089     ad_exit(1);
00090   }
00091 
00092   char * temp_ptr;
00093 
00094   // this routine allocated a block of memory of sizeof(double)*sz bytes
00095   // for the gradients of an array or matrix of prevariables
00096 
00097   arr_link * tmp = gradient_structure::ARR_LIST1->free_last;
00098 
00099   unsigned int bytes_needed = sz * (unsigned int)sizeof(double_and_int);
00100 
00101 #ifdef DIAG
00102   int ss=0;
00103   if (ss)
00104   {
00105     double_and_int* tt=0;
00106     return tt;
00107   }
00108 #endif
00109 
00110   while (tmp)
00111   {
00112     if (tmp->size >= bytes_needed)
00113     {
00114       // if the free block within 20 bytes of the size you want
00115       // simply mark it occupied and return it
00116 
00117       if (tmp->size <= bytes_needed + 50)
00118       {
00119         tmp->status = 1;
00120         // remove tmp from the free list
00121         arr_free_remove(tmp);
00122 
00123         temp_ptr = gradient_structure::ARRAY_MEMBLOCK_BASE + tmp->offset;
00124 
00125         //put the address tmp into the location pointed to by temp_ptr
00126         (* (arr_link **) (temp_ptr)) = tmp;
00127 
00128         return (double_and_int*)temp_ptr;
00129       }
00130       else
00131       {
00132         // otherwise split up this memory block and return
00133         // the part you need
00134 
00135         arr_link* tmp1 = new arr_link;
00136         gradient_structure::ARR_LIST1->number_arr_links += 1;
00137 
00138         // put the new link tmp1-> into the list BEFORE tmp->
00139 
00140         tmp1->prev=tmp->prev;
00141 
00142         if(tmp1->prev)
00143         {
00144           tmp1->prev->next=tmp1;
00145         }
00146 
00147         tmp1->next=tmp;
00148         tmp->prev=tmp1;
00149 
00150         // get the size of the new link and mark it free
00151 
00152         tmp1->size=bytes_needed;
00153         tmp1->status=1;
00154         tmp1->offset=tmp->offset;
00155 
00156         tmp->offset+=bytes_needed;
00157         tmp->size-=bytes_needed;
00158 
00159         temp_ptr = gradient_structure::ARRAY_MEMBLOCK_BASE + tmp1->offset;
00160 
00161    //put the address pointed to by tmp1 into the location pointed to by temp_ptr
00162         (*(arr_link**)(temp_ptr)) = tmp1;
00163 
00164         return (double_and_int*)temp_ptr;
00165       }
00166     }
00167     tmp=tmp->free_prev;
00168   }
00169   // couldn't find a free block large enough
00170   // make a new block
00171 
00172   tmp = new arr_link;
00173   if (tmp==0)
00174   {
00175     cerr << "Error allocating new arr_link" << endl;
00176     ad_exit(1);
00177   }
00178 
00179   gradient_structure::ARR_LIST1->number_arr_links  += 1;
00180 
00181   tmp->prev = gradient_structure::ARR_LIST1->last; // the new block point back
00182                                                  // at the previous last block
00183 
00184   if (gradient_structure::ARR_LIST1->last)
00185   {
00186     gradient_structure::ARR_LIST1->last->next = tmp; // the previous last
00187                                                   // block point forward to tmp
00188   }
00189   gradient_structure::ARR_LIST1->last = tmp;        // tmp is the new last block
00190 
00191   tmp->next = 0;
00192 
00193   tmp->status = 1;
00194 
00195   tmp->offset = gradient_structure::ARR_LIST1->last_offset;
00196 
00197   gradient_structure::ARR_LIST1->last_offset += bytes_needed;
00198 
00199   if (gradient_structure::ARR_LIST1->last_offset>
00200     (unsigned int)gradient_structure::max_last_offset )
00201   {
00202     gradient_structure::max_last_offset=
00203       gradient_structure::ARR_LIST1->last_offset;
00204   }
00205 
00206   if (gradient_structure::ARR_LIST1->last_offset >
00207     gradient_structure::ARR_LIST1->max_last_offset)
00208   {
00209     gradient_structure::ARR_LIST1->max_last_offset =
00210      gradient_structure::ARR_LIST1->last_offset;
00211   }
00212 
00213   if( gradient_structure::ARR_LIST1->last_offset >=
00214     gradient_structure::ARRAY_MEMBLOCK_SIZE)
00215   {
00216     cout << gradient_structure::ARR_LIST1->last_offset <<">="
00217          <<  gradient_structure::ARRAY_MEMBLOCK_SIZE <<"\n";
00218     cout << " No memory for dvar_vectors\n"
00219          << " Need to increase ARRAY_MEMBLOCK_SIZE parameter\n"
00220       "In gradient_structure declaration\n";
00221     //throw gradient_structure::arrmemblerr();
00222     ad_exit(1);
00223   }
00224 
00225   tmp->size = bytes_needed;
00226 
00227   temp_ptr = gradient_structure::ARRAY_MEMBLOCK_BASE + tmp->offset;
00228 
00229   (*(arr_link **) (temp_ptr )) = tmp; //put the address
00230                                    // tmp into the location pointed to
00231                                    //by temp_ptr
00232 
00233 //  return  (double_and_int *) (temp_ptr+sizeof(double_and_int));
00234   return  (double_and_int *) (temp_ptr);
00235 }
00236 
00241 void arr_free(double_and_int * varr)
00242 {
00243   // This routines frees up a memory block and
00244   // consolidates the free blocks if possible
00245   //cout<< "calling arr_free\n";
00246   char * temp_ptr;
00247   arr_link * ptr;
00248 
00249   temp_ptr = (char *) varr;
00250 
00251   //temp=sizeof(double_and_int);
00252 //  ptr = *(arr_link **) (temp_ptr-temp);
00253   ptr = *(arr_link **) (temp_ptr);
00254 
00255   //mark this block free
00256 
00257   ptr->status = 0;
00258  // cout <<"Marking arr_link with adress  "<<farptr_tolong(ptr)<<"free\n";
00259 
00260   // if there is a block after this add this one to the free list
00261   if (ptr->next) arr_free_add(ptr);
00262 
00263   if (!ptr->next)  // Is this the last link?
00264   {
00265     // Check to see if ptr->prev is free and should be deleted as well
00266     // ... but first check to see if ptr is first block in list
00267     // which will be indicated by ptr->prev being a NULL pointer
00268     if (ptr->prev && !ptr->prev->status)
00269     {
00270       // delete ptr->prev
00271       gradient_structure::ARR_LIST1->last = ptr->prev->prev;
00272       //if (gradient_structure::ARR_LIST1->last ==0)
00273        // cout << "gradient_structure::ARR_LIST1->last =0 " << endl;
00274 
00275       gradient_structure::ARR_LIST1->last_offset -= ptr->size + ptr->prev->size;
00276       arr_free_remove(ptr->prev);
00277       arr_remove(&(ptr->prev));
00278     }
00279     else
00280     {
00281       gradient_structure::ARR_LIST1->last = ptr->prev;
00282       //if (gradient_structure::ARR_LIST1->last ==0)
00283        // cout << "gradient_structure::ARR_LIST1->last =0 " << endl;
00284       gradient_structure::ARR_LIST1->last_offset -= ptr->size;
00285     }
00286     arr_remove(&ptr);
00287   }
00288   else
00289   {
00290      // There is another link after this one?
00291 
00292     if (!ptr->next->status) // If yes is it free?
00293     {
00294       // add its memory capacity to the present one and delete it
00295 
00296       ptr->size += ptr->next->size;
00297 
00298       arr_free_remove(ptr->next);
00299       arr_remove(&ptr->next);
00300     }
00301 
00302     if (ptr->prev)  // Is there another link before this one?
00303     {
00304       if (!ptr->prev->status) // If yes is it free?
00305       {
00306         // we will keep ptr->prev and add ptr to it
00307 
00308         ptr->prev->size += ptr->size;
00309         arr_free_remove(ptr);
00310         arr_remove(&ptr);
00311       }
00312     }
00313   }
00314 }
00315 
00320 void check_derivative_values(const char * _s)
00321 {
00322   char * s = (char *) _s;
00323   //char label[20];
00324   save_identifier_string(s);
00325   gradient_structure::GRAD_STACK1->
00326     set_gradient_stack(df_check_derivative_values);
00327 }
00328 
00333 void check_derivative_values(const char * _s,int i)
00334 {
00335   char * s = (char *) _s;
00336   //char label[20];
00337   save_identifier_string(s);
00338   save_int_value(i);
00339   gradient_structure::GRAD_STACK1->
00340     set_gradient_stack(df_check_derivative_values_indexed);
00341 }
00342 
00343 void df_print_identifier_string(void);
00344 
00349 void insert_identifier_string(const char * _s)
00350 {
00351   char * s = (char *) _s;
00352   save_identifier_string(s);
00353   gradient_structure::GRAD_STACK1->
00354     set_gradient_stack(df_print_identifier_string);
00355 }
00356 
00361 void check_derivative_values_break(const char * _s,int i,int b)
00362 {
00363   char * s = (char *) _s;
00364   //char label[20];
00365   save_identifier_string(s);
00366   save_int_value(i);
00367   save_int_value(b);
00368   gradient_structure::GRAD_STACK1->
00369     set_gradient_stack(df_check_derivative_values_indexed_break);
00370 }
00371 
00376 void df_check_derivative_values(void)
00377 {
00378   //char label[20];
00379   adstring str=get_string_marker();
00380   double * temp_ptr = gradient_structure::get_ARRAY_MEMBLOCK_BASE();
00381   unsigned long int max_last_offset =
00382     gradient_structure::ARR_LIST1->get_max_last_offset();
00383   size_t size = sizeof(double_and_int);
00384 
00385   int icount=0;
00386   int exit_flag=0;
00387   cout << str << endl;
00388   unsigned int i;
00389   for (i=0 ; i< (max_last_offset/size) ; i++ )
00390   {
00391     if (fabs(temp_ptr[i])>1.e+8)
00392     {
00393       if (ad_kill_flag) exit_flag=1;
00394       icount++;
00395       cout << i << " " << temp_ptr[i] << endl;
00396       if (icount>10)
00397       {
00398          break;
00399       }
00400     }
00401   }
00402 
00403   icount=0;
00404   for (i=0; i<gradient_structure::GRAD_LIST->nlinks; i++)
00405   {
00406     if (* (double*) (gradient_structure::GRAD_LIST->dlink_addresses[i])
00407       > 1.e+8)
00408     {
00409       icount++;
00410        cout << "dlist " << i << " " << setscientific() <<
00411          * (double*) (gradient_structure::GRAD_LIST->dlink_addresses[i])
00412           << endl;
00413       if (icount>10)
00414       {
00415         if (ad_kill_flag) exit_flag=1;
00416         break;
00417       }
00418     }
00419   }
00420   if (exit_flag) exit(1);
00421 }
00422 
00423 //extern  ofstream gradlog;
00424 
00429 void df_print_identifier_string(void)
00430 {
00431   adstring str=get_string_marker();
00432   cout << "GS = " << str << endl;
00433   //gradlog << "GS = " << str << endl;
00434 }
00435 
00440 void df_check_derivative_values_indexed(void)
00441 {
00442   //char label[20];
00443   int index=restore_int_value();
00444   adstring str=get_string_marker();
00445   double * temp_ptr = gradient_structure::get_ARRAY_MEMBLOCK_BASE();
00446   unsigned long int max_last_offset =
00447     gradient_structure::ARR_LIST1->get_max_last_offset();
00448   size_t size = sizeof(double_and_int);
00449 
00450   int icount=0;
00451   int exit_flag=0;
00452   cout << str << " index = " << index << endl;
00453   unsigned int i;
00454   for (i=0 ; i< (max_last_offset/size) ; i++ )
00455   {
00456     if (fabs(temp_ptr[i])>1.e+8)
00457     {
00458       if (ad_kill_flag) exit_flag=1;
00459       icount++;
00460       cout << i << " " << setscientific() << temp_ptr[i] << endl;
00461       if (icount>10) break;
00462     }
00463   }
00464 
00465   icount=0;
00466   for (i=0; i<gradient_structure::GRAD_LIST->nlinks; i++)
00467   {
00468     if (* (double*) (gradient_structure::GRAD_LIST->dlink_addresses[i])
00469       > 1.e+8)
00470     {
00471       icount++;
00472       if (ad_kill_flag) exit_flag=1;
00473        cout << "dlist " << i << " " << setscientific() <<
00474          * (double*) (gradient_structure::GRAD_LIST->dlink_addresses[i])
00475           << endl;
00476       if (icount>10)
00477       {
00478          break;
00479       }
00480     }
00481   }
00482   if (exit_flag) exit(1);
00483 }
00484 
00489 void df_check_derivative_values_indexed_break(void)
00490 {
00491   //char label[20];
00492   int b=restore_int_value();
00493   int index=restore_int_value();
00494   adstring str=get_string_marker();
00495   double * temp_ptr = gradient_structure::get_ARRAY_MEMBLOCK_BASE();
00496   unsigned long int max_last_offset =
00497     gradient_structure::ARR_LIST1->get_max_last_offset();
00498   size_t size = sizeof(double_and_int);
00499 
00500   if (index<=b)
00501   {
00502     cout << "break condition" << endl;
00503   }
00504   int icount=0;
00505   int exit_flag=0;
00506   cout << str << " index = " << index << endl;
00507   unsigned int i;
00508   for (i=0 ; i< (max_last_offset/size) ; i++ )
00509   {
00510     if (fabs(temp_ptr[i])>1.e+8)
00511     {
00512       if (ad_kill_flag) exit_flag=1;
00513       icount++;
00514       cout << i << " " << temp_ptr[i] << endl;
00515       if (icount>10) break;
00516     }
00517   }
00518 
00519   icount=0;
00520   for (i=0; i<gradient_structure::GRAD_LIST->nlinks; i++)
00521   {
00522     if (* (double*) (gradient_structure::GRAD_LIST->dlink_addresses[i])
00523       > 1.e+8)
00524     {
00525       icount++;
00526       if (ad_kill_flag) exit_flag=1;
00527        cout << "dlist " << i << " " <<
00528          * (double*) (gradient_structure::GRAD_LIST->dlink_addresses[i])
00529           << endl;
00530       if (icount>10)
00531       {
00532          break;
00533       }
00534     }
00535   }
00536   if (exit_flag) exit(1);
00537 }
00538 
00542 void arr_remove(arr_link** pptr)
00543 {
00544 #ifndef OPT_LIB
00545   assert(pptr != NULL);
00546 #endif
00547 
00548   arr_link* tmp = *pptr;
00549 
00550   if (tmp == NULL)
00551   {
00552     cout <<" Error -- tried to delete NULL arr_link in arr_remove\n";
00553     ad_exit(23);
00554   }
00555   else
00556   {
00557     // This routine removes the link pointed to by tmp
00558     if (tmp->next)  // Make the one after it point to tmp->prev
00559     {
00560       tmp->next->prev = tmp->prev;
00561     }
00562     if (tmp->prev)  // Make the one before it point to tmp->next
00563     {
00564       tmp->prev->next = tmp->next;
00565     }
00566 
00567 #ifdef DIAG
00568     cout << "Deleting an arr_link with adress  "
00569   #ifdef __ZTC__
00570          << _farptr_tolong(tmp)
00571   #else
00572          << farptr_tolong(tmp)
00573   #endif
00574          << "\n";
00575 #endif
00576 
00577     delete tmp;
00578     tmp = NULL;
00579   }
00580   gradient_structure::ARR_LIST1->number_arr_links -= 1;
00581   //cout <<  "after delete number_arr_links = "
00582   //<<  gradient_structure::ARR_LIST1->number_arr_links <<"\n";
00583 }