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 <petscsys.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;


 22: EXTERN_C_BEGIN

 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;

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

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

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

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

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

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

 94: EXTERN_C_END