⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 sb2slmdt.m

📁 数字通信第四版原书的例程
💻 M
字号:
%SB2SLMDT provides FORTRAN source code interface for SystemBuild user blocks.
%      Only string data variable assignments are in this script file.
%      It is called by SB2SLMAT.

%	Wes Wang 11/92
%	Copyright (c) 1990-93 by The MathWorks, Inc.
%	$Revision: 1.8 $  $Date: 1993/06/09 22:09:40 $

x1= [setstr(10) ...
'      SUBROUTINE MEXFUNCTION(NLHS, PLHS, NRHS, PRHS)   ' setstr(10) ...
'C   Synopsis:                                          ' setstr(10) ...
'C      [sys,x0] = usersys(t,x,u,flag,pmi,pmr,pms,x0,dt)' setstr(10) ...
'C  Written:                                            ' setstr(10) ...
'C      Wes Wang, The MathWorks, Inc. 11/24/92          ' setstr(10) ...
'      INTEGER          NLHS, NRHS                      ' setstr(10) ...
'      INTEGER          PLHS(*), PRHS(*)                ' setstr(10) ...
'      INTEGER*4        NPMI, NPMR, NU, NY, NX          ' setstr(10) ...
];

x2=[setstr(10) ...
'      REAL*8           SIZE(6), PMSS(7), PMII(NPMI)    ' setstr(10) ...
'      INTEGER*4        PMS(7), PMI(NPMI)               ' setstr(10) ...
'      INTEGER*4        SIZEOUT, SYSOUT                 ' setstr(10) ...
'      REAL*8           T, DT, PMR(NPMR), U(NU)         ' setstr(10) ...
'      REAL*8           RINFO(3)                        ' setstr(10) ...
'      INTEGER*4        FLAG, I                         ' setstr(10) ...
'      INTEGER*4        IINFOR(14)                      ' setstr(10) ...
];

