Silent some warnings about same variable associated with two dummy ar…

…guments.

src/approximation/minpack/dcov.f90

@@ -171,7 +171,7 @@ END SUBROUTINE FCN
   REAL(DP), INTENT(OUT) :: R(Ldr,N), Fvec(M), Wa1(N,1), Wa2(N), Wa3(N), Wa4(M)
   !
   INTEGER :: i, idum(1), iflag, j, k, kp1, nm1, nrow
-  REAL(DP) :: sigma, temp
+  REAL(DP) :: sigma, temp, dum1(N), dum2(N)
   LOGICAL :: sing
   !* FIRST EXECUTABLE STATEMENT  DCOV
   sing = .FALSE.
@@ -223,7 +223,7 @@ END SUBROUTINE FCN
         IF( iflag<0 ) GOTO 100
         !
         !     COMPUTE THE QR DECOMPOSITION
-        CALL DQRFAC(M,N,R,Ldr,.FALSE.,idum,1,Wa1,Wa1,Wa1)
+        CALL DQRFAC(M,N,R,Ldr,.FALSE.,idum,1,Wa1,dum1,dum2)
         DO i = 1, N
           R(i,i) = Wa1(i,1)
         END DO

src/approximation/minpack/scov.f90

@@ -163,7 +163,7 @@ END SUBROUTINE FCN
   REAL(SP), INTENT(OUT) :: R(Ldr,N), Fvec(M), Wa1(N,1), Wa2(N), Wa3(N), Wa4(M)
   !
   INTEGER :: i, idum(1), iflag, j, k, kp1, nm1, nrow
-  REAL(SP) :: sigma, temp
+  REAL(SP) :: sigma, temp, dum1(N), dum2(N)
   LOGICAL :: sing
   !* FIRST EXECUTABLE STATEMENT  SCOV
   sing = .FALSE.
@@ -215,7 +215,7 @@ END SUBROUTINE FCN
         IF( iflag<0 ) GOTO 100
         !
         !     COMPUTE THE QR DECOMPOSITION
-        CALL QRFAC(M,N,R,Ldr,.FALSE.,idum,1,Wa1,Wa1,Wa1)
+        CALL QRFAC(M,N,R,Ldr,.FALSE.,idum,1,Wa1,dum1,dum2)
         DO i = 1, N
           R(i,i) = Wa1(i,1)
         END DO

src/diff_integ_eq/bvsup/dsuds.f90

@@ -114,6 +114,7 @@ PURE SUBROUTINE DSUDS(A,X,B,Neq,Nuk,Nrda,Iflag,Mlso,Work,Iwork)
   REAL(DP), INTENT(INOUT) :: B(Neq), A(Nrda,Nuk), Work(*), X(Nuk)
   !
   INTEGER :: il, ip, is, ks, kt, ku, kv
+  REAL(DP) :: dumb(Neq)
   !
   !* FIRST EXECUTABLE STATEMENT  DSUDS
   is = 2
@@ -124,7 +125,8 @@ PURE SUBROUTINE DSUDS(A,X,B,Neq,Nuk,Nrda,Iflag,Mlso,Work,Iwork)
   ks = kt + Neq
   ku = ks + Nuk
   !
