SUBROUTINE FOURIER(A,TRIGS,IFAX,INC,JUMP,N,LOT,ISIGN) 8,6FOURIE3A.24
FOURIE3A.25
IMPLICIT NONE FOURIE3A.26
! Description: FOURIE3A.27
! FOURIE3A.28
! SUBROUTINE 'FOURIER' - MULTIPLE FAST REAL PERIODIC TRANSFORM FOURIE3A.29
! UNIFIED MODEL RE-WRITE OF ECMWF ROUTINE FFT991 FOURIE3A.30
! FOURIE3A.31
! REAL TRANSFORM OF LENGTH N PERFORMED BY REMOVING REDUNDANT FOURIE3A.32
! OPERATIONS FROM COMPLEX TRANSFORM OF LENGTH N FOURIE3A.33
! FOURIE3A.34
! INPUT INFORMATION: FOURIE3A.35
! A IS THE ARRAY CONTAINING INPUT & OUTPUT DATA FOURIE3A.36
! TRIGS IS A PREVIOUSLY PREPARED LIST OF TRIG FUNCTION VALUES FOURIE3A.37
! IFAX IS A PREVIOUSLY PREPARED LIST OF FACTORS OF N FOURIE3A.38
! INC IS THE INCREMENT WITHIN EACH DATA 'VECTOR' FOURIE3A.39
! (E.G. INC=1 FOR CONSECUTIVELY STORED DATA) FOURIE3A.40
! JUMP IS THE INCREMENT BETWEEN THE START OF EACH DATA VECTOR FOURIE3A.41
! N IS THE LENGTH OF THE DATA VECTORS FOURIE3A.42
! LOT IS THE NUMBER OF DATA VECTORS FOURIE3A.43
! ISIGN = +1 FOR TRANSFORM FROM SPECTRAL TO GRIDPOINT FOURIE3A.44
! = -1 FOR TRANSFORM FROM GRIDPOINT TO SPECTRAL FOURIE3A.45
! FOURIE3A.46
! ORDERING OF COEFFICIENTS: FOURIE3A.47
! A(0),B(0),A(1),B(1),A(2),B(2),...,A(N/2),B(N/2) FOURIE3A.48
! WHERE B(0)=B(N/2)=0; (N+2) LOCATIONS REQUIRED FOURIE3A.49
! FOURIE3A.50
! ORDERING OF DATA: FOURIE3A.51
! X(0),X(1),X(2),...,X(N-1), 0 , 0 ; (N+2) LOCATIONS REQUIRED FOURIE3A.52
! FOURIE3A.53
! N MUST BE COMPOSED OF FACTORS 2,3 & 5 BUT DOES NOT HAVE TO BE EVEN FOURIE3A.54
! FOURIE3A.55
! DEFINITION OF TRANSFORMS: FOURIE3A.56
! FOURIE3A.57
! ISIGN=+1: X(J)=SUM(K=0,...,N-1)(C(K)*EXP(2*I*J*K*PI/N)) FOURIE3A.58
! WHERE C(K)=A(K)+I*B(K) AND C(N-K)=A(K)-I*B(K) FOURIE3A.59
! FOURIE3A.60
! ISIGN=-1: A(K)=(1/N)*SUM(J=0,...,N-1)(X(J)*COS(2*J*K*PI/N)) FOURIE3A.61
! B(K)=-(1/N)*SUM(J=0,...,N-1)(X(J)*SIN(2*J*K*PI/N)) FOURIE3A.62
!--------------------------------------------------------------------- FOURIE3A.63
! FOURIE3A.64
! Current code owner: M.H.Mawson FOURIE3A.65
! FOURIE3A.66
! History: FOURIE3A.67
! Version Date Comment FOURIE3A.68
! ======= ==== ======= FOURIE3A.69
! 4.1 June '96 Original code at 4.1. Based on modifications by FOURIE3A.70
! Ken Hawick on public domain provided software. FOURIE3A.71
! This is primarily for workstation usage. FOURIE3A.72
! 4.5 07/05/98 Blocking size increased from 64 to 512 to give GRB1F405.92
! much better vector performance on Fujitsu VPP700 GRB1F405.93
! RBarnes@ecmwf.int GRB1F405.94
! FOURIE3A.73
! Code description: FOURIE3A.74
! FORTRAN 77 + common Fortran 90 extensions. FOURIE3A.75
! Written to UM programming standards version 7. FOURIE3A.76
! DOCUMENTATION: NIL. FOURIE3A.77
!END------------------------------------------------------------------ FOURIE3A.78
FOURIE3A.79
! Subroutine arguments FOURIE3A.80
! FOURIE3A.81
! Scaler arguments with intent(in): FOURIE3A.82
INTEGER FOURIE3A.83
& INC, ! IN Increment between elements of data vector FOURIE3A.84
& JUMP, ! IN Increment between start of each data vector FOURIE3A.85
& N, ! IN Length of data vector in grid-point space FOURIE3A.86
& ! without extra zeroes FOURIE3A.87
& LOT, ! IN Number of data vectors FOURIE3A.88
& ISIGN, ! IN Determines type of transform FOURIE3A.89
& IFAX(10) ! IN List of factors of n FOURIE3A.90
FOURIE3A.91
! Array arguments with intent(in): FOURIE3A.92
REAL TRIGS(N) ! IN Trigonometrical functions FOURIE3A.93
FOURIE3A.94
! Array arguments with intent(out): FOURIE3A.95
REAL A(JUMP*LOT) ! INOUT Data FOURIE3A.96
FOURIE3A.97
FOURIE3A.98
*IF -DEF,FUJITSU GRB1F405.95
REAL WORK((N+2)*64) ! General workspace FOURIE3A.99
*ELSE GRB1F405.96
REAL WORK((N+2)*512) ! General workspace GRB1F405.97
*ENDIF GRB1F405.98
FOURIE3A.100
! local scalers: FOURIE3A.101
INTEGER NFAX, ! NUMBER OF FACTORS FOURIE3A.102
& NX, ! N+1 EXCEPT WHERE N IS ODD THEN HOLDS N FOURIE3A.103
& NBLOX, ! NUMBER OF BLOCKS LOT IS SPLIT INTO FOURIE3A.104
& NB, ! DO LOOP COUNTER FOURIE3A.105
& ISTART, ! START ADDRESS FOR A BLOCK FOURIE3A.106
& NVEX, ! NUMBER OF ELEMENTS IN VECTOR FOURIE3A.107
& IA, ! USED TO PASS ISTART TO FTRANS FOURIE3A.108
& IX, ! VARIABLE USED FOR ADDRESSING FOURIE3A.109
& LA, ! VARIABLE USED FOR ADDRESSING FOURIE3A.110
& IGO, ! A CONTROL VARIABLE FOURIE3A.111
& K, ! DO LOOP COUNTER FOURIE3A.112
& IFAC, ! HOLDS CURRENT FACTOR FOURIE3A.113
& IERR ! HOLDS ERROR STATUS FOURIE3A.114
FOURIE3A.115
INTEGER I,J,II,IZ,JJ,IBASE,JBASE ! loop/indexing variables. FOURIE3A.116
FOURIE3A.117
FOURIE3A.118
! Function and subroutine calls: FOURIE3A.119
EXTERNAL FTRANS FOURIE3A.120
FOURIE3A.121
!- End of Header -------------------------------------------------- FOURIE3A.122
FOURIE3A.123
C------------------------------------------------------ FOURIE3A.124
C Section 1. Set up information for sections 2 and 3: FOURIE3A.125
C------------------------------------------------------ FOURIE3A.126
FOURIE3A.127
C Set number of factors and NX: FOURIE3A.128
NFAX=IFAX(1) FOURIE3A.129
NX=N+1 FOURIE3A.130
IF (MOD(N,2).EQ.1) NX=N FOURIE3A.131
FOURIE3A.132
*IF -DEF,FUJITSU GRB1F405.99
C Calculate number of blocks of 64 data vectors are to be FOURIE3A.133
*ELSE GRB1F405.100
C Calculate number of blocks of 512, data vectors are to be GRB1F405.101
*ENDIF GRB1F405.102
C split into: FOURIE3A.134
*IF -DEF,FUJITSU GRB1F405.103
NBLOX=1+(LOT-1)/64 FOURIE3A.135
NVEX=LOT-(NBLOX-1)*64 FOURIE3A.136
*ELSE GRB1F405.104
NBLOX=1+(LOT-1)/512 GRB1F405.105
NVEX=LOT-(NBLOX-1)*512 GRB1F405.106
*ENDIF GRB1F405.107
FOURIE3A.137
C------------------------------------------------------ FOURIE3A.138
C Section 2. ISIGN=+1, spectral to gridpoint transformation FOURIE3A.139
C------------------------------------------------------ FOURIE3A.140
FOURIE3A.141
IF (ISIGN.EQ.1) THEN ! spectral-to-gridpoint transform: FOURIE3A.142
ISTART=1 FOURIE3A.143
DO NB=1,NBLOX FOURIE3A.144
IA=ISTART FOURIE3A.145
I=ISTART FOURIE3A.146
DO J=1,NVEX FOURIE3A.147
A(I+INC)=0.5*A(I) FOURIE3A.148
I=I+JUMP FOURIE3A.149
ENDDO FOURIE3A.150
IF (MOD(N,2).NE.1) THEN FOURIE3A.151
I=ISTART+N*INC FOURIE3A.152
DO J=1,NVEX FOURIE3A.153
A(I)=0.5*A(I) FOURIE3A.154
I=I+JUMP FOURIE3A.155
ENDDO FOURIE3A.156
END IF FOURIE3A.157
IA=ISTART+INC FOURIE3A.158
LA=1 FOURIE3A.159
IGO=1 FOURIE3A.160
FOURIE3A.161
DO K=1,NFAX FOURIE3A.162
IFAC=IFAX(K+1) FOURIE3A.163
IERR=-1 FOURIE3A.164
IF (IGO.EQ.1) THEN ! Invoke Fourier Synthesis pass FOURIE3A.165
CALL FTRANS
(-1,A(IA),A(IA+LA*INC),WORK(1),WORK(IFAC*LA+1), FOURIE3A.166
& TRIGS,INC,1,JUMP,NX,NVEX,N,IFAC,LA,IERR) FOURIE3A.167
ELSE FOURIE3A.168
CALL FTRANS(-1,WORK(1),WORK(LA+1),A(IA),A(IA+IFAC*LA*INC), FOURIE3A.169
& TRIGS,1,INC,NX,JUMP,NVEX,N,IFAC,LA,IERR) FOURIE3A.170
END IF FOURIE3A.171
C IF (IERR.NE.0) GO TO 400 FOURIE3A.172
LA=IFAC*LA FOURIE3A.173
IGO=-IGO FOURIE3A.174
IA=ISTART FOURIE3A.175
ENDDO FOURIE3A.176
FOURIE3A.177
C If necessary, copy results back to A: FOURIE3A.178
IF (MOD(NFAX,2).NE.0) THEN FOURIE3A.179
IBASE=1 FOURIE3A.180
JBASE=IA FOURIE3A.181
DO JJ=1,NVEX FOURIE3A.182
I=IBASE FOURIE3A.183
J=JBASE FOURIE3A.184
DO II=1,N FOURIE3A.185
A(J)=WORK(I) FOURIE3A.186
I=I+1 FOURIE3A.187
J=J+INC FOURIE3A.188
ENDDO FOURIE3A.189
IBASE=IBASE+NX FOURIE3A.190
JBASE=JBASE+JUMP FOURIE3A.191
ENDDO FOURIE3A.192
END IF FOURIE3A.193
FOURIE3A.194
C Fill in zeros at end: FOURIE3A.195
IX=ISTART+N*INC FOURIE3A.196
DO J=1,NVEX FOURIE3A.197
A(IX)=0.0 FOURIE3A.198
A(IX+INC)=0.0 FOURIE3A.199
IX=IX+JUMP FOURIE3A.200
ENDDO FOURIE3A.201
ISTART=ISTART+NVEX*JUMP FOURIE3A.202
*IF -DEF,FUJITSU GRB1F405.108
NVEX=64 FOURIE3A.203
*ELSE GRB1F405.109
NVEX=512 GRB1F405.110
*ENDIF GRB1F405.111
ENDDO FOURIE3A.204
FOURIE3A.205
FOURIE3A.206
ELSE ! isign=-1, gridpoint-to-spectral transform FOURIE3A.207
FOURIE3A.208
C------------------------------------------------------ FOURIE3A.209
C Section 3: ISIGN=-1, gridpoint to spectral transform FOURIE3A.210
C------------------------------------------------------ FOURIE3A.211
FOURIE3A.212
ISTART=1 FOURIE3A.213
DO NB=1,NBLOX FOURIE3A.214
IA=ISTART FOURIE3A.215
LA=N FOURIE3A.216
IGO=+1 FOURIE3A.217
FOURIE3A.218
DO K=1,NFAX FOURIE3A.219
IFAC=IFAX(NFAX+2-K) FOURIE3A.220
LA=LA/IFAC FOURIE3A.221
IERR=-1 FOURIE3A.222
IF (IGO.EQ.1) THEN ! Invoke Fourier analysis pass FOURIE3A.223
CALL FTRANS(1,A(IA),A(IA+IFAC*LA*INC),WORK(1),WORK(LA+1), FOURIE3A.224
& TRIGS,INC,1,JUMP,NX,NVEX,N,IFAC,LA,IERR) FOURIE3A.225
ELSE FOURIE3A.226
CALL FTRANS(1,WORK(1),WORK(IFAC*LA+1),A(IA),A(IA+LA*INC), FOURIE3A.227
& TRIGS,1,INC,NX,JUMP,NVEX,N,IFAC,LA,IERR) FOURIE3A.228
END IF FOURIE3A.229
C IF (IERR.NE.0) GO TO 500 FOURIE3A.230
IGO=-IGO FOURIE3A.231
IA=ISTART+INC FOURIE3A.232
ENDDO FOURIE3A.233
FOURIE3A.234
C If necessary, copy results back to A: FOURIE3A.235
IF (MOD(NFAX,2).NE.0) THEN FOURIE3A.236
IBASE=1 FOURIE3A.237
JBASE=IA FOURIE3A.238
DO JJ=1,NVEX FOURIE3A.239
I=IBASE FOURIE3A.240
J=JBASE FOURIE3A.241
DO II=1,N FOURIE3A.242
A(J)=WORK(I) FOURIE3A.243
I=I+1 FOURIE3A.244
J=J+INC FOURIE3A.245
ENDDO FOURIE3A.246
IBASE=IBASE+NX FOURIE3A.247
JBASE=JBASE+JUMP FOURIE3A.248
ENDDO FOURIE3A.249
END IF FOURIE3A.250
FOURIE3A.251
C Shift A(0) and fill in zero imaginary parts: FOURIE3A.252
IX=ISTART FOURIE3A.253
DO J=1,NVEX FOURIE3A.254
A(IX)=A(IX+INC) FOURIE3A.255
A(IX+INC)=0.0 FOURIE3A.256
IX=IX+JUMP FOURIE3A.257
ENDDO FOURIE3A.258
IF (MOD(N,2).NE.1) THEN FOURIE3A.259
IZ=ISTART+(N+1)*INC FOURIE3A.260
DO J=1,NVEX FOURIE3A.261
A(IZ)=0.0 FOURIE3A.262
IZ=IZ+JUMP FOURIE3A.263
ENDDO FOURIE3A.264
END IF FOURIE3A.265
FOURIE3A.266
ISTART=ISTART+NVEX*JUMP FOURIE3A.267
*IF -DEF,FUJITSU GRB1F405.112
NVEX=64 FOURIE3A.268
*ELSE GRB1F405.113
NVEX=512 GRB1F405.114
*ENDIF GRB1F405.115
ENDDO FOURIE3A.269
END IF FOURIE3A.270
FOURIE3A.271
C Error messages: FOURIE3A.272
C 400 CONTINUE FOURIE3A.273
C IF(IERR.NE.0) THEN FOURIE3A.274
C IF(IERR.EQ.1) THEN FOURIE3A.275
C WRITE(6,410) NVEX FOURIE3A.276
*IF -DEF,FUJITSU GRB1F405.116
C 410 FORMAT(16H1VECTOR LENGTH =,I4,17H, GREATER THAN 64) FOURIE3A.277
*ELSE GRB1F405.117
C 410 FORMAT(16H1VECTOR LENGTH =,I4,17H, GREATER THAN 512) GRB1F405.118
*ENDIF GRB1F405.119
C ELSE IF(IERR.EQ.2) THEN FOURIE3A.278
C WRITE(6,420) IFAC FOURIE3A.279
C 420 FORMAT( 9H1FACTOR =,I3,17H, NOT CATERED FOR) FOURIE3A.280
C ELSE IF(IERR.EQ.3) THEN FOURIE3A.281
C WRITE(6,430) IFAC FOURIE3A.282
C 430 FORMAT(9H1FACTOR =,I3,31H, ONLY CATERED FOR IF LA*IFAC=N) FOURIE3A.283
C ELSE FOURIE3A.284
C WRITE(4,440) IFAC FOURIE3A.285
C 440 FORMAT(' UNRECOGNISED ERROR MESSAGE, CODE ',I3) FOURIE3A.286
C END IF FOURIE3A.287
C END IF FOURIE3A.288
FOURIE3A.289
C End of routine FOURIER FOURIE3A.290
FOURIE3A.291
RETURN FOURIE3A.292
END FOURIE3A.293
FOURIE3A.294
!- End of subroutine code----------------------------------------- FOURIE3A.295
FOURIE3A.296
C----------------------------------------------------------------------- FOURIE3A.297
C Subroutine FTRANS FOURIE3A.298
C FOURIE3A.299
C $Header: /u/um1/vn4.1/mods/source/RCS/anf1f401,v 1.2 1996/06/21 10:13: FOURIE3A.300
C----------------------------------------------------------------------- FOURIE3A.301
C Fourier transform: FOURIE3A.302
C FOURIE3A.303
!+ Public Domain provided Fourier transform routine. FOURIE3A.304
! Subroutine Interface: FOURIE3A.305
SUBROUTINE FTRANS(ICTL,A,B,C,D,TRIGS,INC1,INC2,INC3,INC4,LOT,N, 4FOURIE3A.306
& IFAC, LA,IERR) FOURIE3A.307
! Description: FOURIE3A.308
! Calculates Fourier Transforms. FOURIE3A.309
! FOURIE3A.310
! Current code owner: Public Domain. FOURIE3A.311
! FOURIE3A.312
! History: FOURIE3A.313
! Version Date Comment FOURIE3A.314
! ======= ==== ======= FOURIE3A.315
! 4.1 June '96 Original code at 4.1. FOURIE3A.316
! Public domain provided software. FOURIE3A.317
! This is primarily for workstation usage. FOURIE3A.318
! FOURIE3A.319
! Code description: FOURIE3A.320
! FORTRAN 77 + common Fortran 90 extensions. FOURIE3A.321
! Written to UM programming standards version 7. FOURIE3A.322
! DOCUMENTATION: NIL. FOURIE3A.323
!END------------------------------------------------------------------ FOURIE3A.324
FOURIE3A.325
IMPLICIT NONE FOURIE3A.326
! FOURIE3A.327
! Subroutine arguments FOURIE3A.328
FOURIE3A.329
INTEGER ICTL ! Control: 1 = analysis; -1 = synthesis FOURIE3A.330
FOURIE3A.331
FOURIE3A.337
INTEGER INC1, ! ADDRESSING INCREMENT FOR A FOURIE3A.338
& INC2, ! ADDRESSING INCREMENT FOR C FOURIE3A.339
& INC3, ! INCREMENT BETWEEN INPUT VECTORS A FOURIE3A.340
& INC4, ! INCREMENT BETWEEN INPUT VECTORS C FOURIE3A.341
& LOT, ! NUMBER OF VECTORS FOURIE3A.342
& N, ! LENGTH OF THE VECTORS FOURIE3A.343
& IFAC, ! CURRENT FACTOR OF N FOURIE3A.344
& LA, ! N/(PRODUCT OF FACTORS USED SO FAR) FOURIE3A.345
& IERR ! Error INDICATOR: FOURIE3A.346
! 0 - PASS COMPLETED WITHOUT ERROR FOURIE3A.347
*IF -DEF,FUJITSU GRB1F405.120
! 1 - LOT GREATER THAN 64 FOURIE3A.348
*ELSE GRB1F405.121
! 1 - LOT GREATER THAN 512 GRB1F405.122
*ENDIF GRB1F405.123
! 2 - IFAC NOT CATERED FOR FOURIE3A.349
! 3 - IFAC ONLY CATERED FOR IF LA=N/IFAC FOURIE3A.350
REAL A(N), ! First real input vector PXORDER.17
& B(N), PXORDER.18
& C(N), ! First real output vector PXORDER.19
& D(N), PXORDER.20
& TRIGS(N) ! Precalculated list of sines & cosines PXORDER.21
FOURIE3A.351
C for Fourier analysis: FOURIE3A.352
C A IS FIRST REAL INPUT VECTOR FOURIE3A.353
C EQUIVALENCE B(1) WITH A(IFAC*LA*INC1+1) FOURIE3A.354
C C IS FIRST REAL OUTPUT VECTOR FOURIE3A.355
C EQUIVALENCE D(1) WITH C(LA*INC2+1) FOURIE3A.356
C FOURIE3A.357
C or for synthesis: FOURIE3A.358
C A IS FIRST REAL INPUT VECTOR FOURIE3A.359
C EQUIVALENCE B(1) WITH A (LA*INC1+1) FOURIE3A.360
C C IS FIRST REAL OUTPUT VECTOR FOURIE3A.361
C EQUIVALENCE D(1) WITH C(IFAC*LA*INC2+1) FOURIE3A.362
FOURIE3A.363
C----------------------------------------------------------------------- FOURIE3A.364
FOURIE3A.365
INTEGER IINK, FOURIE3A.366
& JINK, FOURIE3A.367
& IJUMP, JUMP, FOURIE3A.368
& KSTOP, FOURIE3A.369
& IBASE, FOURIE3A.370
& JBASE, FOURIE3A.371
& IBAD, FOURIE3A.372
& IGO, FOURIE3A.373
& I, J, K, L, M, FOURIE3A.374
& KB, KC, KD, KE, KF, FOURIE3A.375
& IA, IB, IC, ID, IE, IF, IG, IH, FOURIE3A.376
& JA, JB, JC, JD, JE, JF, JG, JH, FOURIE3A.377
& IJK FOURIE3A.378
FOURIE3A.379
REAL A0, A1, A2, A3, A4, A5, A6 FOURIE3A.380
REAL A10, A11 FOURIE3A.381
REAL A20, A21 FOURIE3A.382
FOURIE3A.383
REAL B0, B1, B2, B3, B4, B5, B6 FOURIE3A.384
REAL B10, B11 FOURIE3A.385
REAL B20, B21 FOURIE3A.386
FOURIE3A.387
REAL C1, C2, C3, C4, C5 FOURIE3A.388
REAL S1, S2, S3, S4, S5 FOURIE3A.389
FOURIE3A.390
REAL Z, ZQRT5, ZSIN36, ZSIN45, ZSIN60, ZSIN72 FOURIE3A.391
REAL QQRT5, SSIN36, SSIN45, SSIN60, SSIN72 FOURIE3A.392
FOURIE3A.393
*IF -DEF,FUJITSU GRB1F405.124
REAL AA10(64),AA11(64),AA20(64),AA21(64), FOURIE3A.394
& BB10(64),BB11(64),BB20(64),BB21(64) FOURIE3A.395
*ELSE GRB1F405.125
REAL AA10(512),AA11(512),AA20(512),AA21(512), GRB1F405.126
& BB10(512),BB11(512),BB20(512),BB21(512) GRB1F405.127
*ENDIF GRB1F405.128
FOURIE3A.396
! DOUBLE PRECISION SIN36, SIN45, SIN72, SIN60, QRT5 FOURIE3A.397
REAL SIN36, SIN45, SIN72, SIN60, QRT5 FOURIE3A.398
FOURIE3A.399
DATA SIN36/0.587785252292473/,SIN72/0.951056516295154/, FOURIE3A.400
& QRT5/0.559016994374947/,SIN60/0.866025403784437/ FOURIE3A.401
FOURIE3A.402
!- End of Header -------------------------------------------------- FOURIE3A.403
FOURIE3A.404
IF( ICTL .EQ. 1 )THEN ! Do Fourier Analysis: FOURIE3A.405
FOURIE3A.406
FOURIE3A.407
M=N/IFAC FOURIE3A.408
IINK=LA*INC1 FOURIE3A.409
JINK=LA*INC2 FOURIE3A.410
IJUMP=(IFAC-1)*IINK FOURIE3A.411
KSTOP=(N-IFAC)/(2*IFAC) FOURIE3A.412
FOURIE3A.413
IBAD=1 FOURIE3A.414
*IF -DEF,FUJITSU GRB1F405.129
IF (LOT.GT.64) GO TO 910 FOURIE3A.415
*ELSE GRB1F405.130
IF (LOT.GT.512) GO TO 910 GRB1F405.131
*ENDIF GRB1F405.132
IBASE=0 FOURIE3A.416
JBASE=0 FOURIE3A.417
IGO=IFAC-1 FOURIE3A.418
IF (IGO.EQ.7) IGO=6 FOURIE3A.419
IBAD=2 FOURIE3A.420
IF (IGO.LT.1.OR.IGO.GT.6) GO TO 910 FOURIE3A.421
GO TO (200,300,400,500,600,800),IGO FOURIE3A.422
FOURIE3A.423
FOURIE3A.424
C CODING FOR FACTOR 2 FOURIE3A.425
200 CONTINUE FOURIE3A.426
IA=1 FOURIE3A.427
IB=IA+IINK FOURIE3A.428
JA=1 FOURIE3A.429
JB=JA+(2*M-LA)*INC2 FOURIE3A.430
FOURIE3A.431
IF (LA.EQ.M) GO TO 290 FOURIE3A.432
FOURIE3A.433
DO 220 L=1,LA FOURIE3A.434
I=IBASE FOURIE3A.435
J=JBASE FOURIE3A.436
CDIR$ IVDEP FOURIE3A.437
! Fujitsu vectorization directive GRB0F405.231
!OCL NOVREC GRB0F405.232
DO 210 IJK=1,LOT FOURIE3A.438
C(JA+J)=A(IA+I)+A(IB+I) FOURIE3A.439
C(JB+J)=A(IA+I)-A(IB+I) FOURIE3A.440
I=I+INC3 FOURIE3A.441
J=J+INC4 FOURIE3A.442
210 CONTINUE FOURIE3A.443
IBASE=IBASE+INC1 FOURIE3A.444
JBASE=JBASE+INC2 FOURIE3A.445
220 CONTINUE FOURIE3A.446
JA=JA+JINK FOURIE3A.447
JINK=2*JINK FOURIE3A.448
JB=JB-JINK FOURIE3A.449
IBASE=IBASE+IJUMP FOURIE3A.450
IJUMP=2*IJUMP+IINK FOURIE3A.451
IF (JA.EQ.JB) GO TO 260 FOURIE3A.452
DO 250 K=LA,KSTOP,LA FOURIE3A.453
KB=K+K FOURIE3A.454
C1=TRIGS(KB+1) FOURIE3A.455
S1=TRIGS(KB+2) FOURIE3A.456
JBASE=0 FOURIE3A.457
DO 240 L=1,LA FOURIE3A.458
I=IBASE FOURIE3A.459
J=JBASE FOURIE3A.460
CDIR$ IVDEP FOURIE3A.461
! Fujitsu vectorization directive GRB0F405.233
!OCL NOVREC GRB0F405.234
DO 230 IJK=1,LOT FOURIE3A.462
C(JA+J)=A(IA+I)+(C1*A(IB+I)+S1*B(IB+I)) FOURIE3A.463
C(JB+J)=A(IA+I)-(C1*A(IB+I)+S1*B(IB+I)) FOURIE3A.464
D(JA+J)=(C1*B(IB+I)-S1*A(IB+I))+B(IA+I) FOURIE3A.465
D(JB+J)=(C1*B(IB+I)-S1*A(IB+I))-B(IA+I) FOURIE3A.466
I=I+INC3 FOURIE3A.467
J=J+INC4 FOURIE3A.468
230 CONTINUE FOURIE3A.469
IBASE=IBASE+INC1 FOURIE3A.470
JBASE=JBASE+INC2 FOURIE3A.471
240 CONTINUE FOURIE3A.472
IBASE=IBASE+IJUMP FOURIE3A.473
JA=JA+JINK FOURIE3A.474
JB=JB-JINK FOURIE3A.475
250 CONTINUE FOURIE3A.476
IF (JA.GT.JB) GO TO 900 FOURIE3A.477
260 CONTINUE FOURIE3A.478
JBASE=0 FOURIE3A.479
DO 280 L=1,LA FOURIE3A.480
I=IBASE FOURIE3A.481
J=JBASE FOURIE3A.482
CDIR$ IVDEP FOURIE3A.483
! Fujitsu vectorization directive GRB0F405.235
!OCL NOVREC GRB0F405.236
DO 270 IJK=1,LOT FOURIE3A.484
C(JA+J)=A(IA+I) FOURIE3A.485
D(JA+J)=-A(IB+I) FOURIE3A.486
I=I+INC3 FOURIE3A.487
J=J+INC4 FOURIE3A.488
270 CONTINUE FOURIE3A.489
IBASE=IBASE+INC1 FOURIE3A.490
JBASE=JBASE+INC2 FOURIE3A.491
280 CONTINUE FOURIE3A.492
GO TO 900 FOURIE3A.493
FOURIE3A.494
290 CONTINUE FOURIE3A.495
Z=1.0/FLOAT(N) FOURIE3A.496
DO 294 L=1,LA FOURIE3A.497
I=IBASE FOURIE3A.498
J=JBASE FOURIE3A.499
CDIR$ IVDEP FOURIE3A.500
! Fujitsu vectorization directive GRB0F405.237
!OCL NOVREC GRB0F405.238
DO 292 IJK=1,LOT FOURIE3A.501
C(JA+J)=Z*(A(IA+I)+A(IB+I)) FOURIE3A.502
C(JB+J)=Z*(A(IA+I)-A(IB+I)) FOURIE3A.503
I=I+INC3 FOURIE3A.504
J=J+INC4 FOURIE3A.505
292 CONTINUE FOURIE3A.506
IBASE=IBASE+INC1 FOURIE3A.507
JBASE=JBASE+INC2 FOURIE3A.508
294 CONTINUE FOURIE3A.509
GO TO 900 FOURIE3A.510
FOURIE3A.511
C- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - FOURIE3A.512
C Coding for factor 3: FOURIE3A.513
300 CONTINUE FOURIE3A.514
IA=1 FOURIE3A.515
IB=IA+IINK FOURIE3A.516
IC=IB+IINK FOURIE3A.517
JA=1 FOURIE3A.518
JB=JA+(2*M-LA)*INC2 FOURIE3A.519
JC=JB FOURIE3A.520
FOURIE3A.521
IF (LA.EQ.M) GO TO 390 FOURIE3A.522
FOURIE3A.523
DO 320 L=1,LA FOURIE3A.524
I=IBASE FOURIE3A.525
J=JBASE FOURIE3A.526
CDIR$ IVDEP FOURIE3A.527
! Fujitsu vectorization directive GRB0F405.239
!OCL NOVREC GRB0F405.240
DO 310 IJK=1,LOT FOURIE3A.528
C(JA+J)=A(IA+I)+(A(IB+I)+A(IC+I)) FOURIE3A.529
C(JB+J)=A(IA+I)-0.5*(A(IB+I)+A(IC+I)) FOURIE3A.530
D(JB+J)=SIN60*(A(IC+I)-A(IB+I)) FOURIE3A.531
I=I+INC3 FOURIE3A.532
J=J+INC4 FOURIE3A.533
310 CONTINUE FOURIE3A.534
IBASE=IBASE+INC1 FOURIE3A.535
JBASE=JBASE+INC2 FOURIE3A.536
320 CONTINUE FOURIE3A.537
JA=JA+JINK FOURIE3A.538
JINK=2*JINK FOURIE3A.539
JB=JB+JINK FOURIE3A.540
JC=JC-JINK FOURIE3A.541
IBASE=IBASE+IJUMP FOURIE3A.542
IJUMP=2*IJUMP+IINK FOURIE3A.543
IF (JA.EQ.JC) GO TO 360 FOURIE3A.544
DO 350 K=LA,KSTOP,LA FOURIE3A.545
KB=K+K FOURIE3A.546
KC=KB+KB FOURIE3A.547
C1=TRIGS(KB+1) FOURIE3A.548
S1=TRIGS(KB+2) FOURIE3A.549
C2=TRIGS(KC+1) FOURIE3A.550
S2=TRIGS(KC+2) FOURIE3A.551
JBASE=0 FOURIE3A.552
DO 340 L=1,LA FOURIE3A.553
I=IBASE FOURIE3A.554
J=JBASE FOURIE3A.555
CDIR$ IVDEP FOURIE3A.556
! Fujitsu vectorization directive GRB0F405.241
!OCL NOVREC GRB0F405.242
DO 330 IJK=1,LOT FOURIE3A.557
A1=(C1*A(IB+I)+S1*B(IB+I))+(C2*A(IC+I)+S2*B(IC+I)) FOURIE3A.558
B1=(C1*B(IB+I)-S1*A(IB+I))+(C2*B(IC+I)-S2*A(IC+I)) FOURIE3A.559
A2=A(IA+I)-0.5*A1 FOURIE3A.560
B2=B(IA+I)-0.5*B1 FOURIE3A.561
A3=SIN60* FOURIE3A.562
$ ((C1*A(IB+I)+S1*B(IB+I))-(C2*A(IC+I)+S2*B(IC+I))) FOURIE3A.563
B3=SIN60* FOURIE3A.564
$ ((C1*B(IB+I)-S1*A(IB+I))-(C2*B(IC+I)-S2*A(IC+I))) FOURIE3A.565
C(JA+J)=A(IA+I)+A1 FOURIE3A.566
D(JA+J)=B(IA+I)+B1 FOURIE3A.567
C(JB+J)=A2+B3 FOURIE3A.568
D(JB+J)=B2-A3 FOURIE3A.569
C(JC+J)=A2-B3 FOURIE3A.570
D(JC+J)=-(B2+A3) FOURIE3A.571
I=I+INC3 FOURIE3A.572
J=J+INC4 FOURIE3A.573
330 CONTINUE FOURIE3A.574
IBASE=IBASE+INC1 FOURIE3A.575
JBASE=JBASE+INC2 FOURIE3A.576
340 CONTINUE FOURIE3A.577
IBASE=IBASE+IJUMP FOURIE3A.578
JA=JA+JINK FOURIE3A.579
JB=JB+JINK FOURIE3A.580
JC=JC-JINK FOURIE3A.581
350 CONTINUE FOURIE3A.582
IF (JA.GT.JC) GO TO 900 FOURIE3A.583
360 CONTINUE FOURIE3A.584
JBASE=0 FOURIE3A.585
DO 380 L=1,LA FOURIE3A.586
I=IBASE FOURIE3A.587
J=JBASE FOURIE3A.588
CDIR$ IVDEP FOURIE3A.589
! Fujitsu vectorization directive GRB0F405.243
!OCL NOVREC GRB0F405.244
DO 370 IJK=1,LOT FOURIE3A.590
C(JA+J)=A(IA+I)+0.5*(A(IB+I)-A(IC+I)) FOURIE3A.591
D(JA+J)=-SIN60*(A(IB+I)+A(IC+I)) FOURIE3A.592
C(JB+J)=A(IA+I)-(A(IB+I)-A(IC+I)) FOURIE3A.593
I=I+INC3 FOURIE3A.594
J=J+INC4 FOURIE3A.595
370 CONTINUE FOURIE3A.596
IBASE=IBASE+INC1 FOURIE3A.597
JBASE=JBASE+INC2 FOURIE3A.598
380 CONTINUE FOURIE3A.599
GO TO 900 FOURIE3A.600
FOURIE3A.601
390 CONTINUE FOURIE3A.602
Z=1.0/FLOAT(N) FOURIE3A.603
ZSIN60=Z*SIN60 FOURIE3A.604
DO 394 L=1,LA FOURIE3A.605
I=IBASE FOURIE3A.606
J=JBASE FOURIE3A.607
CDIR$ IVDEP FOURIE3A.608
! Fujitsu vectorization directive GRB0F405.245
!OCL NOVREC GRB0F405.246
DO 392 IJK=1,LOT FOURIE3A.609
C(JA+J)=Z*(A(IA+I)+(A(IB+I)+A(IC+I))) FOURIE3A.610
C(JB+J)=Z*(A(IA+I)-0.5*(A(IB+I)+A(IC+I))) FOURIE3A.611
D(JB+J)=ZSIN60*(A(IC+I)-A(IB+I)) FOURIE3A.612
I=I+INC3 FOURIE3A.613
J=J+INC4 FOURIE3A.614
392 CONTINUE FOURIE3A.615
IBASE=IBASE+INC1 FOURIE3A.616
JBASE=JBASE+INC2 FOURIE3A.617
394 CONTINUE FOURIE3A.618
GO TO 900 FOURIE3A.619
FOURIE3A.620
C- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - FOURIE3A.621
C Coding for factor 4 FOURIE3A.622
400 CONTINUE FOURIE3A.623
IA=1 FOURIE3A.624
IB=IA+IINK FOURIE3A.625
IC=IB+IINK FOURIE3A.626
ID=IC+IINK FOURIE3A.627
JA=1 FOURIE3A.628
JB=JA+(2*M-LA)*INC2 FOURIE3A.629
JC=JB+2*M*INC2 FOURIE3A.630
JD=JB FOURIE3A.631
FOURIE3A.632
IF (LA.EQ.M) GO TO 490 FOURIE3A.633
FOURIE3A.634
DO 420 L=1,LA FOURIE3A.635
I=IBASE FOURIE3A.636
J=JBASE FOURIE3A.637
CDIR$ IVDEP FOURIE3A.638
! Fujitsu vectorization directive GRB0F405.247
!OCL NOVREC GRB0F405.248
DO 410 IJK=1,LOT FOURIE3A.639
C(JA+J)=(A(IA+I)+A(IC+I))+(A(IB+I)+A(ID+I)) FOURIE3A.640
C(JC+J)=(A(IA+I)+A(IC+I))-(A(IB+I)+A(ID+I)) FOURIE3A.641
C(JB+J)=A(IA+I)-A(IC+I) FOURIE3A.642
D(JB+J)=A(ID+I)-A(IB+I) FOURIE3A.643
I=I+INC3 FOURIE3A.644
J=J+INC4 FOURIE3A.645
410 CONTINUE FOURIE3A.646
IBASE=IBASE+INC1 FOURIE3A.647
JBASE=JBASE+INC2 FOURIE3A.648
420 CONTINUE FOURIE3A.649
JA=JA+JINK FOURIE3A.650
JINK=2*JINK FOURIE3A.651
JB=JB+JINK FOURIE3A.652
JC=JC-JINK FOURIE3A.653
JD=JD-JINK FOURIE3A.654
IBASE=IBASE+IJUMP FOURIE3A.655
IJUMP=2*IJUMP+IINK FOURIE3A.656
IF (JB.EQ.JC) GO TO 460 FOURIE3A.657
DO 450 K=LA,KSTOP,LA FOURIE3A.658
KB=K+K FOURIE3A.659
KC=KB+KB FOURIE3A.660
KD=KC+KB FOURIE3A.661
C1=TRIGS(KB+1) FOURIE3A.662
S1=TRIGS(KB+2) FOURIE3A.663
C2=TRIGS(KC+1) FOURIE3A.664
S2=TRIGS(KC+2) FOURIE3A.665
C3=TRIGS(KD+1) FOURIE3A.666
S3=TRIGS(KD+2) FOURIE3A.667
JBASE=0 FOURIE3A.668
DO 440 L=1,LA FOURIE3A.669
I=IBASE FOURIE3A.670
J=JBASE FOURIE3A.671
CDIR$ IVDEP FOURIE3A.672
! Fujitsu vectorization directive GRB0F405.249
!OCL NOVREC GRB0F405.250
DO 430 IJK=1,LOT FOURIE3A.673
A0=A(IA+I)+(C2*A(IC+I)+S2*B(IC+I)) FOURIE3A.674
A2=A(IA+I)-(C2*A(IC+I)+S2*B(IC+I)) FOURIE3A.675
A1=(C1*A(IB+I)+S1*B(IB+I))+(C3*A(ID+I)+S3*B(ID+I)) FOURIE3A.676
A3=(C1*A(IB+I)+S1*B(IB+I))-(C3*A(ID+I)+S3*B(ID+I)) FOURIE3A.677
B0=B(IA+I)+(C2*B(IC+I)-S2*A(IC+I)) FOURIE3A.678
B2=B(IA+I)-(C2*B(IC+I)-S2*A(IC+I)) FOURIE3A.679
B1=(C1*B(IB+I)-S1*A(IB+I))+(C3*B(ID+I)-S3*A(ID+I)) FOURIE3A.680
B3=(C1*B(IB+I)-S1*A(IB+I))-(C3*B(ID+I)-S3*A(ID+I)) FOURIE3A.681
C(JA+J)=A0+A1 FOURIE3A.682
C(JC+J)=A0-A1 FOURIE3A.683
D(JA+J)=B0+B1 FOURIE3A.684
D(JC+J)=B1-B0 FOURIE3A.685
C(JB+J)=A2+B3 FOURIE3A.686
C(JD+J)=A2-B3 FOURIE3A.687
D(JB+J)=B2-A3 FOURIE3A.688
D(JD+J)=-(B2+A3) FOURIE3A.689
I=I+INC3 FOURIE3A.690
J=J+INC4 FOURIE3A.691
430 CONTINUE FOURIE3A.692
IBASE=IBASE+INC1 FOURIE3A.693
JBASE=JBASE+INC2 FOURIE3A.694
440 CONTINUE FOURIE3A.695
IBASE=IBASE+IJUMP FOURIE3A.696
JA=JA+JINK FOURIE3A.697
JB=JB+JINK FOURIE3A.698
JC=JC-JINK FOURIE3A.699
JD=JD-JINK FOURIE3A.700
450 CONTINUE FOURIE3A.701
IF (JB.GT.JC) GO TO 900 FOURIE3A.702
460 CONTINUE FOURIE3A.703
SIN45=SQRT(0.5) FOURIE3A.704
JBASE=0 FOURIE3A.705
DO 480 L=1,LA FOURIE3A.706
I=IBASE FOURIE3A.707
J=JBASE FOURIE3A.708
CDIR$ IVDEP FOURIE3A.709
! Fujitsu vectorization directive GRB0F405.251
!OCL NOVREC GRB0F405.252
DO 470 IJK=1,LOT FOURIE3A.710
C(JA+J)=A(IA+I)+SIN45*(A(IB+I)-A(ID+I)) FOURIE3A.711
C(JB+J)=A(IA+I)-SIN45*(A(IB+I)-A(ID+I)) FOURIE3A.712
D(JA+J)=-A(IC+I)-SIN45*(A(IB+I)+A(ID+I)) FOURIE3A.713
D(JB+J)=A(IC+I)-SIN45*(A(IB+I)+A(ID+I)) FOURIE3A.714
I=I+INC3 FOURIE3A.715
J=J+INC4 FOURIE3A.716
470 CONTINUE FOURIE3A.717
IBASE=IBASE+INC1 FOURIE3A.718
JBASE=JBASE+INC2 FOURIE3A.719
480 CONTINUE FOURIE3A.720
GO TO 900 FOURIE3A.721
C FOURIE3A.722
490 CONTINUE FOURIE3A.723
Z=1.0/FLOAT(N) FOURIE3A.724
DO 494 L=1,LA FOURIE3A.725
I=IBASE FOURIE3A.726
J=JBASE FOURIE3A.727
CDIR$ IVDEP FOURIE3A.728
! Fujitsu vectorization directive GRB0F405.253
!OCL NOVREC GRB0F405.254
DO 492 IJK=1,LOT FOURIE3A.729
C(JA+J)=Z*((A(IA+I)+A(IC+I))+(A(IB+I)+A(ID+I))) FOURIE3A.730
C(JC+J)=Z*((A(IA+I)+A(IC+I))-(A(IB+I)+A(ID+I))) FOURIE3A.731
C(JB+J)=Z*(A(IA+I)-A(IC+I)) FOURIE3A.732
D(JB+J)=Z*(A(ID+I)-A(IB+I)) FOURIE3A.733
I=I+INC3 FOURIE3A.734
J=J+INC4 FOURIE3A.735
492 CONTINUE FOURIE3A.736
IBASE=IBASE+INC1 FOURIE3A.737
JBASE=JBASE+INC2 FOURIE3A.738
494 CONTINUE FOURIE3A.739
GO TO 900 FOURIE3A.740
FOURIE3A.741
C- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - FOURIE3A.742
C Coding for factor 5 FOURIE3A.743
500 CONTINUE FOURIE3A.744
IA=1 FOURIE3A.745
IB=IA+IINK FOURIE3A.746
IC=IB+IINK FOURIE3A.747
ID=IC+IINK FOURIE3A.748
IE=ID+IINK FOURIE3A.749
JA=1 FOURIE3A.750
JB=JA+(2*M-LA)*INC2 FOURIE3A.751
JC=JB+2*M*INC2 FOURIE3A.752
JD=JC FOURIE3A.753
JE=JB FOURIE3A.754
FOURIE3A.755
IF (LA.EQ.M) GO TO 590 FOURIE3A.756
FOURIE3A.757
DO 520 L=1,LA FOURIE3A.758
I=IBASE FOURIE3A.759
J=JBASE FOURIE3A.760
CDIR$ IVDEP FOURIE3A.761
! Fujitsu vectorization directive GRB0F405.255
!OCL NOVREC GRB0F405.256
DO 510 IJK=1,LOT FOURIE3A.762
A1=A(IB+I)+A(IE+I) FOURIE3A.763
A3=A(IB+I)-A(IE+I) FOURIE3A.764
A2=A(IC+I)+A(ID+I) FOURIE3A.765
A4=A(IC+I)-A(ID+I) FOURIE3A.766
A5=A(IA+I)-0.25*(A1+A2) FOURIE3A.767
A6=QRT5*(A1-A2) FOURIE3A.768
C(JA+J)=A(IA+I)+(A1+A2) FOURIE3A.769
C(JB+J)=A5+A6 FOURIE3A.770
C(JC+J)=A5-A6 FOURIE3A.771
D(JB+J)=-SIN72*A3-SIN36*A4 FOURIE3A.772
D(JC+J)=-SIN36*A3+SIN72*A4 FOURIE3A.773
I=I+INC3 FOURIE3A.774
J=J+INC4 FOURIE3A.775
510 CONTINUE FOURIE3A.776
IBASE=IBASE+INC1 FOURIE3A.777
JBASE=JBASE+INC2 FOURIE3A.778
520 CONTINUE FOURIE3A.779
JA=JA+JINK FOURIE3A.780
JINK=2*JINK FOURIE3A.781
JB=JB+JINK FOURIE3A.782
JC=JC+JINK FOURIE3A.783
JD=JD-JINK FOURIE3A.784
JE=JE-JINK FOURIE3A.785
IBASE=IBASE+IJUMP FOURIE3A.786
IJUMP=2*IJUMP+IINK FOURIE3A.787
IF (JB.EQ.JD) GO TO 560 FOURIE3A.788
DO 550 K=LA,KSTOP,LA FOURIE3A.789
KB=K+K FOURIE3A.790
KC=KB+KB FOURIE3A.791
KD=KC+KB FOURIE3A.792
KE=KD+KB FOURIE3A.793
C1=TRIGS(KB+1) FOURIE3A.794
S1=TRIGS(KB+2) FOURIE3A.795
C2=TRIGS(KC+1) FOURIE3A.796
S2=TRIGS(KC+2) FOURIE3A.797
C3=TRIGS(KD+1) FOURIE3A.798
S3=TRIGS(KD+2) FOURIE3A.799
C4=TRIGS(KE+1) FOURIE3A.800
S4=TRIGS(KE+2) FOURIE3A.801
JBASE=0 FOURIE3A.802
DO 540 L=1,LA FOURIE3A.803
I=IBASE FOURIE3A.804
J=JBASE FOURIE3A.805
CDIR$ IVDEP FOURIE3A.806
! Fujitsu vectorization directive GRB0F405.257
!OCL NOVREC GRB0F405.258
DO 530 IJK=1,LOT FOURIE3A.807
A1=(C1*A(IB+I)+S1*B(IB+I))+(C4*A(IE+I)+S4*B(IE+I)) FOURIE3A.808
A3=(C1*A(IB+I)+S1*B(IB+I))-(C4*A(IE+I)+S4*B(IE+I)) FOURIE3A.809
A2=(C2*A(IC+I)+S2*B(IC+I))+(C3*A(ID+I)+S3*B(ID+I)) FOURIE3A.810
A4=(C2*A(IC+I)+S2*B(IC+I))-(C3*A(ID+I)+S3*B(ID+I)) FOURIE3A.811
B1=(C1*B(IB+I)-S1*A(IB+I))+(C4*B(IE+I)-S4*A(IE+I)) FOURIE3A.812
B3=(C1*B(IB+I)-S1*A(IB+I))-(C4*B(IE+I)-S4*A(IE+I)) FOURIE3A.813
B2=(C2*B(IC+I)-S2*A(IC+I))+(C3*B(ID+I)-S3*A(ID+I)) FOURIE3A.814
B4=(C2*B(IC+I)-S2*A(IC+I))-(C3*B(ID+I)-S3*A(ID+I)) FOURIE3A.815
A5=A(IA+I)-0.25*(A1+A2) FOURIE3A.816
A6=QRT5*(A1-A2) FOURIE3A.817
B5=B(IA+I)-0.25*(B1+B2) FOURIE3A.818
B6=QRT5*(B1-B2) FOURIE3A.819
A10=A5+A6 FOURIE3A.820
A20=A5-A6 FOURIE3A.821
B10=B5+B6 FOURIE3A.822
B20=B5-B6 FOURIE3A.823
A11=SIN72*B3+SIN36*B4 FOURIE3A.824
A21=SIN36*B3-SIN72*B4 FOURIE3A.825
B11=SIN72*A3+SIN36*A4 FOURIE3A.826
B21=SIN36*A3-SIN72*A4 FOURIE3A.827
C(JA+J)=A(IA+I)+(A1+A2) FOURIE3A.828
C(JB+J)=A10+A11 FOURIE3A.829
C(JE+J)=A10-A11 FOURIE3A.830
C(JC+J)=A20+A21 FOURIE3A.831
C(JD+J)=A20-A21 FOURIE3A.832
D(JA+J)=B(IA+I)+(B1+B2) FOURIE3A.833
D(JB+J)=B10-B11 FOURIE3A.834
D(JE+J)=-(B10+B11) FOURIE3A.835
D(JC+J)=B20-B21 FOURIE3A.836
D(JD+J)=-(B20+B21) FOURIE3A.837
I=I+INC3 FOURIE3A.838
J=J+INC4 FOURIE3A.839
530 CONTINUE FOURIE3A.840
IBASE=IBASE+INC1 FOURIE3A.841
JBASE=JBASE+INC2 FOURIE3A.842
540 CONTINUE FOURIE3A.843
IBASE=IBASE+IJUMP FOURIE3A.844
JA=JA+JINK FOURIE3A.845
JB=JB+JINK FOURIE3A.846
JC=JC+JINK FOURIE3A.847
JD=JD-JINK FOURIE3A.848
JE=JE-JINK FOURIE3A.849
550 CONTINUE FOURIE3A.850
IF (JB.GT.JD) GO TO 900 FOURIE3A.851
560 CONTINUE FOURIE3A.852
JBASE=0 FOURIE3A.853
DO 580 L=1,LA FOURIE3A.854
I=IBASE FOURIE3A.855
J=JBASE FOURIE3A.856
CDIR$ IVDEP FOURIE3A.857
! Fujitsu vectorization directive GRB0F405.259
!OCL NOVREC GRB0F405.260
DO 570 IJK=1,LOT FOURIE3A.858
A1=A(IB+I)+A(IE+I) FOURIE3A.859
A3=A(IB+I)-A(IE+I) FOURIE3A.860
A2=A(IC+I)+A(ID+I) FOURIE3A.861
A4=A(IC+I)-A(ID+I) FOURIE3A.862
A5=A(IA+I)+0.25*(A3-A4) FOURIE3A.863
A6=QRT5*(A3+A4) FOURIE3A.864
C(JA+J)=A5+A6 FOURIE3A.865
C(JB+J)=A5-A6 FOURIE3A.866
C(JC+J)=A(IA+I)-(A3-A4) FOURIE3A.867
D(JA+J)=-SIN36*A1-SIN72*A2 FOURIE3A.868
D(JB+J)=-SIN72*A1+SIN36*A2 FOURIE3A.869
I=I+INC3 FOURIE3A.870
J=J+INC4 FOURIE3A.871
570 CONTINUE FOURIE3A.872
IBASE=IBASE+INC1 FOURIE3A.873
JBASE=JBASE+INC2 FOURIE3A.874
580 CONTINUE FOURIE3A.875
GO TO 900 FOURIE3A.876
C FOURIE3A.877
590 CONTINUE FOURIE3A.878
Z=1.0/FLOAT(N) FOURIE3A.879
ZQRT5=Z*QRT5 FOURIE3A.880
ZSIN36=Z*SIN36 FOURIE3A.881
ZSIN72=Z*SIN72 FOURIE3A.882
DO 594 L=1,LA FOURIE3A.883
I=IBASE FOURIE3A.884
J=JBASE FOURIE3A.885
CDIR$ IVDEP FOURIE3A.886
! Fujitsu vectorization directive GRB0F405.261
!OCL NOVREC GRB0F405.262
DO 592 IJK=1,LOT FOURIE3A.887
A1=A(IB+I)+A(IE+I) FOURIE3A.888
A3=A(IB+I)-A(IE+I) FOURIE3A.889
A2=A(IC+I)+A(ID+I) FOURIE3A.890
A4=A(IC+I)-A(ID+I) FOURIE3A.891
A5=Z*(A(IA+I)-0.25*(A1+A2)) FOURIE3A.892
A6=ZQRT5*(A1-A2) FOURIE3A.893
C(JA+J)=Z*(A(IA+I)+(A1+A2)) FOURIE3A.894
C(JB+J)=A5+A6 FOURIE3A.895
C(JC+J)=A5-A6 FOURIE3A.896
D(JB+J)=-ZSIN72*A3-ZSIN36*A4 FOURIE3A.897
D(JC+J)=-ZSIN36*A3+ZSIN72*A4 FOURIE3A.898
I=I+INC3 FOURIE3A.899
J=J+INC4 FOURIE3A.900
592 CONTINUE FOURIE3A.901
IBASE=IBASE+INC1 FOURIE3A.902
JBASE=JBASE+INC2 FOURIE3A.903
594 CONTINUE FOURIE3A.904
GO TO 900 FOURIE3A.905
FOURIE3A.906
C- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - FOURIE3A.907
C Coding for factor 6 FOURIE3A.908
600 CONTINUE FOURIE3A.909
IA=1 FOURIE3A.910
IB=IA+IINK FOURIE3A.911
IC=IB+IINK FOURIE3A.912
ID=IC+IINK FOURIE3A.913
IE=ID+IINK FOURIE3A.914
IF=IE+IINK FOURIE3A.915
JA=1 FOURIE3A.916
JB=JA+(2*M-LA)*INC2 FOURIE3A.917
JC=JB+2*M*INC2 FOURIE3A.918
JD=JC+2*M*INC2 FOURIE3A.919
JE=JC FOURIE3A.920
JF=JB FOURIE3A.921
C FOURIE3A.922
IF (LA.EQ.M) GO TO 690 FOURIE3A.923
C FOURIE3A.924
DO 620 L=1,LA FOURIE3A.925
I=IBASE FOURIE3A.926
J=JBASE FOURIE3A.927
CDIR$ IVDEP FOURIE3A.928
! Fujitsu vectorization directive GRB0F405.263
!OCL NOVREC GRB0F405.264
DO 610 IJK=1,LOT FOURIE3A.929
A11=(A(IC+I)+A(IF+I))+(A(IB+I)+A(IE+I)) FOURIE3A.930
C(JA+J)=(A(IA+I)+A(ID+I))+A11 FOURIE3A.931
C(JC+J)=(A(IA+I)+A(ID+I)-0.5*A11) FOURIE3A.932
D(JC+J)=SIN60*((A(IC+I)+A(IF+I))-(A(IB+I)+A(IE+I))) FOURIE3A.933
A11=(A(IC+I)-A(IF+I))+(A(IE+I)-A(IB+I)) FOURIE3A.934
C(JB+J)=(A(IA+I)-A(ID+I))-0.5*A11 FOURIE3A.935
D(JB+J)=SIN60*((A(IE+I)-A(IB+I))-(A(IC+I)-A(IF+I))) FOURIE3A.936
C(JD+J)=(A(IA+I)-A(ID+I))+A11 FOURIE3A.937
I=I+INC3 FOURIE3A.938
J=J+INC4 FOURIE3A.939
610 CONTINUE FOURIE3A.940
IBASE=IBASE+INC1 FOURIE3A.941
JBASE=JBASE+INC2 FOURIE3A.942
620 CONTINUE FOURIE3A.943
JA=JA+JINK FOURIE3A.944
JINK=2*JINK FOURIE3A.945
JB=JB+JINK FOURIE3A.946
JC=JC+JINK FOURIE3A.947
JD=JD-JINK FOURIE3A.948
JE=JE-JINK FOURIE3A.949
JF=JF-JINK FOURIE3A.950
IBASE=IBASE+IJUMP FOURIE3A.951
IJUMP=2*IJUMP+IINK FOURIE3A.952
IF (JC.EQ.JD) GO TO 660 FOURIE3A.953
DO 650 K=LA,KSTOP,LA FOURIE3A.954
KB=K+K FOURIE3A.955
KC=KB+KB FOURIE3A.956
KD=KC+KB FOURIE3A.957
KE=KD+KB FOURIE3A.958
KF=KE+KB FOURIE3A.959
C1=TRIGS(KB+1) FOURIE3A.960
S1=TRIGS(KB+2) FOURIE3A.961
C2=TRIGS(KC+1) FOURIE3A.962
S2=TRIGS(KC+2) FOURIE3A.963
C3=TRIGS(KD+1) FOURIE3A.964
S3=TRIGS(KD+2) FOURIE3A.965
C4=TRIGS(KE+1) FOURIE3A.966
S4=TRIGS(KE+2) FOURIE3A.967
C5=TRIGS(KF+1) FOURIE3A.968
S5=TRIGS(KF+2) FOURIE3A.969
JBASE=0 FOURIE3A.970
DO 640 L=1,LA FOURIE3A.971
I=IBASE FOURIE3A.972
J=JBASE FOURIE3A.973
CDIR$ IVDEP FOURIE3A.974
! Fujitsu vectorization directive GRB0F405.265
!OCL NOVREC GRB0F405.266
DO 630 IJK=1,LOT FOURIE3A.975
A1=C1*A(IB+I)+S1*B(IB+I) FOURIE3A.976
B1=C1*B(IB+I)-S1*A(IB+I) FOURIE3A.977
A2=C2*A(IC+I)+S2*B(IC+I) FOURIE3A.978
B2=C2*B(IC+I)-S2*A(IC+I) FOURIE3A.979
A3=C3*A(ID+I)+S3*B(ID+I) FOURIE3A.980
B3=C3*B(ID+I)-S3*A(ID+I) FOURIE3A.981
A4=C4*A(IE+I)+S4*B(IE+I) FOURIE3A.982
B4=C4*B(IE+I)-S4*A(IE+I) FOURIE3A.983
A5=C5*A(IF+I)+S5*B(IF+I) FOURIE3A.984
B5=C5*B(IF+I)-S5*A(IF+I) FOURIE3A.985
A11=(A2+A5)+(A1+A4) FOURIE3A.986
A20=(A(IA+I)+A3)-0.5*A11 FOURIE3A.987
A21=SIN60*((A2+A5)-(A1+A4)) FOURIE3A.988
B11=(B2+B5)+(B1+B4) FOURIE3A.989
B20=(B(IA+I)+B3)-0.5*B11 FOURIE3A.990
B21=SIN60*((B2+B5)-(B1+B4)) FOURIE3A.991
C(JA+J)=(A(IA+I)+A3)+A11 FOURIE3A.992
D(JA+J)=(B(IA+I)+B3)+B11 FOURIE3A.993
C(JC+J)=A20-B21 FOURIE3A.994
D(JC+J)=A21+B20 FOURIE3A.995
C(JE+J)=A20+B21 FOURIE3A.996
D(JE+J)=A21-B20 FOURIE3A.997
A11=(A2-A5)+(A4-A1) FOURIE3A.998
A20=(A(IA+I)-A3)-0.5*A11 FOURIE3A.999
A21=SIN60*((A4-A1)-(A2-A5)) FOURIE3A.1000
B11=(B5-B2)-(B4-B1) FOURIE3A.1001
B20=(B3-B(IA+I))-0.5*B11 FOURIE3A.1002
B21=SIN60*((B5-B2)+(B4-B1)) FOURIE3A.1003
C(JB+J)=A20-B21 FOURIE3A.1004
D(JB+J)=A21-B20 FOURIE3A.1005
C(JD+J)=A11+(A(IA+I)-A3) FOURIE3A.1006
D(JD+J)=B11+(B3-B(IA+I)) FOURIE3A.1007
C(JF+J)=A20+B21 FOURIE3A.1008
D(JF+J)=A21+B20 FOURIE3A.1009
I=I+INC3 FOURIE3A.1010
J=J+INC4 FOURIE3A.1011
630 CONTINUE FOURIE3A.1012
IBASE=IBASE+INC1 FOURIE3A.1013
JBASE=JBASE+INC2 FOURIE3A.1014
640 CONTINUE FOURIE3A.1015
IBASE=IBASE+IJUMP FOURIE3A.1016
JA=JA+JINK FOURIE3A.1017
JB=JB+JINK FOURIE3A.1018
JC=JC+JINK FOURIE3A.1019
JD=JD-JINK FOURIE3A.1020
JE=JE-JINK FOURIE3A.1021
JF=JF-JINK FOURIE3A.1022
650 CONTINUE FOURIE3A.1023
IF (JC.GT.JD) GO TO 900 FOURIE3A.1024
660 CONTINUE FOURIE3A.1025
JBASE=0 FOURIE3A.1026
DO 680 L=1,LA FOURIE3A.1027
I=IBASE FOURIE3A.1028
J=JBASE FOURIE3A.1029
CDIR$ IVDEP FOURIE3A.1030
! Fujitsu vectorization directive GRB0F405.267
!OCL NOVREC GRB0F405.268
DO 670 IJK=1,LOT FOURIE3A.1031
C(JA+J)=(A(IA+I)+0.5*(A(IC+I)-A(IE+I))) + FOURIE3A.1032
$ SIN60*(A(IB+I)-A(IF+I)) FOURIE3A.1033
D(JA+J)=-(A(ID+I)+0.5*(A(IB+I)+A(IF+I))) - FOURIE3A.1034
$ SIN60*(A(IC+I)+A(IE+I)) FOURIE3A.1035
C(JB+J)=A(IA+I)-(A(IC+I)-A(IE+I)) FOURIE3A.1036
D(JB+J)=A(ID+I)-(A(IB+I)+A(IF+I)) FOURIE3A.1037
C(JC+J)=(A(IA+I)+0.5*(A(IC+I)-A(IE+I))) - FOURIE3A.1038
$ SIN60*(A(IB+I)-A(IF+I)) FOURIE3A.1039
D(JC+J)=-(A(ID+I)+0.5*(A(IB+I)+A(IF+I))) + FOURIE3A.1040
$ SIN60*(A(IC+I)+A(IE+I)) FOURIE3A.1041
I=I+INC3 FOURIE3A.1042
J=J+INC4 FOURIE3A.1043
670 CONTINUE FOURIE3A.1044
IBASE=IBASE+INC1 FOURIE3A.1045
JBASE=JBASE+INC2 FOURIE3A.1046
680 CONTINUE FOURIE3A.1047
GO TO 900 FOURIE3A.1048
C FOURIE3A.1049
690 CONTINUE FOURIE3A.1050
Z=1.0/FLOAT(N) FOURIE3A.1051
ZSIN60=Z*SIN60 FOURIE3A.1052
DO 694 L=1,LA FOURIE3A.1053
I=IBASE FOURIE3A.1054
J=JBASE FOURIE3A.1055
CDIR$ IVDEP FOURIE3A.1056
! Fujitsu vectorization directive GRB0F405.269
!OCL NOVREC GRB0F405.270
DO 692 IJK=1,LOT FOURIE3A.1057
A11=(A(IC+I)+A(IF+I))+(A(IB+I)+A(IE+I)) FOURIE3A.1058
C(JA+J)=Z*((A(IA+I)+A(ID+I))+A11) FOURIE3A.1059
C(JC+J)=Z*((A(IA+I)+A(ID+I))-0.5*A11) FOURIE3A.1060
D(JC+J)=ZSIN60*((A(IC+I)+A(IF+I))-(A(IB+I)+A(IE+I))) FOURIE3A.1061
A11=(A(IC+I)-A(IF+I))+(A(IE+I)-A(IB+I)) FOURIE3A.1062
C(JB+J)=Z*((A(IA+I)-A(ID+I))-0.5*A11) FOURIE3A.1063
D(JB+J)=ZSIN60*((A(IE+I)-A(IB+I))-(A(IC+I)-A(IF+I))) FOURIE3A.1064
C(JD+J)=Z*((A(IA+I)-A(ID+I))+A11) FOURIE3A.1065
I=I+INC3 FOURIE3A.1066
J=J+INC4 FOURIE3A.1067
692 CONTINUE FOURIE3A.1068
IBASE=IBASE+INC1 FOURIE3A.1069
JBASE=JBASE+INC2 FOURIE3A.1070
694 CONTINUE FOURIE3A.1071
GO TO 900 FOURIE3A.1072
FOURIE3A.1073
C- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - FOURIE3A.1074
C Coding for factor 8: FOURIE3A.1075
800 CONTINUE FOURIE3A.1076
IBAD=3 FOURIE3A.1077
IF (LA.NE.M) GO TO 910 FOURIE3A.1078
IA=1 FOURIE3A.1079
IB=IA+IINK FOURIE3A.1080
IC=IB+IINK FOURIE3A.1081
ID=IC+IINK FOURIE3A.1082
IE=ID+IINK FOURIE3A.1083
IF=IE+IINK FOURIE3A.1084
IG=IF+IINK FOURIE3A.1085
IH=IG+IINK FOURIE3A.1086
JA=1 FOURIE3A.1087
JB=JA+LA*INC2 FOURIE3A.1088
JC=JB+2*M*INC2 FOURIE3A.1089
JD=JC+2*M*INC2 FOURIE3A.1090
JE=JD+2*M*INC2 FOURIE3A.1091
Z=1.0/FLOAT(N) FOURIE3A.1092
ZSIN45=Z*SQRT(0.5) FOURIE3A.1093
FOURIE3A.1094
DO 820 L=1,LA FOURIE3A.1095
I=IBASE FOURIE3A.1096
J=JBASE FOURIE3A.1097
CDIR$ IVDEP FOURIE3A.1098
! Fujitsu vectorization directive GRB0F405.271
!OCL NOVREC GRB0F405.272
DO 810 IJK=1,LOT FOURIE3A.1099
C(JA+J)=Z*(((A(IA+I)+A(IE+I))+(A(IC+I)+A(IG+I)))+ FOURIE3A.1100
* ((A(ID+I)+A(IH+I))+(A(IB+I)+A(IF+I)))) FOURIE3A.1101
C(JE+J)=Z*(((A(IA+I)+A(IE+I))+(A(IC+I)+A(IG+I)))- FOURIE3A.1102
* ((A(ID+I)+A(IH+I))+(A(IB+I)+A(IF+I)))) FOURIE3A.1103
C(JC+J)=Z*((A(IA+I)+A(IE+I))-(A(IC+I)+A(IG+I))) FOURIE3A.1104
D(JC+J)=Z*((A(ID+I)+A(IH+I))-(A(IB+I)+A(IF+I))) FOURIE3A.1105
C(JB+J)=Z*(A(IA+I)-A(IE+I)) FOURIE3A.1106
* +ZSIN45*((A(IH+I)-A(ID+I))-(A(IF+I)-A(IB+I))) FOURIE3A.1107
C(JD+J)=Z*(A(IA+I)-A(IE+I)) FOURIE3A.1108
* -ZSIN45*((A(IH+I)-A(ID+I))-(A(IF+I)-A(IB+I))) FOURIE3A.1109
D(JB+J)=ZSIN45*((A(IH+I)-A(ID+I))+(A(IF+I)-A(IB+I))) FOURIE3A.1110
* +Z*(A(IG+I)-A(IC+I)) FOURIE3A.1111
D(JD+J)=ZSIN45*((A(IH+I)-A(ID+I))+(A(IF+I)-A(IB+I))) FOURIE3A.1112
* -Z*(A(IG+I)-A(IC+I)) FOURIE3A.1113
I=I+INC3 FOURIE3A.1114
J=J+INC4 FOURIE3A.1115
810 CONTINUE FOURIE3A.1116
IBASE=IBASE+INC1 FOURIE3A.1117
JBASE=JBASE+INC2 FOURIE3A.1118
820 CONTINUE FOURIE3A.1119
FOURIE3A.1120
900 CONTINUE FOURIE3A.1121
IBAD=0 FOURIE3A.1122
910 CONTINUE FOURIE3A.1123
IERR=IBAD FOURIE3A.1124
FOURIE3A.1125
C----------------------------------------------------------------------- FOURIE3A.1126
ELSE ! Do Fourier Synthesis: FOURIE3A.1127
FOURIE3A.1128
M=N/IFAC FOURIE3A.1129
IINK=LA*INC1 FOURIE3A.1130
JINK=LA*INC2 FOURIE3A.1131
JUMP=(IFAC-1)*JINK FOURIE3A.1132
KSTOP=(N-IFAC)/(2*IFAC) FOURIE3A.1133
FOURIE3A.1134
IBAD=1 FOURIE3A.1135
*IF -DEF,FUJITSU GRB1F405.133
IF (LOT.GT.64) GO TO 1910 FOURIE3A.1136
*ELSE GRB1F405.134
IF (LOT.GT.512) GO TO 1910 GRB1F405.135
*ENDIF GRB1F405.136
IBASE=0 FOURIE3A.1137
JBASE=0 FOURIE3A.1138
IGO=IFAC-1 FOURIE3A.1139
IF (IGO.EQ.7) IGO=6 FOURIE3A.1140
IBAD=2 FOURIE3A.1141
IF (IGO.LT.1.OR.IGO.GT.6) GO TO 1910 FOURIE3A.1142
GO TO (1200,1300,1400,1500,1600,1800),IGO FOURIE3A.1143
FOURIE3A.1144
C Coding for factor 2: FOURIE3A.1145
FOURIE3A.1146
1200 CONTINUE FOURIE3A.1147
IA=1 FOURIE3A.1148
IB=IA+(2*M-LA)*INC1 FOURIE3A.1149
JA=1 FOURIE3A.1150
JB=JA+JINK FOURIE3A.1151
FOURIE3A.1152
IF (LA.EQ.M) GO TO 1290 FOURIE3A.1153
FOURIE3A.1154
DO L=1,LA FOURIE3A.1155
I=IBASE FOURIE3A.1156
J=JBASE FOURIE3A.1157
CDIR$ IVDEP FOURIE3A.1158
! Fujitsu vectorization directive GRB0F405.273
!OCL NOVREC GRB0F405.274
DO IJK=1,LOT FOURIE3A.1159
C(JA+J)=A(IA+I)+A(IB+I) FOURIE3A.1160
C(JB+J)=A(IA+I)-A(IB+I) FOURIE3A.1161
I=I+INC3 FOURIE3A.1162
J=J+INC4 FOURIE3A.1163
ENDDO FOURIE3A.1164
IBASE=IBASE+INC1 FOURIE3A.1165
JBASE=JBASE+INC2 FOURIE3A.1166
ENDDO FOURIE3A.1167
IA=IA+IINK FOURIE3A.1168
IINK=2*IINK FOURIE3A.1169
IB=IB-IINK FOURIE3A.1170
IBASE=0 FOURIE3A.1171
JBASE=JBASE+JUMP FOURIE3A.1172
JUMP=2*JUMP+JINK FOURIE3A.1173
IF (IA.EQ.IB) GO TO 1260 FOURIE3A.1174
DO K=LA,KSTOP,LA FOURIE3A.1175
KB=K+K FOURIE3A.1176
C1=TRIGS(KB+1) FOURIE3A.1177
S1=TRIGS(KB+2) FOURIE3A.1178
IBASE=0 FOURIE3A.1179
DO L=1,LA FOURIE3A.1180
I=IBASE FOURIE3A.1181
J=JBASE FOURIE3A.1182
CDIR$ IVDEP FOURIE3A.1183
! Fujitsu vectorization directive GRB0F405.275
!OCL NOVREC GRB0F405.276
DO IJK=1,LOT FOURIE3A.1184
C(JA+J)=A(IA+I)+A(IB+I) FOURIE3A.1185
D(JA+J)=B(IA+I)-B(IB+I) FOURIE3A.1186
C(JB+J)=C1*(A(IA+I)-A(IB+I))-S1*(B(IA+I)+B(IB+I)) FOURIE3A.1187
D(JB+J)=S1*(A(IA+I)-A(IB+I))+C1*(B(IA+I)+B(IB+I)) FOURIE3A.1188
I=I+INC3 FOURIE3A.1189
J=J+INC4 FOURIE3A.1190
ENDDO FOURIE3A.1191
IBASE=IBASE+INC1 FOURIE3A.1192
JBASE=JBASE+INC2 FOURIE3A.1193
ENDDO FOURIE3A.1194
IA=IA+IINK FOURIE3A.1195
IB=IB-IINK FOURIE3A.1196
JBASE=JBASE+JUMP FOURIE3A.1197
ENDDO FOURIE3A.1198
IF (IA.GT.IB) GO TO 1900 FOURIE3A.1199
1260 CONTINUE FOURIE3A.1200
IBASE=0 FOURIE3A.1201
DO L=1,LA FOURIE3A.1202
I=IBASE FOURIE3A.1203
J=JBASE FOURIE3A.1204
CDIR$ IVDEP FOURIE3A.1205
! Fujitsu vectorization directive GRB0F405.277
!OCL NOVREC GRB0F405.278
DO IJK=1,LOT FOURIE3A.1206
C(JA+J)=A(IA+I) FOURIE3A.1207
C(JB+J)=-B(IA+I) FOURIE3A.1208
I=I+INC3 FOURIE3A.1209
J=J+INC4 FOURIE3A.1210
ENDDO FOURIE3A.1211
IBASE=IBASE+INC1 FOURIE3A.1212
JBASE=JBASE+INC2 FOURIE3A.1213
ENDDO FOURIE3A.1214
GO TO 1900 FOURIE3A.1215
FOURIE3A.1216
1290 CONTINUE FOURIE3A.1217
DO L=1,LA FOURIE3A.1218
I=IBASE FOURIE3A.1219
J=JBASE FOURIE3A.1220
CDIR$ IVDEP FOURIE3A.1221
! Fujitsu vectorization directive GRB0F405.279
!OCL NOVREC GRB0F405.280
DO IJK=1,LOT FOURIE3A.1222
C(JA+J)=2.0*(A(IA+I)+A(IB+I)) FOURIE3A.1223
C(JB+J)=2.0*(A(IA+I)-A(IB+I)) FOURIE3A.1224
I=I+INC3 FOURIE3A.1225
J=J+INC4 FOURIE3A.1226
ENDDO FOURIE3A.1227
IBASE=IBASE+INC1 FOURIE3A.1228
JBASE=JBASE+INC2 FOURIE3A.1229
ENDDO FOURIE3A.1230
GO TO 1900 FOURIE3A.1231
FOURIE3A.1232
C Coding for factor 3: FOURIE3A.1233
1300 CONTINUE FOURIE3A.1234
IA=1 FOURIE3A.1235
IB=IA+(2*M-LA)*INC1 FOURIE3A.1236
IC=IB FOURIE3A.1237
JA=1 FOURIE3A.1238
JB=JA+JINK FOURIE3A.1239
JC=JB+JINK FOURIE3A.1240
FOURIE3A.1241
IF (LA.EQ.M) GO TO 1390 FOURIE3A.1242
FOURIE3A.1243
DO L=1,LA FOURIE3A.1244
I=IBASE FOURIE3A.1245
J=JBASE FOURIE3A.1246
CDIR$ IVDEP FOURIE3A.1247
! Fujitsu vectorization directive GRB0F405.281
!OCL NOVREC GRB0F405.282
DO IJK=1,LOT FOURIE3A.1248
C(JA+J)=A(IA+I)+A(IB+I) FOURIE3A.1249
C(JB+J)=(A(IA+I)-0.5*A(IB+I))-(SIN60*(B(IB+I))) FOURIE3A.1250
C(JC+J)=(A(IA+I)-0.5*A(IB+I))+(SIN60*(B(IB+I))) FOURIE3A.1251
I=I+INC3 FOURIE3A.1252
J=J+INC4 FOURIE3A.1253
ENDDO FOURIE3A.1254
IBASE=IBASE+INC1 FOURIE3A.1255
JBASE=JBASE+INC2 FOURIE3A.1256
ENDDO FOURIE3A.1257
IA=IA+IINK FOURIE3A.1258
IINK=2*IINK FOURIE3A.1259
IB=IB+IINK FOURIE3A.1260
IC=IC-IINK FOURIE3A.1261
JBASE=JBASE+JUMP FOURIE3A.1262
JUMP=2*JUMP+JINK FOURIE3A.1263
IF (IA.EQ.IC) GO TO 1360 FOURIE3A.1264
DO K=LA,KSTOP,LA FOURIE3A.1265
KB=K+K FOURIE3A.1266
KC=KB+KB FOURIE3A.1267
C1=TRIGS(KB+1) FOURIE3A.1268
S1=TRIGS(KB+2) FOURIE3A.1269
C2=TRIGS(KC+1) FOURIE3A.1270
S2=TRIGS(KC+2) FOURIE3A.1271
IBASE=0 FOURIE3A.1272
DO L=1,LA FOURIE3A.1273
I=IBASE FOURIE3A.1274
J=JBASE FOURIE3A.1275
CDIR$ IVDEP FOURIE3A.1276
! Fujitsu vectorization directive GRB0F405.283
!OCL NOVREC GRB0F405.284
DO IJK=1,LOT FOURIE3A.1277
C(JA+J)=A(IA+I)+(A(IB+I)+A(IC+I)) FOURIE3A.1278
D(JA+J)=B(IA+I)+(B(IB+I)-B(IC+I)) FOURIE3A.1279
C(JB+J)= FOURIE3A.1280
& C1*((A(IA+I)-0.5*(A(IB+I)+A(IC+I)))- FOURIE3A.1281
& (SIN60*(B(IB+I)+B(IC+I)))) FOURIE3A.1282
& -S1*((B(IA+I)-0.5*(B(IB+I)-B(IC+I)))+ FOURIE3A.1283
& (SIN60*(A(IB+I)-A(IC+I)))) FOURIE3A.1284
D(JB+J)= FOURIE3A.1285
& S1*((A(IA+I)-0.5*(A(IB+I)+A(IC+I)))- FOURIE3A.1286
& (SIN60*(B(IB+I)+B(IC+I)))) FOURIE3A.1287
& +C1*((B(IA+I)-0.5*(B(IB+I)-B(IC+I)))+ FOURIE3A.1288
& (SIN60*(A(IB+I)-A(IC+I)))) FOURIE3A.1289
C(JC+J)= FOURIE3A.1290
& C2*((A(IA+I)-0.5*(A(IB+I)+A(IC+I)))+ FOURIE3A.1291
& (SIN60*(B(IB+I)+B(IC+I)))) FOURIE3A.1292
& -S2*((B(IA+I)-0.5*(B(IB+I)-B(IC+I)))- FOURIE3A.1293
& (SIN60*(A(IB+I)-A(IC+I)))) FOURIE3A.1294
D(JC+J)= FOURIE3A.1295
& S2*((A(IA+I)-0.5*(A(IB+I)+A(IC+I)))+ FOURIE3A.1296
& (SIN60*(B(IB+I)+B(IC+I)))) FOURIE3A.1297
& +C2*((B(IA+I)-0.5*(B(IB+I)-B(IC+I)))- FOURIE3A.1298
& (SIN60*(A(IB+I)-A(IC+I)))) FOURIE3A.1299
I=I+INC3 FOURIE3A.1300
J=J+INC4 FOURIE3A.1301
ENDDO FOURIE3A.1302
IBASE=IBASE+INC1 FOURIE3A.1303
JBASE=JBASE+INC2 FOURIE3A.1304
ENDDO FOURIE3A.1305
IA=IA+IINK FOURIE3A.1306
IB=IB+IINK FOURIE3A.1307
IC=IC-IINK FOURIE3A.1308
JBASE=JBASE+JUMP FOURIE3A.1309
ENDDO FOURIE3A.1310
IF (IA.GT.IC) GO TO 1900 FOURIE3A.1311
FOURIE3A.1312
1360 CONTINUE FOURIE3A.1313
IBASE=0 FOURIE3A.1314
DO L=1,LA FOURIE3A.1315
I=IBASE FOURIE3A.1316
J=JBASE FOURIE3A.1317
CDIR$ IVDEP FOURIE3A.1318
! Fujitsu vectorization directive GRB0F405.285
!OCL NOVREC GRB0F405.286
DO IJK=1,LOT FOURIE3A.1319
C(JA+J)=A(IA+I)+A(IB+I) FOURIE3A.1320
C(JB+J)=(0.5*A(IA+I)-A(IB+I))-(SIN60*B(IA+I)) FOURIE3A.1321
C(JC+J)=-(0.5*A(IA+I)-A(IB+I))-(SIN60*B(IA+I)) FOURIE3A.1322
I=I+INC3 FOURIE3A.1323
J=J+INC4 FOURIE3A.1324
ENDDO FOURIE3A.1325
IBASE=IBASE+INC1 FOURIE3A.1326
JBASE=JBASE+INC2 FOURIE3A.1327
ENDDO FOURIE3A.1328
GO TO 1900 FOURIE3A.1329
FOURIE3A.1330
1390 CONTINUE FOURIE3A.1331
SSIN60=2.0*SIN60 FOURIE3A.1332
DO L=1,LA FOURIE3A.1333
I=IBASE FOURIE3A.1334
J=JBASE FOURIE3A.1335
CDIR$ IVDEP FOURIE3A.1336
! Fujitsu vectorization directive GRB0F405.287
!OCL NOVREC GRB0F405.288
DO IJK=1,LOT FOURIE3A.1337
C(JA+J)=2.0*(A(IA+I)+A(IB+I)) FOURIE3A.1338
C(JB+J)=(2.0*A(IA+I)-A(IB+I))-(SSIN60*B(IB+I)) FOURIE3A.1339
C(JC+J)=(2.0*A(IA+I)-A(IB+I))+(SSIN60*B(IB+I)) FOURIE3A.1340
I=I+INC3 FOURIE3A.1341
J=J+INC4 FOURIE3A.1342
ENDDO FOURIE3A.1343
IBASE=IBASE+INC1 FOURIE3A.1344
JBASE=JBASE+INC2 FOURIE3A.1345
ENDDO FOURIE3A.1346
GO TO 1900 FOURIE3A.1347
FOURIE3A.1348
C Coding for factor 4: FOURIE3A.1349
1400 CONTINUE FOURIE3A.1350
IA=1 FOURIE3A.1351
IB=IA+(2*M-LA)*INC1 FOURIE3A.1352
IC=IB+2*M*INC1 FOURIE3A.1353
ID=IB FOURIE3A.1354
JA=1 FOURIE3A.1355
JB=JA+JINK FOURIE3A.1356
JC=JB+JINK FOURIE3A.1357
JD=JC+JINK FOURIE3A.1358
FOURIE3A.1359
IF (LA.EQ.M) GO TO 1490 FOURIE3A.1360
FOURIE3A.1361
DO L=1,LA FOURIE3A.1362
I=IBASE FOURIE3A.1363
J=JBASE FOURIE3A.1364
CDIR$ IVDEP FOURIE3A.1365
! Fujitsu vectorization directive GRB0F405.289
!OCL NOVREC GRB0F405.290
DO IJK=1,LOT FOURIE3A.1366
C(JA+J)=(A(IA+I)+A(IC+I))+A(IB+I) FOURIE3A.1367
C(JB+J)=(A(IA+I)-A(IC+I))-B(IB+I) FOURIE3A.1368
C(JC+J)=(A(IA+I)+A(IC+I))-A(IB+I) FOURIE3A.1369
C(JD+J)=(A(IA+I)-A(IC+I))+B(IB+I) FOURIE3A.1370
I=I+INC3 FOURIE3A.1371
J=J+INC4 FOURIE3A.1372
ENDDO FOURIE3A.1373
IBASE=IBASE+INC1 FOURIE3A.1374
JBASE=JBASE+INC2 FOURIE3A.1375
ENDDO FOURIE3A.1376
IA=IA+IINK FOURIE3A.1377
IINK=2*IINK FOURIE3A.1378
IB=IB+IINK FOURIE3A.1379
IC=IC-IINK FOURIE3A.1380
ID=ID-IINK FOURIE3A.1381
JBASE=JBASE+JUMP FOURIE3A.1382
JUMP=2*JUMP+JINK FOURIE3A.1383
IF (IB.EQ.IC) GO TO 1460 FOURIE3A.1384
DO K=LA,KSTOP,LA FOURIE3A.1385
KB=K+K FOURIE3A.1386
KC=KB+KB FOURIE3A.1387
KD=KC+KB FOURIE3A.1388
C1=TRIGS(KB+1) FOURIE3A.1389
S1=TRIGS(KB+2) FOURIE3A.1390
C2=TRIGS(KC+1) FOURIE3A.1391
S2=TRIGS(KC+2) FOURIE3A.1392
C3=TRIGS(KD+1) FOURIE3A.1393
S3=TRIGS(KD+2) FOURIE3A.1394
IBASE=0 FOURIE3A.1395
DO L=1,LA FOURIE3A.1396
I=IBASE FOURIE3A.1397
J=JBASE FOURIE3A.1398
CDIR$ IVDEP FOURIE3A.1399
! Fujitsu vectorization directive GRB0F405.291
!OCL NOVREC GRB0F405.292
DO IJK=1,LOT FOURIE3A.1400
C(JA+J)=(A(IA+I)+A(IC+I))+(A(IB+I)+A(ID+I)) FOURIE3A.1401
D(JA+J)=(B(IA+I)-B(IC+I))+(B(IB+I)-B(ID+I)) FOURIE3A.1402
C(JC+J)= FOURIE3A.1403
& C2*((A(IA+I)+A(IC+I))-(A(IB+I)+A(ID+I))) FOURIE3A.1404
& -S2*((B(IA+I)-B(IC+I))-(B(IB+I)-B(ID+I))) FOURIE3A.1405
D(JC+J)= FOURIE3A.1406
& S2*((A(IA+I)+A(IC+I))-(A(IB+I)+A(ID+I))) FOURIE3A.1407
& +C2*((B(IA+I)-B(IC+I))-(B(IB+I)-B(ID+I))) FOURIE3A.1408
C(JB+J)= FOURIE3A.1409
& C1*((A(IA+I)-A(IC+I))-(B(IB+I)+B(ID+I))) FOURIE3A.1410
& -S1*((B(IA+I)+B(IC+I))+(A(IB+I)-A(ID+I))) FOURIE3A.1411
D(JB+J)= FOURIE3A.1412
& S1*((A(IA+I)-A(IC+I))-(B(IB+I)+B(ID+I))) FOURIE3A.1413
& +C1*((B(IA+I)+B(IC+I))+(A(IB+I)-A(ID+I))) FOURIE3A.1414
C(JD+J)= FOURIE3A.1415
& C3*((A(IA+I)-A(IC+I))+(B(IB+I)+B(ID+I))) FOURIE3A.1416
& -S3*((B(IA+I)+B(IC+I))-(A(IB+I)-A(ID+I))) FOURIE3A.1417
D(JD+J)= FOURIE3A.1418
& S3*((A(IA+I)-A(IC+I))+(B(IB+I)+B(ID+I))) FOURIE3A.1419
& +C3*((B(IA+I)+B(IC+I))-(A(IB+I)-A(ID+I))) FOURIE3A.1420
I=I+INC3 FOURIE3A.1421
J=J+INC4 FOURIE3A.1422
ENDDO FOURIE3A.1423
IBASE=IBASE+INC1 FOURIE3A.1424
JBASE=JBASE+INC2 FOURIE3A.1425
ENDDO FOURIE3A.1426
IA=IA+IINK FOURIE3A.1427
IB=IB+IINK FOURIE3A.1428
IC=IC-IINK FOURIE3A.1429
ID=ID-IINK FOURIE3A.1430
JBASE=JBASE+JUMP FOURIE3A.1431
ENDDO FOURIE3A.1432
IF (IB.GT.IC) GO TO 1900 FOURIE3A.1433
1460 CONTINUE FOURIE3A.1434
IBASE=0 FOURIE3A.1435
SIN45=SQRT(0.5) FOURIE3A.1436
DO L=1,LA FOURIE3A.1437
I=IBASE FOURIE3A.1438
J=JBASE FOURIE3A.1439
CDIR$ IVDEP FOURIE3A.1440
! Fujitsu vectorization directive GRB0F405.293
!OCL NOVREC GRB0F405.294
DO IJK=1,LOT FOURIE3A.1441
C(JA+J)=A(IA+I)+A(IB+I) FOURIE3A.1442
C(JB+J)=SIN45*((A(IA+I)-A(IB+I))-(B(IA+I)+B(IB+I))) FOURIE3A.1443
C(JC+J)=B(IB+I)-B(IA+I) FOURIE3A.1444
C(JD+J)=-SIN45*((A(IA+I)-A(IB+I))+(B(IA+I)+B(IB+I))) FOURIE3A.1445
I=I+INC3 FOURIE3A.1446
J=J+INC4 FOURIE3A.1447
ENDDO FOURIE3A.1448
IBASE=IBASE+INC1 FOURIE3A.1449
JBASE=JBASE+INC2 FOURIE3A.1450
ENDDO FOURIE3A.1451
GO TO 1900 FOURIE3A.1452
FOURIE3A.1453
1490 CONTINUE FOURIE3A.1454
DO L=1,LA FOURIE3A.1455
I=IBASE FOURIE3A.1456
J=JBASE FOURIE3A.1457
CDIR$ IVDEP FOURIE3A.1458
! Fujitsu vectorization directive GRB0F405.295
!OCL NOVREC GRB0F405.296
DO IJK=1,LOT FOURIE3A.1459
C(JA+J)=2.0*((A(IA+I)+A(IC+I))+A(IB+I)) FOURIE3A.1460
C(JB+J)=2.0*((A(IA+I)-A(IC+I))-B(IB+I)) FOURIE3A.1461
C(JC+J)=2.0*((A(IA+I)+A(IC+I))-A(IB+I)) FOURIE3A.1462
C(JD+J)=2.0*((A(IA+I)-A(IC+I))+B(IB+I)) FOURIE3A.1463
I=I+INC3 FOURIE3A.1464
J=J+INC4 FOURIE3A.1465
ENDDO FOURIE3A.1466
IBASE=IBASE+INC1 FOURIE3A.1467
JBASE=JBASE+INC2 FOURIE3A.1468
ENDDO FOURIE3A.1469
GO TO 1900 FOURIE3A.1470
FOURIE3A.1471
C Coding for factor 5: FOURIE3A.1472
FOURIE3A.1473
1500 CONTINUE FOURIE3A.1474
IA=1 FOURIE3A.1475
IB=IA+(2*M-LA)*INC1 FOURIE3A.1476
IC=IB+2*M*INC1 FOURIE3A.1477
ID=IC FOURIE3A.1478
IE=IB FOURIE3A.1479
JA=1 FOURIE3A.1480
JB=JA+JINK FOURIE3A.1481
JC=JB+JINK FOURIE3A.1482
JD=JC+JINK FOURIE3A.1483
JE=JD+JINK FOURIE3A.1484
FOURIE3A.1485
IF (LA.EQ.M) GO TO 1590 FOURIE3A.1486
FOURIE3A.1487
DO L=1,LA FOURIE3A.1488
I=IBASE FOURIE3A.1489
J=JBASE FOURIE3A.1490
CDIR$ IVDEP FOURIE3A.1491
! Fujitsu vectorization directive GRB0F405.297
!OCL NOVREC GRB0F405.298
DO IJK=1,LOT FOURIE3A.1492
C(JA+J)=A(IA+I)+(A(IB+I)+A(IC+I)) FOURIE3A.1493
C(JB+J)=((A(IA+I)-0.25*(A(IB+I)+A(IC+I)))+QRT5* FOURIE3A.1494
& (A(IB+I)-A(IC+I))) - (SIN72*B(IB+I)+SIN36*B(IC+I)) FOURIE3A.1495
C(JC+J)=((A(IA+I)-0.25*(A(IB+I)+A(IC+I)))-QRT5* FOURIE3A.1496
& (A(IB+I)-A(IC+I))) - (SIN36*B(IB+I)-SIN72*B(IC+I)) FOURIE3A.1497
C(JD+J)=((A(IA+I)-0.25*(A(IB+I)+A(IC+I)))-QRT5* FOURIE3A.1498
& (A(IB+I)-A(IC+I))) + (SIN36*B(IB+I)-SIN72*B(IC+I)) FOURIE3A.1499
C(JE+J)=((A(IA+I)-0.25*(A(IB+I)+A(IC+I)))+QRT5* FOURIE3A.1500
& (A(IB+I)-A(IC+I))) + (SIN72*B(IB+I)+SIN36*B(IC+I)) FOURIE3A.1501
I=I+INC3 FOURIE3A.1502
J=J+INC4 FOURIE3A.1503
ENDDO FOURIE3A.1504
IBASE=IBASE+INC1 FOURIE3A.1505
JBASE=JBASE+INC2 FOURIE3A.1506
ENDDO FOURIE3A.1507
IA=IA+IINK FOURIE3A.1508
IINK=2*IINK FOURIE3A.1509
IB=IB+IINK FOURIE3A.1510
IC=IC+IINK FOURIE3A.1511
ID=ID-IINK FOURIE3A.1512
IE=IE-IINK FOURIE3A.1513
JBASE=JBASE+JUMP FOURIE3A.1514
JUMP=2*JUMP+JINK FOURIE3A.1515
IF (IB.EQ.ID) GO TO 1560 FOURIE3A.1516
DO K=LA,KSTOP,LA FOURIE3A.1517
KB=K+K FOURIE3A.1518
KC=KB+KB FOURIE3A.1519
KD=KC+KB FOURIE3A.1520
KE=KD+KB FOURIE3A.1521
C1=TRIGS(KB+1) FOURIE3A.1522
S1=TRIGS(KB+2) FOURIE3A.1523
C2=TRIGS(KC+1) FOURIE3A.1524
S2=TRIGS(KC+2) FOURIE3A.1525
C3=TRIGS(KD+1) FOURIE3A.1526
S3=TRIGS(KD+2) FOURIE3A.1527
C4=TRIGS(KE+1) FOURIE3A.1528
S4=TRIGS(KE+2) FOURIE3A.1529
IBASE=0 FOURIE3A.1530
DO L=1,LA FOURIE3A.1531
I=IBASE FOURIE3A.1532
J=JBASE FOURIE3A.1533
CDIR$ IVDEP FOURIE3A.1534
! Fujitsu vectorization directive GRB0F405.299
!OCL NOVREC GRB0F405.300
DO IJK=1,LOT FOURIE3A.1535
FOURIE3A.1536
AA10(IJK)=(A(IA+I)-0.25*((A(IB+I)+A(IE+I))+ FOURIE3A.1537
& (A(IC+I)+A(ID+I)))) FOURIE3A.1538
& +QRT5*((A(IB+I)+A(IE+I))-(A(IC+I)+A(ID+I))) FOURIE3A.1539
AA20(IJK)=(A(IA+I)-0.25*((A(IB+I)+A(IE+I))+ FOURIE3A.1540
& (A(IC+I)+A(ID+I)))) FOURIE3A.1541
& -QRT5*((A(IB+I)+A(IE+I))-(A(IC+I)+A(ID+I))) FOURIE3A.1542
BB10(IJK)=(B(IA+I)-0.25*((B(IB+I)-B(IE+I))+ FOURIE3A.1543
& (B(IC+I)-B(ID+I)))) FOURIE3A.1544
& +QRT5*((B(IB+I)-B(IE+I))-(B(IC+I)-B(ID+I))) FOURIE3A.1545
BB20(IJK)=(B(IA+I)-0.25*((B(IB+I)-B(IE+I))+ FOURIE3A.1546
& (B(IC+I)-B(ID+I)))) FOURIE3A.1547
& -QRT5*((B(IB+I)-B(IE+I))-(B(IC+I)-B(ID+I))) FOURIE3A.1548
AA11(IJK)=SIN72*(B(IB+I)+B(IE+I))+ FOURIE3A.1549
& SIN36*(B(IC+I)+B(ID+I)) FOURIE3A.1550
AA21(IJK)=SIN36*(B(IB+I)+B(IE+I))- FOURIE3A.1551
& SIN72*(B(IC+I)+B(ID+I)) FOURIE3A.1552
BB11(IJK)=SIN72*(A(IB+I)-A(IE+I))+ FOURIE3A.1553
& SIN36*(A(IC+I)-A(ID+I)) FOURIE3A.1554
BB21(IJK)=SIN36*(A(IB+I)-A(IE+I))- FOURIE3A.1555
& SIN72*(A(IC+I)-A(ID+I)) FOURIE3A.1556
FOURIE3A.1557
C(JA+J)=A(IA+I)+((A(IB+I)+A(IE+I))+(A(IC+I)+A(ID+I))) FOURIE3A.1558
D(JA+J)=B(IA+I)+((B(IB+I)-B(IE+I))+(B(IC+I)-B(ID+I))) FOURIE3A.1559
C(JB+J)=C1*(AA10(IJK)-AA11(IJK))-S1*(BB10(IJK)+BB11(IJK)) FOURIE3A.1560
D(JB+J)=S1*(AA10(IJK)-AA11(IJK))+C1*(BB10(IJK)+BB11(IJK)) FOURIE3A.1561
C(JE+J)=C4*(AA10(IJK)+AA11(IJK))-S4*(BB10(IJK)-BB11(IJK)) FOURIE3A.1562
D(JE+J)=S4*(AA10(IJK)+AA11(IJK))+C4*(BB10(IJK)-BB11(IJK)) FOURIE3A.1563
C(JC+J)=C2*(AA20(IJK)-AA21(IJK))-S2*(BB20(IJK)+BB21(IJK)) FOURIE3A.1564
D(JC+J)=S2*(AA20(IJK)-AA21(IJK))+C2*(BB20(IJK)+BB21(IJK)) FOURIE3A.1565
C(JD+J)=C3*(AA20(IJK)+AA21(IJK))-S3*(BB20(IJK)-BB21(IJK)) FOURIE3A.1566
D(JD+J)=S3*(AA20(IJK)+AA21(IJK))+C3*(BB20(IJK)-BB21(IJK)) FOURIE3A.1567
FOURIE3A.1568
I=I+INC3 FOURIE3A.1569
J=J+INC4 FOURIE3A.1570
ENDDO FOURIE3A.1571
IBASE=IBASE+INC1 FOURIE3A.1572
JBASE=JBASE+INC2 FOURIE3A.1573
ENDDO FOURIE3A.1574
IA=IA+IINK FOURIE3A.1575
IB=IB+IINK FOURIE3A.1576
IC=IC+IINK FOURIE3A.1577
ID=ID-IINK FOURIE3A.1578
IE=IE-IINK FOURIE3A.1579
JBASE=JBASE+JUMP FOURIE3A.1580
ENDDO FOURIE3A.1581
IF (IB.GT.ID) GO TO 1900 FOURIE3A.1582
1560 CONTINUE FOURIE3A.1583
IBASE=0 FOURIE3A.1584
DO L=1,LA FOURIE3A.1585
I=IBASE FOURIE3A.1586
J=JBASE FOURIE3A.1587
CDIR$ IVDEP FOURIE3A.1588
! Fujitsu vectorization directive GRB0F405.301
!OCL NOVREC GRB0F405.302
DO IJK=1,LOT FOURIE3A.1589
C(JA+J)=(A(IA+I)+A(IB+I))+A(IC+I) FOURIE3A.1590
C(JB+J)=(QRT5*(A(IA+I)-A(IB+I))+ FOURIE3A.1591
& (0.25*(A(IA+I)+A(IB+I))-A(IC+I))) FOURIE3A.1592
& -(SIN36*B(IA+I)+SIN72*B(IB+I)) FOURIE3A.1593
C(JE+J)=-(QRT5*(A(IA+I)-A(IB+I))+ FOURIE3A.1594
& (0.25*(A(IA+I)+A(IB+I))-A(IC+I))) FOURIE3A.1595
& -(SIN36*B(IA+I)+SIN72*B(IB+I)) FOURIE3A.1596
C(JC+J)=(QRT5*(A(IA+I)-A(IB+I))- FOURIE3A.1597
& (0.25*(A(IA+I)+A(IB+I))-A(IC+I))) FOURIE3A.1598
& -(SIN72*B(IA+I)-SIN36*B(IB+I)) FOURIE3A.1599
C(JD+J)=-(QRT5*(A(IA+I)-A(IB+I))- FOURIE3A.1600
& (0.25*(A(IA+I)+A(IB+I))-A(IC+I))) FOURIE3A.1601
& -(SIN72*B(IA+I)-SIN36*B(IB+I)) FOURIE3A.1602
I=I+INC3 FOURIE3A.1603
J=J+INC4 FOURIE3A.1604
ENDDO FOURIE3A.1605
IBASE=IBASE+INC1 FOURIE3A.1606
JBASE=JBASE+INC2 FOURIE3A.1607
ENDDO FOURIE3A.1608
GO TO 1900 FOURIE3A.1609
FOURIE3A.1610
1590 CONTINUE FOURIE3A.1611
QQRT5=2.0*QRT5 FOURIE3A.1612
SSIN36=2.0*SIN36 FOURIE3A.1613
SSIN72=2.0*SIN72 FOURIE3A.1614
DO L=1,LA FOURIE3A.1615
I=IBASE FOURIE3A.1616
J=JBASE FOURIE3A.1617
CDIR$ IVDEP FOURIE3A.1618
! Fujitsu vectorization directive GRB0F405.303
!OCL NOVREC GRB0F405.304
DO IJK=1,LOT FOURIE3A.1619
C(JA+J)=2.0*(A(IA+I)+(A(IB+I)+A(IC+I))) FOURIE3A.1620
C(JB+J)=(2.0*(A(IA+I)-0.25*(A(IB+I)+A(IC+I))) FOURIE3A.1621
& +QQRT5*(A(IB+I)-A(IC+I)))-(SSIN72*B(IB+I)+ FOURIE3A.1622
& SSIN36*B(IC+I)) FOURIE3A.1623
C(JC+J)=(2.0*(A(IA+I)-0.25*(A(IB+I)+A(IC+I))) FOURIE3A.1624
& -QQRT5*(A(IB+I)-A(IC+I)))-(SSIN36*B(IB+I)- FOURIE3A.1625
& SSIN72*B(IC+I)) FOURIE3A.1626
C(JD+J)=(2.0*(A(IA+I)-0.25*(A(IB+I)+A(IC+I))) FOURIE3A.1627
& -QQRT5*(A(IB+I)-A(IC+I)))+(SSIN36*B(IB+I)- FOURIE3A.1628
& SSIN72*B(IC+I)) FOURIE3A.1629
C(JE+J)=(2.0*(A(IA+I)-0.25*(A(IB+I)+A(IC+I))) FOURIE3A.1630
& +QQRT5*(A(IB+I)-A(IC+I)))+(SSIN72*B(IB+I)+ FOURIE3A.1631
& SSIN36*B(IC+I)) FOURIE3A.1632
I=I+INC3 FOURIE3A.1633
J=J+INC4 FOURIE3A.1634
ENDDO FOURIE3A.1635
IBASE=IBASE+INC1 FOURIE3A.1636
JBASE=JBASE+INC2 FOURIE3A.1637
ENDDO FOURIE3A.1638
GO TO 1900 FOURIE3A.1639
FOURIE3A.1640
C Coding for factor 6: FOURIE3A.1641
1600 CONTINUE FOURIE3A.1642
IA=1 FOURIE3A.1643
IB=IA+(2*M-LA)*INC1 FOURIE3A.1644
IC=IB+2*M*INC1 FOURIE3A.1645
ID=IC+2*M*INC1 FOURIE3A.1646
IE=IC FOURIE3A.1647
IF=IB FOURIE3A.1648
JA=1 FOURIE3A.1649
JB=JA+JINK FOURIE3A.1650
JC=JB+JINK FOURIE3A.1651
JD=JC+JINK FOURIE3A.1652
JE=JD+JINK FOURIE3A.1653
JF=JE+JINK FOURIE3A.1654
FOURIE3A.1655
IF (LA.EQ.M) GO TO 1690 FOURIE3A.1656
FOURIE3A.1657
DO L=1,LA FOURIE3A.1658
I=IBASE FOURIE3A.1659
J=JBASE FOURIE3A.1660
CDIR$ IVDEP FOURIE3A.1661
! Fujitsu vectorization directive GRB0F405.305
!OCL NOVREC GRB0F405.306
DO IJK=1,LOT FOURIE3A.1662
C(JA+J)=(A(IA+I)+A(ID+I))+(A(IB+I)+A(IC+I)) FOURIE3A.1663
C(JD+J)=(A(IA+I)-A(ID+I))-(A(IB+I)-A(IC+I)) FOURIE3A.1664
C(JB+J)=((A(IA+I)-A(ID+I))+0.5*(A(IB+I)-A(IC+I))) FOURIE3A.1665
& -(SIN60*(B(IB+I)+B(IC+I))) FOURIE3A.1666
C(JF+J)=((A(IA+I)-A(ID+I))+0.5*(A(IB+I)-A(IC+I))) FOURIE3A.1667
& +(SIN60*(B(IB+I)+B(IC+I))) FOURIE3A.1668
C(JC+J)=((A(IA+I)+A(ID+I))-0.5*(A(IB+I)+A(IC+I))) FOURIE3A.1669
& -(SIN60*(B(IB+I)-B(IC+I))) FOURIE3A.1670
C(JE+J)=((A(IA+I)+A(ID+I))-0.5*(A(IB+I)+A(IC+I))) FOURIE3A.1671
& +(SIN60*(B(IB+I)-B(IC+I))) FOURIE3A.1672
I=I+INC3 FOURIE3A.1673
J=J+INC4 FOURIE3A.1674
ENDDO FOURIE3A.1675
IBASE=IBASE+INC1 FOURIE3A.1676
JBASE=JBASE+INC2 FOURIE3A.1677
ENDDO FOURIE3A.1678
IA=IA+IINK FOURIE3A.1679
IINK=2*IINK FOURIE3A.1680
IB=IB+IINK FOURIE3A.1681
IC=IC+IINK FOURIE3A.1682
ID=ID-IINK FOURIE3A.1683
IE=IE-IINK FOURIE3A.1684
IF=IF-IINK FOURIE3A.1685
JBASE=JBASE+JUMP FOURIE3A.1686
JUMP=2*JUMP+JINK FOURIE3A.1687
IF (IC.EQ.ID) GO TO 1660 FOURIE3A.1688
DO K=LA,KSTOP,LA FOURIE3A.1689
KB=K+K FOURIE3A.1690
KC=KB+KB FOURIE3A.1691
KD=KC+KB FOURIE3A.1692
KE=KD+KB FOURIE3A.1693
KF=KE+KB FOURIE3A.1694
C1=TRIGS(KB+1) FOURIE3A.1695
S1=TRIGS(KB+2) FOURIE3A.1696
C2=TRIGS(KC+1) FOURIE3A.1697
S2=TRIGS(KC+2) FOURIE3A.1698
C3=TRIGS(KD+1) FOURIE3A.1699
S3=TRIGS(KD+2) FOURIE3A.1700
C4=TRIGS(KE+1) FOURIE3A.1701
S4=TRIGS(KE+2) FOURIE3A.1702
C5=TRIGS(KF+1) FOURIE3A.1703
S5=TRIGS(KF+2) FOURIE3A.1704
IBASE=0 FOURIE3A.1705
DO L=1,LA FOURIE3A.1706
I=IBASE FOURIE3A.1707
J=JBASE FOURIE3A.1708
CDIR$ IVDEP FOURIE3A.1709
! Fujitsu vectorization directive GRB0F405.307
!OCL NOVREC GRB0F405.308
DO IJK=1,LOT FOURIE3A.1710
FOURIE3A.1711
AA11(IJK)= (A(IE+I)+A(IB+I))+(A(IC+I)+A(IF+I)) FOURIE3A.1712
AA20(IJK)=(A(IA+I)+A(ID+I))-0.5*AA11(IJK) FOURIE3A.1713
AA21(IJK)=SIN60*((A(IE+I)+A(IB+I))-(A(IC+I)+A(IF+I))) FOURIE3A.1714
BB11(IJK)= (B(IB+I)-B(IE+I))+(B(IC+I)-B(IF+I)) FOURIE3A.1715
BB20(IJK)=(B(IA+I)-B(ID+I))-0.5*BB11(IJK) FOURIE3A.1716
BB21(IJK)=SIN60*((B(IB+I)-B(IE+I))-(B(IC+I)-B(IF+I))) FOURIE3A.1717
FOURIE3A.1718
C(JA+J)=(A(IA+I)+A(ID+I))+AA11(IJK) FOURIE3A.1719
D(JA+J)=(B(IA+I)-B(ID+I))+BB11(IJK) FOURIE3A.1720
C(JC+J)=C2*(AA20(IJK)-BB21(IJK))-S2*(BB20(IJK)+AA21(IJK)) FOURIE3A.1721
D(JC+J)=S2*(AA20(IJK)-BB21(IJK))+C2*(BB20(IJK)+AA21(IJK)) FOURIE3A.1722
C(JE+J)=C4*(AA20(IJK)+BB21(IJK))-S4*(BB20(IJK)-AA21(IJK)) FOURIE3A.1723
D(JE+J)=S4*(AA20(IJK)+BB21(IJK))+C4*(BB20(IJK)-AA21(IJK)) FOURIE3A.1724
FOURIE3A.1725
AA11(IJK)=(A(IE+I)-A(IB+I))+(A(IC+I)-A(IF+I)) FOURIE3A.1726
BB11(IJK)=(B(IE+I)+B(IB+I))-(B(IC+I)+B(IF+I)) FOURIE3A.1727
AA20(IJK)=(A(IA+I)-A(ID+I))-0.5*AA11(IJK) FOURIE3A.1728
AA21(IJK)=SIN60*((A(IE+I)-A(IB+I))-(A(IC+I)-A(IF+I))) FOURIE3A.1729
BB20(IJK)=(B(IA+I)+B(ID+I))+0.5*BB11(IJK) FOURIE3A.1730
BB21(IJK)=SIN60*((B(IE+I)+B(IB+I))+(B(IC+I)+B(IF+I))) FOURIE3A.1731
FOURIE3A.1732
C(JD+J)=C3*((A(IA+I)-A(ID+I))+AA11(IJK))- FOURIE3A.1733
& S3*((B(IA+I)+B(ID+I))-BB11(IJK)) FOURIE3A.1734
D(JD+J)=S3*((A(IA+I)-A(ID+I))+AA11(IJK))+ FOURIE3A.1735
& C3*((B(IA+I)+B(ID+I))-BB11(IJK)) FOURIE3A.1736
C(JB+J)=C1*(AA20(IJK)-BB21(IJK))-S1*(BB20(IJK)-AA21(IJK)) FOURIE3A.1737
D(JB+J)=S1*(AA20(IJK)-BB21(IJK))+C1*(BB20(IJK)-AA21(IJK)) FOURIE3A.1738
C(JF+J)=C5*(AA20(IJK)+BB21(IJK))-S5*(BB20(IJK)+AA21(IJK)) FOURIE3A.1739
D(JF+J)=S5*(AA20(IJK)+BB21(IJK))+C5*(BB20(IJK)+AA21(IJK)) FOURIE3A.1740
FOURIE3A.1741
I=I+INC3 FOURIE3A.1742
J=J+INC4 FOURIE3A.1743
ENDDO FOURIE3A.1744
IBASE=IBASE+INC1 FOURIE3A.1745
JBASE=JBASE+INC2 FOURIE3A.1746
ENDDO FOURIE3A.1747
IA=IA+IINK FOURIE3A.1748
IB=IB+IINK FOURIE3A.1749
IC=IC+IINK FOURIE3A.1750
ID=ID-IINK FOURIE3A.1751
IE=IE-IINK FOURIE3A.1752
IF=IF-IINK FOURIE3A.1753
JBASE=JBASE+JUMP FOURIE3A.1754
ENDDO FOURIE3A.1755
IF (IC.GT.ID) GO TO 1900 FOURIE3A.1756
1660 CONTINUE FOURIE3A.1757
IBASE=0 FOURIE3A.1758
DO L=1,LA FOURIE3A.1759
I=IBASE FOURIE3A.1760
J=JBASE FOURIE3A.1761
CDIR$ IVDEP FOURIE3A.1762
! Fujitsu vectorization directive GRB0F405.309
!OCL NOVREC GRB0F405.310
DO IJK=1,LOT FOURIE3A.1763
C(JA+J)=A(IB+I)+(A(IA+I)+A(IC+I)) FOURIE3A.1764
C(JD+J)=B(IB+I)-(B(IA+I)+B(IC+I)) FOURIE3A.1765
C(JB+J)=(SIN60*(A(IA+I)-A(IC+I)))- FOURIE3A.1766
& (0.5*(B(IA+I)+B(IC+I))+B(IB+I)) FOURIE3A.1767
C(JF+J)=-(SIN60*(A(IA+I)-A(IC+I)))- FOURIE3A.1768
& (0.5*(B(IA+I)+B(IC+I))+B(IB+I)) FOURIE3A.1769
C(JC+J)=SIN60*(B(IC+I)-B(IA+I))+ FOURIE3A.1770
& (0.5*(A(IA+I)+A(IC+I))-A(IB+I)) FOURIE3A.1771
C(JE+J)=SIN60*(B(IC+I)-B(IA+I))- FOURIE3A.1772
& (0.5*(A(IA+I)+A(IC+I))-A(IB+I)) FOURIE3A.1773
I=I+INC3 FOURIE3A.1774
J=J+INC4 FOURIE3A.1775
ENDDO FOURIE3A.1776
IBASE=IBASE+INC1 FOURIE3A.1777
JBASE=JBASE+INC2 FOURIE3A.1778
ENDDO FOURIE3A.1779
GO TO 1900 FOURIE3A.1780
FOURIE3A.1781
1690 CONTINUE FOURIE3A.1782
SSIN60=2.0*SIN60 FOURIE3A.1783
DO L=1,LA FOURIE3A.1784
I=IBASE FOURIE3A.1785
J=JBASE FOURIE3A.1786
CDIR$ IVDEP FOURIE3A.1787
! Fujitsu vectorization directive GRB0F405.311
!OCL NOVREC GRB0F405.312
DO IJK=1,LOT FOURIE3A.1788
C(JA+J)=(2.0*(A(IA+I)+A(ID+I)))+(2.0*(A(IB+I)+A(IC+I))) FOURIE3A.1789
C(JD+J)=(2.0*(A(IA+I)-A(ID+I)))-(2.0*(A(IB+I)-A(IC+I))) FOURIE3A.1790
C(JB+J)=(2.0*(A(IA+I)-A(ID+I))+(A(IB+I)-A(IC+I))) FOURIE3A.1791
& -(SSIN60*(B(IB+I)+B(IC+I))) FOURIE3A.1792
C(JF+J)=(2.0*(A(IA+I)-A(ID+I))+(A(IB+I)-A(IC+I))) FOURIE3A.1793
& +(SSIN60*(B(IB+I)+B(IC+I))) FOURIE3A.1794
C(JC+J)=(2.0*(A(IA+I)+A(ID+I))-(A(IB+I)+A(IC+I))) FOURIE3A.1795
& -(SSIN60*(B(IB+I)-B(IC+I))) FOURIE3A.1796
C(JE+J)=(2.0*(A(IA+I)+A(ID+I))-(A(IB+I)+A(IC+I))) FOURIE3A.1797
& +(SSIN60*(B(IB+I)-B(IC+I))) FOURIE3A.1798
I=I+INC3 FOURIE3A.1799
J=J+INC4 FOURIE3A.1800
ENDDO FOURIE3A.1801
IBASE=IBASE+INC1 FOURIE3A.1802
JBASE=JBASE+INC2 FOURIE3A.1803
ENDDO FOURIE3A.1804
GO TO 1900 FOURIE3A.1805
FOURIE3A.1806
C Coding for factor 8: FOURIE3A.1807
1800 CONTINUE FOURIE3A.1808
IBAD=3 FOURIE3A.1809
IF (LA.NE.M) GO TO 1910 FOURIE3A.1810
IA=1 FOURIE3A.1811
IB=IA+LA*INC1 FOURIE3A.1812
IC=IB+2*LA*INC1 FOURIE3A.1813
ID=IC+2*LA*INC1 FOURIE3A.1814
IE=ID+2*LA*INC1 FOURIE3A.1815
JA=1 FOURIE3A.1816
JB=JA+JINK FOURIE3A.1817
JC=JB+JINK FOURIE3A.1818
JD=JC+JINK FOURIE3A.1819
JE=JD+JINK FOURIE3A.1820
JF=JE+JINK FOURIE3A.1821
JG=JF+JINK FOURIE3A.1822
JH=JG+JINK FOURIE3A.1823
SSIN45=SQRT(2.0) FOURIE3A.1824
FOURIE3A.1825
DO L=1,LA FOURIE3A.1826
I=IBASE FOURIE3A.1827
J=JBASE FOURIE3A.1828
CDIR$ IVDEP FOURIE3A.1829
! Fujitsu vectorization directive GRB0F405.313
!OCL NOVREC GRB0F405.314
DO IJK=1,LOT FOURIE3A.1830
C(JA+J)=2.0*(((A(IA+I)+A(IE+I))+A(IC+I))+ FOURIE3A.1831
& (A(IB+I)+A(ID+I))) FOURIE3A.1832
C(JE+J)=2.0*(((A(IA+I)+A(IE+I))+A(IC+I))- FOURIE3A.1833
& (A(IB+I)+A(ID+I))) FOURIE3A.1834
C(JC+J)=2.0*(((A(IA+I)+A(IE+I))-A(IC+I))- FOURIE3A.1835
& (B(IB+I)-B(ID+I))) FOURIE3A.1836
C(JG+J)=2.0*(((A(IA+I)+A(IE+I))-A(IC+I))+ FOURIE3A.1837
& (B(IB+I)-B(ID+I))) FOURIE3A.1838
C(JB+J)=2.0*((A(IA+I)-A(IE+I))-B(IC+I)) FOURIE3A.1839
& +SSIN45*((A(IB+I)-A(ID+I))-(B(IB+I)+B(ID+I))) FOURIE3A.1840
C(JF+J)=2.0*((A(IA+I)-A(IE+I))-B(IC+I)) FOURIE3A.1841
& -SSIN45*((A(IB+I)-A(ID+I))-(B(IB+I)+B(ID+I))) FOURIE3A.1842
C(JD+J)=2.0*((A(IA+I)-A(IE+I))+B(IC+I)) FOURIE3A.1843
& -SSIN45*((A(IB+I)-A(ID+I))+(B(IB+I)+B(ID+I))) FOURIE3A.1844
C(JH+J)=2.0*((A(IA+I)-A(IE+I))+B(IC+I)) FOURIE3A.1845
& +SSIN45*((A(IB+I)-A(ID+I))+(B(IB+I)+B(ID+I))) FOURIE3A.1846
I=I+INC3 FOURIE3A.1847
J=J+INC4 FOURIE3A.1848
ENDDO FOURIE3A.1849
IBASE=IBASE+INC1 FOURIE3A.1850
JBASE=JBASE+INC2 FOURIE3A.1851
ENDDO FOURIE3A.1852
FOURIE3A.1853
1900 CONTINUE FOURIE3A.1854
IBAD=0 FOURIE3A.1855
1910 CONTINUE FOURIE3A.1856
IERR=IBAD FOURIE3A.1857
FOURIE3A.1858
ENDIF ! end of Fourier Synthesis FOURIE3A.1859
FOURIE3A.1860
RETURN ! end of FTRANS FOURIE3A.1861
END FOURIE3A.1862
FOURIE3A.1863
!- End of subroutine code----------------------------------------- FOURIE3A.1864
*ENDIF FOURIE3A.1865