x3=[setstr(10) ...
'      EXTERNAL         MXCOPYPTRTOREAL8               ' setstr(10) ... 
'      INTEGER*4        MXCREATEFULL, MXGETPR          ' setstr(10) ...
'      EXTERNAL         MXCREATEFULL, MXGETPR          ' setstr(10) ...
'      DOUBLE PRECISION MXGETSCALAR                    ' setstr(10) ...
'      EXTERNAL         MXGETSCALAR                    ' setstr(10) ...
'      EXTERNAL         MXCOPYPTRTOREAL8, MXCOPYREAL8TOPTR' setstr(10) ...
'      EXTERNAL         MEXERRMSGTXT, MXCOPYINTEGER4TOPTR' setstr(10) ...
'      EXTERNAL         MATWR                          ' setstr(10) ...
'      INTRINSIC        IABS, MAX0, MIN0, INT ' setstr(10) setstr(10) ...      
'      IF ((NLHS .GT. 2) .OR. (NRHS .NE. 9)) THEN      ' setstr(10) ...
'         CALL MEXERRMSGTXT(''Wrong number of input arguments.'')' setstr(10) ...
'         RETURN                                       ' setstr(10) ...
'      ENDIF                                           ' setstr(10) ...
'C     GET ALL OF THE PARAMETERS                       ' setstr(10) ...
'C     PMS = [INPUT OUTPUT STATE PMI PMR C/D WWDT]     ' setstr(10) ...
'      CALL MXCOPYPTRTOREAL8(MXGETPR(PRHS(5)),PMSS,7)  ' setstr(10) ...
'      IF (PMSS(2) .LE. 0) THEN                        ' setstr(10) ...
'         PMSS(2) = 1                                  ' setstr(10) ...
'      ENDIF                                           ' setstr(10) ...
'      DO 10 I = 1,7                                   ' setstr(10) ...
'10    PMS(I) = INT(PMSS(I))                           ' setstr(10) ...
'C      WRITE(*,*) ''PMS''                             ' setstr(10) ...
'C      WRITE(*,1) PMS                                 ' setstr(10) ...
'1     FORMAT(6I10)                                    ' setstr(10) ...
'      FLAG = INT(MXGETSCALAR(PRHS(4)))                ' setstr(10) ...
'C      WRITE(*,*) ''FLAG''                            ' setstr(10) ...
'C      WRITE(*,1) FLAG                                ' setstr(10) ...
'      CALL MXCOPYPTRTOREAL8(MXGETPR(PRHS(6)),PMII,PMS(4))' setstr(10) ...
'      DO 20 I = 1,PMS(4)                              ' setstr(10) ...
'20    PMI(I) = INT(PMII(I))                           ' setstr(10) ...
'C      WRITE(*,*) ''PMI''                             ' setstr(10) ...
'C      WRITE(*,1) PMI                                 ' setstr(10) ...
'      CALL MXCOPYPTRTOREAL8(MXGETPR(PRHS(7)),PMR,PMS(5))' setstr(10) ...
'C      WRITE(*,*) ''PMR''                             ' setstr(10) ...
'C      WRITE(*,2) PMR                                 ' setstr(10) ...
'2     FORMAT(6F15.6)                                  ' setstr(10) ...
'      CALL MXCOPYPTRTOREAL8(MXGETPR(PRHS(8)),X0,PMS(3))' setstr(10) ...
'C      WRITE(*,*) ''X0''                              ' setstr(10) ...
'C      WRITE(*,2) X0                                  ' setstr(10) ...
'      IF (FLAG .NE. 0) THEN                           ' setstr(10) ...
'         T   = MXGETSCALAR(PRHS(1))                   ' setstr(10) ...
'         CALL MXCOPYPTRTOREAL8(MXGETPR(PRHS(2)),X,PMS(3))' setstr(10) ...
'C      WRITE(*,*) ''X''                               ' setstr(10) ...
'C      WRITE(*,2) X                                   ' setstr(10) ...
'         CALL MXCOPYPTRTOREAL8(MXGETPR(PRHS(3)),U,PMS(1))' setstr(10) ...
'C      WRITE(*,*) ''U''                               ' setstr(10) ...
'C      WRITE(*,2) U                                   ' setstr(10) ...
'         DT  = MXGETSCALAR(PRHS(9))                   ' setstr(10) ...
'      ENDIF                                           ' setstr(10) ...
'      IF (FLAG .EQ. 0) THEN                           ' setstr(10) ...
'         PLHS(1) = MXCREATEFULL(6, 1, 0)              ' setstr(10) ...
'         SIZEOUT = MXGETPR(PLHS(1))                   ' setstr(10) ...
'         DO 200 I = 1,6                               ' setstr(10) ...
'            SIZE(I) = 0                               ' setstr(10) ...
' 200     CONTINUE                                     ' setstr(10) ...
'         IF (PMS(6) .EQ. 0) THEN                      ' setstr(10) ...
'            SIZE(1) = PMSS(3)                         ' setstr(10) ...
'         ELSE                                         ' setstr(10) ...
'            SIZE(2) = PMSS(3)                         ' setstr(10) ...
'         ENDIF                                        ' setstr(10) ...
'         SIZE(3) = PMSS(2)                            ' setstr(10) ...
'         SIZE(4) = PMSS(1)                            ' setstr(10) ...
'         SIZE(6) = PMSS(7)                            ' setstr(10) ...
'         IF (PMS(3) .LE. 0) THEN                      ' setstr(10) ...
'            SIZE(6) = 1                               ' setstr(10) ...
'         ENDIF                                        ' setstr(10) ...
'C        WRITE(*,*) ''SIZE''                          ' setstr(10) ...
'C        WRITE(*,2) SIZE                              ' setstr(10) ...
'         CALL MXCOPYREAL8TOPTR(SIZE, SIZEOUT, 6)      ' setstr(10) ...
'         PLHS(2) = MXCREATEFULL(PMS(3), 1, 0)         ' setstr(10) ...
'         SYSOUT = MXGETPR(PLHS(2))                    ' setstr(10) ...
'         CALL MXCOPYREAL8TOPTR(X0, SYSOUT, PMS(3))    ' setstr(10) ...
'         RETURN                                       ' setstr(10) ...
'      ENDIF                                           ' setstr(10) ...
'C     THE REGULAR CALCULATION FROM USERXX             ' setstr(10) ...
'      DO 250 I = 1,14                                 ' setstr(10) ...
'         IINFOR(I) = 0                                ' setstr(10) ...
' 250  CONTINUE                                        ' setstr(10) ...
'      IF (IABS(FLAG) .EQ. 1) THEN                     ' setstr(10) ...
'         IINFOR(3) = 1                                ' setstr(10) ...
'      ELSEIF (IABS(FLAG) .EQ. 2) THEN                 ' setstr(10) ...
'         IINFOR(3) = 1                                ' setstr(10) ...
'         T = T+DT                                     ' setstr(10) ...
'      ELSEIF (IABS(FLAG) .EQ. 3) THEN                 ' setstr(10) ...
'         IINFOR(4) = 1                                ' setstr(10) ...
'      ELSEIF (IABS(FLAG) .EQ. 4) THEN                 ' setstr(10) ...
'         IINFOR(4) = 3                                ' setstr(10) ...
'         T = T+DT                                     ' setstr(10) ...
'      ENDIF                                           ' setstr(10) ...
'      IINFOR(9)  = PMS(4)                             ' setstr(10) ...
'      IINFOR(10) = PMS(5)                             ' setstr(10) ...
'      IINFOR(11) = 1                                  ' setstr(10) ...
'      RINFO(1) = T                                    ' setstr(10) ...
'      RINFO(2) = 0                                    ' setstr(10) ...
'      RINFO(3) = 0                                    ' setstr(10) ...
'      IF (PMS(6) .NE. 0) THEN                         ' setstr(10) ...
'         RINFO(2) = DT                                ' setstr(10) ...
'      ENDIF                                           ' setstr(10) ...
'      CALL '];

