转到 FORTRAN 77 中

问题描述 投票:0回答:1

我想将以 FORTRAN 77 编写的代码翻译为 FORTRAN 90。 这是我想翻译的代码,但我不明白 go to 语法。

FUNCTION YRR(L1,L2,L,CT1,CT2,DP)

      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
      
      PI=dacos(-1d0)
      
      XL1=L1
      XL2=L2
      XL=L
      DEN=SQRT(4.D0*PI)*2.D0*PI
      FACT=((2.D0*XL+1.D0)/DEN)*PARITII(L1+L2)

      M=0
      
      SUM=THRJ(XL1,XL2,XL,dble(0),dble(0),dble(0))*PLM(L1,0,CT1)*PLM(L2,0,CT2)*FACT
 2000 M=M+1
      IF (M.Gt.min(l1,l2)) GO TO 3000
      SUM=SUM+2.D0*PARITii(M)*THRJ(XL1,XL2,XL,dble(M),dble(-M),dble(0)) &
              *PLM(L1,M,CT1)*PLM(L2,M,CT2)*COS(dble(M)*DP)*FACT
              
      GO TO 2000
        
 3000 YRR=SUM
      RETURN
 
      END

我尝试翻译,但总和不能作为乘积之和。

FUNCTION YRR(L1, L2, L, CT1, CT2, DP)
  IMPLICIT NONE
  INTEGER, INTENT(IN) :: L1, L2, L
  REAL(8), INTENT(IN) :: CT1, CT2, DP
  REAL(8) :: YRR
  REAL(8), PARAMETER :: PI = ACOS(-1.0d0)
  REAL(8) :: XL1, XL2, XL, DEN, FACT
  INTEGER :: M
  REAL(8) :: SUM
  XL1 = L1
  XL2 = L2
  XL = L
  DEN = SQRT(4.0d0 * PI) * 2.0d0 * PI
  FACT = ((2.0d0 * XL + 1.0d0) / DEN) * PARITII(L1 + L2)
  M = 0
  SUM = THRJ(XL1, XL2, XL, 0.0d0, 0.0d0, 0.0d0) * PLM(L1, 0, CT1) * PLM(L2, 0, CT2) * FACT
  DO WHILE (M <= MIN(L1, L2))
    M = M + 1
    SUM = SUM + 2.0d0 * PARITii(M) * THRJ(XL1, XL2, XL, M, -M, 0.0d0) &
        * PLM(L1, M, CT1) * PLM(L2, M, CT2) * COS(M * DP) * FACT
  END DO
  YRR = SUM
  RETURN
END FUNCTION YRR

有人可以帮助我吗?

gfortran fortran90 fortran77
1个回答
0
投票

这对

GOTO
语句给你一个带有转义的无限循环。现代 Fortran(除了使用
dble
implicit
语句)就可以了

function yrr(l1, l2, l, ct1, ct2, dp)

   implicit double precision (a-h,o-z)
      
   pi = acos(-1.d0)
      
   xl1 = l1
   xl2 = l2
   xl = l
   den = 4 * sqrt(pi) * pi
   fact = ((2 * xl + 1) / den) * paritii(l1 + l2)

   m = 0
      
   sum = thrj(xl1,xl2,xl,dble(0),dble(0),dble(0)) &
   &   * plm(l1,0,ct1) * plm(l2,0,ct2) * fact
   do
      m = m+1
      if (m > min(l1,l2)) exit
      sum = sum + 2 * paritii(m) &
      &   * thrj(xl1,xl2,xl,dble(m),dble(-m),dble(0)) &
          * plm(l1,m,ct1) * plm(l2,m,ct2) * cos(m * dp) * fact
   end do
        
   yrr=sum

end function yrr

© www.soinside.com 2019 - 2024. All rights reserved.