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