-  CALL DLSSUD(A,X,B,Neq,Nuk,Nrda,Work(ku),Nuk,Iflag,Mlso,Iwork(1),Iwork(is),&
+  dumb = B
+  CALL DLSSUD(A,X,dumb,Neq,Nuk,Nrda,Work(ku),Nuk,Iflag,Mlso,Iwork(1),Iwork(is),&
     A,Work(1),Iwork(ip),B,Work(kv),Work(kt),Iwork(il),Work(ks))
   !
 END SUBROUTINE DSUDS

src/diff_integ_eq/bvsup/orthol.f90

@@ -86,8 +86,8 @@ PURE SUBROUTINE ORTHOL(A,M,N,Nrda,Iflag,Irank,Iscale,Diag,Kpivot,Scales,Cols,Cs)
   REAL(SP), INTENT(OUT) :: Cols(N), Cs(N), Diag(N), Scales(N)
   !
   INTEGER :: j, jcol, k, kp, l, mk
-  REAL(SP) :: acc, akk, anorm, as, asave, css, diagk, dum(1), sad, sc, sig, sigma, &
-    sruro, uro
+  REAL(SP) :: acc, akk, anorm, as, asave, css, diagk, dum1(1), dum2(1), sad, sc, &
+    sig, sigma, sruro, uro
   !
   !- *********************************************************************
   !
@@ -96,7 +96,8 @@ PURE SUBROUTINE ORTHOL(A,M,N,Nrda,Iflag,Irank,Iscale,Diag,Kpivot,Scales,Cols,Cs)
   !
   !* FIRST EXECUTABLE STATEMENT  ORTHOL
   uro = eps_2_sp
-  dum = 0._SP
+  dum1 = 0._SP
+  dum2 = 0._SP
   !
   !- *********************************************************************
   !
@@ -120,7 +121,7 @@ PURE SUBROUTINE ORTHOL(A,M,N,Nrda,Iflag,Irank,Iscale,Diag,Kpivot,Scales,Cols,Cs)
     !
     !     PERFORM COLUMN SCALING ON A WHEN SPECIFIED
     !
-    CALL CSCALE(A,Nrda,M,N,Cols,Cs,dum,dum,anorm,Scales,Iscale,0)
+    CALL CSCALE(A,Nrda,M,N,Cols,Cs,dum1,dum2,anorm,Scales,Iscale,0)
     !
     anorm = SQRT(anorm)
     !

src/diff_integ_eq/bvsup/sods.f90

@@ -107,6 +107,7 @@ PURE SUBROUTINE SODS(A,X,B,Neq,Nuk,Nrda,Iflag,Work,Iwork)
   REAL(SP), INTENT(INOUT) :: A(Nrda,Nuk), B(Neq), Work(*), X(Nuk)
   !
   INTEGER :: ip, is, iter, kc, kd, ks, kt, kv, kz
+  REAL(SP) :: dumb(Neq)
   !
   !* FIRST EXECUTABLE STATEMENT  SODS
   iter = 0
@@ -119,7 +120,8 @@ PURE SUBROUTINE SODS(A,X,B,Neq,Nuk,Nrda,Iflag,Work,Iwork)
   kt = kv + Nuk
   kc = kt + Nuk
   !
-  CALL LSSODS(A,X,B,Neq,Nuk,Nrda,Iflag,Iwork(1),Iwork(is),A,Work(kd),&
+  dumb = B
+  CALL LSSODS(A,X,dumb,Neq,Nuk,Nrda,Iflag,Iwork(1),Iwork(is),A,Work(kd),&
     Iwork(ip),iter,Work(1),Work(ks),Work(kz),B,Work(kv),Work(kt),Work(kc))
   !
 END SUBROUTINE SODS

src/diff_integ_eq/bvsup/suds.f90

@@ -114,6 +114,7 @@ PURE SUBROUTINE SUDS(A,X,B,Neq,Nuk,Nrda,Iflag,Mlso,Work,Iwork)
   REAL(SP), INTENT(INOUT) :: B(Neq), A(Nrda,Nuk), Work(*), X(Nuk)
   !
   INTEGER :: il, ip, is, ks, kt, ku, kv
+  REAL(SP) :: dumb(Neq)
   !* FIRST EXECUTABLE STATEMENT  SUDS
   is = 2
   ip = 3
@@ -123,7 +124,8 @@ PURE SUBROUTINE SUDS(A,X,B,Neq,Nuk,Nrda,Iflag,Mlso,Work,Iwork)
   ks = kt + Neq
   ku = ks + Nuk
   !
-  CALL LSSUDS(A,X,B,Neq,Nuk,Nrda,Work(ku),Nuk,Iflag,Mlso,Iwork(1),Iwork(is),&
+  dumb = B
+  CALL LSSUDS(A,X,dumb,Neq,Nuk,Nrda,Work(ku),Nuk,Iflag,Mlso,Iwork(1),Iwork(is),&
     A,Work(1),Iwork(ip),B,Work(kv),Work(kt),Iwork(il),Work(ks))
   !
 END SUBROUTINE SUDS

src/diff_integ_eq/fishpack/blktr1.f90

@@ -58,7 +58,7 @@ END SUBROUTINE CPRDCT
   INTEGER :: i, i1, i2, i3, i4, idxa, idxc, if, ifd, im1, im2, im3, imi1, &
     imi2, ip, ip1, ip2, ip3, ipi1, ipi2, ipi3, ir, irm1, iz, izr, j, kdo, l, &
     ll, na, nc, nm1, nm2, nm3, np, np1, np2, np3, nz
-  REAL(SP) :: dum(0), dum2(0,0)
+  REAL(SP) :: dum(0), dum2(0,0), duma(M)
   COMPLEX(SP) :: bc(nm_com/2), dc(M), wc(M), yc(M)
   !* FIRST EXECUTABLE STATEMENT  BLKTR1
   kdo = k_com - 1
@@ -133,12 +133,14 @@ END SUBROUTINE CPRDCT
       CALL INDXB(i,ir,iz,nz)
       CALL INDXB(i-i1,ir-1,im1,nm1)
       CALL INDXB(i+i1,ir-1,ip1,np1)
-      CALL PRDCT(np1,B(ip1:ip1+np1-1),0,dum,0,dum,nc,Cn(idxc),W1,W1,M,Am,Bm,Cm,Wd,Ww,Wu)
+      duma = W1
+      CALL PRDCT(np1,B(ip1:ip1+np1-1),0,dum,0,dum,nc,Cn(idxc),duma,W1,M,Am,Bm,Cm,Wd,Ww,Wu)
       DO j = 1, M
         W1(j) = Y(j,i) + W1(j)
       END DO
+      duma = W1
       CALL PRDCT(nz,B(iz:iz+nz-1),nm1,B(im1:im1+nm1-1),np1,B(ip1:ip1+np1-1),0,dum2,&
-        W1,W1,M,Am,Bm,Cm,Wd,Ww,Wu)
+        duma,W1,M,Am,Bm,Cm,Wd,Ww,Wu)
     END DO
     DO ll = 2, k_com
       l = k_com - ll + 1
@@ -154,13 +156,15 @@ END SUBROUTINE CPRDCT
           CALL INDXB(i,ir,iz,nz)
           CALL INDXB(i-i1,ir-1,im1,nm1)
           CALL INDXB(i+i1,ir-1,ip1,np1)
-          CALL PRDCT(nm1,B(im1:im1+nm1-1),0,dum,0,dum,na,An(idxa),W2,W2,M,Am,Bm,&
+          duma = W2
+          CALL PRDCT(nm1,B(im1:im1+nm1-1),0,dum,0,dum,na,An(idxa),duma,W2,M,Am,Bm,&
             Cm,Wd,Ww,Wu)
           DO j = 1, M
             W2(j) = Y(j,i) + W2(j)
           END DO
+          duma = W2
           CALL PRDCT(nz,B(iz:iz+nz-1),nm1,B(im1:im1+nm1-1),np1,B(ip1:ip1+np1-1),&
-            0,dum,W2,W2,M,Am,Bm,Cm,Wd,Ww,Wu)
+            0,dum,duma,W2,M,Am,Bm,Cm,Wd,Ww,Wu)
           izr = i
           IF( i==nm_com ) GOTO 50
         END IF
@@ -199,9 +203,11 @@ END SUBROUTINE CPRDCT
       CALL INDXB(i-i2,ir,im2,nm2)
       CALL INDXB(i-i2-i1,ir-1,im3,nm3)
       CALL INDXB(i-i1,ir-1,im1,nm1)
+      duma = W1
       CALL PRDCT(nm2,B(im2:im2+nm2-1),nm3,B(im3:im3+nm3-1),nm1,B(im1:im1+nm1-1),0,&
-        dum,W1,W1,M,Am,Bm,Cm,Wd,Ww,Wu)
-      CALL PRDCT(nm1,B(im1:im1+nm1-1),0,dum,0,dum,na,An(idxa),W1,W1,M,Am,Bm,Cm,Wd,Ww,Wu)
+        dum,duma,W1,M,Am,Bm,Cm,Wd,Ww,Wu)
+      duma = W1
+      CALL PRDCT(nm1,B(im1:im1+nm1-1),0,dum,0,dum,na,An(idxa),duma,W1,M,Am,Bm,Cm,Wd,Ww,Wu)
       DO j = 1, M
         Y(j,i) = Y(j,i) - W1(j)
       END DO
@@ -224,9 +230,11 @@ END SUBROUTINE CPRDCT
           CALL INDXB(ipi2,ir,ip2,np2)
           CALL INDXB(ipi1,irm1,ip1,np1)
           CALL INDXB(ipi3,irm1,ip3,np3)
+          duma = W2
           CALL PRDCT(np2,B(ip2:ip2+np2-1),np1,B(ip1:ip1+np1-1),np3,B(ip3:ip3+np3-1),0,&
-            dum,W2,W2,M,Am,Bm,Cm,Wd,Ww,Wu)
-          CALL PRDCT(np1,B(ip1:ip1+np1-1),0,dum,0,dum,nc,Cn(idxc),W2,W2,M,Am,Bm,&
+            dum,duma,W2,M,Am,Bm,Cm,Wd,Ww,Wu)
+          duma = W2
+          CALL PRDCT(np1,B(ip1:ip1+np1-1),0,dum,0,dum,nc,Cn(idxc),duma,W2,M,Am,Bm,&
             Cm,Wd,Ww,Wu)
           DO j = 1, M
             Y(j,i) = Y(j,i) - W2(j)

src/diff_integ_eq/fishpack/cblkt1.f90

@@ -58,7 +58,7 @@ END SUBROUTINE CPRDCT
     imi2, ip, ip1, ip2, ip3, ipi1, ipi2, ipi3, ir, irm1, iz, izr, j, kdo, l, ll, &
     na, nc, nm1, nm2, nm3, np, np1, np2, np3, nz
   REAL(SP) :: dum(0)
-  COMPLEX(SP) :: bc(nm_com/2)
+  COMPLEX(SP) :: bc(nm_com/2), duma(M)
   !* FIRST EXECUTABLE STATEMENT  CBLKT1
   kdo = k_com - 1
   DO l = 1, kdo
@@ -132,12 +132,14 @@ END SUBROUTINE CPRDCT
       CALL INXCB(i,ir,iz,nz)
       CALL INXCB(i-i1,ir-1,im1,nm1)
       CALL INXCB(i+i1,ir-1,ip1,np1)
-      CALL PRDCT(np1,B(ip1:ip1+np1-1),0,dum,0,dum,nc,Cn(idxc),W1,W1,M,Am,Bm,Cm,Wd,Ww,Wu)
+      duma = W1
+      CALL PRDCT(np1,B(ip1:ip1+np1-1),0,dum,0,dum,nc,Cn(idxc),duma,W1,M,Am,Bm,Cm,Wd,Ww,Wu)
       DO j = 1, M
         W1(j) = Y(j,i) + W1(j)
       END DO
+      duma = W1
       CALL PRDCT(nz,B(iz:iz+nz-1),nm1,B(im1:im1+nm1-1),np1,B(ip1:ip1+np1-1),0,&
-        dum,W1,W1,M,Am,Bm,Cm,Wd,Ww,Wu)
+        dum,duma,W1,M,Am,Bm,Cm,Wd,Ww,Wu)
     END DO
     DO ll = 2, k_com
       l = k_com - ll + 1
