import_real_full.F

Go to the documentation of this file.

#include "fintrf.h"
C======================================================================
C     Gateway routine to call the zggev.f function from LAPACK package.
C     (See: http://www.netlib.org/lapack/explore-html/d9/d52/dggev_8f.html for details)
C     Copyright (C) 2009-2015 Peter Rakyta, Ph.D.
C
C     This program is free software: you can redistribute it and/or modify
C     it under the terms of the GNU General Public License as published by
C     the Free Software Foundation, either version 3 of the License, or
C     (at your option) any later version.
C 
C     This program is distributed in the hope that it will be useful,
C     but WITHOUT ANY WARRANTY; without even the implied warranty of
C     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
C     GNU General Public License for more details.
C
C     You should have received a copy of the GNU General Public License
C     along with this program.  If not, see http://www.gnu.org/licenses/.
C     
C======================================================================
C     Gateway routine
      subroutine mexfunction(nlhs, plhs, nrhs, prhs)

C     Declarations
      implicit none

C     mexFunction arguments:
      mwpointer plhs(*), prhs(*)
      integer nlhs, nrhs


C     Function declarations:
      mwpointer mxgetjc
      mwpointer mxgetir
      mwpointer mxcreatestring
      mwpointer mxgetstring, getstring_stat 
      integer mxIsChar

C     Arguments for copying data between fortran and MATLAB
      integer*4 complexflag

      mwpointer mxgetpr
      mwpointer mxcreatedoublematrix
      mwpointer mxgetm, mxgetn

      logical fileExist
      character(len=100) :: filename 
      character(len=7) :: file_status

C     Array information:
      mwpointer mxrows, mxcols !size of the input string containing the filename
      integer*4 strlen ! the length of the input string

C     Arguments for computational routine:  
C     fortran representation of the input matrix (CSR format)
      integer*4 rows, cols
      real*8, allocatable ::  mtx(:,:) 
      mwpointer mxmtx
        
C     Parameters for pardiso
      integer i,j

#ifdef DEBUG
C     Debug parameters
      integer*4 mexPrintf
      integer*4 tmp
      character*800 line
#endif


C-----------------------------------------------------------------------
C     Check for proper number of arguments. 
      if(nrhs .ne. 1) then
         call mexerrmsgidandtxt ('MATLAB:import_real_full:nInput',
     +                           'One input required.')
      elseif(nlhs .gt. 1) then
         call mexerrmsgidandtxt ('MATLAB:import_real_full:nOutput',
     +                           'Too many output arguments.')
      endif

C     Validate inputs      

C     The input filename must be a string.
       if(mxischar(prhs(1)) .ne. 1) then
         call mexerrmsgidandtxt ('MATLAB:import_real_full:NonString',
     +                 'Input filename must be a string.')
       endif

C     Get the size of the input string.
       mxrows = mxgetm(prhs(1))
       mxcols = mxgetn(prhs(1))

C     Get the length of the input string and validate.
       strlen = int(mxrows*mxcols, 4)
       if (strlen .gt. len(filename)) then
         call mexerrmsgidandtxt ('MATLAB:import_real_full:NonDouble',
     +             'input filename is greater than max str size.')   
       endif

C     Get the input filename.
      getstring_stat = 
     + mxgetstring(prhs(1), filename, int(len(filename), 8))

#ifdef DEBUG
      write(line,*) 'Input file name: ',filename, new_line('A')
      tmp = mexprintf(line)
#endif



C     Read in the matrix from the binary
C     Testing the existance of the input file containing the sparse matrix A    
      inquire(file=trim(filename),exist=fileexist)!check if it exist
      if(.not.fileexist)then
         call mexerrmsgidandtxt ('MATLAB:import_real_full:FileNotFound',
     +             'input file ', trim(filename), 'not found.')  
      endif

C     Opening the file to read in data   
      OPEN(unit=6, file=trim(filename),status='OLD'
     + ,form='UNFORMATTED')

      READ(6,end=999,err=1000) rows
      READ(6,end=999,err=1000) cols

#ifdef DEBUG
      write(line,*) 'rows: ',rows, ' cols: ', cols, new_line('A')
      tmp = mexprintf(line)
#endif

      allocate(mtx(rows,cols))
      if ( .not.(allocated(mtx) )) then
         call mexerrmsgidandtxt (
     +                  'MATLAB:import_real_full:BadAllocation',
     +             'Memory space failed to allocate for the matrix.')   
      end if

      do j = 1, cols
        READ(6,end=999,err=1000) mtx(:,j)   
      end do


C     Closing the input file
      CLOSE(unit=6)


      complexflag = 0;
      mxrows = int( rows, 8)
      mxcols = int( cols, 8)
      plhs(1) = mxcreatedoublematrix(mxrows, mxcols, 
     + complexflag) 
      mxmtx = mxgetpr(plhs(1))
      call mxcopyreal8toptr(mtx, mxmtx,mxrows*mxcols) 

      deallocate(mtx)
      return

 999  call mexerrmsgidandtxt ('MATLAB:import_real_full:FileEnd',
     +   'File end reached while reading the file')        

 1000 call mexerrmsgidandtxt ('MATLAB:import_real_full:FileError',
     +   'Error occured while reading the file')        



      return
      

      end