Actual source code: ad_grad.c

      1: #define PETSC_DLL
      2: /*
      3:   THIS PROGRAM DISCLOSES MATERIAL PROTECTABLE UNDER COPYRIGHT
      4:   LAWS OF THE UNITED STATES.  FOR LICENSING INFORMATION CONTACT:

      6:   Christian Bischof or Lucas Roh, Mathematics and Computer Science Division,
      7:   Argonne National Laboratory, 9700 S. Cass Avenue, Argonne IL 60439,
      8:   {bischof,roh}@mcs.anl.gov.
      9: */

     11: #include "petsc.h"
     12: #include <stdarg.h>

     14: #include "ad_deriv.h"
     15: #include "ad_grad.h"

     17: int ad_grad_size = 0;
     18: int ad_total_grad_size = 0;
     19: int ad_grad_size_shadow = 0;

     24: int ad_AD_IncrShadowVar(void)
     25: { return ad_grad_size_shadow++; }

     27: void ad_AD_CommitShadowVar(void)
     28: { ad_grad_size = ad_grad_size_shadow; }

     30: void ad_AD_ResetShadowVar(void)
     31: { ad_grad_size_shadow = 0; }

     33: void ad_grad_axpy_n(int arity, void* ddz, ...)
     34: {
     35:   int                i, j;
     36:   double             *z,alpha,*gradv;
     37:   static double      alphas[100];
     38:   static DERIV_TYPE* grads[100];
     39:   va_list            parg;
     40:   PetscErrorCode     ierr;

     42:   va_start(parg, ddz);
     43:   for (i = 0; i < arity; i++) {
     44:     alphas[i] = va_arg(parg, double);
     45:     grads[i]  = (DERIV_TYPE*)va_arg(parg, DERIV_TYPE*);
     46:   }
     47:   va_end(parg);

     49:   z = DERIV_grad(*((DERIV_TYPE*)ddz));
     50:   {
     51:     gradv = DERIV_grad(*grads[0]);
     52:     alpha = alphas[0];
     53:     for (i = 0; i < ad_GRAD_MAX; i++) {
     54:       z[i] = alpha*gradv[i];
     55:     }
     56:   }
     57:   for (j = 1; j < arity; j++) {
     58:     gradv = DERIV_grad(*grads[j]);
     59:     alpha = alphas[j];
     60:     for (i = 0; i < ad_GRAD_MAX; i++) {
     61:       z[i] += alpha*gradv[i];
     62:     }
     63:   }
     64:   PetscLogFlops(2*ad_GRAD_MAX*(arity-.5));
     65: }

     67: void mfad_grad_axpy_n(int arity, void* ddz, ...)
     68: {
     69:   int                j;
     70:   double             *z,*gradv;
     71:   static double      alphas[100];
     72:   static DERIV_TYPE* grads[100];
     73:   va_list            parg;
     74:   PetscErrorCode     ierr;

     76:   va_start(parg, ddz);
     77:   for (j = 0; j < arity; j++) {
     78:     alphas[j] = va_arg(parg, double);
     79:     grads[j]  = (DERIV_TYPE*)va_arg(parg, DERIV_TYPE*);
     80:   }
     81:   va_end(parg);

     83:   z = DERIV_grad(*((DERIV_TYPE*)ddz));
     84:   {
     85:     gradv = DERIV_grad(*grads[0]);
     86:     z[0] = alphas[0]*gradv[0];
     87:   }

     89:   for (j = 1; j < arity; j++) {
     90:     gradv = DERIV_grad(*grads[j]);
     91:     z[0] += alphas[j]*gradv[0];
     92:   }
     93:   PetscLogFlops(2*(arity-.5));
     94: }