2017-05-07 5 views
-1

기본적으로 특정 데이터 테스트에 적합하도록 출력을 제공하는 책에서이 포트란 프로그램을 가져 왔습니다. 코드와 실제 결과/출력은 아래로 주어진 :이 프로그램의포트란 코드 오류가 발생했습니다

real*4 x(50),xc(50,20),omega(50) 
integer ir(50) 
real*8 xx 
c This code tests goodness of fit. 
n=47 
c The method of Bak, Nielsen, and Madsen is used. 
data (x(i), i=1,47)/ 18, 22, 26, 16, 19, 21, 18, 22, 
* 25, 31, 30, 34, 31, 25, 21, 24, 21, 28, 24, 26, 32, 
* 33, 36, 39, 32, 33, 42, 44, 43, 48, 50, 56, 57, 59, 
* 51, 49, 49, 57, 69, 72, 75, 76, 78, 73, 73, 75, 86/ 
do 999 icase=1,2 
c Parameter icase =1 or 2 denotes SDE model 1 or 2. 
xx=102038. 
m=8 
h=1.0 
do 10 j=1,m+1 
10 omega(j)=0.0 
kk=4 
akk=kk 
h=h/akk 
do 202 i=2,n 
xs=x(i-1) 
xe=x(i) 
do 202 j=1,m 
xk=xs 
do 252 k=1,kk 
call functs(icase,xk,f,g) 
call random(xx,rand1,rand2) 
252 xk=xk+h*f+sqrt(h)*g*rand1 
xc(i,j)=xk 
202 continue 
do 402 i=2,n 
irr=1 
do 302 j=1,m 
xe=x(i) 
xcalc=xc(i,j) 
if(xe.gt.xcalc) irr=irr+1 
302 continue 
402 ir(i)=irr 
do 502 i=2,n 
irr=ir(i) 
omega(irr)=omega(irr)+1.0 
502 continue 
chi2=0.0 
an=n 
am=m 
hlp=(an-1.0)/(am+1.0) 
do 602 j=1,m+1 
602 chi2=chi2+(omega(j)-hlp)**2/hlp 
write(6,100) icase,chi2 
100 format(5x,i7,5x,f9.2) 
999 continue 
stop 
end 
subroutine functs(icase,x,f,g) 
th1=3510.0 
th2=13500.0 
f=th1/(x*x) 
g=th2/(x*x) 
if(icase.eq.1) goto 17 
th1=.0361 
th2=.6090 
f=th1*x 
g=sqrt(th2*x) 
17 continue 
return 
end 
subroutine random(xx,rand1,rand2) 
real*8 xx,a,b,d,rng(2) 
a=16807. 
ib=2147483647 
b=ib 
do 55 i=1,2 
id=a*xx/b 
d=id 
xx=a*xx-d*b 
55 rng(i)=xx/b 
pi=3.141592654 
u1=rng(1) 
u2=rng(2) 
hlp=sqrt(-2.0*alog(u1)) 
rand1=hlp*cos(pi*2.0*u2) 
rand2=hlp*sin(pi*2.0*u2) 
return 
end 

출력은 다음과 같습니다

1 18.57 
2 4.09 

는 그러나, 많은 온라인 포트란 컴파일러를 사용 후 나는이 결과를 얻고 있지 않다. 비표준 형 선언과 같은 에러를 내고 있습니다.

위에서 언급 한 것과 같은 결과를 얻으려면 도움이 필요합니다.

+3

정확한 오류와 발생 줄을 표시하고 해결하지 못하게하십시오. – Carcigenicate

+0

들여 쓰기, 공백 및 빈 줄을 사용하여 코드를 읽을 수있게하십시오. Seriusly, 그것은 끔찍합니다. 정확한 오류 메시지와 그 메시지를 생성 한 컴파일러 명령을 알려주십시오. –

답변

3

