将fortran程序转换为从R调用的子程序

我之前发布了一个问题，关于试图从统计文件中复制样本大小的问题。作者为我提供了本文使用的代码，这是一个Fortran程序。我想使用我的团队在工作中使用的R包调用此代码。为此，我需要将这个Fortran程序转换成一个子例程。这是我第一次使用Fortran，我似乎以某种方式破坏了程序，得到了错误的数字，当我更改输入时，这些数字不会改变。我还应该注意到，为了让程序正常运行，我不得不对作者提供的原始代码进行一些小的修改

编译并运行时产生正确结果的“原始”程序：

    PROGRAM Exact_Mid_P_binomial_sample_size
          real(8) probA,probB,part1,part2,part3,part4
          real(8) totprA,totprB,factt, resp
!       character  resp
1       format ('Enter proportion       ',$)
2       format ('Enter error limit      ',$)
3       format ('Enter confidence level ',$)
4       format ('Calculated sample size is   ',i6)
5       format ('Exact mid-P with ',f7.5,' 2-tail probability')
6       format ('Sorry, unable to mathmatically solve this problem.')
7       format ('Reported sample size is not accuarate.')
8       format ('Enter q to quit  ',$)
9       format ('Actual limits for distribution  ',f5.3,' - ',f5.3)
        print *, 'Exact sampleroportions'
        print *, 'Using Mid-P methods'
        print *, 'Geoff Fosgate DVM PhD'
        print *, 'College of Veterinary Medicine'
        print *, 'Texas A&M University'
        print *
10      print *
        print 1
          read *, prop1
        print 2
          read *,range
        print 3
          read *,conlev
        print *
!           Convert proportions less than 0.5 for algorithm
        if (prop1 .lt. 0.5) then
            prop = 1 - prop1
            nprop = 1
              else
                prop = prop1
                nprop = 0
              end if
        slimit = max ((prop - range) , 0.0001)
        supper = min ((prop + range) , 0.9999)
!           Probabilities cannot be calculated for p=0 and p=1
        alpha = (1 - conlev)
        if (alpha .gt. 1.0) go to 10
        if (alpha .lt. 0.0) go to 10
        if (prop .gt. 1.0) go to 10
        if (prop .lt. 0.0) go to 10
        numbr = (1 / (1 - prop)) - 1
!           Define and initialize variables
!             Note names of variables based on Fortran 77 rules
!             Starting sample size is based on estimated proportion
!             Resulting sample size must be large enough to obtain this proportion
100     numbr = numbr + 1
        numx = (numbr * prop) + 0.001
!             This is the number of binomial "successes" resulting in the proportion
        if (numx .eq. numbr) go to 100
        if (numx .lt. 1) go to 100
        totprA = slimit**numbr
        totprB = supper**numbr
          do 130 loop1 = numx, (numbr - 1)
!               Must initialize variables within loop
            factt = 1.0
            probA = 0.0
            probB = 0.0
            part1 = 0.0
            part2 = 0.0
            part3 = 0.0
            part4 = 0.0
!                Start loop to calculate factorial component of binomial probability
!                Note that complete factorial calculations not necessary due to cancellations
            do 110 loop2 = (loop1 + 1) , numbr
               factt = factt * (loop2) / (numbr - (loop2 - 1))
110         continue
!                Calculate probability for this particular number of successes
!                Total probability is a running total
!                Note that real variables must have high precision and be comprised
!                of multiple bytes because factorial component can be very large
!                and exponentiated component can be very small
!                Program will fail if any component is recognized as zero or infinity
            part1 = slimit**loop1
              part2 = (1.0-slimit)**(numbr-loop1)
            part3 = supper**loop1
              part4 = (1.0-supper)**(numbr-loop1)
            if (part1 .eq. 0.0) part1 = 1.0D-307
            if (part2 .eq. 0.0) part2 = 1.0D-307
            if (part3 .eq. 0.0) part3 = 1.0D-307
            if (part4 .eq. 0.0) part4 = 1.0D-307
            if (factt .gt. 1.0D308) factt = 1.0D308
            probA = part1 * part2 * factt
            probB = part3 * part4 * factt
            if (loop1 .eq. numx)  then
                totprA = totprA + (0.5 * probA)
                totprB = totprB + (0.5 * probB)
                else
                    totprA = totprA + probA
                    totprB = totprB + probB
                end if
            if (probA .eq. 0.0) then 
                    print 6
                    print 7
                    print *
                    go to 150
                end if
            if (probB .eq. 0.0) then
                    print 6
                    print 7
                    print *
                    go to 150
                end if
