Файл: Лекция 11.pdf

16 

Напишем теперь функцию-обертку, куда будем передавать объявлен-

ные аргументы. Перейдем в Фортран и создадим файл QS12R_wrapper.F. 
 
#include "fintrf.h" 
 
! Gateway routine 
      subroutine mexFunction(nlhs, plhs, nrhs, prhs) 
 
! Declarations 
      implicit none 
 
! mexFunction arguments: 
      mwPointer plhs(*), prhs

(*)     ! массивы произвольного размера 

      integer nlhs, nrhs 
 
! Function declarations: 
      mwPointer mxGetPr 
      mwPointer mxGetData 
      mwPointer mxCreateNumericArray 
      integer mxIsClass 
      integer mxClassIDFromClassName 
      integer mexCallMATLAB 
      integer mexPrintf 
 
! Variables 
      real RESULT, A, B, err   ! MATLAB 

использует тип double, но мы исполь-

зуем single 
      integer N, IERR, status, classid 
      

mwPointer input(2), output(1)   ! массивы указателей 

17 

       
      character*120 line 
      integer k 
       
! Program 
!----------------------------------------------------------------------- 
!     Check for proper number of arguments.  
      if(nrhs .ne. 5) then 
         call mexErrMsgIdAndTxt ('MATLAB:QS12R_wrapper:nInput', 
     +                           'Five inputs required.') 
      elseif(nlhs .gt. 1) then 
         call mexErrMsgIdAndTxt ('MATLAB:QS12R_wrapper:nOutput', 
     +                           'Too many output arguments.') 
      endif 
 
