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