이 코드는 몇 가지 일반적인 확장 기능이 추가 된 (이전) 포트란 77 스타일을 사용하여 작성되었습니다. 소위 고정형을 사용하므로 소스 코드에서 사용되는 열은 올바른 코드를 유지하는 데 중요합니다. 경우에 특히 :

    의견이 여섯 번째 열에서
  • 연속 선에 의해 정의 된 첫 번째 열 *에서 C 문자로 정의
  • 라벨은 처음 5 열을
  • 일반 코드를 사용해야합니다 7-72 열 범위를 사용해야합니다

코드를 올바르게 들여 쓰면 GNU gfortran (v.4.8.2를 사용하여 테스트 됨)과 Intel ifort (버전 15.0.2를 사용하여 테스트 됨)에서 실행되도록 할 수 있습니다. 컴파일러에게 대부분의 컴파일러에 대해 고정 양식을 채택하고자 함을 알리기 위해 소스 파일에 .f 확장자를 사용하면됩니다. 그렇지 않으면 적절한 컴파일러 옵션이 있습니다. gfortran의 경우, -ffixed-form을 지정하여 컴파일하십시오. to (최소) 들여 쓰기 된 코드는 아래에 제공됩니다.

 real*4 x(50),xc(50,20),omega(50) 
     integer ir(50) 
     real*8 xx 
c This code tests goodness of fit. 
     n=47 
c The method of Bak, Nielsen, and Madsen is used. 
     data (x(i), i=1,47)/ 18, 22, 26, 16, 19, 21, 18, 22, 
    * 25, 31, 30, 34, 31, 25, 21, 24, 21, 28, 24, 26, 32, 
    * 33, 36, 39, 32, 33, 42, 44, 43, 48, 50, 56, 57, 59, 
    * 51, 49, 49, 57, 69, 72, 75, 76, 78, 73, 73, 75, 86/ 
     do 999 icase=1,2 
c Parameter icase =1 or 2 denotes SDE model 1 or 2. 
     xx=102038. 
     m=8 
     h=1.0 
     do 10 j=1,m+1 
10 omega(j)=0.0 
     kk=4 
     akk=kk 
     h=h/akk 
     do 202 i=2,n 
     xs=x(i-1) 
     xe=x(i) 
     do 202 j=1,m 
     xk=xs 
     do 252 k=1,kk 
     call functs(icase,xk,f,g) 
     call random(xx,rand1,rand2) 
252 xk=xk+h*f+sqrt(h)*g*rand1 
     xc(i,j)=xk 
202 continue 
     do 402 i=2,n 
     irr=1 
     do 302 j=1,m 
     xe=x(i) 
     xcalc=xc(i,j) 
     if(xe.gt.xcalc) irr=irr+1 
302 continue 
402 ir(i)=irr 
     do 502 i=2,n 
     irr=ir(i) 
     omega(irr)=omega(irr)+1.0 
502 continue 
     chi2=0.0 
     an=n 
     am=m 
     hlp=(an-1.0)/(am+1.0) 
     do 602 j=1,m+1 
602 chi2=chi2+(omega(j)-hlp)**2/hlp 
     write(6,100) icase,chi2 
100 format(5x,i7,5x,f9.2) 
999 continue 
     stop 
     end 
     subroutine functs(icase,x,f,g) 
     th1=3510.0 
     th2=13500.0 
     f=th1/(x*x) 
     g=th2/(x*x) 
     if(icase.eq.1) goto 17 
     th1=.0361 
     th2=.6090 
     f=th1*x 
     g=sqrt(th2*x) 
17 continue 
     return 
     end 
     subroutine random(xx,rand1,rand2) 
     real*8 xx,a,b,d,rng(2) 
     a=16807. 
     ib=2147483647 
     b=ib 
     do 55 i=1,2 
     id=a*xx/b 
     d=id 
     xx=a*xx-d*b 
55 rng(i)=xx/b 
     pi=3.141592654 
     u1=rng(1) 
     u2=rng(2) 
     hlp=sqrt(-2.0*alog(u1)) 
     rand1=hlp*cos(pi*2.0*u2) 
     rand2=hlp*sin(pi*2.0*u2) 
     return 
     end 

