00001 subroutine zfftb1 (n,c,ch,wa,ifac)
00002 implicit double precision (a-h,o-z)
00003 dimension ch(*) ,c(*) ,wa(*) ,ifac(*)
00004 nf = ifac(2)
00005 na = 0
00006 l1 = 1
00007 iw = 1
00008 do 116 k1=1,nf
00009 ip = ifac(k1+2)
00010 l2 = ip*l1
00011 ido = n/l2
00012 idot = ido+ido
00013 idl1 = idot*l1
00014 if (ip .ne. 4) go to 103
00015 ix2 = iw+idot
00016 ix3 = ix2+idot
00017 if (na .ne. 0) go to 101
00018 call zpassb4 (idot,l1,c,ch,wa(iw),wa(ix2),wa(ix3))
00019 go to 102
00020 101 call zpassb4 (idot,l1,ch,c,wa(iw),wa(ix2),wa(ix3))
00021 102 na = 1-na
00022 go to 115
00023 103 if (ip .ne. 2) go to 106
00024 if (na .ne. 0) go to 104
00025 call zpassb2 (idot,l1,c,ch,wa(iw))
00026 go to 105
00027 104 call zpassb2 (idot,l1,ch,c,wa(iw))
00028 105 na = 1-na
00029 go to 115
00030 106 if (ip .ne. 3) go to 109
00031 ix2 = iw+idot
00032 if (na .ne. 0) go to 107
00033 call zpassb3 (idot,l1,c,ch,wa(iw),wa(ix2))
00034 go to 108
00035 107 call zpassb3 (idot,l1,ch,c,wa(iw),wa(ix2))
00036 108 na = 1-na
00037 go to 115
00038 109 if (ip .ne. 5) go to 112
00039 ix2 = iw+idot
00040 ix3 = ix2+idot
00041 ix4 = ix3+idot
00042 if (na .ne. 0) go to 110
00043 call zpassb5 (idot,l1,c,ch,wa(iw),wa(ix2),wa(ix3),wa(ix4))
00044 go to 111
00045 110 call zpassb5 (idot,l1,ch,c,wa(iw),wa(ix2),wa(ix3),wa(ix4))
00046 111 na = 1-na
00047 go to 115
00048 112 if (na .ne. 0) go to 113
00049 call zpassb (nac,idot,ip,l1,idl1,c,c,c,ch,ch,wa(iw))
00050 go to 114
00051 113 call zpassb (nac,idot,ip,l1,idl1,ch,ch,ch,c,c,wa(iw))
00052 114 if (nac .ne. 0) na = 1-na
00053 115 l1 = l2
00054 iw = iw+(ip-1)*idot
00055 116 continue
00056 if (na .eq. 0) return
00057 n2 = n+n
00058 do 117 i=1,n2
00059 c(i) = ch(i)
00060 117 continue
00061 return
00062 end
1.7.1
