1#if defined(XLF14) || defined(XLFLINUX) 2@PROCESS OPT(0) STRICT(ALL) 3#endif 4 subroutine scfti1 (n,wa,ifac) 5 dimension wa(*),ifac(*),ntryh(4) 6 data ntryh(1),ntryh(2),ntryh(3),ntryh(4)/3,4,2,5/ 7 nl = n 8 nf = 0 9 j = 0 10 101 j = j+1 11 if (j-4) 102,102,103 12 102 ntry = ntryh(j) 13 go to 104 14 103 ntry = ntry+2 15 104 nq = nl/ntry 16 nr = nl-ntry*nq 17 if (nr) 101,105,101 18 105 nf = nf+1 19 ifac(nf+2) = ntry 20 nl = nq 21 if (ntry .ne. 2) go to 107 22 if (nf .eq. 1) go to 107 23 do 106 i=2,nf 24 ib = nf-i+2 25 ifac(ib+2) = ifac(ib+1) 26 106 continue 27 ifac(3) = 2 28 107 if (nl .ne. 1) go to 104 29 ifac(1) = n 30 ifac(2) = nf 31 tpi = 6.28318530717959 32 argh = tpi/float(n) 33 i = 2 34 l1 = 1 35 do 110 k1=1,nf 36 ip = ifac(k1+2) 37 ld = 0 38 l2 = l1*ip 39 ido = n/l2 40 idot = ido+ido+2 41 ipm = ip-1 42 do 109 j=1,ipm 43 i1 = i 44 wa(i-1) = 1. 45 wa(i) = 0. 46 ld = ld+l1 47 fi = 0. 48 argld = float(ld)*argh 49 do 108 ii=4,idot,2 50 i = i+2 51 fi = fi+1. 52 arg = fi*argld 53 wa(i-1) = cos(arg) 54 wa(i) = sin(arg) 55 108 continue 56 if (ip .le. 5) go to 109 57 wa(i1-1) = wa(i-1) 58 wa(i1) = wa(i) 59 109 continue 60 l1 = l2 61 110 continue 62 return 63 end 64