ADMB Documentation  11.5.3287
 All Classes Files Functions Variables Typedefs Friends Defines
gradstrc.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  */
00011 #ifndef _MSC_VER
00012   #include <unistd.h>
00013 #endif
00014 #include "fvar.hpp"
00015 
00016 //#define THREAD_SAFE
00017 
00018 #if defined(THREAD_SAFE)
00019   pthread_mutex_t mutex_return_arrays = PTHREAD_MUTEX_INITIALIZER;
00020 #endif
00021 
00022 void null_ptr_err_message(void);
00023 
00024 #include <string.h>
00025 
00026 #if defined(__TURBOC__)
00027   #pragma hdrstop
00028   #include <iostream.h>
00029   #include <alloc.h>
00030 #endif
00031 
00032 #include <stdlib.h>
00033 
00034 #ifdef __ZTC__
00035   #include <iostream.hpp>
00036   int _cdecl farfree(void _far *ptr);
00037   void _far * _cdecl farmalloc(unsigned long size);
00038 #endif
00039 
00040 #ifndef OPT_LIB
00041   #include <cassert>
00042 #endif
00043 
00044 extern ofstream clogf;
00045 #ifndef __SUNPRO_CC
00046 typedef int (* fptr) (const char * format, ...) ;
00047 #endif
00048 
00049 //void adwait(double);
00050 fptr ad_printf = printf;
00051 extern "C"{
00052   exitptr ad_exit=&exit;
00053 
00054   void spdll_exit(int ierr)
00055   {
00056     if (ad_printf) (*ad_printf) (" Exception -- error code %d\n",ierr);
00057     if (ad_printf) (*ad_printf) (" Pause");
00058     //adwait(4.0);
00059 #if defined(USE_EXCEPTIONS)
00060     throw spdll_exception(ierr);
00061 #endif
00062   }
00063 }
00064 
00065 // *************************************************************
00066 // *************************************************************
00067 int ctlc_flag = 0;
00068 int gradient_structure::Hybrid_bounded_flag=0;
00069 DF_FILE * gradient_structure::fp=NULL;
00070 char gradient_structure::cmpdif_file_name[61];
00071 //char gradient_structure::var_store_file_name[61];
00072 int gradient_structure::NUM_RETURN_ARRAYS = 25;
00073 double * gradient_structure::hessian_ptr=NULL;
00074 int gradient_structure::NUM_DEPENDENT_VARIABLES = 2000;
00075 #if (defined(NO_DERIVS))
00076   int gradient_structure::no_derivatives = 0;
00077 #endif
00078 unsigned long int gradient_structure::max_last_offset = 0;
00079 long int gradient_structure::NVAR = 0;
00080 size_t gradient_structure::TOTAL_BYTES = 0;
00081 size_t gradient_structure::PREVIOUS_TOTAL_BYTES = 0;
00082 long int gradient_structure::USE_FOR_HESSIAN = 0;
00083 dvariable** gradient_structure::RETURN_ARRAYS = NULL;
00084 int gradient_structure::RETURN_ARRAYS_PTR;
00085 dvariable ** gradient_structure::RETURN_PTR_CONTAINER = NULL;
00086 int gradient_structure::RETURN_ARRAYS_SIZE = 70;
00087 int gradient_structure::instances = 0;
00088 //int gradient_structure::RETURN_INDEX = 0;
00089 //dvariable * gradient_structure::FRETURN = NULL;
00090 dvariable * gradient_structure::MAX_RETURN = NULL;
00091 dvariable * gradient_structure::MIN_RETURN = NULL;
00092 dvariable * gradient_structure::RETURN_PTR = NULL;
00093 #ifdef __BORLANDC__
00094 long int gradient_structure::GRADSTACK_BUFFER_SIZE = 4000000L;
00095 long int gradient_structure::CMPDIF_BUFFER_SIZE=140000000L;
00096 #else
00097 size_t gradient_structure::GRADSTACK_BUFFER_SIZE = 4000000L;
00098 size_t gradient_structure::CMPDIF_BUFFER_SIZE=140000000L;
00099 #endif
00100 
00101 dependent_variables_information * gradient_structure::DEPVARS_INFO=NULL;
00102 
00103 int gradient_structure::save_var_flag=0;
00104 int gradient_structure::save_var_file_flag=0;
00105 
00106 // should be int gradfile_handle;
00107 //int gradient_structure::_GRADFILE_PTR = NULL;
00108 
00109 // should be int gradfile_handle;
00110 //int gradient_structure::_GRADFILE_PTR1 = NULL;
00111 
00112 // should be int gradfile_handle;
00113 //int gradient_structure::_GRADFILE_PTR2 = NULL;
00114 
00115 // should be int gradfile_handle;
00116 //int gradient_structure::_VARSSAV_PTR = 0;
00117 
00118 unsigned int gradient_structure::MAX_NVAR_OFFSET = 5000;
00119 unsigned long gradient_structure::ARRAY_MEMBLOCK_SIZE = 0L; //js
00120 dlist * gradient_structure::GRAD_LIST;
00121 grad_stack * gradient_structure::GRAD_STACK1;
00122 indvar_offset_list * gradient_structure::INDVAR_LIST = NULL;
00123 arr_list * gradient_structure::ARR_LIST1 = NULL;
00124 arr_list * gradient_structure::ARR_FREE_LIST1 = NULL;
00125 unsigned int gradient_structure::MAX_DLINKS = 5000;
00126 
00127 // note: ARRAY_MEMBLOCK stuff is set by tpl2cpp for historical reasons
00128 //       those settings could be moved into this file in the future
00129 //       - Ian Taylor 5/3/2012
00130 
00131 //unsigned long int gradient_structure::ARRAY_MEMBLOCK_BASE = 0L;
00132 humungous_pointer gradient_structure::ARRAY_MEMBLOCK_BASE;
00133 humungous_pointer gradient_structure::ARRAY_MEMBLOCK_SAVE;
00134 #ifdef DIAG
00135 long int farptr_tolong(void *) ;
00136 #endif
00137 void memory_allocate_error(const char * s, void * ptr);
00138 
00143 size_t gradient_structure::NUM_GRADSTACK_BYTES_WRITTEN(void)
00144 {
00145   size_t tmp = TOTAL_BYTES - PREVIOUS_TOTAL_BYTES;
00146   PREVIOUS_TOTAL_BYTES = TOTAL_BYTES;
00147   return tmp;
00148 }
00149 
00154 char lastchar(char* s)
00155 {
00156   size_t k = strlen(s);
00157   return s[k - 1];
00158 }
00159 
00164 size_t gradient_structure::totalbytes(void)
00165 {
00166   return TOTAL_BYTES;
00167 }
00168 
00169  void fill_ad_random_part(void);
00170  extern char ad_random_part[6];
00171 
00175 void cleanup_temporary_files()
00176 {
00177    if (gradient_structure::fp)
00178    {
00179      delete gradient_structure::fp;
00180      gradient_structure::fp=NULL;
00181    }
00182    if (gradient_structure::GRAD_STACK1)
00183    {
00184      if (close(gradient_structure::GRAD_STACK1->_GRADFILE_PTR1))
00185      {
00186        cerr << "Error closing file "
00187        << gradient_structure::GRAD_STACK1->gradfile_name1 << "\n";
00188      }
00189      if (close(gradient_structure::GRAD_STACK1->_GRADFILE_PTR2))
00190      {
00191        cerr << "Error closing file "
00192        << gradient_structure::GRAD_STACK1->gradfile_name2 << "\n";
00193      }
00194      if (close( gradient_structure::GRAD_STACK1->_VARSSAV_PTR))
00195      {
00196        cerr << "Error closing file "
00197        << gradient_structure::GRAD_STACK1->var_store_file_name << "\n";
00198      }
00199    }
00200 #if !defined (_MSC_VER)
00201    if (gradient_structure::GRAD_STACK1)
00202    {
00203      unlink(gradient_structure::GRAD_STACK1->gradfile_name1);
00204      unlink(gradient_structure::GRAD_STACK1->gradfile_name2);
00205      unlink(gradient_structure::GRAD_STACK1->var_store_file_name);
00206      //unlink(gradient_structure::cmpdif_file_name);
00207    }
00208 #else
00209    if (gradient_structure::GRAD_STACK1)
00210    {
00211      remove(gradient_structure::GRAD_STACK1->gradfile_name1);
00212      remove(gradient_structure::GRAD_STACK1->gradfile_name2);
00213      remove(gradient_structure::GRAD_STACK1->var_store_file_name);
00214      //cout << remove(gradient_structure::cmpdif_file_name);
00215    }
00216 #endif
00217 }
00218 
00223 void allocate_dvariable_space()
00224 {
00225   int on,nopt = 0;
00226   if ( (on=option_match(ad_comm::argc,ad_comm::argv,"-mdl",nopt))>-1)
00227   {
00228     if (nopt ==1)
00229     {
00230       const int i = atoi(ad_comm::argv[on+1]);
00231       if (i > 0)
00232       {
00233         gradient_structure::MAX_DLINKS = (unsigned int)i;
00234       }
00235     }
00236     else
00237     {
00238       cerr << "Wrong number of options to -mdl -- must be 1"
00239         " you have " << nopt << endl;
00240       ad_exit(1);
00241     }
00242   }
00243   unsigned int numlinks=gradient_structure::MAX_DLINKS;
00244   //cout << sizeof(dlink) << endl;
00245 
00246 #ifndef OPT_LIB
00247   //cerr << "sizeof(char) is not equal 1) --"
00248   // " need to modify allocate_dvariable_space in gradstrc.cpp" << endl;
00249   assert(sizeof(char) == 1);
00250 
00251   //cerr << "sizeof(dlink) is greater than 2*sizeof(double) --"
00252   // " need to modify allocate_dvariable_space in gradstrc.cpp" << endl;
00253   assert(sizeof(dlink) == 2 * sizeof(double));
00254 #endif
00255   const size_t size = 2 * sizeof(double) * (numlinks + 1);
00256   char* tmp1 = (char*)malloc(size * sizeof(char));
00257   if (!tmp1)
00258   {
00259     cerr << "Error[" << __FILE__ << ":" << __LINE__
00260          << "]: unable to allocate memory.\n";
00261     ad_exit(1);
00262   }
00263   else
00264   {
00265     dlink * dl=(dlink*)tmp1;
00266     tmp1+=2*sizeof(double);
00267     dl->prev=NULL;
00268     dlink * prev=dl;
00269     int& nlinks=(int&)gradient_structure::GRAD_LIST->nlinks;
00270     gradient_structure::GRAD_LIST->dlink_addresses[nlinks++]=dl;
00271     for (unsigned int i=1;i<=numlinks;i++)
00272     {
00273       dl=(dlink*)tmp1;
00274       dl->prev=prev;
00275       prev=dl;
00276       tmp1+=2*sizeof(double);
00277 
00278       gradient_structure::GRAD_LIST->dlink_addresses[nlinks++]=dl;
00279       // keep track of the links so you can zero them out
00280     }
00281     gradient_structure::GRAD_LIST->last=dl;
00282   }
00283 }
00284 
00288 gradient_structure::gradient_structure(long int _size):
00289   x(0)
00290 {
00291 #ifndef OPT_LIB
00292   assert(_size > 0);
00293 #endif
00294   gradient_structure::NVAR=0;
00295   atexit(cleanup_temporary_files);
00296   fill_ad_random_part();
00297 
00298   const unsigned long int size = (unsigned long int)_size;
00299 
00300   if (instances++ > 0)
00301   {
00302     cerr << "More than one gradient_structure object has been declared.\n"
00303          << "  Only one gradient_structure object can exist. Check the scope\n"
00304          << "  of the objects declared.\n";
00305     ad_exit(1);
00306   }
00307   gradient_structure::ARRAY_MEMBLOCK_SIZE=size; //js
00308 
00309   char* path = getenv("ADTMP1"); // NULL if not defined
00310   if (path != NULL && strlen(path) <= 45)
00311   {
00312 #ifdef __SUN__
00313     sprintf(&cmpdif_file_name[0],"%s/cmpdiff.%s", path,
00314             ad_random_part);
00315 #else
00316     if (lastchar(path)!='\\')
00317     {
00318       sprintf(&cmpdif_file_name[0],"%s\\cmpdiff.%s", path,
00319               ad_random_part);
00320     }
00321     else
00322     {
00323       sprintf(&cmpdif_file_name[0],"%scmpdiff.%s", path,
00324               ad_random_part);
00325     }
00326 #endif
00327   }
00328   else
00329   {
00330     sprintf(&cmpdif_file_name[0],"cmpdiff.%s",ad_random_part);
00331   }
00332   if (DEPVARS_INFO!= NULL)
00333   {
00334     cerr << "  0 Trying to allocate to a non NULL pointer in gradient"
00335             "_structure" << endl;
00336   }
00337   else
00338   {
00339     int on,nopt = 0;
00340     if ( (on=option_match(ad_comm::argc,ad_comm::argv,"-ndv",nopt))>-1)
00341     {
00342       if (!nopt)
00343       {
00344         cerr << "Usage -ndv option needs integer  -- ignored" << endl;
00345       }
00346       else
00347       {
00348         int jj=atoi(ad_comm::argv[on+1]);
00349         if (jj<=0)
00350         {
00351           cerr << "Usage -ndv option needs positive integer -- ignored"
00352                << endl;
00353         }
00354         else
00355         {
00356           NUM_DEPENDENT_VARIABLES=jj;
00357         }
00358       }
00359     }
00360     DEPVARS_INFO=new dependent_variables_information(NUM_DEPENDENT_VARIABLES);
00361     memory_allocate_error("DEPVARS_INFO", (void *) DEPVARS_INFO);
00362   }
00363 
00364   if (fp!= NULL)
00365   {
00366     cerr << "  0 Trying to allocate to a non NULL pointer in gradient"
00367             "_structure" << endl;
00368   }
00369   else
00370   {
00371     fp = new DF_FILE(CMPDIF_BUFFER_SIZE);
00372     memory_allocate_error("fp", (void *) fp);
00373   }
00374 
00375   // double_and_int * tmp;
00376 #ifdef DIAG
00377   cerr <<" In gradient_structure::gradient_structure()\n";
00378   cerr <<"  ARRAY_MEMBLOCK_SIZE = " << ARRAY_MEMBLOCK_SIZE << "\n";
00379 #endif
00380 
00381    if (GRAD_LIST!= NULL)
00382    {
00383      cerr << "Trying to allocate to a non NULL pointer in gradient structure\n";
00384    }
00385    else
00386    {
00387      GRAD_LIST = new dlist;
00388      memory_allocate_error("GRAD_LIST", (void *) GRAD_LIST);
00389    }
00390    if (ARR_LIST1!= NULL)
00391    {
00392      cerr << "Trying to allocate to a non NULL pointer in gradient structure\n";
00393    }
00394    else
00395    {
00396       ARR_LIST1 = new arr_list;
00397       memory_allocate_error("ARR_LIST1", (void *) ARR_LIST1);
00398    }
00399 
00400 /*
00401    if ( ARR_FREE_LIST1!= NULL)
00402    {
00403 cerr << "  2 Trying to allocate to a non NULL pointer in gradient structure \n";
00404    }
00405    else
00406    {
00407       ARR_FREE_LIST1 = new arr_list;
00408       memory_allocate_error("ARR_FREE_LIST1", (void *) ARR_FREE_LIST1);
00409    }
00410 */
00411 
00412    void* temp_ptr = NULL;
00413 #ifdef __ZTC__
00414    if ((temp_ptr = farmalloc(ARRAY_MEMBLOCK_SIZE)) == 0)
00415 #else
00416    if ((temp_ptr = (void*)malloc(ARRAY_MEMBLOCK_SIZE)) == 0)
00417 #endif
00418    {
00419      cerr << "insufficient memory to allocate space for ARRAY_MEMBLOCKa\n";
00420      ad_exit(1);
00421    }
00422 
00423   /*
00424    if (ARRAY_MEMBLOCK_BASE != NULL)
00425    {
00426 cerr << "Trying to allocate to a non NULL pointer in gradient structure \n";
00427    }
00428  */
00429 
00430    ARRAY_MEMBLOCK_BASE = temp_ptr;
00431 
00432    const size_t adjustment = (8 -((size_t)ARRAY_MEMBLOCK_BASE.ptr) % 8) % 8;
00433    ARRAY_MEMBLOCK_BASE.adjust(adjustment);
00434 
00435    if (GRAD_STACK1 != NULL)
00436    {
00437      cerr << "Trying to allocate to a non NULL pointer\n";
00438    }
00439    else
00440    {
00441      GRAD_STACK1 = new grad_stack;
00442      memory_allocate_error("GRAD_STACK1",GRAD_STACK1);
00443      gradient_structure::hessian_ptr= (double*) GRAD_STACK1->true_ptr_first;
00444    }
00445 #ifdef DIAG
00446    cout << "GRAD_STACK1= "<< farptr_tolong(GRAD_STACK1)<<"\n";
00447 #endif
00448 
00449    if (INDVAR_LIST!= NULL)
00450    {
00451       cerr <<
00452         "Trying to allocate to a non NULL pointer in gradient structure \n";
00453       ad_exit(1);
00454    }
00455    else
00456    {
00457      INDVAR_LIST = new indvar_offset_list;
00458      memory_allocate_error("INDVAR_LIST",INDVAR_LIST);
00459  // ****************************************************************
00460  // ****************************************************************
00461       int nopt=0;
00462       int on=0;
00463 
00464       if ( (on=option_match(ad_comm::argc,ad_comm::argv,"-mno",nopt))>-1)
00465       {
00466         if (nopt ==1)
00467         {
00468           const int i = atoi(ad_comm::argv[on+1]);
00469           MAX_NVAR_OFFSET = (unsigned int)i;
00470         }
00471         else
00472         {
00473           cerr << "Wrong number of options to -mno -- must be 1"
00474             " you have " << nopt << endl;
00475           ad_exit(1);
00476         }
00477       }
00478 
00479  // ****************************************************************
00480  // ****************************************************************
00481 
00482      INDVAR_LIST->address = new double * [ (size_t) MAX_NVAR_OFFSET];
00483      memory_allocate_error("INDVAR_LIST->address",INDVAR_LIST->address);
00484    }
00485 
00486    //allocate_dvariable_space();
00487 
00488   if ( RETURN_ARRAYS!= NULL)
00489   {
00490 cerr << "Trying to allocate to a non NULL pointer in gradient structure \n";
00491     ad_exit(1);
00492   }
00493   else
00494   {
00495     RETURN_ARRAYS = new dvariable*[NUM_RETURN_ARRAYS];
00496     memory_allocate_error("RETURN_ARRAYS",RETURN_ARRAYS);
00497 
00498     //allocate_dvariable_space();
00499     for (int i=0; i< NUM_RETURN_ARRAYS; i++)
00500     {
00501       RETURN_ARRAYS[i]=new dvariable[RETURN_ARRAYS_SIZE];
00502       memory_allocate_error("RETURN_ARRAYS[i]",RETURN_ARRAYS[i]);
00503     }
00504     RETURN_ARRAYS_PTR = 0;
00505     MIN_RETURN = RETURN_ARRAYS[RETURN_ARRAYS_PTR];
00506     MAX_RETURN = RETURN_ARRAYS[RETURN_ARRAYS_PTR]+RETURN_ARRAYS_SIZE-1;
00507     RETURN_PTR = MIN_RETURN;
00508   }
00509   //RETURN_INDEX = 0;
00510 
00511   RETURN_PTR_CONTAINER=new dvariable*[NUM_RETURN_ARRAYS];
00512   memory_allocate_error("RETURN_INDICES_CONTAINER",RETURN_PTR_CONTAINER);
00513 
00514   for (int i=0; i< NUM_RETURN_ARRAYS; i++)
00515   {
00516     RETURN_PTR_CONTAINER[i]=0;
00517   }
00518 }
00519 
00526 void RETURN_ARRAYS_INCREMENT(void)
00527 {
00528 #if defined(THREAD_SAFE)
00529   pthread_mutex_lock(&mutex_return_arrays);
00530 #endif
00531   gradient_structure::RETURN_PTR_CONTAINER[
00532     gradient_structure::RETURN_ARRAYS_PTR]=gradient_structure::RETURN_PTR;
00533   if (++gradient_structure::RETURN_ARRAYS_PTR ==
00534     gradient_structure::NUM_RETURN_ARRAYS)
00535   {
00536     cerr << " Overflow in RETURN_ARRAYS stack -- Increase NUM_RETURN_ARRAYS\n";
00537     cerr << " There may be a RETURN_ARRAYS_INCREMENT()\n";
00538     cerr << " which is not matched by a RETURN_ARRAYS_DECREMENT()\n";
00539     ad_exit(24);
00540   }
00541   gradient_structure::MIN_RETURN =
00542     gradient_structure::RETURN_ARRAYS[gradient_structure::RETURN_ARRAYS_PTR];
00543   gradient_structure::MAX_RETURN =
00544     gradient_structure::RETURN_ARRAYS[gradient_structure::RETURN_ARRAYS_PTR]+
00545     gradient_structure::RETURN_ARRAYS_SIZE-1;
00546   gradient_structure::RETURN_PTR = gradient_structure::MIN_RETURN;
00547 #if defined(THREAD_SAFE)
00548   pthread_mutex_unlock(&mutex_return_arrays);
00549 #endif
00550 }
00551 
00558 void RETURN_ARRAYS_DECREMENT(void)
00559 {
00560 #if defined(THREAD_SAFE)
00561   pthread_mutex_lock(&mutex_return_arrays);
00562 #endif
00563   if (--gradient_structure::RETURN_ARRAYS_PTR< 0)
00564   {
00565     cerr << " Error -- RETURN_ARRAYS_PTR < 0  \n";
00566     cerr << " There must be a RETURN_ARRAYS_DECREMENT()\n";
00567     cerr << " which is not matched by a RETURN_ARRAYS_INCREMENT()\n";
00568     ad_exit(24);
00569   }
00570   gradient_structure::MIN_RETURN =
00571     gradient_structure::RETURN_ARRAYS[gradient_structure::RETURN_ARRAYS_PTR];
00572   gradient_structure::MAX_RETURN =
00573     gradient_structure::RETURN_ARRAYS[gradient_structure::RETURN_ARRAYS_PTR]+
00574     gradient_structure::RETURN_ARRAYS_SIZE-1;
00575   gradient_structure::RETURN_PTR =
00576     gradient_structure::RETURN_PTR_CONTAINER[
00577       gradient_structure::RETURN_ARRAYS_PTR];
00578 #if defined(THREAD_SAFE)
00579   pthread_mutex_unlock(&mutex_return_arrays);
00580 #endif
00581 }
00585 gradient_structure::~gradient_structure()
00586 {
00587   gradient_structure::NVAR=0;
00588   if (RETURN_ARRAYS == NULL)
00589   {
00590     null_ptr_err_message();
00591     ad_exit(1);
00592   }
00593   else
00594   {
00595      for (int i=0; i< NUM_RETURN_ARRAYS; i++)
00596      {
00597        delete [] RETURN_ARRAYS[i];
00598        RETURN_ARRAYS[i]=NULL;
00599      }
00600      delete [] RETURN_ARRAYS;
00601      RETURN_ARRAYS = NULL;
00602      delete [] RETURN_PTR_CONTAINER;
00603      RETURN_PTR_CONTAINER = NULL;
00604   }
00605   if (INDVAR_LIST == NULL)
00606   {
00607      null_ptr_err_message();
00608      ad_exit(1);
00609   }
00610   else
00611   {
00612      delete [] INDVAR_LIST->address;
00613      delete INDVAR_LIST;
00614      INDVAR_LIST = NULL;
00615   }
00616   if (GRAD_STACK1 == NULL)
00617   {
00618     null_ptr_err_message();
00619     ad_exit(1);
00620   }
00621   else
00622   {
00623     delete GRAD_STACK1;
00624     GRAD_STACK1 = NULL;
00625   }
00626   if (ARRAY_MEMBLOCK_BASE == NULL)
00627   {
00628     cerr << "Trying to farfree a NULL pointer in ~gradient_structure\n";
00629     ad_exit(1);
00630   }
00631   else
00632   {
00633     ARRAY_MEMBLOCK_BASE.free();
00634   }
00635   if (ARR_LIST1 == NULL)
00636   {
00637     null_ptr_err_message();
00638     ad_exit(1);
00639   }
00640   else
00641   {
00642     delete ARR_LIST1;
00643     ARR_LIST1 = NULL;
00644   }
00645   if (GRAD_LIST == NULL)
00646   {
00647     null_ptr_err_message();
00648     ad_exit(1);
00649   }
00650   else
00651   {
00652     delete GRAD_LIST;
00653     GRAD_LIST = NULL;
00654   }
00655 
00656   instances--;
00657 
00658   if (DEPVARS_INFO==NULL)
00659   {
00660     null_ptr_err_message();
00661     ad_exit(1);
00662   }
00663 
00664   delete DEPVARS_INFO;
00665   DEPVARS_INFO=NULL;
00666 
00667   if (fp == NULL)
00668   {
00669     cerr << "Trying to close stream referenced by a NULL pointer\n"
00670             " in ~gradient_structure\n";
00671     ad_exit(1);
00672   }
00673 
00674   delete fp;
00675   fp = NULL;
00676 }
00677 
00681 void null_ptr_err_message(void)
00682 {
00683    cerr << "Trying to delete a NULL pointer in ~gradient_structure" << endl;
00684 }
00685 
00690 void memory_allocate_error(const char * s, void * ptr)
00691 {
00692   if (ptr == NULL)
00693   {
00694     cerr << " Error trying to allocate " << s << "\n";
00695     ad_exit(21);
00696   }
00697 }
00698 
00699  #if defined(NO_DERIVS)
00700 
00705     void gradient_structure::set_NO_DERIVATIVES(void)
00706     {
00707       no_derivatives=1;
00708     }
00709 
00714     void gradient_structure::set_YES_DERIVATIVES(void)
00715     {
00716       no_derivatives=0;
00717     }
00718  #endif
00719 
00724     void  gradient_structure::set_YES_SAVE_VARIABLES_VALUES(void)
00725     {
00726       save_var_flag=1;
00727     }
00728 
00733     void  gradient_structure::set_NO_SAVE_VARIABLES_VALUES(void)
00734     {
00735       save_var_flag=0;
00736     }
00737 
00742     void gradient_structure::set_NUM_DEPENDENT_VARIABLES(int i)
00743     {
00744       if (i<1)
00745       {
00746         cerr << " Error in "
00747                 "gradient_structure::set_NUM_DEPENDENT_VARIABLES(int i)"
00748              << endl << " value of i must be >= 1" << endl;
00749         i=1;
00750       }
00751       NUM_DEPENDENT_VARIABLES=i;
00752     }