ADMB Documentation  11.1x.2735
 All Classes Files Functions Variables Typedefs Friends Defines
gradstrc.cpp
Go to the documentation of this file.
00001 /*
00002  * $Id: gradstrc.cpp 2664 2014-11-16 21:58:41Z 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 * tmp= (char*)malloc(size * sizeof(char));
00259   char * tmp1=tmp;
00260 
00261   dlink * dl=(dlink*)tmp1;
00262   tmp1+=2*sizeof(double);
00263   dl->prev=NULL;
00264   dlink * prev=dl;
00265   int& nlinks=(int&)gradient_structure::GRAD_LIST->nlinks;
00266   gradient_structure::GRAD_LIST->dlink_addresses[nlinks++]=dl;
00267   for (unsigned int i=1;i<=numlinks;i++)
00268   {
00269     dl=(dlink*)tmp1;
00270     dl->prev=prev;
00271     prev=dl;
00272     tmp1+=2*sizeof(double);
00273 
00274     gradient_structure::GRAD_LIST->dlink_addresses[nlinks++]=dl;
00275       // keep track of the links so you can
00276   }                               // zero them out
00277   gradient_structure::GRAD_LIST->last=dl;
00278 }
00279 
00284  gradient_structure::gradient_structure(long int _size)
00285  {
00286 #ifndef OPT_LIB
00287   assert(_size > 0);
00288 #endif
00289    gradient_structure::NVAR=0;
00290    atexit(cleanup_temporary_files);
00291    fill_ad_random_part();
00292 
00293    const unsigned long int size = (unsigned long int)_size;
00294 
00295    if (instances++ > 0)
00296    {
00297      cerr << "More than one gradient_structure object has been declared.\n"
00298           << "  Only one gradient_structure object can exist. Check the scope\n"
00299           << "  of the objects declared.\n";
00300      ad_exit(1);
00301    }
00302    gradient_structure::ARRAY_MEMBLOCK_SIZE=size; //js
00303 
00304    char * path = getenv("ADTMP1"); // NULL if not defined
00305    if (path != NULL)
00306    {
00307      #ifdef __SUN__
00308      sprintf(&cmpdif_file_name[0],"%s/cmpdiff.%s", path,
00309           ad_random_part);
00310      #else
00311         if (lastchar(path)!='\\')
00312         {
00313           sprintf(&cmpdif_file_name[0],"%s\\cmpdiff.%s", path,
00314             ad_random_part);
00315         }
00316         else
00317         {
00318           sprintf(&cmpdif_file_name[0],"%scmpdiff.%s", path,
00319             ad_random_part);
00320         }
00321      #endif
00322    }
00323    else
00324    {
00325       sprintf(&cmpdif_file_name[0],"cmpdiff.%s",ad_random_part);
00326    }
00327 
00328    if (DEPVARS_INFO!= NULL)
00329    {
00330       cerr << "  0 Trying to allocate to a non NULL pointer in gradient"
00331               "_structure" << endl;
00332    }
00333    else
00334    {
00335      int on,nopt = 0;
00336      if ( (on=option_match(ad_comm::argc,ad_comm::argv,"-ndv",nopt))>-1)
00337      {
00338        if (!nopt)
00339        {
00340          cerr << "Usage -ndv option needs integer  -- ignored" << endl;
00341        }
00342        else
00343        {
00344          int jj=atoi(ad_comm::argv[on+1]);
00345          if (jj<=0)
00346          {
00347            cerr << "Usage -ndv option needs positive integer"
00348               "  -- ignored" << endl;
00349          }
00350          else
00351          {
00352            NUM_DEPENDENT_VARIABLES=jj;
00353          }
00354        }
00355      }
00356      DEPVARS_INFO=new dependent_variables_information(NUM_DEPENDENT_VARIABLES);
00357      memory_allocate_error("DEPVARS_INFO", (void *) DEPVARS_INFO);
00358    }
00359 
00360    if (fp!= NULL)
00361    {
00362       cerr << "  0 Trying to allocate to a non NULL pointer in gradient"
00363               "_structure" << endl;
00364    }
00365    else
00366    {
00367      fp=new DF_FILE(CMPDIF_BUFFER_SIZE);
00368      memory_allocate_error("fp", (void *) fp);
00369    }
00370 
00371    void * temp_ptr;
00372   // double_and_int * tmp;
00373    int i;
00374    #ifdef DIAG
00375      cerr <<" In gradient_structure::gradient_structure()\n";
00376      cerr <<"  ARRAY_MEMBLOCK_SIZE = " << ARRAY_MEMBLOCK_SIZE << "\n";
00377    #endif
00378 
00379    if ( GRAD_LIST!= NULL)
00380    {
00381     cerr << "Trying to allocate to a non NULL pointer in gradient structure\n";
00382    }
00383    else
00384    {
00385       GRAD_LIST = new dlist;
00386       memory_allocate_error("GRAD_LIST", (void *) GRAD_LIST);
00387    }
00388 
00389    if ( ARR_LIST1!= NULL)
00390    {
00391      cerr << "Trying to allocate to a non NULL pointer in gradient structure\n";
00392    }
00393    else
00394    {
00395       ARR_LIST1 = new arr_list;
00396       memory_allocate_error("ARR_LIST1", (void *) ARR_LIST1);
00397    }
00398 
00399  /*
00400    if ( ARR_FREE_LIST1!= NULL)
00401    {
00402 cerr << "  2 Trying to allocate to a non NULL pointer in gradient structure \n";
00403    }
00404    else
00405    {
00406       ARR_FREE_LIST1 = new arr_list;
00407       memory_allocate_error("ARR_FREE_LIST1", (void *) ARR_FREE_LIST1);
00408    }
00409  */
00410 
00411 #ifdef __ZTC__
00412    if ((temp_ptr = farmalloc(ARRAY_MEMBLOCK_SIZE)) == 0)
00413 #else
00414    if ((temp_ptr = (void*)malloc(ARRAY_MEMBLOCK_SIZE)) == 0)
00415 #endif
00416    {
00417      cerr << "insufficient memory to allocate space for ARRAY_MEMBLOCKa\n";
00418      ad_exit(1);
00419    }
00420 
00421   /*
00422    if (ARRAY_MEMBLOCK_BASE != NULL)
00423    {
00424 cerr << "Trying to allocate to a non NULL pointer in gradient structure \n";
00425    }
00426  */
00427 
00428    ARRAY_MEMBLOCK_BASE = temp_ptr;
00429 
00430    const size_t adjustment = (8 -((size_t)ARRAY_MEMBLOCK_BASE.ptr) % 8) % 8;
00431    ARRAY_MEMBLOCK_BASE.adjust(adjustment);
00432 
00433    if (GRAD_STACK1 != NULL)
00434    {
00435       cerr << "Trying to allocate to a non NULL pointer\n";
00436    }
00437    else
00438    {
00439      GRAD_STACK1 = new grad_stack;
00440      memory_allocate_error("GRAD_STACK1",GRAD_STACK1);
00441      gradient_structure::hessian_ptr= (double*) GRAD_STACK1->true_ptr_first;
00442    }
00443     #ifdef DIAG
00444         cout << "GRAD_STACK1= "<< farptr_tolong(GRAD_STACK1)<<"\n";
00445     #endif
00446 
00447    if ( INDVAR_LIST!= NULL)
00448    {
00449       cerr <<
00450         "Trying to allocate to a non NULL pointer in gradient structure \n";
00451       ad_exit(1);
00452    }
00453    else
00454    {
00455      INDVAR_LIST = new indvar_offset_list;
00456      memory_allocate_error("INDVAR_LIST",INDVAR_LIST);
00457  // ****************************************************************
00458  // ****************************************************************
00459       int nopt=0;
00460       int on=0;
00461 
00462       if ( (on=option_match(ad_comm::argc,ad_comm::argv,"-mno",nopt))>-1)
00463       {
00464         if (nopt ==1)
00465         {
00466           const int i = atoi(ad_comm::argv[on+1]);
00467           MAX_NVAR_OFFSET = (unsigned int)i;
00468         }
00469         else
00470         {
00471           cerr << "Wrong number of options to -mno -- must be 1"
00472             " you have " << nopt << endl;
00473           ad_exit(1);
00474         }
00475       }
00476 
00477  // ****************************************************************
00478  // ****************************************************************
00479 
00480      INDVAR_LIST->address = new double * [ (size_t) MAX_NVAR_OFFSET];
00481      memory_allocate_error("INDVAR_LIST->address",INDVAR_LIST->address);
00482    }
00483 
00484    //allocate_dvariable_space();
00485 
00486    if ( RETURN_ARRAYS!= NULL)
00487    {
00488 cerr << "Trying to allocate to a non NULL pointer in gradient structure \n";
00489       ad_exit(1);
00490    }
00491    else
00492    {
00493       RETURN_ARRAYS = new dvariable*[NUM_RETURN_ARRAYS];
00494       memory_allocate_error("RETURN_ARRAYS",RETURN_ARRAYS);
00495 
00496       //allocate_dvariable_space();
00497       for (i=0; i< NUM_RETURN_ARRAYS; i++)
00498       {
00499         RETURN_ARRAYS[i]=new dvariable[RETURN_ARRAYS_SIZE];
00500         memory_allocate_error("RETURN_ARRAYS[i]",RETURN_ARRAYS[i]);
00501       }
00502       RETURN_ARRAYS_PTR=0;
00503       MIN_RETURN = RETURN_ARRAYS[RETURN_ARRAYS_PTR];
00504       MAX_RETURN = RETURN_ARRAYS[RETURN_ARRAYS_PTR]+RETURN_ARRAYS_SIZE-1;
00505       RETURN_PTR = MIN_RETURN;
00506    }
00507    //RETURN_INDEX = 0;
00508 
00509    RETURN_PTR_CONTAINER=new dvariable*[NUM_RETURN_ARRAYS];
00510    memory_allocate_error("RETURN_INDICES_CONTAINER",RETURN_PTR_CONTAINER);
00511 
00512    for (i=0; i< NUM_RETURN_ARRAYS; i++)
00513    {
00514      RETURN_PTR_CONTAINER[i]=0;
00515    }
00516  }
00517 
00524 void RETURN_ARRAYS_INCREMENT(void)
00525 {
00526 #if defined(THREAD_SAFE)
00527   pthread_mutex_lock(&mutex_return_arrays);
00528 #endif
00529   gradient_structure::RETURN_PTR_CONTAINER[
00530     gradient_structure::RETURN_ARRAYS_PTR]=gradient_structure::RETURN_PTR;
00531   if (++gradient_structure::RETURN_ARRAYS_PTR ==
00532     gradient_structure::NUM_RETURN_ARRAYS)
00533   {
00534     cerr << " Overflow in RETURN_ARRAYS stack -- Increase NUM_RETURN_ARRAYS\n";
00535     cerr << " There may be a RETURN_ARRAYS_INCREMENT()\n";
00536     cerr << " which is not matched by a RETURN_ARRAYS_DECREMENT()\n";
00537     ad_exit(24);
00538   }
00539   gradient_structure::MIN_RETURN =
00540     gradient_structure::RETURN_ARRAYS[gradient_structure::RETURN_ARRAYS_PTR];
00541   gradient_structure::MAX_RETURN =
00542     gradient_structure::RETURN_ARRAYS[gradient_structure::RETURN_ARRAYS_PTR]+
00543     gradient_structure::RETURN_ARRAYS_SIZE-1;
00544   gradient_structure::RETURN_PTR = gradient_structure::MIN_RETURN;
00545 #if defined(THREAD_SAFE)
00546   pthread_mutex_unlock(&mutex_return_arrays);
00547 #endif
00548 }
00549 
00556 void RETURN_ARRAYS_DECREMENT(void)
00557 {
00558 #if defined(THREAD_SAFE)
00559   pthread_mutex_lock(&mutex_return_arrays);
00560 #endif
00561   if (--gradient_structure::RETURN_ARRAYS_PTR< 0)
00562   {
00563     cerr << " Error -- RETURN_ARRAYS_PTR < 0  \n";
00564     cerr << " There must be a RETURN_ARRAYS_DECREMENT()\n";
00565     cerr << " which is not matched by a RETURN_ARRAYS_INCREMENT()\n";
00566     ad_exit(24);
00567   }
00568   gradient_structure::MIN_RETURN =
00569     gradient_structure::RETURN_ARRAYS[gradient_structure::RETURN_ARRAYS_PTR];
00570   gradient_structure::MAX_RETURN =
00571     gradient_structure::RETURN_ARRAYS[gradient_structure::RETURN_ARRAYS_PTR]+
00572     gradient_structure::RETURN_ARRAYS_SIZE-1;
00573   gradient_structure::RETURN_PTR =
00574     gradient_structure::RETURN_PTR_CONTAINER[
00575       gradient_structure::RETURN_ARRAYS_PTR];
00576 #if defined(THREAD_SAFE)
00577   pthread_mutex_unlock(&mutex_return_arrays);
00578 #endif
00579 }
00580 
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 
00617    if (GRAD_STACK1 == NULL)
00618    {
00619      null_ptr_err_message();
00620      ad_exit(1);
00621    }
00622    else
00623    {
00624      delete GRAD_STACK1;
00625      GRAD_STACK1 = NULL;
00626    }
00627 
00628    if (ARRAY_MEMBLOCK_BASE == NULL)
00629    {
00630      cerr << "Trying to farfree a NULL pointer in ~gradient_structure\n";
00631      ad_exit(1);
00632    }
00633    else
00634    {
00635      ARRAY_MEMBLOCK_BASE.free();
00636    }
00637 
00638    if (ARR_LIST1 == NULL)
00639    {
00640      null_ptr_err_message();
00641      ad_exit(1);
00642    }
00643    else
00644    {
00645       delete ARR_LIST1;
00646       ARR_LIST1 = NULL;
00647    }
00648 
00649    if (GRAD_LIST == NULL)
00650    {
00651      null_ptr_err_message();
00652      ad_exit(1);
00653    }
00654    else
00655    {
00656       delete GRAD_LIST;
00657       GRAD_LIST = NULL;
00658    }
00659 
00660    instances--;
00661 
00662    if (DEPVARS_INFO==NULL)
00663    {
00664      null_ptr_err_message();
00665      ad_exit(1);
00666    }
00667    delete DEPVARS_INFO;
00668    DEPVARS_INFO=NULL;
00669 
00670    if (fp == NULL)
00671    {
00672      cerr << "Trying to close stream referenced by a NULL pointer\n"
00673        " in ~gradient_structure\n";
00674      ad_exit(1);
00675    }
00676    delete fp;
00677    fp = NULL;
00678 }
00679 
00684 void null_ptr_err_message(void)
00685 {
00686    cerr << "Trying to delete a NULL pointer in ~gradient_structure" << endl;
00687 }
00688 
00693 void memory_allocate_error(const char * s, void * ptr)
00694 {
00695   if (ptr == NULL)
00696   {
00697     cerr << " Error trying to allocate " << s << "\n";
00698     ad_exit(21);
00699   }
00700 }
00701 
00702  #if defined(NO_DERIVS)
00703 
00708     void gradient_structure::set_NO_DERIVATIVES(void)
00709     {
00710       no_derivatives=1;
00711     }
00712 
00717     void gradient_structure::set_YES_DERIVATIVES(void)
00718     {
00719       no_derivatives=0;
00720     }
00721  #endif
00722 
00727     void  gradient_structure::set_YES_SAVE_VARIABLES_VALUES(void)
00728     {
00729       save_var_flag=1;
00730     }
00731 
00736     void  gradient_structure::set_NO_SAVE_VARIABLES_VALUES(void)
00737     {
00738       save_var_flag=0;
00739     }
00740 
00745     void gradient_structure::set_NUM_DEPENDENT_VARIABLES(int i)
00746     {
00747       if (i<1)
00748       {
00749         cerr << " Error in "
00750                 "gradient_structure::set_NUM_DEPENDENT_VARIABLES(int i)"
00751              << endl << " value of i must be >= 1" << endl;
00752         i=1;
00753       }
00754       NUM_DEPENDENT_VARIABLES=i;
00755     }