130       continue
140     if ((totprA + (1 - totprB)) .gt. alpha) go to 100
!             go to beginning and increase sample size by 1 if have not
!             reached specified level of confidence
150         if (nprop .eq. 1) then
                print 4,numbr
                print 9, (1-supper),(1-slimit)
            else
                print 4,numbr
                print 9, slimit,supper
            end if
            if (totprA+(1-totprB) .lt. alpha) print 5,(totprA+(1-totprB))
            print *
            print 8
            result = resp
!           print *
!       if (resp .ne. 'q') go to 10
      print *
      print *
999   end

上面的程序变成了一个子程序：

       subroutine midpss(prop1, range, conlev, numbr)

       integer numbr, nprop
       real(8) prop1, range, conlev, prop, slimit, supper
       real(8) probA,probB,part1,part2,part3,part4,factt
       real(8) totprA,totprB, resp
c         character  resp

c           Convert proportions less than 0.5 for algorithm
           if (prop1 .lt. 0.5) then
              prop = 1 - prop1
              nprop = 1
             else
                prop = prop1
                nprop = 0
             end if
         slimit = max ((prop - range) , 0.0001)
         supper = min ((prop + range) , 0.9999)

           numbr = (1 / (1 - prop)) - 1
c           Define and initialize variables
c             Note names of variables based on Fortran 77 rules
c             Starting sample size is based on estimated proportion
c             Resulting sample size must be large enough to obtain this proportion
100      numbr = numbr + 1
           numx = (numbr * prop) + 0.001
c             This is the number of binomial "successes" resulting in the proportion
           if (numx .eq. numbr) go to 100
           if (numx .lt. 1) go to 100
           totprA = slimit**numbr
           totprB = supper**numbr
           do 130 loop1 = numx, (numbr - 1)
c               Must initialize variables within loop
           factt = 1.0
           probA = 0.0
             probB = 0.0
           part1 = 0.0
           part2 = 0.0
             part3 = 0.0
             part4 = 0.0
c                Start loop to calculate factorial component of binomial probability
c                Note that complete factorial calculations not necessary due to cancellations
         do 110 loop2 = (loop1 + 1) , numbr
         factt = factt * (loop2) / (numbr - (loop2 - 1))
110    continue
c                Calculate probability for this particular number of successes
c                Total probability is a running total
c                Note that real variables must have high precision and be comprised
c                of multiple bytes because factorial component can be very large
c                and exponentiated component can be very small
c                Program will fail if any component is recognized as zero or infinity
           part1 = slimit**loop1
       part2 = (1.0-slimit)**(numbr-loop1)
           part3 = supper**loop1
       part4 = (1.0-supper)**(numbr-loop1)
             if (part1 .eq. 0.0) part1 = 1.0D-307
             if (part2 .eq. 0.0) part2 = 1.0D-307
             if (part3 .eq. 0.0) part3 = 1.0D-307
             if (part4 .eq. 0.0) part4 = 1.0D-307
             if (factt .gt. 1.0D308) factt = 1.0D308
         probA = part1 * part2 * factt
             probB = part3 * part4 * factt
           if (loop1 .eq. numx)  then
                totprA = totprA + (0.5 * probA)
                totprB = totprB + (0.5 * probB)
             else
              totprA = totprA + probA
              totprB = totprB + probB
             end if

130      continue
140      if ((totprA + (1 - totprB)) .gt. alpha) go to 100


       return
       end

为了编译原始程序，我在命令行中运行以下命令：

gfortran midpSS_original.f

R CMD SHLIB midpSS_subroutine.f

为了编译子例程，我在命令行中运行以下命令：

gfortran midpSS_original.f

