wrfv2_fire/chem/KPP/kpp/kpp-2.1/util/Mex_Jac_SP.f90

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