MEX Fortran code crashes Matlab

Hello, I have written a MEX Fortran code to take advantage of MSC's FORTRAN READ4.F function that reads NASTRAN OP4 (binary) files in order get the necessary matrices in Matlab. It inconsistently crashes Matlab and I am having a hard time understanding why. It will run fine until I start using it in my object oriented class structure. From these forums and the research I have done, I believe I am getting memory leak, but I'm not sure how to figure out where it is. Any suggestions would be much appreciated.

gateway function:

#include "fintrf.h"
C==========================================================

C     GATEWAY ROUTINE FOR READ4 FUNCTION
C     to compile: mex read4.F read4_gateway.F
C     matlab syntax: [MAA, PHIA] = read4(output4_file_path)
C==========================================================
      subroutine mexFunction(nlhs, plhs, nrhs, prhs)

C ---------------------------------------------------------

C DECLERATIONS
C ---------------------------------------------------------

        mwPointer plhs(*), prhs(*)
        integer nlhs, nrhs
        mwPointer mxCreateString
        mwPointer mxGetString 
        mwPointer mxGetM, mxGetN
        mwPointer mxCreateNumericArray
        integer*4 mxClassIDFromClassName
        mwPointer mxIsInt8 
        mwPointer mxGetPr
        integer mxIsChar
        mwPointer mrows, ncols
        mwSize maxbuf, mwNROW, mwNCOL
        integer*4 ComplexFlag
        integer*4 classid
        mwSize ndim, MAA_size, PHIA_size
        mwSize dims(2)
        parameter(maxbuf = 255)
        character*120 line
        integer*4 outPrint
        character*255 output4_file_path 
        mwPointer  strlen, MAA_pr, PHIA_pr
        LOGICAL THERE
        INTEGER IU
        INTEGER NRB(20),NFB(150)
        REAL MAA, PHIA
        REAL, DIMENSION(:, :), ALLOCATABLE :: MAA_SMALL
        REAL, DIMENSION(:, :), ALLOCATABLE :: PHIA_SMALL
        INTEGER AllocateStatus, DeAllocateStatus
        CHARACTER*4 NAME(2)
        COMMON/ARRAY/MAA(8000,8000),PHIA(8000,8000)
    COMMON/LAMA/IMODE,LAMA(150,5)

        IU = 2
  C ----------------------------------------------------------------------
  C I/O LOGIC
  C ----------------------------------------------------------------------
  C     Check for proper number of arguments. 
        if(nrhs .ne. 1) then
           write(line,*) 'error: must have 1 input argument'
           outPrint=mexPrintf(line//achar(13)) 
           return

C     The input must be a string.
      elseif(mxIsChar(prhs(1)) .ne. 1) then
         write(line,*) 'error: input argument is not a string'
         outPrint=mexPrintf(line//achar(13)) 
         return
      endif

C     Check for proper number of outputs. 
      if(nlhs .ne. 2) then
         write(line,*) 'error: must have output arguments'
         outPrint=mexPrintf(line//achar(13)) 
         return
      endif

C     Get the size of the input string.
      mrows = mxGetM(prhs(1))
      ncols = mxGetN(prhs(1))

C     Get the length of the input string and validate.
      strlen = mrows*ncols
      if (strlen .gt. maxbuf) then
         write(line,*) 'error: input is greater than max str size'
         outPrint=mexPrintf(line//achar(13)) 
         return
      endif

C     Get the string 
      status = mxGetString(prhs(1), output4_file_path, maxbuf)

C     The input must be a valid file.
      INQUIRE( FILE=output4_file_path, EXIST=THERE ) 
      if(.NOT. THERE) then 
         write(line,*) 'error: file is not valid'
         outPrint=mexPrintf(line//achar(13)) 
         return
      endif     
C ----------------------------------------------------------------------
C OPEN OUTPUT4 FILE
C ----------------------------------------------------------------------
      OPEN(UNIT=2,STATUS='UNKNOWN',FORM='UNFORMATTED',
     & ACCESS='SEQUENTIAL',FILE=output4_file_path)     
C ----------------------------------------------------------------------
C SET MEX VARIABLES
C ----------------------------------------------------------------------
      classid = mxClassIDFromClassName('single')
      complexflag = 0
      ndim = 2
C ----------------------------------------------------------------------
C READ MAA MATRIX FROM OUTPUT4 FILE
C ----------------------------------------------------------------------
      IDL=0
      CALL READ4(MAA,NCOL,NROW,NF,NTYPE,NAME,8000,8000,X,IDL,IU)   
C ----------------------------------------------------------------------
C TRUNCATE MAA TO NROW BY NCOL MATRIX
C ----------------------------------------------------------------------
      ALLOCATE ( MAA_SMALL(NROW, NCOL), STAT = AllocateStatus)
      IF (AllocateStatus /= 0) STOP "*** Not enough memory ***"
      DO 510 I=1,NROW
       DO 500 J=1,NCOL
        MAA_SMALL(I,J)=MAA(I,J)
  500  CONTINUE
  510 CONTINUE
C ----------------------------------------------------------------------
C POINT TO RETURN VARIABLE
C ----------------------------------------------------------------------
      MAA_size = NROW*NCOL
      dims(1) = NROW
      dims(2) = NCOL
      plhs(1) = mxCreateNumericMatrix(dims(1), dims(2), 
     +          classid, 
     +          complexflag)
      MAA_pr = mxGetPr(plhs(1))
      call mxCopyReal4ToPtr(MAA_SMALL, MAA_pr, MAA_size)
      DEALLOCATE (MAA_SMALL, STAT = DeAllocateStatus)
      IF (AllocateStatus /= 0) STOP "*** Could not dealocate ***"  
C ----------------------------------------------------------------------
C READ PHIA MATRIX FROM OUTPUT4 FILE
C ----------------------------------------------------------------------
      IDL=0
      CALL READ4(PHIA,NCOL,NROW,NF,NTYPE,NAME,8000,8000,X,IDL,IU)
C ----------------------------------------------------------------------
C TRUNCATE PHIA TO NROW BY NCOL MATRIX
C ----------------------------------------------------------------------
      ALLOCATE ( PHIA_SMALL(NROW, NCOL), STAT = AllocateStatus)
      IF (AllocateStatus /= 0) STOP "*** Not enough memory ***"
      DO 610 I=1,NROW
       DO 600 J=1,NCOL
        PHIA_SMALL(I,J)=PHIA(I,J)
  600  CONTINUE
  610 CONTINUE
C ----------------------------------------------------------------------
C POINT TO RETURN VARIABLE
C ----------------------------------------------------------------------
      PHIA_size = NROW*NCOL
      dims(1) = NROW
      dims(2) = NCOL
      plhs(2) = mxCreateNumericMatrix(dims(1), dims(2), 
     +          classid, 
     +          complexflag)
      PHIA_pr = mxGetPr(plhs(2))
      CALL mxCopyReal4ToPtr(PHIA_SMALL, PHIA_pr, PHIA_size)
      DEALLOCATE (PHIA_SMALL, STAT = DeAllocateStatus)
      IF (AllocateStatus /= 0) STOP "*** Could not dealocate ***"  
C ----------------------------------------------------------------------
C CLOSE OUTPUT4 FILE
C ----------------------------------------------------------------------
      CLOSE(UNIT=2)
      RETURN
      END

READ4.F:

C***********************************************************************
C
C <READ4> OUTPUT4 MATRIX READ
C
C***********************************************************************
      SUBROUTINE READ4(B,NCOL,NROW,NF,NTYPE,NAME,NRB,NCB,DB,IDL,IU)
      CHARACTER*4 NAME(2)
      DOUBLE PRECISION DB(NRB,NCB)
      DOUBLE PRECISION DA,DD(1)
      REAL B(NRB,NCB)
      REAL DR(2)
      DIMENSION A(8000),DA(8000),IA(8000)
      EQUIVALENCE (A(1),DA(1),IA(1))
      EQUIVALENCE (DD(1),DR(1))
      INTEGER LENA
      CHARACTER*120 line 
      integer*4 outPrint 

        READ(IU) NCOL,NROW,NF,NTYPE,NAME(1),NAME(2)
        LENA = 8000
        DO 30 I=1,NCOL
         DO 20 J=1,NROW
          IF(IDL.EQ.0) THEN
           B(J,I)=0.0
          ELSE
           DB(J,I)=0.0D0
          ENDIF
     20  CONTINUE
     30 CONTINUE
        DO 130 I=1,NCOL
         READ(IU) ICOL,IROW,NW,(A(K),K=1,NW)
         IF(ICOL.GT.NCOL) RETURN
         IF(IROW.EQ.0) GOTO 70
         IF(NTYPE.EQ.2) GOTO 50
         DO 40 J=1,NW
          K=IROW+J-1
          IF(IDL.EQ.0) THEN
           B(K,ICOL)=A(J)
          ELSE
           DB(K,ICOL)=A(J)
          ENDIF
     40  CONTINUE
         GOTO 130
     50  NW=NW/2
         DO 60 J=1,NW
          K=IROW+J-1
          IF(IDL.EQ.0) THEN
           B(K,ICOL)=DA(J)
          ELSE
           DB(K,ICOL)=DA(J)
          ENDIF
     60  CONTINUE
         GOTO 130
     70  CONTINUE
         NTR=1
     80  L=IA(NTR)/65536
         IROW=IA(NTR)-L*65536
         NTW=L-1
         IF(NTYPE.EQ.2) GOTO 110
         DO 90 J=1,NTW
          K=IROW+J-1
          IF(IDL.EQ.0) THEN
           B(K,ICOL)=A(NTR+J)
          ELSE
           DB(K,ICOL)=A(NTR+J)
          ENDIF
     90  CONTINUE
    100  NTR=NTR+L
         IF(NTR.GE.NW) GOTO 130
         GOTO 80
    110  CONTINUE
         DO 120 J=1,NTW,2
          K=IROW+J/2
          DR(1)=A(NTR+J)
          DR(2)=A(NTR+J+1)
          IF(IDL.EQ.0) THEN
           B(K,ICOL)=DD(1)
          ELSE
           DB(K,ICOL)=DD(1)
          ENDIF
    120  CONTINUE
         GOTO 100
    130 CONTINUE
        READ(IU)ICOL,IROW,NW,(A(K),K=1,NW)
        RETURN
        END

Answer 1

[James Tursa]

I haven't had time to look this over in any detail yet, but the first thing you should do is replace those STOP statements. E.g., replace

      IF (AllocateStatus /= 0) STOP "*** Not enough memory ***"

with something like

      IF (AllocateStatus /= 0) THEN
          CALL mexErrMsgTxt("*** Not enough memory ***")
      ENDIF

That way you will get a graceful exit to the routine instead of a forced crash. I would also advise changing your argument check errors to this as well. E.g., change

        if(nrhs .ne. 1) then
           write(line,*) 'error: must have 1 input argument'
           outPrint=mexPrintf(line//achar(13)) 
           return

to

        if(nrhs .ne. 1) then
           CALL mexErrMsgTxt('error: must have 1 input argument')

[Paul Jacks]

James - Thanks for the response and thank you for the advice on removing the STOPs. I was able to solve this issue by including an "IMPLICIT NONE" call at the beginning of the gateway function.