@@ -153,13 +155,15 @@ END SUBROUTINE CPRDCT
           CALL INXCB(i,ir,iz,nz)
           CALL INXCB(i-i1,ir-1,im1,nm1)
           CALL INXCB(i+i1,ir-1,ip1,np1)
-          CALL PRDCT(nm1,B(im1:im1+nm1-1),0,dum,0,dum,na,An(idxa),W2,W2,M,Am,Bm,&
+          duma = W2
+          CALL PRDCT(nm1,B(im1:im1+nm1-1),0,dum,0,dum,na,An(idxa),duma,W2,M,Am,Bm,&
             Cm,Wd,Ww,Wu)
           DO j = 1, M
             W2(j) = Y(j,i) + W2(j)
           END DO
+          duma = W2
           CALL PRDCT(nz,B(iz:iz+nz-1),nm1,B(im1:im1+nm1-1),np1,B(ip1:ip1+np1-1),0,&
-            dum,W2,W2,M,Am,Bm,Cm,Wd,Ww,Wu)
+            dum,duma,W2,M,Am,Bm,Cm,Wd,Ww,Wu)
           izr = i
           IF( i==nm_com ) GOTO 50
         END IF
@@ -195,9 +199,11 @@ END SUBROUTINE CPRDCT
       CALL INXCB(i-i2,ir,im2,nm2)
       CALL INXCB(i-i2-i1,ir-1,im3,nm3)
       CALL INXCB(i-i1,ir-1,im1,nm1)
