ADMB Documentation  11.4.2891
 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_BASEA;
00134 humungous_pointer gradient_structure::ARRAY_MEMBLOCK_SAVE;
00135 void * farptr_norm(void *);
00136 long int farptr_tolong(void *) ;
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 
00289  gradient_structure::gradient_structure(long int _size)
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)
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 
00333    if (DEPVARS_INFO!= NULL)
00334    {
00335       cerr << "  0 Trying to allocate to a non NULL pointer in gradient"
00336               "_structure" << endl;
00337    }
00338    else
00339    {
00340      int on,nopt = 0;
00341      if ( (on=option_match(ad_comm::argc,ad_comm::argv,"-ndv",nopt))>-1)
00342      {
00343        if (!nopt)
00344        {
00345          cerr << "Usage -ndv option needs integer  -- ignored" << endl;
00346        }
00347        else
00348        {
00349          int jj=atoi(ad_comm::argv[on+1]);
00350          if (jj<=0)
00351          {
00352            cerr << "Usage -ndv option needs positive integer"
00353               "  -- ignored" << endl;
00354          }
00355          else
00356          {
00357            NUM_DEPENDENT_VARIABLES=jj;
00358          }
00359        }
00360      }
00361      DEPVARS_INFO=new dependent_variables_information(NUM_DEPENDENT_VARIABLES);
00362      memory_allocate_error("DEPVARS_INFO", (void *) DEPVARS_INFO);
00363    }
00364 
00365    if (fp!= NULL)
00366    {
00367       cerr << "  0 Trying to allocate to a non NULL pointer in gradient"
00368               "_structure" << endl;
00369    }
00370    else
00371    {
00372      fp=new DF_FILE(CMPDIF_BUFFER_SIZE);
00373      memory_allocate_error("fp", (void *) fp);
00374    }
00375 
00376    void * temp_ptr;
00377   // double_and_int * tmp;
00378    #ifdef DIAG
00379      cerr <<" In gradient_structure::gradient_structure()\n";
00380      cerr <<"  ARRAY_MEMBLOCK_SIZE = " << ARRAY_MEMBLOCK_SIZE << "\n";
00381    #endif
00382 
00383    if ( GRAD_LIST!= NULL)
00384    {
00385     cerr << "Trying to allocate to a non NULL pointer in gradient structure\n";
00386    }
00387    else
00388    {
00389       GRAD_LIST = new dlist;
00390       memory_allocate_error("GRAD_LIST", (void *) GRAD_LIST);
00391    }
00392 
00393    if ( ARR_LIST1!= NULL)
00394    {
00395      cerr << "Trying to allocate to a non NULL pointer in gradient structure\n";
00396    }
00397    else
00398    {
00399       ARR_LIST1 = new arr_list;
00400       memory_allocate_error("ARR_LIST1", (void *) ARR_LIST1);
00401    }
00402 
00403  /*
00404    if ( ARR_FREE_LIST1!= NULL)
00405    {
00406 cerr << "  2 Trying to allocate to a non NULL pointer in gradient structure \n";
00407    }
00408    else
00409    {
00410       ARR_FREE_LIST1 = new arr_list;
00411       memory_allocate_error("ARR_FREE_LIST1", (void *) ARR_FREE_LIST1);
00412    }
00413  */
00414 
00415 #ifdef __ZTC__
00416    if ((temp_ptr = farmalloc(ARRAY_MEMBLOCK_SIZE)) == 0)
00417 #else
00418    if ((temp_ptr = (void*)malloc(ARRAY_MEMBLOCK_SIZE)) == 0)
00419 #endif
00420    {
00421      cerr << "insufficient memory to allocate space for ARRAY_MEMBLOCKa\n";
00422      ad_exit(1);
00423    }
00424 
00425   /*
00426    if (ARRAY_MEMBLOCK_BASE != NULL)
00427    {
00428 cerr << "Trying to allocate to a non NULL pointer in gradient structure \n";
00429    }
00430  */
00431 
00432    ARRAY_MEMBLOCK_BASE = temp_ptr;
00433 
00434    const size_t adjustment = (8 -((size_t)ARRAY_MEMBLOCK_BASE.ptr) % 8) % 8;
00435    ARRAY_MEMBLOCK_BASE.adjust(adjustment);
00436 
00437    if (GRAD_STACK1 != NULL)
00438    {
00439       cerr << "Trying to allocate to a non NULL pointer\n";
00440    }
00441    else
00442    {
00443      GRAD_STACK1 = new grad_stack;
00444      memory_allocate_error("GRAD_STACK1",GRAD_STACK1);
00445      gradient_structure::hessian_ptr= (double*) GRAD_STACK1->true_ptr_first;
00446    }
00447     #ifdef DIAG
00448         cout << "GRAD_STACK1= "<< farptr_tolong(GRAD_STACK1)<<"\n";
00449     #endif
00450 
00451    if ( INDVAR_LIST!= NULL)
00452    {
00453       cerr <<
00454         "Trying to allocate to a non NULL pointer in gradient structure \n";
00455       ad_exit(1);
00456    }
00457    else
00458    {
00459      INDVAR_LIST = new indvar_offset_list;
00460      memory_allocate_error("INDVAR_LIST",INDVAR_LIST);
00461  // ****************************************************************
00462  // ****************************************************************
00463       int nopt=0;
00464       int on=0;
00465 
00466       if ( (on=option_match(ad_comm::argc,ad_comm::argv,"-mno",nopt))>-1)
00467       {
00468         if (nopt ==1)
00469         {
00470           const int i = atoi(ad_comm::argv[on+1]);
00471           MAX_NVAR_OFFSET = (unsigned int)i;
00472         }
00473         else
00474         {
00475           cerr << "Wrong number of options to -mno -- must be 1"
00476             " you have " << nopt << endl;
00477           ad_exit(1);
00478         }
00479       }
00480 
00481  // ****************************************************************
00482  // ****************************************************************
00483 
00484      INDVAR_LIST->address = new double * [ (size_t) MAX_NVAR_OFFSET];
00485      memory_allocate_error("INDVAR_LIST->address",INDVAR_LIST->address);
00486    }
00487 
00488    //allocate_dvariable_space();
00489 
00490    if ( RETURN_ARRAYS!= NULL)
00491    {
00492 cerr << "Trying to allocate to a non NULL pointer in gradient structure \n";
00493       ad_exit(1);
00494    }
00495    else
00496    {
00497       RETURN_ARRAYS = new dvariable*[NUM_RETURN_ARRAYS];
00498       memory_allocate_error("RETURN_ARRAYS",RETURN_ARRAYS);
00499 
00500       //allocate_dvariable_space();
00501       for (int i=0; i< NUM_RETURN_ARRAYS; i++)
00502       {
00503         RETURN_ARRAYS[i]=new dvariable[RETURN_ARRAYS_SIZE];
00504         memory_allocate_error("RETURN_ARRAYS[i]",RETURN_ARRAYS[i]);
00505       }
00506       RETURN_ARRAYS_PTR=0;
00507       MIN_RETURN = RETURN_ARRAYS[RETURN_ARRAYS_PTR];
00508       MAX_RETURN = RETURN_ARRAYS[RETURN_ARRAYS_PTR]+RETURN_ARRAYS_SIZE-1;
00509       RETURN_PTR = MIN_RETURN;
00510    }
00511    //RETURN_INDEX = 0;
00512 
00513    RETURN_PTR_CONTAINER=new dvariable*[NUM_RETURN_ARRAYS];
00514    memory_allocate_error("RETURN_INDICES_CONTAINER",RETURN_PTR_CONTAINER);
00515 
00516    for (int i=0; i< NUM_RETURN_ARRAYS; i++)
00517    {
00518      RETURN_PTR_CONTAINER[i]=0;
00519    }
00520  }
00521 
00528 void RETURN_ARRAYS_INCREMENT(void)
00529 {
00530 #if defined(THREAD_SAFE)
00531   pthread_mutex_lock(&mutex_return_arrays);
00532 #endif
00533   gradient_structure::RETURN_PTR_CONTAINER[
00534     gradient_structure::RETURN_ARRAYS_PTR]=gradient_structure::RETURN_PTR;
00535   if (++gradient_structure::RETURN_ARRAYS_PTR ==
00536     gradient_structure::NUM_RETURN_ARRAYS)
00537   {
00538     cerr << " Overflow in RETURN_ARRAYS stack -- Increase NUM_RETURN_ARRAYS\n";
00539     cerr << " There may be a RETURN_ARRAYS_INCREMENT()\n";
00540     cerr << " which is not matched by a RETURN_ARRAYS_DECREMENT()\n";
00541     ad_exit(24);
00542   }
00543   gradient_structure::MIN_RETURN =
00544     gradient_structure::RETURN_ARRAYS[gradient_structure::RETURN_ARRAYS_PTR];
00545   gradient_structure::MAX_RETURN =
00546     gradient_structure::RETURN_ARRAYS[gradient_structure::RETURN_ARRAYS_PTR]+
00547     gradient_structure::RETURN_ARRAYS_SIZE-1;
00548   gradient_structure::RETURN_PTR = gradient_structure::MIN_RETURN;
00549 #if defined(THREAD_SAFE)
00550   pthread_mutex_unlock(&mutex_return_arrays);
00551 #endif
00552 }
00553 
00560 void RETURN_ARRAYS_DECREMENT(void)
00561 {
00562 #if defined(THREAD_SAFE)
00563   pthread_mutex_lock(&mutex_return_arrays);
00564 #endif
00565   if (--gradient_structure::RETURN_ARRAYS_PTR< 0)
00566   {
00567     cerr << " Error -- RETURN_ARRAYS_PTR < 0  \n";
00568     cerr << " There must be a RETURN_ARRAYS_DECREMENT()\n";
00569     cerr << " which is not matched by a RETURN_ARRAYS_INCREMENT()\n";
00570     ad_exit(24);
00571   }
00572   gradient_structure::MIN_RETURN =
00573     gradient_structure::RETURN_ARRAYS[gradient_structure::RETURN_ARRAYS_PTR];
00574   gradient_structure::MAX_RETURN =
00575     gradient_structure::RETURN_ARRAYS[gradient_structure::RETURN_ARRAYS_PTR]+
00576     gradient_structure::RETURN_ARRAYS_SIZE-1;
00577   gradient_structure::RETURN_PTR =
00578     gradient_structure::RETURN_PTR_CONTAINER[
00579       gradient_structure::RETURN_ARRAYS_PTR];
00580 #if defined(THREAD_SAFE)
00581   pthread_mutex_unlock(&mutex_return_arrays);
00582 #endif
00583 }
00584 
00589 gradient_structure::~gradient_structure()
00590 {
00591    gradient_structure::NVAR=0;
00592    if (RETURN_ARRAYS == NULL)
00593    {
00594      null_ptr_err_message();
00595      ad_exit(1);
00596    }
00597    else
00598    {
00599      for (int i=0; i< NUM_RETURN_ARRAYS; i++)
00600      {
00601        delete [] RETURN_ARRAYS[i];
00602        RETURN_ARRAYS[i]=NULL;
00603      }
00604      delete [] RETURN_ARRAYS;
00605      RETURN_ARRAYS = NULL;
00606      delete [] RETURN_PTR_CONTAINER;
00607      RETURN_PTR_CONTAINER = NULL;
00608    }
00609    if (INDVAR_LIST == NULL)
00610    {
00611      null_ptr_err_message();
00612      ad_exit(1);
00613    }
00614    else
00615    {
00616      delete [] INDVAR_LIST->address;
00617      delete INDVAR_LIST;
00618      INDVAR_LIST = NULL;
00619    }
00620 
00621    if (GRAD_STACK1 == NULL)
00622    {
00623      null_ptr_err_message();
00624      ad_exit(1);
00625    }
00626    else
00627    {
00628      delete GRAD_STACK1;
00629      GRAD_STACK1 = NULL;
00630    }
00631 
00632    if (ARRAY_MEMBLOCK_BASE == NULL)
00633    {
00634      cerr << "Trying to farfree a NULL pointer in ~gradient_structure\n";
00635      ad_exit(1);
00636    }
00637    else
00638    {
00639      ARRAY_MEMBLOCK_BASE.free();
00640    }
00641 
00642    if (ARR_LIST1 == NULL)
00643    {
00644      null_ptr_err_message();
00645      ad_exit(1);
00646    }
00647    else
00648    {
00649       delete ARR_LIST1;
00650       ARR_LIST1 = NULL;
00651    }
00652 
00653    if (GRAD_LIST == NULL)
00654    {
00655      null_ptr_err_message();
00656      ad_exit(1);
00657    }
00658    else
00659    {
00660       delete GRAD_LIST;
00661       GRAD_LIST = NULL;
00662    }
00663 
00664    instances--;
00665 
00666    if (DEPVARS_INFO==NULL)
00667    {
00668      null_ptr_err_message();
00669      ad_exit(1);
00670    }
00671    delete DEPVARS_INFO;
00672    DEPVARS_INFO=NULL;
00673 
00674    if (fp == NULL)
00675    {
00676      cerr << "Trying to close stream referenced by a NULL pointer\n"
00677        " in ~gradient_structure\n";
00678      ad_exit(1);
00679    }
00680    delete fp;
00681    fp = NULL;
00682 }
00683 
00688 void null_ptr_err_message(void)
00689 {
00690    cerr << "Trying to delete a NULL pointer in ~gradient_structure" << endl;
00691 }
00692 
00697 void memory_allocate_error(const char * s, void * ptr)
00698 {
00699   if (ptr == NULL)
00700   {
00701     cerr << " Error trying to allocate " << s << "\n";
00702     ad_exit(21);
00703   }
00704 }
00705 
00706  #if defined(NO_DERIVS)
00707 
00712     void gradient_structure::set_NO_DERIVATIVES(void)
00713     {
00714       no_derivatives=1;
00715     }
00716 
00721     void gradient_structure::set_YES_DERIVATIVES(void)
00722     {
00723       no_derivatives=0;
00724     }
00725  #endif
00726 
00731     void  gradient_structure::set_YES_SAVE_VARIABLES_VALUES(void)
00732     {
00733       save_var_flag=1;
00734     }
00735 
00740     void  gradient_structure::set_NO_SAVE_VARIABLES_VALUES(void)
00741     {
00742       save_var_flag=0;
00743     }
00744 
00749     void gradient_structure::set_NUM_DEPENDENT_VARIABLES(int i)
00750     {
00751       if (i<1)
00752       {
00753         cerr << " Error in "
00754                 "gradient_structure::set_NUM_DEPENDENT_VARIABLES(int i)"
00755              << endl << " value of i must be >= 1" << endl;
00756         i=1;
00757       }
00758       NUM_DEPENDENT_VARIABLES=i;
00759     }