R CMD SHLIB midpSS_subroutine.f

然后从R控制台运行以下命令：

> dyn.load("midpSS_subroutine.dll")
> is.loaded("midpss")
[1] TRUE
> .Fortran("midpss", prop1=as.numeric(0.9), range=as.numeric(0.1), conlev=as.numeric(0.90), numbr=as.integer(0)) # numbr should be 29
$prop1
[1] 0.9

$range
[1] 0.1

$conlev
[1] 0.9

$numbr
[1] 2091

> .Fortran("midpss", prop1=as.numeric(0.9), range=as.numeric(0.1), conlev=as.numeric(0.95), numbr=as.integer(0)) # numbr should be 47
$prop1
[1] 0.9

$range
[1] 0.1

$conlev
[1] 0.95

$numbr
[1] 2091

---

在对子例程的第一次调用中，numbr应该是29。在第二个例子中，numbr应该是47。编译“原始”fortran程序并运行相同参数时，结果是正确的。我不知道这里发生了什么。非常感谢您的帮助。

下面的程序块正在检查输入数据：

    if (alpha .gt. 1.0) go to 10
if (alpha .lt. 0.0) go to 10
if (prop .gt. 1.0) go to 10
if (prop .lt. 0.0) go to 10

此块使代码转到输入位置以再次读取输入数据。您可能会得到错误的结果，因为子例程中的输入数据可能超出范围。请先检查一下

另一个缺失的区块是

if (probA .eq. 0.0) then 
  print 6
  print 7
  print *
 go to 150
end if

if (probB .eq. 0.0) then
 print 6
 print 7
 print *
 go to 150
end if

还有标签150。您确定省略这两个块不会改变原始代码的准确性和功能吗

将程序转换成子程序非常简单。主要步骤如下：

将语法

程序

转换为

子例程

将语法

结束程序

转换为

结束子例程

在子例程的名称后面加一个括号“（）”

将程序的所有输入和输出放在括号“（）”内

在

程序

或

子例程

我把程序转换成自己的子程序。请注意，子程序末尾的

result=resp

可能是错误的，因为据我所知，命令“result”用于函数而不是子程序

在子例程中，必须指定输出。因为我不知道哪个变量是输出，所以我没有将该变量包含在子例程名称后面的括号“（）”中。请写在那里。 我的子程序如下所示：

!    PROGRAM Exact_Mid_P_binomial_sample_size
    subroutine midpss (prop1, range, conlev, output)
    implicit none
          real(8) probA,probB,part1,part2,part3,part4
          real(8) totprA,totprB,factt, resp
          integer numbr, nprop,loop1,loop2
          real(8) prop1,prop,range,conlev,slimit,supper,alpha,numx,output

!       character  resp
!1       format ('Enter proportion       ',$)
!2       format ('Enter error limit      ',$)
!3       format ('Enter confidence level ',$)
4       format ('Calculated sample size is   ',i6)
5       format ('Exact mid-P with ',f7.5,' 2-tail probability')
6       format ('Sorry, unable to mathmatically solve this problem.')
7       format ('Reported sample size is not accuarate.')
8       format ('Enter q to quit  ',$)
9       format ('Actual limits for distribution  ',f5.3,' - ',f5.3)
        print *, 'Exact sampleroportions'
        print *, 'Using Mid-P methods'
        print *, 'Geoff Fosgate DVM PhD'
        print *, 'College of Veterinary Medicine'
        print *, 'Texas A&M University'
        print *
!10      print *
!        print 1
!          read *, prop1
!        print 2
!         read *, range
!       print 3
!         read *, conlev
!       print *
!           Convert proportions less than 0.5 for algorithm
        if (prop1 .lt. 0.5) then
            prop = 1 - prop1
            nprop = 1
              else
                prop = prop1
                nprop = 0
              end if
        slimit = max ((prop - range) , 0.0001)
        supper = min ((prop + range) , 0.9999)
!           Probabilities cannot be calculated for p=0 and p=1
        alpha = (1 - conlev)
