fft.f90

          JB0 = JB
          JC0 = JC
          JD0 = JD
          JE0 = JE
          JF0 = JF
!$acc loop independent private( KB, KC, KD, KE, KF, C1, S1, C2, S2, C3, S3, C4, S4, C5, S5, IBASE, JA, JB, JC, JD, JE, JF )
          DO K=ILA,KSTOP,ILA
            KB=K+K
            KC=KB+KB
            KD=KC+KB
            KE=KD+KB
            KF=KE+KB
            C1=TRIGS(KB+1)
            S1=TRIGS(KB+2)
            C2=TRIGS(KC+1)
            S2=TRIGS(KC+2)
            C3=TRIGS(KD+1)
            S3=TRIGS(KD+2)
            C4=TRIGS(KE+1)
            S4=TRIGS(KE+2)
            C5=TRIGS(KF+1)
            S5=TRIGS(KF+2)
            IBASE = IBASE0 + (K-ILA)/ILA * (ILA + IJUMP )
            JA = JA0 + (K-ILA)/ILA * JINK
            JB = JB0 + (K-ILA)/ILA * JINK
            JC = JC0 + (K-ILA)/ILA * JINK
            JD = JD0 - (K-ILA)/ILA * JINK
            JE = JE0 - (K-ILA)/ILA * JINK
            JF = JF0 - (K-ILA)/ILA * JINK
!$acc loop independent
            DO JL=1,ILA
!CDIR$ IVDEP
!!CDIR NODEP
!*VOCL LOOP,NOVREC
!$acc loop independent private( I, J, A1, A2, A3, A4, A5, A11, A20, A21, B1, B2, B3, B4, B5, B11, B20, B21 )
              DO IJK=1,ILOT
                I = IBASE + JL - 1 + (IJK - 1 ) * INC3
                J =         JL - 1 + (IJK - 1 ) * INC4
                A1=C1*A(IB+I)+S1*B(IB+I)
                B1=C1*B(IB+I)-S1*A(IB+I)
                A2=C2*A(IC+I)+S2*B(IC+I)
                B2=C2*B(IC+I)-S2*A(IC+I)
                A3=C3*A(ID+I)+S3*B(ID+I)
                B3=C3*B(ID+I)-S3*A(ID+I)
                A4=C4*A(IE+I)+S4*B(IE+I)
                B4=C4*B(IE+I)-S4*A(IE+I)
                A5=C5*A(IF+I)+S5*B(IF+I)
                B5=C5*B(IF+I)-S5*A(IF+I)
                A11=(A2+A5)+(A1+A4)
                A20=(A(IA+I)+A3)-0.5*A11
                A21=XSIN60*((A2+A5)-(A1+A4))
                B11=(B2+B5)+(B1+B4)
                B20=(B(IA+I)+B3)-0.5*B11
                B21=XSIN60*((B2+B5)-(B1+B4))
                C(JA+J)=(A(IA+I)+A3)+A11
                D(JA+J)=(B(IA+I)+B3)+B11
                C(JC+J)=A20-B21
                D(JC+J)=A21+B20
                C(JE+J)=A20+B21
                D(JE+J)=A21-B20
                A11=(A2-A5)+(A4-A1)
                A20=(A(IA+I)-A3)-0.5*A11
                A21=XSIN60*((A4-A1)-(A2-A5))
                B11=(B5-B2)-(B4-B1)
                B20=(B3-B(IA+I))-0.5*B11
                B21=XSIN60*((B5-B2)+(B4-B1))
                C(JB+J)=A20-B21
                D(JB+J)=A21-B20
                C(JD+J)=A11+(A(IA+I)-A3)
                D(JD+J)=B11+(B3-B(IA+I))
                C(JF+J)=A20+B21
                D(JF+J)=A21+B20
              END DO
            END DO
          END DO
          IBASE = IBASE0 + ((KSTOP-ILA)/ILA+1) * ( ILA + IJUMP )
          JA = JA0 + ((KSTOP-ILA)/ILA+1) * JINK
          JB = JB0 + ((KSTOP-ILA)/ILA+1) * JINK
          JC = JC0 + ((KSTOP-ILA)/ILA+1) * JINK
          JD = JD0 - ((KSTOP-ILA)/ILA+1) * JINK
          JE = JE0 - ((KSTOP-ILA)/ILA+1) * JINK
          JF = JF0 - ((KSTOP-ILA)/ILA+1) * JINK
!$acc end kernels
        END IF

        IF ( JC <= JD ) THEN
!$acc kernels
          JBASE=0
!$acc loop independent
          DO JL=1,ILA