+      duma = W1
       CALL PRDCT(nm2,B(im2:im2+nm2-1),nm3,B(im3:im3+nm3-1),nm1,B(im1:im1-nm1-1),0,&
-        dum,W1,W1,M,Am,Bm,Cm,Wd,Ww,Wu)
-      CALL PRDCT(nm1,B(im1:im1+nm1-1),0,dum,0,dum,na,An(idxa),W1,W1,M,Am,Bm,Cm,Wd,Ww,Wu)
+        dum,duma,W1,M,Am,Bm,Cm,Wd,Ww,Wu)
+      duma = W1
+      CALL PRDCT(nm1,B(im1:im1+nm1-1),0,dum,0,dum,na,An(idxa),duma,W1,M,Am,Bm,Cm,Wd,Ww,Wu)
       DO j = 1, M
         Y(j,i) = Y(j,i) - W1(j)
       END DO
@@ -220,9 +226,11 @@ END SUBROUTINE CPRDCT
           CALL INXCB(ipi2,ir,ip2,np2)
           CALL INXCB(ipi1,irm1,ip1,np1)
           CALL INXCB(ipi3,irm1,ip3,np3)
+          duma = W2
           CALL PRDCT(np2,B(ip2:ip2+np2-1),np1,B(ip1:ip1+np1-1),np3,B(ip3:ip3+np3-1),0,&
-            dum,W2,W2,M,Am,Bm,Cm,Wd,Ww,Wu)
-          CALL PRDCT(np1,B(ip1:ip1+np1-1),0,dum,0,dum,nc,Cn(idxc),W2,W2,M,Am,Bm,Cm,Wd,&
+            dum,duma,W2,M,Am,Bm,Cm,Wd,Ww,Wu)
+          duma = W2
+          CALL PRDCT(np1,B(ip1:ip1+np1-1),0,dum,0,dum,nc,Cn(idxc),duma,W2,M,Am,Bm,Cm,Wd,&
             Ww,Wu)
           DO j = 1, M
             Y(j,i) = Y(j,i) - W2(j)