!     Validate inputs 
 
      if(mxIsClass(prhs(1), 'function_handle') .ne. 1) then 
         call mexErrMsgIdAndTxt ('1st input argument must be a 
     +                           function_handle') 
      elseif(mxIsClass(prhs(2), 'single') .ne. 1) then 
         call mexErrMsgIdAndTxt ('2nd input argument must be a single') 
      elseif(mxIsClass(prhs(3), 'single') .ne. 1) then 
         call mexErrMsgIdAndTxt ('3rd input argument must be a single') 
      elseif(mxIsClass(prhs(4), 'single') .ne. 1) then 
         call mexErrMsgIdAndTxt ('4th input argument must be a single') 
      elseif(mxIsClass(prhs(5), 'int32') .ne. 1) then 
         call mexErrMsgIdAndTxt ('5th input argument must be an int32') 
      endif 
! -------------------------------------------------------------------------- 
       
      input(1) = prhs(1)      ! 

копируем указатель на ссылку на функцию 

       
      classid = mxClassIDFromClassName ('single

')     ! определяем класс аргу-

мента вычисляемой функции 
      input(2) = mxCreateNumericArray (2, (/1,1/), classid

, 0)    ! создаем указа-

тель на аргумент, сюда потом будем записывать аргумент функции 
       
! 

у указателя prhs(2) надо взять еще указатель... 

      call mxCopyPtrToReal4 (mxGetPr (prhs(2)), A,   1)      ! WARNING: 

переменная должна быть REAL4 
      call mxCopyPtrToReal4 (mxGetPr (prhs(3)), B,   1)      ! WARNING: 

переменная должна быть REAL4 

18 

      call mxCopyPtrToReal4 (mxGetPr (prhs(4)), err, 1)      ! WARNING: 

переменная должна быть REAL4 
      call mxCopyPtrToInteger4 (mxGetPr (prhs(5)), N,   1)      ! WARNING

: пе-

ременная должна быть INT 
       
      call QS12R (RESULT, A, B, ourfunc, err, N, IERR

)   ! выполнение функ-

ции, ради которой все и затевалось 
 
      write (line, *) 'A number of nodes = ', N     

! итоговое количество узлов для 

заданной точности 
      k = mexPrintf (line//achar(13)) 
       
      plhs(1) = mxCreateNumericArray (2, (/1,1/), classid

, 0)  ! в plhs(1) нет объ-

екта, надо его создать 
      call mxCopyReal4ToPtr (RESULT, mxGetPr(plhs

(1)), 1)  ! запишем резуль-

тат на выход, не забываем о соответствии типов 
       
      

! не забываем за собой убирать 

      call mxDestroyArray (input (2)) 
       
       
      

CONTAINS                                                    ! подфункция-обертка 

      real FUNCTION ourfunc (x) 
          real x, out 
          integer mexCallMATLAB 
           
          call mxCopyReal4ToPtr (x, mxGetPr (input(2

)), 1)       ! мы присваиваем 

х аргументу функции, которая в input(1) 
          status = mexCallMATLAB (1, output, 2, input, 'feval') 
          

call  mxCopyPtrToReal4  (mxGetPr  (output(1)),  out,  1)        !  достаем 

значение функции 
          ourfunc = out 
          return 
      END FUNCTION 
       
      END SUBROUTINE 

Теперь  в  рабочем  каталоге  Matlab  должны  находится  следующие 

файлы 

19 

Скомпилируем МЕХ-функцию при помощи команды mex 

>> mex QS12R_wrapper.F QS12R.FOR UTQS10.FOR 

Теперь запуская на выполнение файл Test.m, можем получить иско-

мый результат 

Работа с комплексными переменными 

Использование процедуры на Fortran, оперирующей с комплексными 

переменными,  требует  соответствующей  организации  обмена  данными  в 

интерфейсной   процедуре.   Кроме   функции   mxGetPr,  придется исполь-

зовать mxGetPi, которая возвращает указатель на комплексную часть пер-

вого элемента массива. Получение и запись значения переменной по указа-

телю  производится  при  помощи  процедур  mxCopyPtrToComplex16  и 
mxCopyComplex16ToPtr

, причем входным аргументом, кроме указателя на 

вещественную, является еще и указатель на комплексную часть. При созда-

нии массива функцией mxCreateFull следует задать единицу в качестве тре-

тьего аргумента, поскольку предполагается хранение комплексных чисел. 

Текст исходной процедуры на Fortran приведен в листинге 6.3, а отвечаю-

щая ей интерфейсная процедура – в листинге 6.4. 

Листинг  6.3.  Процедура  сложения  комплексных  чисел  (файл 

my

сsum.f) 

 
      subroutine sum(a,  b

,   с) 

С  Процедура sum складывает два комплексных числа  
      complex

*16 а,  b,   с  

с = а + b  

      end 
  

Листинг 6.4. Интерфейсная процедура mexFunction (файл myсsumg.f) 

20 

 
      subroutine mexFunction (nlhs, plhs, nrhs, 

prhs) 

C 

Интерфейсная процедура для sum 

C  

Описание типов аргументов 

      integer nlhs, nrhs, plhs(*), prhs(*) 
C  

Описание  типов  используемых  функций  из Matlab 

API 

      integer mxCreateFull, mxGetPr, mxGetPi 
C  

Описание типов указателей на используемые пере-

менные 

      integer a_pr, b_pr, c_pr, a_pi, b_pi, c_pi 
C  

Описание типов используемых переменных 

      complex*16  a, b

, с 

C  

Получение  указателей  на  вещественные  и  мнимые 

части  

C  

первого и второго входных аргументов, с которыми  

C  

вызывается  МЕХ-функция,  указатели  хранятся  в 

массиве  

С  prhs, используются функции Matlab API 
      a_pr = mxGetPr(prhs(l))  
      a_pi = mxGetPi(prhs(1)) 
      b_pr= mxGetPr (prhs (2)) 
      b_pi = mxGetPi (prhs (2)) 

С  Запись значений первого и второго входных аргу-

ментов  

С  с указателями a_pr, a_pi и b_pr, b_pi в пере-

менные 

С  а и b при помощи процедуры Matlab API 
      call mxCopyPtrToComplex16 (a_pr, a_pi, a, 1) 
      call mxCopyPtrToCompiex16 (b_pr, b_pi, b, 1) 

С  Вызов процедуры sum, которая заносит в  

С  переменную с сумму а и b 
      call sum(a,b,c) 

С  Создание выходного аргумента — комплексного мас-

сива  

С  размера один на один при помощи функции Matlab 

API,  

С  выходной аргумент есть указатель на массив 
      plhs(l) = mxCreateFull (1, 1, 1) 
      c_pr = mxGetPr(plhs(1)) 
      c_pi = mxGetPi (plhs (1)) 

С  Копирование значения с в массив с указателями 

с_рг  

С  (на вещественную часть) и c_pi (на мнимую часть)