qpassm.f90

!c Copyright 1981-2016 ECMWF.
!c
!c This software is licensed under the terms of the Apache Licence 
!c Version 2.0 which can be obtained at http://www.apache.org/licenses/LICENSE-2.0.
!c
!c In applying this licence, ECMWF does not waive the privileges and immunities 
!c granted to it by virtue of its status as an intergovernmental organisation 
!c nor does it submit to any jurisdiction.
!c

      SUBROUTINE QPASSM(A,B,C,D,TRIGS,INC1,INC2,INC3,INC4,ILOT,N,IFAC,ILA,IERR)
      REAL A(*),B(*),C(*),D(*),TRIGS(*)
!C
!C     SUBROUTINE 'QPASSM' - PERFORMS ONE PASS THROUGH DATA AS PART
!C     OF MULTIPLE REAL FFT (FOURIER ANALYSIS) ROUTINE
!C
!C     A IS FIRST REAL INPUT VECTOR
!C         EQUIVALENCE B(1) WITH A(IFAC*ILA*INC1+1)
!C     C IS FIRST REAL OUTPUT VECTOR
!C         EQUIVALENCE D(1) WITH C(ILA*INC2+1)
!C     TRIGS IS A PRECALCULATED LIST OF SINES & COSINES
!C     INC1 IS THE ADDRESSING INCREMENT FOR A
!C     INC2 IS THE ADDRESSING INCREMENT FOR C
!C     INC3 IS THE INCREMENT BETWEEN INPUT VECTORS A
!C     INC4 IS THE INCREMENT BETWEEN OUTPUT VECTORS C
!C     ILOT IS THE NUMBER OF VECTORS
!C     N IS THE LENGTH OF THE VECTORS
!C     IFAC IS THE CURRENT FACTOR OF N
!C     ILA = N/(PRODUCT OF FACTORS USED SO FAR)
!C     IERR IS AN ERROR INDICATOR:
!C              0 - PASS COMPLETED WITHOUT ERROR
!C              1 - ILOT GREATER THAN 64
!C              2 - IFAC NOT CATERED FOR
!C              3 - IFAC ONLY CATERED FOR IF ILA=N/IFAC
!C
!C-----------------------------------------------------------------------
!C
      SAVE SIN36, SIN72, QRT5, SIN60

      DATA SIN36/0.587785252292473/,SIN72/0.951056516295154/,&
           QRT5/0.559016994374947/,SIN60/0.866025403784437/

      M=N/IFAC
      IINK=ILA*INC1
      JINK=ILA*INC2
      IJUMP=(IFAC-1)*IINK
      KSTOP=(N-IFAC)/(2*IFAC)

      IBAD=1
      IF (ILOT.GT.512) GO TO 910
      IBASE=0
      JBASE=0
      IGO=IFAC-1
      IF (IGO.EQ.7) IGO=6
      IBAD=2
      IF (IGO.LT.1.OR.IGO.GT.6) GO TO 910
      GO TO (200,300,400,500,600,800),IGO

!     CODING FOR FACTOR 2
!     -------------------
  200 CONTINUE
      IA=1
      IB=IA+IINK
      JA=1
      JB=JA+(2*M-ILA)*INC2

      IF (ILA.EQ.M) GO TO 290

      DO 220 JL=1,ILA
      I=IBASE