src/integ_trans/fftpack/cfftb1.f90

@@ -79,7 +79,9 @@ PURE SUBROUTINE CFFTB1(N,C,Ch,Wa,Ifac)
   INTEGER, INTENT(IN) :: N, Ifac(15)
   REAL(SP), INTENT(IN) :: Wa(2*N)
   REAL(SP), INTENT(INOUT) :: Ch(2*N), C(2*N)
+  !
   INTEGER :: i, idl1, ido, idot, ip, iw, ix2, ix3, ix4, k1, l1, l2, n2, na, nac, nf
+  REAL(SP) :: dum(2*N)
   !* FIRST EXECUTABLE STATEMENT  CFFTB1
   nf = Ifac(2)
   na = 0
@@ -117,9 +119,11 @@ PURE SUBROUTINE CFFTB1(N,C,Ch,Wa,Ifac)
       na = 1 - na
     ELSEIF( ip/=5 ) THEN
       IF( na/=0 ) THEN
-        CALL PASSB(nac,idot,ip,l1,idl1,Ch,Ch,Ch,C,C,Wa(iw:))
+        dum = Ch
+        CALL PASSB(nac,idot,ip,l1,idl1,dum,Ch,Ch,C,C,Wa(iw:))
       ELSE
-        CALL PASSB(nac,idot,ip,l1,idl1,C,C,C,Ch,Ch,Wa(iw:))
+        dum = C
+        CALL PASSB(nac,idot,ip,l1,idl1,dum,C,C,Ch,Ch,Wa(iw:))
       END IF
       IF( nac/=0 ) na = 1 - na
     ELSE

src/integ_trans/fftpack/cfftf1.f90

@@ -80,7 +80,9 @@ PURE SUBROUTINE CFFTF1(N,C,Ch,Wa,Ifac)
   INTEGER, INTENT(IN) :: N, Ifac(15)
   REAL(SP), INTENT(IN) :: Wa(2*N)
   REAL(SP), INTENT(INOUT) :: C(2*N), Ch(2*N)
+  !
   INTEGER :: i, idl1, ido, idot, ip, iw, ix2, ix3, ix4, k1, l1, l2, n2, na, nac, nf
+  REAL(SP) :: dum(2*N)
   !* FIRST EXECUTABLE STATEMENT  CFFTF1
   nf = Ifac(2)
   na = 0
@@ -118,9 +120,11 @@ PURE SUBROUTINE CFFTF1(N,C,Ch,Wa,Ifac)
       na = 1 - na
     ELSEIF( ip/=5 ) THEN
       IF( na/=0 ) THEN
-        CALL PASSF(nac,idot,ip,l1,idl1,Ch,Ch,Ch,C,C,Wa(iw:))
+        dum = Ch
+        CALL PASSF(nac,idot,ip,l1,idl1,dum,Ch,Ch,C,C,Wa(iw:))
       ELSE
-        CALL PASSF(nac,idot,ip,l1,idl1,C,C,C,Ch,Ch,Wa(iw:))
+        dum = C
+        CALL PASSF(nac,idot,ip,l1,idl1,dum,C,C,Ch,Ch,Wa(iw:))
       END IF
       IF( nac/=0 ) na = 1 - na
     ELSE