!        if (alpha .gt. 1.0) go to 10
!        if (alpha .lt. 0.0) go to 10
!        if (prop .gt. 1.0) go to 10
!        if (prop .lt. 0.0) go to 10
        numbr = (1 / (1 - prop)) - 1
!           Define and initialize variables
!             Note names of variables based on Fortran 77 rules
!             Starting sample size is based on estimated proportion
!             Resulting sample size must be large enough to obtain this proportion
100     numbr = numbr + 1
        numx = (numbr * prop) + 0.001
!             This is the number of binomial "successes" resulting in the proportion
        if (numx .eq. numbr) go to 100
        if (numx .lt. 1) go to 100
        totprA = slimit**numbr
        totprB = supper**numbr
          do 130 loop1 = numx, (numbr - 1)
!               Must initialize variables within loop
            factt = 1.0
            probA = 0.0
            probB = 0.0
            part1 = 0.0
            part2 = 0.0
            part3 = 0.0
            part4 = 0.0
!                Start loop to calculate factorial component of binomial probability
!                Note that complete factorial calculations not necessary due to cancellations
            do 110 loop2 = (loop1 + 1) , numbr
               factt = factt * (loop2) / (numbr - (loop2 - 1))
110         continue
!                Calculate probability for this particular number of successes
!                Total probability is a running total
!                Note that real variables must have high precision and be comprised
!                of multiple bytes because factorial component can be very large
!                and exponentiated component can be very small
!                Program will fail if any component is recognized as zero or infinity
            part1 = slimit**loop1
              part2 = (1.0-slimit)**(numbr-loop1)
            part3 = supper**loop1
              part4 = (1.0-supper)**(numbr-loop1)
            if (part1 .eq. 0.0) part1 = 1.0D-307
            if (part2 .eq. 0.0) part2 = 1.0D-307
            if (part3 .eq. 0.0) part3 = 1.0D-307
            if (part4 .eq. 0.0) part4 = 1.0D-307
            if (factt .gt. 1.0D308) factt = 1.0D308
            probA = part1 * part2 * factt
            probB = part3 * part4 * factt
            if (loop1 .eq. numx)  then
                totprA = totprA + (0.5 * probA)
                totprB = totprB + (0.5 * probB)
                else
                    totprA = totprA + probA
                    totprB = totprB + probB
                end if
            if (probA .eq. 0.0) then 
                    print 6
                    print 7
                    print *
                    go to 150
                end if
            if (probB .eq. 0.0) then
                    print 6
                    print 7
                    print *
                    go to 150
                end if
130       continue
140     if ((totprA + (1 - totprB)) .gt. alpha) go to 100
!             go to beginning and increase sample size by 1 if have not
!             reached specified level of confidence
150         if (nprop .eq. 1) then
                print 4,numbr
                print 9, (1-supper),(1-slimit)
            else
                print 4,numbr
                print 9, slimit,supper
            end if
            if (totprA+(1-totprB) .lt. alpha) print 5,(totprA+(1-totprB))
            print *
            print 8
            !result = resp
!           print *
!       if (resp .ne. 'q') go to 10
!      output=***     !write the output variable instead of ***
      print *
      print *
999   end subroutine midpss 

---

您能找到一种方法将编译选项传递给R吗？让编译器警告您，比如说，您没有在子例程中设置

alpha

，这会很有帮助。我建议您编写一个新的fortran main小程序来调用新的子例程。确保先工作，然后在

R

界面上工作。@agentp我刚刚做了这个。我得到了同样的错误输出，当我调用它通过R。。。谢谢你。我现在知道我把它转换成一个子程序时弄糟了。@agentp我似乎已经修复了这个子程序，现在又遇到了使它在R中工作的问题。再次感谢您的指导。如果有人感兴趣，我的新问题是：关于

result=resp

，

result

只是一个变量的名称，与函数的result子句无关。[这也是一个变量，在本任务之外似乎没有被引用，但这是另一个问题。]。现在，当我从fortran程序调用子例程时，这种方法就可以工作了（但从R调用相同的子例程时，它似乎挂起了）。谢谢。@panterabox:“隐式无”会在您没有声明变量时让编译器提醒您。然后编译器产生错误。因此，您知道需要声明哪个变量。