R studio аварийно завершает работу при вызове модуля Fortran - PullRequest
Новая
       10

R studio аварийно завершает работу при вызове модуля Fortran

0 голосов
/ 29 июня 2018

Я пытаюсь вызвать модуль, написанный на Fortran в R studio, но последний неожиданно вылетает.

Я пробовал с другими примерами на Фортране (факториальная и MC оценка числа пи), и они сработали хорошо.

Единственное различие, которое я вижу между моим кодом, который не работает, и этими примерами в том, что я использовал оболочку подпрограммы для своей чистой функции (вызывая другую чистую функцию), тогда как эти примеры опирались только на подпрограммы, и тот факт, что моя функция имеет вектор в качестве входных данных.

Вот процедура, которую я выполнил (или набрал код):

  • R CMD SHLIB mypath/myfile.f90 #this compiles without problem; code supplied below.
  • dyn.load('ptoh') #This is just the given name of the wrapper subroutine
  • .Fortran('ptoh', dimen=as.integer(dimen), p=as.matrix(p), m=as.integer(m), h=integer(1) )

где я произвольно установил в R: dimen<-3; p<-c(4,6,7); m=3;

Ты хоть представляешь, почему он падает? Правильный ли способ создания моей обертки? Это проблема, связанная с bind(C, name="ptoh_")?

Я уже очень благодарю вас за вашу помощь.

Жиль

Я работаю на Mac под управлением HighSierra с последней версией R. Код в 'myfile.90' следующий: 

module hilbert
  implicit none

contains    
  pure function rotate_right(x, d, dimen)
    integer, intent(in) :: x, d, dimen    
    integer :: rotate_right, tmp, mask 

    mask = 2 ** dimen - 1     
    rotate_right = shiftr(x, d)    
    tmp = shiftl(x, dimen - d)    
    rotate_right = iand(ior(rotate_right, tmp), mask)
  end

  pure function rotate_left(x, d, dimen)    
    integer, intent(in) :: x, d, dimen    
    integer :: rotate_left, tmp, mask

    mask = 2 ** dimen - 1        
    rotate_left = shiftl(x, d)    
    tmp = shiftr(x, dimen - d)    
    rotate_left = iand(ior(rotate_left, tmp), mask)
  end    

  pure function gc(i)    
    integer, intent(in) :: i    
    integer :: gc

    gc = ieor(i, shiftr(i, 1))
  end

  pure function entry_point(i)    
    integer, intent(in) :: i    
    integer :: entry_point

    if(i == 0) then    
       entry_point = 0    
    else    
       entry_point = gc(2 * ((i - 1) / 2))
    end if
  end

  pure function exit_point(i, dimen)    
    integer, intent(in) :: i, dimen    
    integer :: exit_point, mask

    mask = 2 ** dimen - 1
    exit_point = ieor(entry_point(mask - i), 2 ** (dimen - 1))
  end

  pure function inverse_gc(g, dimen)    
    integer, intent(in) :: g, dimen    
    integer :: inverse_gc, j

    inverse_gc = g    
    j = 1    
    do while(j < dimen)    
       inverse_gc = ieor(inverse_gc, shiftr(g, j))    
       j = j + 1    
    end do
  end

  pure function intercube_g(i) result(g)    
    integer, intent(in) :: i    
    integer :: g

    g = trailz(ieor(gc(i), gc(i + 1)))
  end

  pure function intracube_d(i, dimen) result(d)    
    integer, intent(in) :: i, dimen    
    integer :: d

    if(i == 0) then    
       d = 0    
    else if(modulo(i, 2) == 0) then    
       d = modulo(intercube_g(i - 1), dimen)    
    else    
       d = modulo(intercube_g(i), dimen)    
    end if    
  end

  pure function transform(e, d, b, dimen) result(t)    
    integer, intent(in) :: e, d, b, dimen    
    integer :: t

    t = rotate_right(ieor(b, e), d + 1, dimen)    
  end

  pure function inverse_transform(e, d, b, dimen) result(t)    
    integer, intent(in) :: e, d, b, dimen    
    integer :: t    

    t = transform(rotate_right(e, d + 1, dimen), dimen - d - 2, b, dimen)
  end

  pure function ptoh(dimen, p, m) result(h)      
    integer, intent(in) :: dimen, p(dimen), m    
    integer :: h, e, d, i, j, l, w    

    h = 0    
    e = 0    
    d = 2    
    do i = m - 1, 0, -1    
       l = 0    
       do j = 1, dimen    
          l = l + 2 ** (j - 1) * ibits(p(j), i, 1)    
       end do    
       l = transform(e, d, l, dimen)    
       w = inverse_gc(l, dimen)    
       e = ieor(e, rotate_left(entry_point(w), d + 1, dimen))    
       d = modulo(d + intracube_d(w, dimen) + 1, dimen)    
       h = ior(shiftl(h, dimen), w)    
    end do    
  end

  subroutine ptoh_R_wrapper(dimen, p, m, h) bind(C, name="ptoh_")
    integer :: dimen, p(dimen), m, h, ptoh
    external ptoh

    h = ptoh(dimen, p, m)
  end
end

1 Ответ

0 голосов
/ 30 июня 2018

Вы выставили свою оболочку subroutine с именем "ptoh_" в своем модуле, но вы вызываете ее с 'ptoh' в R Studio. На самом деле, 'ptoh' - это имя завернутого (но также и открытого) function.

Итак, ошибка может возникать при передаче аргумента h=integer(1), если функция не ожидает этот аргумент.

Если это причина, чтобы исправить это, измените свой вызов в R Studio на: 

.Fortran('ptoh_', dimen=as.integer(dimen), p=as.matrix(p), m=as.integer(m), h=integer(1))

Редактировать

Другая причина, которая может вызывать ошибку, заключается в том, что вы переопределяете имя ptoh в своей функции-обертке. 

subroutine ptoh_R_wrapper(dimen, p, m, h) bind(C, name="ptoh_")
  integer :: dimen, p(dimen), m, h, ptoh
  external ptoh

  h = ptoh(dimen, p, m)
end

Функция ptoh уже доступна во всем модуле, включая подпрограмму-оболочку (оператор external ptoh также должен быть удален).

Изменить объявление на это: 

subroutine ptoh_R_wrapper(dimen, p, m, h) bind(C, name="ptoh_")
  integer :: dimen, p(dimen), m, h

  h = ptoh(dimen, p, m)
end

И проверьте, если ошибка не исчезла, пожалуйста.

В качестве последнего замечания, когда вы делаете подпрограмму совместимой с C, рассмотрите возможность использования параметров типа из встроенного модуля iso_c_binding в ваших совместимых аргументах (и, возможно, атрибут value, если применимо).

Я недостаточно знаю R, чтобы быть уверенным, что это необходимо, но это не больно. Конечный код будет выглядеть так: 

subroutine ptoh_R_wrapper(dimen, p, m, h) bind(C, name="ptoh_")
  use, intrinsic :: iso_c_binding, only: c_int
  integer(c_int) :: dimen, p(dimen), m, h

  h = ptoh(dimen, p, m)
end
...