@@ -142,4 +146,5 @@ PURE SUBROUTINE CFFTF1(N,C,Ch,Wa,Ifac)
   DO i = 1, n2
     C(i) = Ch(i)
   END DO
-END SUBROUTINE CFFTF1
+  !
+END SUBROUTINE CFFTF1

src/integ_trans/fftpack/passb.f90

@@ -140,6 +140,6 @@ PURE SUBROUTINE PASSB(Nac,Ido,Ip,L1,Idl1,Cc,C1,C2,Ch,Ch2,Wa)
       END DO
     END DO
   END DO
-
+  !
   RETURN
 END SUBROUTINE PASSB

src/integ_trans/fftpack/passf.f90

@@ -140,5 +140,6 @@ PURE SUBROUTINE PASSF(Nac,Ido,Ip,L1,Idl1,Cc,C1,C2,Ch,Ch2,Wa)
       END DO
     END DO
   END DO
+  !
   RETURN
-END SUBROUTINE PASSF
+END SUBROUTINE PASSF

src/integ_trans/fftpack/radbg.f90

@@ -29,6 +29,7 @@ PURE SUBROUTINE RADBG(Ido,Ip,L1,Idl1,Cc,C1,C2,Ch,Ch2,Wa)
   REAL(SP), INTENT(IN) :: Cc(Ido,Ip,L1), Wa(:)
   REAL(SP), INTENT(INOUT) :: Ch2(Idl1,Ip)
   REAL(SP), INTENT(OUT) :: C1(Ido,L1,Ip), C2(Idl1,Ip), Ch(Ido,L1,Ip)
+  !
   INTEGER :: i, ic, idij, idp2, ik, ipp2, ipph, is, j, j2, jc, k, l, lc, nbd
   REAL(SP) :: ai1, ai2, ar1, ar1h, ar2, ar2h, arg, dc2, dcp, ds2, dsp, tpi
   !* FIRST EXECUTABLE STATEMENT  RADBG
@@ -191,5 +192,5 @@ PURE SUBROUTINE RADBG(Ido,Ip,L1,Idl1,Cc,C1,C2,Ch,Ch2,Wa)
       END DO
     END DO
   END IF
-
+  !
 END SUBROUTINE RADBG

src/integ_trans/fftpack/radfg.f90

@@ -198,6 +198,6 @@ PURE SUBROUTINE RADFG(Ido,Ip,L1,Idl1,Cc,C1,C2,Ch,Ch2,Wa)
       END DO
     END DO
   END DO
-
+  !
   RETURN
 END SUBROUTINE RADFG

src/integ_trans/fftpack/rfftb1.f90

@@ -92,7 +92,9 @@ PURE SUBROUTINE RFFTB1(N,C,Ch,Wa,Ifac)
   INTEGER, INTENT(IN) :: N, Ifac(15)
   REAL(SP), INTENT(IN) :: Wa(N)
   REAL(SP), INTENT(INOUT) :: C(N),  Ch(N)
+  !
   INTEGER :: i, idl1, ido, ip, iw, ix2, ix3, ix4, k1, l1, l2, na, nf
+  REAL(SP) :: dum(N)
   !* FIRST EXECUTABLE STATEMENT  RFFTB1
   nf = Ifac(2)
   na = 0
@@ -129,9 +131,11 @@ PURE SUBROUTINE RFFTB1(N,C,Ch,Wa,Ifac)
       na = 1 - na
     ELSEIF( ip/=5 ) THEN
       IF( na/=0 ) THEN
-        CALL RADBG(ido,ip,l1,idl1,Ch,Ch,Ch,C,C,Wa(iw:))
+        dum = Ch
+        CALL RADBG(ido,ip,l1,idl1,dum,Ch,Ch,C,C,Wa(iw:))
       ELSE
-        CALL RADBG(ido,ip,l1,idl1,C,C,C,Ch,Ch,Wa(iw:))
+        dum = C
+        CALL RADBG(ido,ip,l1,idl1,dum,C,C,Ch,Ch,Wa(iw:))
       END IF
       IF( ido==1 ) na = 1 - na
     ELSE
@@ -152,4 +156,5 @@ PURE SUBROUTINE RFFTB1(N,C,Ch,Wa,Ifac)
   DO i = 1, N
     C(i) = Ch(i)
   END DO
-END SUBROUTINE RFFTB1
+  !
+END SUBROUTINE RFFTB1