How to have a matrix input in a level-1 Fortran S-function Block

2 views (last 30 days)
Hi,
To bring my question straight out, I'm looking to change the given simulink help template (sfun_timestwo_for.f) to be able to have a matrix input/output and not just a scalar or vector input/output
simulink help gives you a demo and a template to create your own simple lvl 1 Fortran S-function block.
Demo "sfcndemo_timestwo_for.slx"
the template files are to create the S-Block yourself are (sfun_timestwo_for.f) and (simulink.f) and to make it work you need to use the mex command as so
>>mex sfun_timestwo_for.f simulink.f
Simply what the demo does is it multiplies the input by 2. But how the template is set up, I cannot seem to find a way to change the sfun_timestwo_for.f file to have an input size of a matrix. (for my example i will use a [5x2] matrix) (also output size is the same as input size)
The given template file(sfun_timestwo_for.f) looks like this
if true
% code
C
C File: SFUN_TIMESTWO_FOR.F
C
C Abstract:
C A sample Level 1 FORTRAN representation of a
C timestwo S-function.
C
C The basic mex command for this example is:
C
C >> mex sfun_timestwo_for.f simulink.f
C
C Copyright 1990-2009 The MathWorks, Inc.
C
C $Revision: 1.1.6.1 $
C
C=====================================================
C Function: SIZES
C
C Abstract:
C Set the size vector.
C
C SIZES returns a vector which determines model
C characteristics. This vector contains the
C sizes of the state vector and other
C parameters. More precisely,
C SIZE(1) number of continuous states
C SIZE(2) number of discrete states
C SIZE(3) number of outputs
C SIZE(4) number of inputs
C SIZE(5) number of discontinuous roots in
C the system
C SIZE(6) set to 1 if the system has direct
C feedthrough of its inputs,
C otherwise 0
C
C=====================================================
C
SUBROUTINE SIZES(SIZE)
C .. Array arguments ..
INTEGER*4 SIZE(*)
C .. Parameters ..
INTEGER*4 NSIZES
PARAMETER (NSIZES=6)
SIZE(1) = 0
SIZE(2) = 0
SIZE(3) = 1
SIZE(4) = 1
SIZE(5) = 0
SIZE(6) = 1
RETURN
END
C
C=====================================================
C
C Function: OUTPUT
C
C Abstract:
C Perform output calculations for continuous
C signals.
C
C=====================================================
C .. Parameters ..
SUBROUTINE OUTPUT(T, X, U, Y)
REAL*8 T
REAL*8 X(*), U(*), Y(*)
Y(1) = U(1) * 2.0
RETURN
END
C
C=====================================================
C
C Stubs for unused functions.
C
C=====================================================
SUBROUTINE INITCOND(X0)
REAL*8 X0(*)
C --- Nothing to do.
RETURN
END
SUBROUTINE DERIVS(T, X, U, DX)
REAL*8 T, X(*), U(*), DX(*)
C --- Nothing to do.
RETURN
END
SUBROUTINE DSTATES(T, X, U, XNEW)
REAL*8 T, X(*), U(*), XNEW(*)
C --- Nothing to do.
RETURN
END
SUBROUTINE DOUTPUT(T, X, U, Y)
REAL*8 T, X(*), U(*), Y(*)
C --- Nothing to do.
RETURN
END
SUBROUTINE TSAMPL(T, X, U, TS, OFFSET)
REAL*8 T,TS,OFFSET,X(*),U(*)
C --- Nothing to do.
RETURN
END
SUBROUTINE SINGUL(T, X, U, SING)
REAL*8 T, X(*), U(*), SING(*)
C --- Nothing to do.
RETURN
END
end
This code will only accept a scalar input. (matrix [1x1])
If I change
SIZE(3) = 1 to SIZE(3) = 5
SIZE(4) = 1 to SIZE(4) = 5
the code will only accept a vector of size 5 (matrix [5x1]), (and output of same size) or... If I change
SIZE(3) = 1 to SIZE(3) = 8
SIZE(4) = 1 to SIZE(4) = 8
the code will only accept a vector of size 8 (matrix [8x1]), (and output of same size)
Is there anyway I can still use the level-1 S-block and have an input with more than one column? (matrix [5x2]) or (matrix [7x8]) etc... and not just a single column vector
I know how to edit the output to change multiple cells in the matrix, but my problem is trying to throw in a [5x2]matrix as the input and i do not know how to edit this so the input is a matrix size, not vector.
although I think i explained it well. Here are the errors for those who like to see them.
Error in port widths or dimensions. Output port 1 of 'SBlockers1_Test/Constant2' is a [5x2] matrix.
Error in port widths or dimensions. Input port 1 of 'SBlockers1_Test/S-Function Matrix1' is a one dimensional vector with 5 elements.
I want to input a 5x2 matrix...(from a constant block) but.... the S-Function block will only accept a 5x1 vector...
The more i look into it, the more i feel like both files need to be changed, not just the sfun_timestwo_for.f :(
The simulink.f code is below for those who dont wish to look it up, its the same code you will find in the demo for simulink
also I do not know anything about Fortran coding. Just what I can google.
Thanks for the help!
C Copyright 1997-2013 The MathWorks, Inc.
#include <fintrf.h>
SUBROUTINE MEXFUNCTION(NLHS, PLHS, NRHS, PRHS)
#ifdef MSWIND
C This is the library needed to set the floating point exception word
C and it needs to be here in the code!
USE MSFLIB
#endif
C .. Scalar arguments ..
INTEGER NLHS, NRHS
C .. Array arguments ..
C-----------------------------------------------------------------------
C (pointer) Replace integer by integer*8 on the DEC Alpha and the
C SGI 64-bit platforms
C
MWPOINTER PLHS(*), PRHS(*)
C-----------------------------------------------------------------------
C
C=======================================================================
C Purpose:
C Glue routine for making FORTRAN MEX-file systems and blocks
C Synopsis:
C [sys,x0] = usersys(t,x,u,flag)
C Arguments:
C Description:
C This file should be linked with the subroutines that return
C derivatives, outputs, discrete states and sample times.
C Use a syntax of the form:
C mex usersys.f simulink.f
C where usersys.f is the name of the user-defined function.
C
C Note, the .F files are designed to be passed through the C language
C preprocessor before passing them onto the fortran compiler. The
C .f files are created from the .F files.
C
C Algorithm:
C Usersys is a MEX-file
C=======================================================================
C Written:
C Aleksandar Bozin Mar 03, 1992
C Modifications, bug fixes and extensions:
C Ned Gulley Apr 29, 1992
C Copyright 1990-2002 The MathWorks, Inc.
C=======================================================================
C .. Parameters ..
INTEGER*4 NSIZES
PARAMETER (NSIZES=6)
REAL*8 HUGE
PARAMETER (HUGE=1.0E+33)
C .. Local scalars ..
C-----------------------------------------------------------------------
C (pointer) Replace integer by integer*8 on the DEC Alpha and the
C SGI 64-bit platforms
C
MWPOINTER X0, SIZEOUT, T, X, U, SYS
C-----------------------------------------------------------------------
C
INTEGER*4 I
INTEGER FLAG
C .. Local arrays ..
INTEGER*4 LSIZE(NSIZES)
REAL*8 DSIZE(NSIZES)
C .. External subroutines ..
EXTERNAL MXCOPYREAL8TOPTR, MEXERRMSGTXT
EXTERNAL SIZES
#if !defined MSWIND
EXTERNAL INITCOND
EXTERNAL DERIVS, DSTATES, OUTPUT, DOUTPUT, SINGUL
EXTERNAL TNEXT, DCOPY
C .. External functions ..
EXTERNAL SAMPLHIT
#endif
LOGICAL SAMPLHIT
C-----------------------------------------------------------------------
C (pointer) Replace integer by integer*8 on the DEC Alpha and the
C SGI 64-bit platforms
C
MWPOINTER MXCREATEDOUBLEMATRIX, MXGETPR
C-----------------------------------------------------------------------
C
EXTERNAL MXCREATEDOUBLEMATRIX, MXGETPR
DOUBLE PRECISION MXGETSCALAR
EXTERNAL MXGETSCALAR
INTEGER*4 MXGETM, MXGETN
EXTERNAL MXGETM, MXGETN
C .. Intrinsic functions ..
INTRINSIC IABS, MAX0, MIN0, DBLE
C .. Scalars in common ..
REAL*8 CURHIT, NXTHIT
C .. Arrays in common ..
INTEGER*4 MDLSIZES(NSIZES)
INTEGER*4 NROWS
C .. Common blocks ..
COMMON /SIMLAB/CURHIT, NXTHIT, MDLSIZES
#ifdef MSWIND
C Set prototypes for all functions which use %VAL's
#include "simulinkf.h"
C
C Set the floating point control word to allow divide by zero
INTEGER(2) CONTROL, NEWCONTROL
CALL GETCONTROLFPQQ(CONTROL)
NEWCONTROL = CONTROL .OR. FPCW$ZERODIVIDE
NEWCONTROL = NEWCONTROL .OR. FPCW$OVERFLOW
NEWCONTROL = NEWCONTROL .OR. FPCW$INVALID
CALL SETCONTROLFPQQ(NEWCONTROL)
#endif
C .. Executable statements ..
C
C Check validity of arguments
C
IF (NRHS .EQ. 0) THEN
IF (NLHS .GT. 2) THEN
CALL MEXERRMSGTXT('Too many output arguments.')
ENDIF
C
C Special case FLAG=0, return sizes and initial conditions
C
PLHS(1) = MXCREATEDOUBLEMATRIX(NSIZES, 1, 0)
SIZEOUT = MXGETPR(PLHS(1))
DO 100 I = 1,NSIZES
LSIZE(I) = 0
100 CONTINUE
CALL SIZES(LSIZE)
DO 150 I = 1,NSIZES
MDLSIZES(I) = LSIZE(I)
DSIZE(I) = DBLE(LSIZE(I))
150 CONTINUE
CALL MXCOPYREAL8TOPTR(DSIZE, SIZEOUT, NSIZES)
IF (NLHS .GT. 1) THEN
NROWS = MDLSIZES(1)+MDLSIZES(2)
PLHS(2) = MXCREATEDOUBLEMATRIX(NROWS, 1, 0)
X0 = MXGETPR(PLHS(2))
CALL INITCOND(%VAL(X0))
ENDIF
CURHIT = -HUGE
NXTHIT = HUGE
RETURN
ENDIF
C
C Right hand side arguments
C
IF ((NLHS .GT. 2) .OR. (NRHS .NE. 4)) THEN
CALL MEXERRMSGTXT('Wrong number of input arguments.')
ENDIF
C
C Check for correct dimensions of input arguments
C
M = MXGETM(PRHS(4))
N = MXGETN(PRHS(4))
IF ((M .NE. 1) .OR. (N .NE. 1)) THEN
CALL MEXERRMSGTXT('Flag must be a scalar variable.')
ENDIF
C
C The sizes vector is needed in most cases, if for nothing else it
C is used for error checking.
C
DO 200 I = 1,NSIZES
LSIZE(I) = 0
200 CONTINUE
CALL SIZES(LSIZE)
DO 250 I = 1,NSIZES
MDLSIZES(I) = LSIZE(I)
250 CONTINUE
FLAG = INT(MXGETSCALAR(PRHS(4)))
IF (FLAG .EQ. 0) THEN
IF (NLHS .GT. 2) THEN
CALL MEXERRMSGTXT('Too many output arguments.')
ENDIF
C
C Special case FLAG=0, return sizes and initial conditions
C
PLHS(1) = MXCREATEDOUBLEMATRIX(NSIZES, 1, 0)
SIZEOUT = MXGETPR(PLHS(1))
DO 300 I = 1,NSIZES
DSIZE(I) = DBLE(LSIZE(I))
300 CONTINUE
CALL MXCOPYREAL8TOPTR(DSIZE, SIZEOUT, NSIZES)
IF (NLHS .GT. 1) THEN
NROWS = MDLSIZES(1)+MDLSIZES(2)
PLHS(2) = MXCREATEDOUBLEMATRIX(NROWS, 1, 0)
X0 = MXGETPR(PLHS(2))
CALL INITCOND(%VAL(X0))
ENDIF
CURHIT = -HUGE
NXTHIT = HUGE
RETURN
ENDIF
C
C Error checking (can be omitted for speed but may cause
C segmentation faults if called with the wrong sizes of
C arguments)
C
IF ((NLHS .GT. 1) .OR. (NRHS .NE. 4)) THEN
CALL MEXERRMSGTXT('Too many output arguments.')
ENDIF
C
C Time parameter
C
M = MXGETM(PRHS(1))
N = MXGETN(PRHS(1))
IF ((M .NE. 1) .OR. (N .NE. 1)) THEN
CALL MEXERRMSGTXT('Time must be a scalar variable.')
ENDIF
C
C State vector
C
M = MXGETM(PRHS(2))
N = MXGETN(PRHS(2))
IF ((M*N) .NE. MDLSIZES(1)+MDLSIZES(2)) THEN
CALL MEXERRMSGTXT('State vector of wrong size.')
ENDIF
C
C Input vector
C
M = MXGETM(PRHS(3))
N = MXGETN(PRHS(3))
IF ((M*N) .NE. MDLSIZES(4)) THEN
CALL MEXERRMSGTXT('Input vector of wrong size.')
ENDIF
C
C Check flag value and return appropriate vector
C
T = MXGETPR(PRHS(1))
X = MXGETPR(PRHS(2))
U = MXGETPR(PRHS(3))
IF (IABS(FLAG) .GT. 5) THEN
IF (IABS(FLAG) .EQ. 9) THEN
PLHS(1) = MXCREATEDOUBLEMATRIX(0, 0, 0)
GOTO 900
ELSE
CALL MEXERRMSGTXT('Not a valid flag number.')
ENDIF
ENDIF
GOTO (400,500,600,700,800) IABS(FLAG)
C
C Flag is 1 or -1, return state derivatives
C
400 CONTINUE
IF (NLHS .GE. 0) THEN
PLHS(1) = MXCREATEDOUBLEMATRIX(MDLSIZES(1), 1, 0)
ENDIF
SYS = MXGETPR(PLHS(1))
CALL DERIVS(%VAL(T), %VAL(X), %VAL(U), %VAL(SYS))
GOTO 900
C
C Flag is 2 or -2, return discrete states
C
500 CONTINUE
IF (NLHS .GE. 0) THEN
PLHS(1) = MXCREATEDOUBLEMATRIX(MDLSIZES(2), 1, 0)
ENDIF
IF (MDLSIZES(2) .NE. 0) THEN
SYS = MXGETPR(PLHS(1))
IF (SAMPLHIT(%VAL(T))) THEN
CALL DSTATES(%VAL(T), %VAL(X), %VAL(U), %VAL(SYS))
ELSE
CALL DCOPY(%VAL(X), MDLSIZES(1)+1, %VAL(SYS), MDLSIZES(2))
ENDIF
ENDIF
GOTO 900
C
C Flag is 3, return system outputs
C
600 CONTINUE
IF (NLHS .GE. 0) THEN
PLHS(1) = MXCREATEDOUBLEMATRIX(MDLSIZES(3), 1, 0)
ENDIF
SYS = MXGETPR(PLHS(1))
IF (SAMPLHIT(%VAL(T))) THEN
CALL DOUTPUT(%VAL(T), %VAL(X), %VAL(U), %VAL(SYS))
ENDIF
CALL OUTPUT(%VAL(T), %VAL(X), %VAL(U), %VAL(SYS))
GOTO 900
C
C Flag is 4, return next time interval for update
C
700 CONTINUE
IF (NLHS .GE. 0) THEN
PLHS(1) = MXCREATEDOUBLEMATRIX(1, 1, 0)
ENDIF
SYS = MXGETPR(PLHS(1))
IF (MDLSIZES(2) .GT. 0) THEN
CALL TNEXT(%VAL(T), %VAL(X), %VAL(U), %VAL(SYS))
ENDIF
CALL MXCOPYREAL8TOPTR(NXTHIT, SYS, 1)
GOTO 900
C
C Flag is 5, return the values of the system root functions
C
800 CONTINUE
IF (NLHS .GE. 0) THEN
PLHS(1) = MXCREATEDOUBLEMATRIX(MDLSIZES(5), 1, 0)
ENDIF
IF (MDLSIZES(5) .NE. 0) THEN
SYS = MXGETPR(PLHS(1))
CALL SINGUL(%VAL(T), %VAL(X), %VAL(U), %VAL(SYS))
ENDIF
GOTO 900
C
C Last card of MEXFUNCTION
C
900 CONTINUE
RETURN
END
REAL*8 FUNCTION HITFCN(TS, OFFSET, T)
C .. Scalar arguments ..
REAL*8 TS, OFFSET, T
C=======================================================================
C Description:
C Function to calculate the next sample time
C Input arguments:
C T time
C OFFSET offset time
C TS sample time
C Remark:
C This function should not be called by the user.
C=======================================================================
C .. Parameters ..
INTEGER*4 NSIZES
PARAMETER (NSIZES=6)
REAL*8 HUGE
PARAMETER (HUGE=1.0E+33)
C .. Local scalars ..
REAL*8 NSAMPL
C .. Intrinsic functions ..
INTRINSIC AINT
C .. Executable statements ..
NSAMPL = (T-OFFSET)/TS
HITFCN = OFFSET+(1.0+AINT(NSAMPL+1.0E-13*(1.0+NSAMPL)))*TS
RETURN
END
SUBROUTINE TNEXT(T, X, U, TN)
C .. Scalar arguments ..
REAL*8 T
C .. Array arguments ..
REAL*8 X(*), U(*), TN(*)
C=======================================================================
C Description:
C Function to return the next sample time
C Input arguments:
C T time
C X state vector
C U input vector
C Output arguments:
C TN a scalar which contains the next sample time
C Remark:
C This function should not be called directly by the user.
C=======================================================================
C .. Parameters ..
INTEGER*4 NSIZES
PARAMETER (NSIZES=6)
REAL*8 HUGE
PARAMETER (HUGE=1.0E+33)
C .. Local scalars ..
REAL*8 TS, OFFSET
C .. External subroutines ..
EXTERNAL TSAMPL
C .. External functions ..
DOUBLE PRECISION HITFCN
EXTERNAL HITFCN
C .. Scalars in common ..
REAL*8 CURHIT, NXTHIT
C .. Arrays in common ..
INTEGER*4 MDLSIZES(NSIZES)
C .. Common blocks ..
COMMON /SIMLAB/CURHIT, NXTHIT, MDLSIZES
C .. Executable statements ..
CALL TSAMPL(T, X, U, TS, OFFSET)
IF (CURHIT .EQ. -HUGE) THEN
CURHIT = HITFCN(TS, OFFSET, T-TS)
ELSE
CURHIT = NXTHIT
ENDIF
NXTHIT = HITFCN(TS, OFFSET, T)
TN(1) = NXTHIT
RETURN
END
LOGICAL FUNCTION SAMPLHIT(T)
C .. Scalar arguments ..
REAL*8 T
C=======================================================================
C Purpose:
C Function to check whether it is a sample hit or not
C Input arguments:
C T time
C Description:
C This functions returns a boolean variable which can be used
C to decide whether a sample hit occured or not.
C Remark:
C Called internally, but can be used by the user as well.
C=======================================================================
C .. Parameters ..
INTEGER*4 NSIZES
PARAMETER (NSIZES=6)
C .. Scalars in common ..
REAL*8 CURHIT, NXTHIT
C .. Arrays in common ..
INTEGER*4 MDLSIZES(NSIZES)
C .. Common blocks ..
COMMON /SIMLAB/CURHIT, NXTHIT, MDLSIZES
C .. Executable statements ..
IF (T .EQ. CURHIT) THEN
SAMPLHIT = .TRUE.
ELSE
SAMPLHIT = .FALSE.
ENDIF
RETURN
END
SUBROUTINE DCOPY(X, OFFSET, Y, N)
C .. Scalar arguments ..
INTEGER OFFSET, N
C .. Array arguments ..
REAL*8 X(*), Y(*)
C=======================================================================
C Purpose:
C Function to copy one array into another
C Input arguments:
C X input array
C OFFSET an index of the first element to be copied
C N number of elements to be copied
C Output arguments:
C Y a vector containing a copy of the input vector
C=======================================================================
C .. Local scalars ..
INTEGER I, IB
C .. Executable statements ..
IB = OFFSET
DO 100 I = 1,N
Y(I) = X(IB)
IB = IB+1
100 CONTINUE
RETURN
END

Answers (0)

Categories

Find more on Historical Contests in Help Center and File Exchange

Products

Community Treasure Hunt

Find the treasures in MATLAB Central and discover how the community can help you!

Start Hunting!