chem/KPP/kpp/kpp-2.1/util/Mex_Hessian.f90

   1
   2 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
   3  SUBROUTINE mexFunction( nlhs, plhs, nrhs, prhs )
   4 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
   5 !                  Matlab Gateway for the Function Hessian
   6 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
   7
   8  USE KPP_ROOT_Model
   9
  10       INTEGER nlhs, nrhs
  11       INTEGER plhs(*), prhs(*)
  12       INTEGER mxGetPr, mxCreateFull, mxGetM, mxgetN
  13       INTEGER VPtr, FPtr, RPtr, HESSPtr
  14       KPP_REAL V(KPP_NVAR), F(KPP_NFIX), RCT(KPP_NREACT)
  15       KPP_REAL HESS(KPP_NHESS)
  16
  17 ! Check for the right number of input arguments
  18       IF ( nrhs .ne. 3 ) THEN
  19          CALL mexErrMsgTxt('Hessian requires 3 input vectors: &
  20      &V(KPP_NVAR), F(KPP_NFIX), RCT(KPP_NREACT)')
  21       END IF
  22 ! Check for the right number of output arguments
  23       IF ( nlhs .ne. 1 ) THEN
  24          CALL mexErrMsgTxt('Hessian requires 1 output vector: &
  25      &HESS(KPP_NHESS)')
  26       END IF
  27
  28       plhs(1) = mxCreateDoubleMatrix(KPP_NHESS,1,0)
  29
  30       VPtr = mxGetPr(prhs(1));
  31       CALL mxCopyPtrToReal8(VPtr,V,KPP_NVAR)
  32
  33       FPtr = mxGetPr(prhs(2));
  34       CALL mxCopyPtrToReal8(FPtr,F,KPP_NFIX)
  35
  36       RPtr = mxGetPr(prhs(3));
  37       CALL mxCopyPtrToReal8(RPtr,RCT,KPP_NREACT)
  38
  39       HESSPtr = mxGetPr(plhs(1))
  40
  41       CALL Hessian( V, F, RCT, HESS )
  42
  43       CALL mxCopyReal8ToPtr(HESS, HESSPtr, KPP_NHESS)
  44
  45  END SUBROUTINE mexFunction