x4 = [setstr(10) ...
'     *(IINFO, RINFO, U, PMS(1), X, XDOT, PMS(3), Y, PMS(2), PMR, PMI)' ...
 setstr(10) ...
'C      WRITE(*,*) ''X''                              ' setstr(10) ...
'C      WRITE(*,2) X                                  ' setstr(10) ...
'C      WRITE(*,*) ''XDOT''                           ' setstr(10) ...
'C      WRITE(*,2) XDOT                               ' setstr(10) ...
'      IF (IABS(FLAG) .EQ. 1) THEN                    ' setstr(10) ...
'         IF (PMS(6) .EQ. 0) THEN                     ' setstr(10) ...
'            I = PMS(3)                               ' setstr(10) ...
'         ELSE                                        ' setstr(10) ...
'            I = 0                                    ' setstr(10) ...
'         ENDIF                                       ' setstr(10) ...
'         PLHS(1) = MXCREATEFULL(I, 1, 0)             ' setstr(10) ...
'         SYSOUT = MXGETPR(PLHS(1))                   ' setstr(10) ...
'         CALL MXCOPYREAL8TOPTR(XDOT,SYSOUT, I)       ' setstr(10) ...
'C        WRITE(*,*) ''XDOT''                         ' setstr(10) ...
'C        WRITE(*,1) PMS(3),FLAG                      ' setstr(10) ...
'C        WRITE(*,2) XDOT                             ' setstr(10) ...
'      ELSEIF (IABS(FLAG) .EQ. 2) THEN                ' setstr(10) ...
'         IF (PMS(6) .EQ. 0) THEN                     ' setstr(10) ...
'            I = 0                                    ' setstr(10) ...
'         ELSE                                        ' setstr(10) ...
'            I = PMS(3)                               ' setstr(10) ...
'         ENDIF                                       ' setstr(10) ...
'         PLHS(1) = MXCREATEFULL(I, 1, 0)             ' setstr(10) ...
'         SYSOUT = MXGETPR(PLHS(1))                   ' setstr(10) ...
'         CALL MXCOPYREAL8TOPTR(X,SYSOUT, I)          ' setstr(10) ...
'C      WRITE(*,*) ''X''                              ' setstr(10) ...
'C      WRITE(*,1) PMS(3),FLAG                        ' setstr(10) ...
'C      WRITE(*,2) X                                  ' setstr(10) ...
'      ELSEIF (IABS(FLAG) .EQ. 3) THEN                ' setstr(10) ...
'         PLHS(1) = MXCREATEFULL(PMS(2), 1, 0)        ' setstr(10) ...
'         SYSOUT = MXGETPR(PLHS(1))                   ' setstr(10) ...
'         CALL MXCOPYREAL8TOPTR(Y,SYSOUT, PMS(2))     ' setstr(10) ...
'C      WRITE(*,*) ''Y''                              ' setstr(10) ...
'C      WRITE(*,1) PMS(2),FLAG                        ' setstr(10) ...
'C      WRITE(*,2) Y                                  ' setstr(10) ...
'      ELSEIF (IABS(FLAG) .EQ. 4) THEN                ' setstr(10) ...
'         PLHS(1) = MXCREATEFULL(1, 1, 0)             ' setstr(10) ...
'         SYSOUT = MXGETPR(PLHS(1))                   ' setstr(10) ...
'         CALL MXCOPYREAL8TOPTR(T, SYSOUT, 1)         ' setstr(10) ...
'C      WRITE(*,*) ''DT''                             ' setstr(10) ...
'C      WRITE(*,2) DT,FLAG                            ' setstr(10) ...
'      ELSEIF (IABS(FLAG) .EQ. 5) THEN                ' setstr(10) ...
'         PLHS(1) = MXCREATEFULL(PMS(2), 1, 0)        ' setstr(10) ...
'         SYSOUT = MXGETPR(PLHS(1))                   ' setstr(10) ...
'         CALL MXCOPYREAL8TOPTR(Y,SYSOUT, PMS(2))     ' setstr(10) ...
'C      WRITE(*,*) ''Y''                              ' setstr(10) ...
'C      WRITE(*,1) PMS(2),FLAG                        ' setstr(10) ...
'C      WRITE(*,2) Y                                  ' setstr(10) ...
'      ENDIF                                          ' setstr(10) ...
'      RETURN                                         ' setstr(10) ...
'      END                                            ' setstr(10) ...
'      SUBROUTINE MATWR(X)                            ' setstr(10) ...
'      CHARACTER*80 X                                 ' setstr(10) ...
'      EXTERNAL      MEXERRMSGTXT                     ' setstr(10) ...
'      CALL MEXERRMSGTXT(X)                           ' setstr(10) ...
'      RETURN                                         ' setstr(10) ...
'      END                                            ' setstr(10) ...
];

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -