1

我不知道这个问题是否合适。如果不是,我很抱歉。我是 fortran 的新用户,花了很多时间在下面的东西上。

我构造了一个名为“loglike”的函数,它根据两个参数返回一个实数。我想用这个函数来构造一个mcmc算法

是这样的。

psi = min(0, loglike(propalpha,propbeta) - loglike(currentalpha,currentbeta))

其中propalpha = currentalpha + noise, 和propbeta = currentbeta + noise, 噪声是来自某个分布的随机样本。

现在我想通过调用以前构造的函数“loglike”来使用这个算法。

1)如何为名为主程序的新程序调用函数'loglike'
2)如何将其用于子程序?

任何帮助对我来说都非常棒。提前致谢

编辑:

module mcmc

implicit none

contains

    subroutine subru(A,B, alphaprop, betaprop)
        real, intent(in)::A,B
        real, intent(out)::alphaprop, betaprop
    end subroutine subru

    real function aloglike(A,B)
        real:: A,B,U, aloglike
        aloglike = U
    end function aloglike

end module mcmc


program  likelihood
    use mcmc

    implicit none

    real :: alpha,beta,dist1,dist2,prob1,prob2
    real:: psi,a(1000),b(1000), u1, u2,u, alphaprop, betaprop
    real, dimension(1:1):: loglike
    integer :: t,i,j,k,l
    real, dimension(1:625):: x
    real, dimension(1:625):: y
    integer, dimension(1:625):: inftime

    alpha = 0.5
    beta = 2.0

    open(10, file = 'epidemic.txt', form = 'formatted')
    do l = 1,625
       read(10,*,end = 200) x(l), y(l), inftime(l)
    enddo
200 continue

    loglike = 0.0
    do t=1,10
        do i=1,625
            if(inftime(i)==0 .or. t < (inftime(i)-1)) then
                dist1 = 0.0
                do  j = 1, 625
                    if(t >= inftime(j) .and. inftime(j)/=0)then
                        dist1 = dist1 + sqrt((x(i) - x(j))**2 + (y(i) - y(j))**2)**(-beta)
                    endif
                enddo
                prob1 = 1 - exp(-alpha * dist1)
                loglike = loglike + log(1 - prob1)
            endif

            if(inftime(i) .eq. (t+1)) then
                dist2 = 0.0
                    do k=1, 625
                    if(t >= inftime(k) .and. inftime(k)/=0) then
                        dist2 = dist2 + sqrt((x(i) - x(k))**2 + (y(i) - y(k))**2)**(-beta)
                    endif
                enddo
                prob2 = 1 - exp(-alpha * dist2)
                loglike = loglike + log(prob2)
            endif
        enddo
    enddo

    do i = 2, 1000
        a(1)= 0.0
        b(1) = 0.0
        call subru(a(i),b(i), alphaprop, betaprop)
        call random_number(u1)
        call random_number(u2)

        alphaprop = a(i-1) + (u1*0.4)-0.2
        betaprop= b(i-1) + (u2*0.4)-0.2

        if(alphaprop> 0 .and. alphaprop < 0.2 .and. betaprop > 0 .and. betaprop < 0.2)then
            psi = min(0.0,aloglike(alphaprop,betaprop)- aloglike(a(i-1),b(i-1)))
            call random_number(u)

            if(u < psi)then
                a(i)= alphaprop
                b(i) = betaprop
            else
                a(i) = a(i-1)
                b(i) = b(i-1)
            endif
        endif
    enddo

    do j = 1, 1000
        print *, A(j), A(j), LOGLIKE
    enddo

end program
4

2 回答 2

4

最简单和最可靠的技术是将您的函数和子例程放在一个模块中,并从您的主程序中“使用”该模块。这可以在一个文件中完成。此方法使过程(函数和子例程)的接口已知,以便编译器可以检查调用(实际参数)和被调用(虚拟参数)中的参数之间的一致性。草图:

module mysubs

implicit none

contains

subroutine sub1 (xyz)
   declarations
   code
end subroutine sub1

function func2 (u)
   declarations
   code
   func2 = ...
end func2

end module mysubs

program myprog

use mysubs

implicit none

declarations...

call sub1 (xyz)

q = func2 (z)

end program myprog

添加:“implicit none”用于禁用隐式类型,我认为这很危险。因此,您需要键入所有变量,包括函数中的函数名称。您可以从模块的其他过程调用子例程和函数——它们将自动被识别。因此,如果您愿意,可以使用“sub1”中的“func2”。对于模块之外的实体,例如您的主程序,您必须“使用”该模块。

于 2012-02-17T22:18:00.513 回答
2

这是它的一般外观。请注意,函数通过将结果分配给它自己的名称来返回一个值。不需要return声明。

C "loglike" is renamed "aloglike" so implicit typing uses REAL
C A type declaration could be used instead

    function aloglike (alpha, beta)
        aloglike = ... (expression which computes value)
    end

    program whateveryouwanttocallit
       ...
       propalpha = ...
       propbeta = ...
       currentalpha = ...
       currentbeta = ...
       ...
       psi = min(0, aloglike(propalpha,propbeta) - aloglike(currentalpha,currentbeta))
       print *, 'psi = ', psi

    end
于 2012-02-17T21:03:14.233 回答