당신이 온라인 리소스를 제대로 (오른쪽 들여 쓰기) 코드를 복사 - 붙여 넣기 반드시 사용하여 컴파일하고 정형의 옵션을 사용하십시오. 예를 들어 아래 쉘에서 https://www.tutorialspoint.com/compile_fortran_online.php을 사용하여 입력하면 컴파일합니다 : gfortran -ffixed-form *.f95 -o main.

이제 Fortran 77 스타일이 꽤 오래되었으므로 새 코드를 시작하려면 필자는 자유형 소스 코드로 이동하고 더 최근의 Fortran 기능을 사용하는 것이 좋습니다. 현대적인 스타일을 사용하여 코드를 다시 작성할 수있는 방법은 다음과 같습니다.

module my_kinds 
    integer, parameter :: sp = selected_real_kind(9) 
    integer, parameter :: dp = selected_real_kind(18) 
end module my_kinds 

program test_from_book 
    use my_kinds 
    real(sp) :: x(50),xc(50,20),omega(50) 
    integer :: ir(50) 
    real(dp) :: xx 
    ! This code tests goodness of fit. 
    n=47 
    ! The method of Bak, Nielsen, and Madsen is used. 
    x = [ 18, 22, 26, 16, 19, 21, 18, 22, & 
      25, 31, 30, 34, 31, 25, 21, 24, 21, 28, 24, 26, 32, & 
      33, 36, 39, 32, 33, 42, 44, 43, 48, 50, 56, 57, 59, & 
      51, 49, 49, 57, 69, 72, 75, 76, 78, 73, 73, 75, 86, & 
      0 , 0, 0] 
    loop_999: do icase=1,2 
     ! Parameter icase =1 or 2 denotes SDE model 1 or 2. 
     xx=102038. 
     m=8 
     h=1.0 
     do j=1,m+1 
      omega(j)=0.0 
     enddo 
     kk=4 
     akk=kk 
     h=h/akk 
     loop_202: do i=2,n 
      xs=x(i-1) 
      xe=x(i) 
      do j=1,m 
       xk=xs 
       do k=1,kk 
        call functs(icase,xk,f,g) 
        call random(xx,rand1,rand2) 
        xk=xk+h*f+sqrt(h)*g*rand1 
       enddo 
       xc(i,j)=xk 
      enddo 
     enddo loop_202 
     loop_402: do i=2,n 
      irr=1 
      do j=1,m 
       xe=x(i) 
       xcalc=xc(i,j) 
       if(xe.gt.xcalc) irr=irr+1 
      enddo 
      ir(i)=irr 
     enddo loop_402 
     do i=2,n 
      irr=ir(i) 
      omega(irr)=omega(irr)+1.0 
     enddo 
     chi2=0.0 
     an=n 
     am=m 
     hlp=(an-1.0)/(am+1.0) 
     do j=1,m+1 
      chi2=chi2+(omega(j)-hlp)**2/hlp 
     enddo 
     write(6,100) icase,chi2 
     100 format(5x,i7,5x,f9.2) 
    enddo loop_999 
    stop 
end 

subroutine functs(icase,x,f,g) 
    th1=3510.0 
    th2=13500.0 
    f=th1/(x*x) 
    g=th2/(x*x) 
    if(icase.ne.1) then 
     th1=.0361 
     th2=.6090 
     f=th1*x 
     g=sqrt(th2*x) 
    endif 
end 

subroutine random(xx,rand1,rand2) 
    use my_kinds 
    real(dp) :: xx,a,b,d,rng(2) 
    a=16807. 
    ib=2147483647 
    b=ib 
    do i=1,2 
     id=a*xx/b 
     d=id 
     xx=a*xx-d*b 
     rng(i)=xx/b 
    enddo 
    pi=3.141592654 
    u1=rng(1) 
    u2=rng(2) 
    hlp=sqrt(-2.0*alog(u1)) 
    rand1=hlp*cos(pi*2.0*u2) 
    rand2=hlp*sin(pi*2.0*u2) 
end 
+0

감사합니다. 현대적인 스타일의 코드가 잘 작동했습니다! –

관련 문제