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

   1
   2 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
   3  SUBROUTINE mexFunction( nlhs, plhs, nrhs, prhs )
   4 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
   5 !                 Matlab Gateway for the Derivative Function Fun
   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, VdotPtr
  14       KPP_REAL V(KPP_NVAR), F(KPP_NFIX), RCT(KPP_NREACT)
  15       KPP_REAL Vdot(KPP_NVAR)
  16
  17 ! Check for the right number of input arguments
  18       IF ( nrhs .ne. 3 ) THEN
  19          CALL mexErrMsgTxt('Fun 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('Fun requires 1 output vector: &
  25      &Vdot(KPP_NVAR)')
  26       END IF
  27
  28       plhs(1) = mxCreateDoubleMatrix(KPP_NVAR,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       VdotPtr = mxGetPr(plhs(1))
  40
  41       CALL Fun( V, F, RCT, Vdot )
  42
  43       CALL mxCopyReal8ToPtr(Vdot, VdotPtr, KPP_NVAR)
  44
  45  END SUBROUTINE mexFunction