!CDIR$ IVDEP
!!CDIR NODEP
!*VOCL LOOP,NOVREC
!$acc loop independent private( I, J )
            DO IJK=1,ILOT
              I = IBASE + JL - 1 + (IJK - 1 ) * INC3
              J = JBASE + JL - 1 + (IJK - 1 ) * INC4
              C(JA+J)=(A(IA+I)+0.5*(A(IC+I)-A(IE+I)))+ XSIN60*(A(IB+I)-A(IF+I))
              D(JA+J)=-(A(ID+I)+0.5*(A(IB+I)+A(IF+I)))-XSIN60*(A(IC+I)+A(IE+I))
              C(JB+J)=A(IA+I)-(A(IC+I)-A(IE+I))
              D(JB+J)=A(ID+I)-(A(IB+I)+A(IF+I))
              C(JC+J)=(A(IA+I)+0.5*(A(IC+I)-A(IE+I)))-XSIN60*(A(IB+I)-A(IF+I))
              D(JC+J)=-(A(ID+I)+0.5*(A(IB+I)+A(IF+I)))+XSIN60*(A(IC+I)+A(IE+I))
            END DO
          END DO
          IBASE = IBASE + ILA
          JBASE = JBASE + ILA
!$acc end kernels
        END IF

      ELSE

!$acc kernels
        Z=1.0/REAL(N)
        ZSIN60=Z*XSIN60
!$acc loop independent
        DO JL=1,ILA
!CDIR$ IVDEP
!!CDIR NODEP
!*VOCL LOOP,NOVREC
!$acc loop independent private( I, J, A11 )
          DO IJK=1,ILOT
            I = IBASE + JL - 1 + (IJK - 1 ) * INC3
            J = JBASE + JL - 1 + (IJK - 1 ) * INC4
            A11=(A(IC+I)+A(IF+I))+(A(IB+I)+A(IE+I))
            C(JA+J)=Z*((A(IA+I)+A(ID+I))+A11)
            C(JC+J)=Z*((A(IA+I)+A(ID+I))-0.5*A11)
            D(JC+J)=ZSIN60*((A(IC+I)+A(IF+I))-(A(IB+I)+A(IE+I)))
            A11=(A(IC+I)-A(IF+I))+(A(IE+I)-A(IB+I))
            C(JB+J)=Z*((A(IA+I)-A(ID+I))-0.5*A11)
            D(JB+J)=ZSIN60*((A(IE+I)-A(IB+I))-(A(IC+I)-A(IF+I)))
            C(JD+J)=Z*((A(IA+I)-A(ID+I))+A11)
          END DO
        END DO
        IBASE = IBASE + ILA
        JBASE = JBASE + ILA
!$acc end kernels
      END IF

      IBAD=0



      CASE ( 7, 8 )
!
!     CODING FOR FACTOR 8
!     -------------------
      IF ( ILA /= M ) THEN
        IBAD = 3
      ELSE
!$acc kernels
        IA=1
        IB=IA+IINK
        IC=IB+IINK
        ID=IC+IINK
        IE=ID+IINK
        IF=IE+IINK
        IG=IF+IINK
        IH=IG+IINK
        JA=1
        JB=JA+ILA
        JC=JB+2*M
        JD=JC+2*M
        JE=JD+2*M
        Z=1.0/REAL(N)
        ZSIN45=Z*SQRT(0.5)

!$acc loop independent
        DO JL=1,ILA
!CDIR$ IVDEP
!!CDIR NODEP
!*VOCL LOOP,NOVREC
!$acc loop independent private( I, J )
          DO IJK=1,ILOT
            I = IBASE + JL - 1 + (IJK - 1 ) * INC3
            J = JBASE + JL - 1 + (IJK - 1 ) * INC4
            C(JA+J)=Z*(((A(IA+I)+A(IE+I))+(A(IC+I)+A(IG+I)))+ &
                ((A(ID+I)+A(IH+I))+(A(IB+I)+A(IF+I))))
            C(JE+J)=Z*(((A(IA+I)+A(IE+I))+(A(IC+I)+A(IG+I)))- &
                ((A(ID+I)+A(IH+I))+(A(IB+I)+A(IF+I))))
            C(JC+J)=Z*((A(IA+I)+A(IE+I))-(A(IC+I)+A(IG+I)))
            D(JC+J)=Z*((A(ID+I)+A(IH+I))-(A(IB+I)+A(IF+I)))
            C(JB+J)=Z*(A(IA+I)-A(IE+I))                       &
                +ZSIN45*((A(IH+I)-A(ID+I))-(A(IF+I)-A(IB+I)))
            C(JD+J)=Z*(A(IA+I)-A(IE+I))                       &
                -ZSIN45*((A(IH+I)-A(ID+I))-(A(IF+I)-A(IB+I)))
            D(JB+J)=ZSIN45*((A(IH+I)-A(ID+I))+(A(IF+I)-A(IB+I))) &
                +Z*(A(IG+I)-A(IC+I))
            D(JD+J)=ZSIN45*((A(IH+I)-A(ID+I))+(A(IF+I)-A(IB+I))) &
                -Z*(A(IG+I)-A(IC+I))
          END DO
        END DO
        IBASE = IBASE + ILA
        JBASE = JBASE + ILA
!$acc end kernels
        IBAD=0
      END IF



      CASE DEFAULT
        CALL PRINT_MSG( NVERB_ERROR, 'GEN', 'QPASSM', 'invalid factor' )

      END SELECT
!
!     RETURN
!     ------
  910 CONTINUE
      IERR=IBAD

!$acc end data

END SUBROUTINE QPASSM

END MODULE MODE_FFT