Changeset 1682 for palm/trunk/SOURCE/temperton_fft.f90
- Timestamp:
- Oct 7, 2015 11:56:08 PM (9 years ago)
- File:
-
- 1 edited
-
palm/trunk/SOURCE/temperton_fft.f90 (modified) (10 diffs)
Legend:
- Unmodified
- Added
- Removed
-
palm/trunk/SOURCE/temperton_fft.f90
r1343 r1682 1 MODULE temperton_fft 2 1 !> @file temperton_fft.f90 3 2 !------------------------------------------------------------------------------! 3 ! 4 4 ! Current revisions: 5 5 ! ----------------- 6 ! 6 ! Code annotations made doxygen readable 7 7 ! 8 8 ! Former revisions: … … 31 31 ! Description: 32 32 ! ------------ 33 ! Fast Fourier transformation developed by Clive Temperton, ECMWF.33 !> Fast Fourier transformation developed by Clive Temperton, ECMWF. 34 34 !------------------------------------------------------------------------------! 35 MODULE temperton_fft 35 36 36 37 USE kinds … … 43 44 44 45 45 INTEGER(iwp) :: nfax(10) ! :array used by *fft991*.46 REAL(wp), ALLOCATABLE :: trig(:) ! :array used by *fft991*.46 INTEGER(iwp) :: nfax(10) !< array used by *fft991*. 47 REAL(wp), ALLOCATABLE :: trig(:) !< array used by *fft991*. 47 48 48 49 ! 49 50 !-- nfft: maximum length of calls to *fft. 50 51 #if defined( __nec ) 51 INTEGER(iwp), PARAMETER :: nfft = 256 ! :52 INTEGER(iwp), PARAMETER :: nfft = 256 !< 52 53 #else 53 INTEGER(iwp), PARAMETER :: nfft = 32 ! :54 INTEGER(iwp), PARAMETER :: nfft = 32 !< 54 55 #endif 55 56 56 INTEGER(iwp), PARAMETER :: nout = 6 ! :standard output stream57 INTEGER(iwp), PARAMETER :: nout = 6 !< standard output stream 57 58 58 59 CONTAINS 59 60 61 !------------------------------------------------------------------------------! 62 ! Description: 63 ! ------------ 64 !> Calls fortran-versions of fft's. 65 !> 66 !> Method: 67 !> 68 !> Subroutine 'fft991cy' - multiple fast real periodic transform 69 !> supersedes previous routine 'fft991cy'. 70 !> 71 !> Real transform of length n performed by removing redundant 72 !> operations from complex transform of length n. 73 !> 74 !> a is the array containing input & output data. 75 !> work is an area of size (n+1)*min(lot,nfft). 76 !> trigs is a previously prepared list of trig function values. 77 !> ifax is a previously prepared list of factors of n. 78 !> inc is the increment within each data 'vector' 79 !> (e.g. inc=1 for consecutively stored data). 80 !> jump is the increment between the start of each data vector. 81 !> n is the length of the data vectors. 82 !> lot is the number of data vectors. 83 !> isign = +1 for transform from spectral to gridpoint 84 !> = -1 for transform from gridpoint to spectral. 85 !> 86 !> ordering of coefficients: 87 !> a(0),b(0),a(1),b(1),a(2),b(2),.,a(n/2),b(n/2) 88 !> where b(0)=b(n/2)=0; (n+2) locations required. 89 !> 90 !> ordering of data: 91 !> x(0),x(1),x(2),.,x(n-1), 0 , 0 ; (n+2) locations required. 92 !> 93 !> Vectorization is achieved on cray by doing the transforms 94 !> in parallel. 95 !> 96 !> n must be composed of factors 2,3 & 5 but does not have to be even. 97 !> 98 !> definition of transforms: 99 !> 100 !> isign=+1: x(j)=sum(k=0,.,n-1)(c(k)*exp(2*i*j*k*pi/n)) 101 !> where c(k)=a(k)+i*b(k) and c(n-k)=a(k)-i*b(k) 102 !> 103 !> isign=-1: a(k)=(1/n)*sum(j=0,.,n-1)(x(j)*cos(2*j*k*pi/n)) 104 !> b(k)=-(1/n)*sum(j=0,.,n-1)(x(j)*sin(2*j*k*pi/n)) 105 !> 106 !> calls fortran-versions of fft's !!! 107 !> dimension a(n),work(n),trigs(n),ifax(1) 108 !------------------------------------------------------------------------------! 60 109 SUBROUTINE fft991cy(a,work,trigs,ifax,inc,jump,n,lot,isign) 61 110 62 ! Description:63 !64 ! Calls fortran-versions of fft's.65 !66 ! Method:67 !68 ! Subroutine 'fft991cy' - multiple fast real periodic transform69 ! supersedes previous routine 'fft991cy'.70 !71 ! Real transform of length n performed by removing redundant72 ! operations from complex transform of length n.73 !74 ! a is the array containing input & output data.75 ! work is an area of size (n+1)*min(lot,nfft).76 ! trigs is a previously prepared list of trig function values.77 ! ifax is a previously prepared list of factors of n.78 ! inc is the increment within each data 'vector'79 ! (e.g. inc=1 for consecutively stored data).80 ! jump is the increment between the start of each data vector.81 ! n is the length of the data vectors.82 ! lot is the number of data vectors.83 ! isign = +1 for transform from spectral to gridpoint84 ! = -1 for transform from gridpoint to spectral.85 !86 ! ordering of coefficients:87 ! a(0),b(0),a(1),b(1),a(2),b(2),.,a(n/2),b(n/2)88 ! where b(0)=b(n/2)=0; (n+2) locations required.89 !90 ! ordering of data:91 ! x(0),x(1),x(2),.,x(n-1), 0 , 0 ; (n+2) locations required.92 !93 ! Vectorization is achieved on cray by doing the transforms94 ! in parallel.95 !96 ! n must be composed of factors 2,3 & 5 but does not have to be even.97 !98 ! definition of transforms:99 !100 ! isign=+1: x(j)=sum(k=0,.,n-1)(c(k)*exp(2*i*j*k*pi/n))101 ! where c(k)=a(k)+i*b(k) and c(n-k)=a(k)-i*b(k)102 103 ! isign=-1: a(k)=(1/n)*sum(j=0,.,n-1)(x(j)*cos(2*j*k*pi/n))104 ! b(k)=-(1/n)*sum(j=0,.,n-1)(x(j)*sin(2*j*k*pi/n))105 106 ! calls fortran-versions of fft's !!!107 ! dimension a(n),work(n),trigs(n),ifax(1)108 109 111 USE kinds 110 112 … … 112 114 113 115 ! Scalar arguments 114 INTEGER(iwp) :: inc ! :115 INTEGER(iwp) :: isign ! :116 INTEGER(iwp) :: jump ! :117 INTEGER(iwp) :: lot ! :118 INTEGER(iwp) :: n ! :116 INTEGER(iwp) :: inc !< 117 INTEGER(iwp) :: isign !< 118 INTEGER(iwp) :: jump !< 119 INTEGER(iwp) :: lot !< 120 INTEGER(iwp) :: n !< 119 121 120 122 ! Array arguments 121 REAL(wp) :: a(*) ! :122 REAL(wp) :: trigs(*) ! :123 REAL(wp) :: work(*) ! :124 INTEGER(iwp) :: ifax(*) ! :123 REAL(wp) :: a(*) !< 124 REAL(wp) :: trigs(*) !< 125 REAL(wp) :: work(*) !< 126 INTEGER(iwp) :: ifax(*) !< 125 127 126 128 ! Local scalars: 127 INTEGER(iwp) :: i ! :128 INTEGER(iwp) :: ia ! :129 INTEGER(iwp) :: ibase ! :130 INTEGER(iwp) :: ierr ! :131 INTEGER(iwp) :: ifac ! :132 INTEGER(iwp) :: igo ! :133 INTEGER(iwp) :: ii ! :134 INTEGER(iwp) :: istart ! :135 INTEGER(iwp) :: ix ! :136 INTEGER(iwp) :: iz ! :137 INTEGER(iwp) :: j ! :138 INTEGER(iwp) :: jbase ! :139 INTEGER(iwp) :: jj ! :140 INTEGER(iwp) :: k ! :141 INTEGER(iwp) :: la ! :142 INTEGER(iwp) :: nb ! :143 INTEGER(iwp) :: nblox ! :144 INTEGER(iwp) :: nfax ! :145 INTEGER(iwp) :: nvex ! :146 INTEGER(iwp) :: nx ! :129 INTEGER(iwp) :: i !< 130 INTEGER(iwp) :: ia !< 131 INTEGER(iwp) :: ibase !< 132 INTEGER(iwp) :: ierr !< 133 INTEGER(iwp) :: ifac !< 134 INTEGER(iwp) :: igo !< 135 INTEGER(iwp) :: ii !< 136 INTEGER(iwp) :: istart !< 137 INTEGER(iwp) :: ix !< 138 INTEGER(iwp) :: iz !< 139 INTEGER(iwp) :: j !< 140 INTEGER(iwp) :: jbase !< 141 INTEGER(iwp) :: jj !< 142 INTEGER(iwp) :: k !< 143 INTEGER(iwp) :: la !< 144 INTEGER(iwp) :: nb !< 145 INTEGER(iwp) :: nblox !< 146 INTEGER(iwp) :: nfax !< 147 INTEGER(iwp) :: nvex !< 148 INTEGER(iwp) :: nx !< 147 149 148 150 ! Intrinsic functions … … 320 322 END SUBROUTINE fft991cy 321 323 324 !------------------------------------------------------------------------------! 325 ! Description: 326 ! ------------ 327 !> Performs one pass through data as part of 328 !> multiple real fft (fourier analysis) routine. 329 !> 330 !> Method: 331 !> 332 !> a is first real input vector 333 !> equivalence b(1) with a(ifac*la*inc1+1) 334 !> c is first real output vector 335 !> equivalence d(1) with c(la*inc2+1) 336 !> trigs is a precalculated list of sines & cosines 337 !> inc1 is the addressing increment for a 338 !> inc2 is the addressing increment for c 339 !> inc3 is the increment between input vectors a 340 !> inc4 is the increment between output vectors c 341 !> lot is the number of vectors 342 !> n is the length of the vectors 343 !> ifac is the current factor of n 344 !> la = n/(product of factors used so far) 345 !> ierr is an error indicator: 346 !> 0 - pass completed without error 347 !> 1 - lot greater than nfft 348 !> 2 - ifac not catered for 349 !> 3 - ifac only catered for if la=n/ifac 350 !------------------------------------------------------------------------------! 322 351 SUBROUTINE qpassm(a,b,c,d,trigs,inc1,inc2,inc3,inc4,lot,n,ifac,la,ierr) 323 352 324 ! Description:325 !326 ! Performs one pass through data as part of327 ! multiple real fft (fourier analysis) routine.328 !329 ! Method:330 !331 ! a is first real input vector332 ! equivalence b(1) with a(ifac*la*inc1+1)333 ! c is first real output vector334 ! equivalence d(1) with c(la*inc2+1)335 ! trigs is a precalculated list of sines & cosines336 ! inc1 is the addressing increment for a337 ! inc2 is the addressing increment for c338 ! inc3 is the increment between input vectors a339 ! inc4 is the increment between output vectors c340 ! lot is the number of vectors341 ! n is the length of the vectors342 ! ifac is the current factor of n343 ! la = n/(product of factors used so far)344 ! ierr is an error indicator:345 ! 0 - pass completed without error346 ! 1 - lot greater than nfft347 ! 2 - ifac not catered for348 ! 3 - ifac only catered for if la=n/ifac349 !350 351 353 USE kinds 352 354 … … 354 356 355 357 ! Scalar arguments 356 INTEGER(iwp) :: ierr ! :357 INTEGER(iwp) :: ifac ! :358 INTEGER(iwp) :: inc1 ! :359 INTEGER(iwp) :: inc2 ! :360 INTEGER(iwp) :: inc3 ! :361 INTEGER(iwp) :: inc4 ! :362 INTEGER(iwp) :: la ! :363 INTEGER(iwp) :: lot ! :364 INTEGER(iwp) :: n ! :358 INTEGER(iwp) :: ierr !< 359 INTEGER(iwp) :: ifac !< 360 INTEGER(iwp) :: inc1 !< 361 INTEGER(iwp) :: inc2 !< 362 INTEGER(iwp) :: inc3 !< 363 INTEGER(iwp) :: inc4 !< 364 INTEGER(iwp) :: la !< 365 INTEGER(iwp) :: lot !< 366 INTEGER(iwp) :: n !< 365 367 366 368 ! Array arguments 367 369 ! REAL :: a(n),b(n),c(n),d(n),trigs(n) 368 REAL(wp) :: a(*) ! :369 REAL(wp) :: b(*) ! :370 REAL(wp) :: c(*) ! :371 REAL(wp) :: d(*) ! :372 REAL(wp) :: trigs(*) ! :370 REAL(wp) :: a(*) !< 371 REAL(wp) :: b(*) !< 372 REAL(wp) :: c(*) !< 373 REAL(wp) :: d(*) !< 374 REAL(wp) :: trigs(*) !< 373 375 374 376 ! Local scalars: 375 REAL(wp) :: a0 ! :376 REAL(wp) :: a1 ! :377 REAL(wp) :: a10 ! :378 REAL(wp) :: a11 ! :379 REAL(wp) :: a2 ! :380 REAL(wp) :: a20 ! :381 REAL(wp) :: a21 ! :382 REAL(wp) :: a3 ! :383 REAL(wp) :: a4 ! :384 REAL(wp) :: a5 ! :385 REAL(wp) :: a6 ! :386 REAL(wp) :: b0 ! :387 REAL(wp) :: b1 ! :388 REAL(wp) :: b10 ! :389 REAL(wp) :: b11 ! :390 REAL(wp) :: b2 ! :391 REAL(wp) :: b20 ! :392 REAL(wp) :: b21 ! :393 REAL(wp) :: b3 ! :394 REAL(wp) :: b4 ! :395 REAL(wp) :: b5 ! :396 REAL(wp) :: b6 ! :397 REAL(wp) :: c1 ! :398 REAL(wp) :: c2 ! :399 REAL(wp) :: c3 ! :400 REAL(wp) :: c4 ! :401 REAL(wp) :: c5 ! :402 REAL(wp) :: qrt5 ! :403 REAL(wp) :: s1 ! :404 REAL(wp) :: s2 ! :405 REAL(wp) :: s3 ! :406 REAL(wp) :: s4 ! :407 REAL(wp) :: s5 ! :408 REAL(wp) :: sin36 ! :409 REAL(wp) :: sin45 ! :410 REAL(wp) :: sin60 ! :411 REAL(wp) :: sin72 ! :412 REAL(wp) :: z ! :413 REAL(wp) :: zqrt5 ! :414 REAL(wp) :: zsin36 ! :415 REAL(wp) :: zsin45 ! :416 REAL(wp) :: zsin60 ! :417 REAL(wp) :: zsin72 ! :418 419 INTEGER(iwp) :: i ! :420 INTEGER(iwp) :: ia ! :421 INTEGER(iwp) :: ib ! :422 INTEGER(iwp) :: ibad ! :423 INTEGER(iwp) :: ibase ! :424 INTEGER(iwp) :: ic ! :425 INTEGER(iwp) :: id ! :426 INTEGER(iwp) :: ie ! :427 INTEGER(iwp) :: if ! :428 INTEGER(iwp) :: ig ! :429 INTEGER(iwp) :: igo ! :430 INTEGER(iwp) :: ih ! :431 INTEGER(iwp) :: iink ! :432 INTEGER(iwp) :: ijk ! :433 INTEGER(iwp) :: ijump ! :434 INTEGER(iwp) :: j ! :435 INTEGER(iwp) :: ja ! :436 INTEGER(iwp) :: jb ! :437 INTEGER(iwp) :: jbase ! :438 INTEGER(iwp) :: jc ! :439 INTEGER(iwp) :: jd ! :440 INTEGER(iwp) :: je ! :441 INTEGER(iwp) :: jf ! :442 INTEGER(iwp) :: jink ! :443 INTEGER(iwp) :: k ! :444 INTEGER(iwp) :: kb ! :445 INTEGER(iwp) :: kc ! :446 INTEGER(iwp) :: kd ! :447 INTEGER(iwp) :: ke ! :448 INTEGER(iwp) :: kf ! :449 INTEGER(iwp) :: kstop ! :450 INTEGER(iwp) :: l ! :451 INTEGER(iwp) :: m ! :377 REAL(wp) :: a0 !< 378 REAL(wp) :: a1 !< 379 REAL(wp) :: a10 !< 380 REAL(wp) :: a11 !< 381 REAL(wp) :: a2 !< 382 REAL(wp) :: a20 !< 383 REAL(wp) :: a21 !< 384 REAL(wp) :: a3 !< 385 REAL(wp) :: a4 !< 386 REAL(wp) :: a5 !< 387 REAL(wp) :: a6 !< 388 REAL(wp) :: b0 !< 389 REAL(wp) :: b1 !< 390 REAL(wp) :: b10 !< 391 REAL(wp) :: b11 !< 392 REAL(wp) :: b2 !< 393 REAL(wp) :: b20 !< 394 REAL(wp) :: b21 !< 395 REAL(wp) :: b3 !< 396 REAL(wp) :: b4 !< 397 REAL(wp) :: b5 !< 398 REAL(wp) :: b6 !< 399 REAL(wp) :: c1 !< 400 REAL(wp) :: c2 !< 401 REAL(wp) :: c3 !< 402 REAL(wp) :: c4 !< 403 REAL(wp) :: c5 !< 404 REAL(wp) :: qrt5 !< 405 REAL(wp) :: s1 !< 406 REAL(wp) :: s2 !< 407 REAL(wp) :: s3 !< 408 REAL(wp) :: s4 !< 409 REAL(wp) :: s5 !< 410 REAL(wp) :: sin36 !< 411 REAL(wp) :: sin45 !< 412 REAL(wp) :: sin60 !< 413 REAL(wp) :: sin72 !< 414 REAL(wp) :: z !< 415 REAL(wp) :: zqrt5 !< 416 REAL(wp) :: zsin36 !< 417 REAL(wp) :: zsin45 !< 418 REAL(wp) :: zsin60 !< 419 REAL(wp) :: zsin72 !< 420 421 INTEGER(iwp) :: i !< 422 INTEGER(iwp) :: ia !< 423 INTEGER(iwp) :: ib !< 424 INTEGER(iwp) :: ibad !< 425 INTEGER(iwp) :: ibase !< 426 INTEGER(iwp) :: ic !< 427 INTEGER(iwp) :: id !< 428 INTEGER(iwp) :: ie !< 429 INTEGER(iwp) :: if !< 430 INTEGER(iwp) :: ig !< 431 INTEGER(iwp) :: igo !< 432 INTEGER(iwp) :: ih !< 433 INTEGER(iwp) :: iink !< 434 INTEGER(iwp) :: ijk !< 435 INTEGER(iwp) :: ijump !< 436 INTEGER(iwp) :: j !< 437 INTEGER(iwp) :: ja !< 438 INTEGER(iwp) :: jb !< 439 INTEGER(iwp) :: jbase !< 440 INTEGER(iwp) :: jc !< 441 INTEGER(iwp) :: jd !< 442 INTEGER(iwp) :: je !< 443 INTEGER(iwp) :: jf !< 444 INTEGER(iwp) :: jink !< 445 INTEGER(iwp) :: k !< 446 INTEGER(iwp) :: kb !< 447 INTEGER(iwp) :: kc !< 448 INTEGER(iwp) :: kd !< 449 INTEGER(iwp) :: ke !< 450 INTEGER(iwp) :: kf !< 451 INTEGER(iwp) :: kstop !< 452 INTEGER(iwp) :: l !< 453 INTEGER(iwp) :: m !< 452 454 453 455 ! Intrinsic functions … … 1219 1221 END SUBROUTINE qpassm 1220 1222 1223 !------------------------------------------------------------------------------! 1224 ! Description: 1225 ! ------------ 1226 !> @todo Missing subroutine description. 1227 !------------------------------------------------------------------------------! 1221 1228 SUBROUTINE rpassm(a,b,c,d,trigs,inc1,inc2,inc3,inc4,lot,n,ifac,la,ierr) 1222 1229 ! Dimension a(n),b(n),c(n),d(n),trigs(n) … … 1227 1234 1228 1235 ! Scalar arguments 1229 INTEGER(iwp) :: ierr ! :1230 INTEGER(iwp) :: ifac ! :1231 INTEGER(iwp) :: inc1 ! :1232 INTEGER(iwp) :: inc2 ! :1233 INTEGER(iwp) :: inc3 ! :1234 INTEGER(iwp) :: inc4 ! :1235 INTEGER(iwp) :: la ! :1236 INTEGER(iwp) :: lot ! :1237 INTEGER(iwp) :: n ! :1236 INTEGER(iwp) :: ierr !< 1237 INTEGER(iwp) :: ifac !< 1238 INTEGER(iwp) :: inc1 !< 1239 INTEGER(iwp) :: inc2 !< 1240 INTEGER(iwp) :: inc3 !< 1241 INTEGER(iwp) :: inc4 !< 1242 INTEGER(iwp) :: la !< 1243 INTEGER(iwp) :: lot !< 1244 INTEGER(iwp) :: n !< 1238 1245 1239 1246 ! Array arguments 1240 REAL(wp) :: a(*) ! :1241 REAL(wp) :: b(*) ! :1242 REAL(wp) :: c(*) ! :1243 REAL(wp) :: d(*) ! :1244 REAL(wp) :: trigs(*) ! :1247 REAL(wp) :: a(*) !< 1248 REAL(wp) :: b(*) !< 1249 REAL(wp) :: c(*) !< 1250 REAL(wp) :: d(*) !< 1251 REAL(wp) :: trigs(*) !< 1245 1252 1246 1253 ! Local scalars: 1247 REAL(wp) :: c1 ! :1248 REAL(wp) :: c2 ! :1249 REAL(wp) :: c3 ! :1250 REAL(wp) :: c4 ! :1251 REAL(wp) :: c5 ! :1252 REAL(wp) :: qqrt5 ! :1253 REAL(wp) :: qrt5 ! :1254 REAL(wp) :: s1 ! :1255 REAL(wp) :: s2 ! :1256 REAL(wp) :: s3 ! :1257 REAL(wp) :: s4 ! :1258 REAL(wp) :: s5 ! :1259 REAL(wp) :: sin36 ! :1260 REAL(wp) :: sin45 ! :1261 REAL(wp) :: sin60 ! :1262 REAL(wp) :: sin72 ! :1263 REAL(wp) :: ssin36 ! :1264 REAL(wp) :: ssin45 ! :1265 REAL(wp) :: ssin60 ! :1266 REAL(wp) :: ssin72 ! :1267 1268 INTEGER(iwp) :: i ! :1269 INTEGER(iwp) :: ia ! :1270 INTEGER(iwp) :: ib ! :1271 INTEGER(iwp) :: ibad ! :1272 INTEGER(iwp) :: ibase ! :1273 INTEGER(iwp) :: ic ! :1274 INTEGER(iwp) :: id ! :1275 INTEGER(iwp) :: ie ! :1276 INTEGER(iwp) :: if ! :1277 INTEGER(iwp) :: igo ! :1278 INTEGER(iwp) :: iink ! :1279 INTEGER(iwp) :: ijk ! :1280 INTEGER(iwp) :: j ! :1281 INTEGER(iwp) :: ja ! :1282 INTEGER(iwp) :: jb ! :1283 INTEGER(iwp) :: jbase ! :1284 INTEGER(iwp) :: jc ! :1285 INTEGER(iwp) :: jd ! :1286 INTEGER(iwp) :: je ! :1287 INTEGER(iwp) :: jf ! :1288 INTEGER(iwp) :: jg ! :1289 INTEGER(iwp) :: jh ! :1290 INTEGER(iwp) :: jink ! :1291 INTEGER(iwp) :: jump ! :1292 INTEGER(iwp) :: k ! :1293 INTEGER(iwp) :: kb ! :1294 INTEGER(iwp) :: kc ! :1295 INTEGER(iwp) :: kd ! :1296 INTEGER(iwp) :: ke ! :1297 INTEGER(iwp) :: kf ! :1298 INTEGER(iwp) :: kstop ! :1299 INTEGER(iwp) :: l ! :1300 INTEGER(iwp) :: m ! :1254 REAL(wp) :: c1 !< 1255 REAL(wp) :: c2 !< 1256 REAL(wp) :: c3 !< 1257 REAL(wp) :: c4 !< 1258 REAL(wp) :: c5 !< 1259 REAL(wp) :: qqrt5 !< 1260 REAL(wp) :: qrt5 !< 1261 REAL(wp) :: s1 !< 1262 REAL(wp) :: s2 !< 1263 REAL(wp) :: s3 !< 1264 REAL(wp) :: s4 !< 1265 REAL(wp) :: s5 !< 1266 REAL(wp) :: sin36 !< 1267 REAL(wp) :: sin45 !< 1268 REAL(wp) :: sin60 !< 1269 REAL(wp) :: sin72 !< 1270 REAL(wp) :: ssin36 !< 1271 REAL(wp) :: ssin45 !< 1272 REAL(wp) :: ssin60 !< 1273 REAL(wp) :: ssin72 !< 1274 1275 INTEGER(iwp) :: i !< 1276 INTEGER(iwp) :: ia !< 1277 INTEGER(iwp) :: ib !< 1278 INTEGER(iwp) :: ibad !< 1279 INTEGER(iwp) :: ibase !< 1280 INTEGER(iwp) :: ic !< 1281 INTEGER(iwp) :: id !< 1282 INTEGER(iwp) :: ie !< 1283 INTEGER(iwp) :: if !< 1284 INTEGER(iwp) :: igo !< 1285 INTEGER(iwp) :: iink !< 1286 INTEGER(iwp) :: ijk !< 1287 INTEGER(iwp) :: j !< 1288 INTEGER(iwp) :: ja !< 1289 INTEGER(iwp) :: jb !< 1290 INTEGER(iwp) :: jbase !< 1291 INTEGER(iwp) :: jc !< 1292 INTEGER(iwp) :: jd !< 1293 INTEGER(iwp) :: je !< 1294 INTEGER(iwp) :: jf !< 1295 INTEGER(iwp) :: jg !< 1296 INTEGER(iwp) :: jh !< 1297 INTEGER(iwp) :: jink !< 1298 INTEGER(iwp) :: jump !< 1299 INTEGER(iwp) :: k !< 1300 INTEGER(iwp) :: kb !< 1301 INTEGER(iwp) :: kc !< 1302 INTEGER(iwp) :: kd !< 1303 INTEGER(iwp) :: ke !< 1304 INTEGER(iwp) :: kf !< 1305 INTEGER(iwp) :: kstop !< 1306 INTEGER(iwp) :: l !< 1307 INTEGER(iwp) :: m !< 1301 1308 1302 1309 ! Local arrays: 1303 REAL(wp) :: a10(nfft) ! :1304 REAL(wp) :: a11(nfft) ! :1305 REAL(wp) :: a20(nfft) ! :1306 REAL(wp) :: a21(nfft) ! :1307 REAL(wp) :: b10(nfft) ! :1308 REAL(wp) :: b11(nfft) ! :1309 REAL(wp) :: b20(nfft) ! :1310 REAL(wp) :: b21(nfft) ! :1310 REAL(wp) :: a10(nfft) !< 1311 REAL(wp) :: a11(nfft) !< 1312 REAL(wp) :: a20(nfft) !< 1313 REAL(wp) :: a21(nfft) !< 1314 REAL(wp) :: b10(nfft) !< 1315 REAL(wp) :: b11(nfft) !< 1316 REAL(wp) :: b20(nfft) !< 1317 REAL(wp) :: b21(nfft) !< 1311 1318 1312 1319 ! Intrinsic functions … … 2065 2072 END SUBROUTINE rpassm 2066 2073 2074 !------------------------------------------------------------------------------! 2075 ! Description: 2076 ! ------------ 2077 !> Computes factors of n & trigonometric functins required by fft99 & fft991cy 2078 !> Method: Dimension trigs(n),ifax(1),jfax(10),lfax(7) 2079 !> subroutine 'set99' - computes factors of n & trigonometric 2080 !> functins required by fft99 & fft991cy 2081 !------------------------------------------------------------------------------! 2067 2082 SUBROUTINE set99(trigs,ifax,n) 2068 2069 ! Description:2070 !2071 ! Computes factors of n & trigonometric functins required by fft99 & fft991cy2072 !2073 ! Method:2074 !2075 ! Dimension trigs(n),ifax(1),jfax(10),lfax(7)2076 !2077 ! subroutine 'set99' - computes factors of n & trigonometric2078 ! functins required by fft99 & fft991cy2079 2083 2080 2084 … … 2087 2091 2088 2092 ! Scalar arguments 2089 INTEGER(iwp) :: n ! :2093 INTEGER(iwp) :: n !< 2090 2094 2091 2095 ! Array arguments 2092 INTEGER(iwp) :: ifax(*) ! :2093 REAL(wp) :: trigs(*) ! :2096 INTEGER(iwp) :: ifax(*) !< 2097 REAL(wp) :: trigs(*) !< 2094 2098 2095 2099 2096 2100 ! Local scalars: 2097 REAL(wp) :: angle ! :2098 REAL(wp) :: del ! :2099 INTEGER(iwp) :: i ! :2100 INTEGER(iwp) :: ifac ! :2101 INTEGER(iwp) :: ixxx ! :2102 INTEGER(iwp) :: k ! :2103 INTEGER(iwp) :: l ! :2104 INTEGER(iwp) :: nfax ! :2105 INTEGER(iwp) :: nhl ! :2106 INTEGER(iwp) :: nil ! :2107 INTEGER(iwp) :: nu ! :2101 REAL(wp) :: angle !< 2102 REAL(wp) :: del !< 2103 INTEGER(iwp) :: i !< 2104 INTEGER(iwp) :: ifac !< 2105 INTEGER(iwp) :: ixxx !< 2106 INTEGER(iwp) :: k !< 2107 INTEGER(iwp) :: l !< 2108 INTEGER(iwp) :: nfax !< 2109 INTEGER(iwp) :: nhl !< 2110 INTEGER(iwp) :: nil !< 2111 INTEGER(iwp) :: nu !< 2108 2112 2109 2113 ! Local arrays: 2110 INTEGER(iwp) :: jfax(10) ! :2111 INTEGER(iwp) :: lfax(7) ! :2114 INTEGER(iwp) :: jfax(10) !< 2115 INTEGER(iwp) :: lfax(7) !< 2112 2116 2113 2117 ! Intrinsic functions
Note: See TracChangeset
for help on using the changeset viewer.
