C----------------------------------------------------------------------- SUBROUTINE SPFFTE(IMAX,INCW,INCG,KMAX,W,G,IDIR,AFFT) C$$$ SUBPROGRAM DOCUMENTATION BLOCK C C SUBPROGRAM: SPFFTE PERFORM MULTIPLE FAST FOURIER TRANSFORMS C PRGMMR: IREDELL ORG: W/NMC23 DATE: 96-02-20 C C ABSTRACT: THIS SUBPROGRAM PERFORMS MULTIPLE FAST FOURIER TRANSFORMS C BETWEEN COMPLEX AMPLITUDES IN FOURIER SPACE AND REAL VALUES C IN CYCLIC PHYSICAL SPACE. C SUBPROGRAM SPFFTE MUST BE INVOKED FIRST WITH IDIR=0 C TO INITIALIZE TRIGONEMETRIC DATA. USE SUBPROGRAM SPFFT1 C TO PERFORM AN FFT WITHOUT PREVIOUS INITIALIZATION. C THIS VERSION INVOKES THE IBM ESSL FFT. C C PROGRAM HISTORY LOG: C 1998-12-18 IREDELL C 2012-11-12 MIRVIS -fixing hard-wired types problem on Intel/Linux C USAGE: CALL SPFFTE(IMAX,INCW,INCG,KMAX,W,G,IDIR,AFFT) C C INPUT ARGUMENT LIST: C IMAX - INTEGER NUMBER OF VALUES IN THE CYCLIC PHYSICAL SPACE C (SEE LIMITATIONS ON IMAX IN REMARKS BELOW.) C INCW - INTEGER FIRST DIMENSION OF THE COMPLEX AMPLITUDE ARRAY C (INCW >= IMAX/2+1) C INCG - INTEGER FIRST DIMENSION OF THE REAL VALUE ARRAY C (INCG >= IMAX) C KMAX - INTEGER NUMBER OF TRANSFORMS TO PERFORM C W - COMPLEX(INCW,KMAX) COMPLEX AMPLITUDES IF IDIR>0 C G - REAL(INCG,KMAX) REAL VALUES IF IDIR<0 C IDIR - INTEGER DIRECTION FLAG C IDIR=0 TO INITIALIZE TRIGONOMETRIC DATA C IDIR>0 TO TRANSFORM FROM FOURIER TO PHYSICAL SPACE C IDIR<0 TO TRANSFORM FROM PHYSICAL TO FOURIER SPACE C AFFT REAL(8) (50000+4*IMAX) AUXILIARY ARRAY IF IDIR<>0 C C OUTPUT ARGUMENT LIST: C W - COMPLEX(INCW,KMAX) COMPLEX AMPLITUDES IF IDIR<0 C G - REAL(INCG,KMAX) REAL VALUES IF IDIR>0 C AFFT REAL(8) (50000+4*IMAX) AUXILIARY ARRAY IF IDIR=0 C C SUBPROGRAMS CALLED: C SCRFT IBM ESSL COMPLEX TO REAL FOURIER TRANSFORM C DCRFT IBM ESSL COMPLEX TO REAL FOURIER TRANSFORM C SRCFT IBM ESSL REAL TO COMPLEX FOURIER TRANSFORM C DRCFT IBM ESSL REAL TO COMPLEX FOURIER TRANSFORM C C ATTRIBUTES: C LANGUAGE: FORTRAN 90 C C REMARKS: C THE RESTRICTIONS ON IMAX ARE THAT IT MUST BE A MULTIPLE C OF 1 TO 25 FACTORS OF TWO, UP TO 2 FACTORS OF THREE, C AND UP TO 1 FACTOR OF FIVE, SEVEN AND ELEVEN. C C IF IDIR=0, THEN W AND G NEED NOT CONTAIN ANY VALID DATA. C THE OTHER PARAMETERS MUST BE SUPPLIED AND CANNOT CHANGE C IN SUCCEEDING CALLS UNTIL THE NEXT TIME IT IS CALLED WITH IDIR=0. C C THIS SUBPROGRAM IS THREAD-SAFE. C C$$$ IMPLICIT NONE INTEGER,INTENT(IN):: IMAX,INCW,INCG,KMAX,IDIR REAL,INTENT(INOUT):: W(2*INCW,KMAX) REAL,INTENT(INOUT):: G(INCG,KMAX) REAL(8),INTENT(INOUT):: AFFT(50000+4*IMAX) INTEGER:: INIT,INC2X,INC2Y,N,M,ISIGN,NAUX1,NAUX2,NAUX3 C ==EM== ^(4) REAL:: SCALE REAL(8):: AUX2(20000+2*IMAX),AUX3 INTEGER:: IACR,IARC C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - NAUX1=25000+2*IMAX NAUX2=20000+2*IMAX NAUX3=1 IACR=1 IARC=1+NAUX1 C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - C INITIALIZATION. C FILL AUXILIARY ARRAYS WITH TRIGONOMETRIC DATA SELECT CASE(IDIR) CASE(0) INIT=1 INC2X=INCW INC2Y=INCG N=IMAX M=KMAX ISIGN=-1 SCALE=1. IF(DIGITS(1.).LT.DIGITS(1._8)) THEN CALL SCRFT(INIT,W,INC2X,G,INC2Y,N,M,ISIGN,SCALE, & AFFT(IACR),NAUX1,AUX2,NAUX2,AUX3,NAUX3) ELSE CALL DCRFT(INIT,W,INC2X,G,INC2Y,N,M,ISIGN,SCALE, & AFFT(IACR),NAUX1,AUX2,NAUX2) ENDIF INIT=1 INC2X=INCG INC2Y=INCW N=IMAX M=KMAX ISIGN=+1 SCALE=1./IMAX IF(DIGITS(1.).LT.DIGITS(1._8)) THEN CALL SRCFT(INIT,G,INC2X,W,INC2Y,N,M,ISIGN,SCALE, & AFFT(IARC),NAUX1,AUX2,NAUX2,AUX3,NAUX3) ELSE CALL DRCFT(INIT,G,INC2X,W,INC2Y,N,M,ISIGN,SCALE, & AFFT(IARC),NAUX1,AUX2,NAUX2) ENDIF C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - C FOURIER TO PHYSICAL TRANSFORM. CASE(1:) INIT=0 INC2X=INCW INC2Y=INCG N=IMAX M=KMAX ISIGN=-1 SCALE=1. IF(DIGITS(1.).LT.DIGITS(1._8)) THEN CALL SCRFT(INIT,W,INC2X,G,INC2Y,N,M,ISIGN,SCALE, & AFFT(IACR),NAUX1,AUX2,NAUX2,AUX3,NAUX3) ELSE CALL DCRFT(INIT,W,INC2X,G,INC2Y,N,M,ISIGN,SCALE, & AFFT(IACR),NAUX1,AUX2,NAUX2) ENDIF C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - C PHYSICAL TO FOURIER TRANSFORM. CASE(:-1) INIT=0 INC2X=INCG INC2Y=INCW N=IMAX M=KMAX ISIGN=+1 SCALE=1./IMAX IF(DIGITS(1.).LT.DIGITS(1._8)) THEN CALL SRCFT(INIT,G,INC2X,W,INC2Y,N,M,ISIGN,SCALE, & AFFT(IARC),NAUX1,AUX2,NAUX2,AUX3,NAUX3) ELSE CALL DRCFT(INIT,G,INC2X,W,INC2Y,N,M,ISIGN,SCALE, & AFFT(IARC),NAUX1,AUX2,NAUX2) ENDIF END SELECT END SUBROUTINE