| [459] | 1 | /* fftpackc.c is the fortran FFTPACK package retrieved from netlib */ | 
|---|
|  | 2 |  | 
|---|
|  | 3 | /* allf.f -- translated by f2c (version 19970805). | 
|---|
|  | 4 | You must link the resulting object file with the libraries: | 
|---|
|  | 5 | -lf2c -lm   (in that order) | 
|---|
|  | 6 | */ | 
|---|
|  | 7 |  | 
|---|
|  | 8 | /* #include "f2c.h" -- Remplace par ce qui suit */ | 
|---|
|  | 9 | #include "fftpackc.h" | 
|---|
| [663] | 10 | #include <math.h> | 
|---|
| [459] | 11 |  | 
|---|
|  | 12 | /*  ------ File cfftb.f ------ */ | 
|---|
| [756] | 13 | /* Subroutine */ int cfftb_(int_4 *n, r_4 *c__, r_4 *wsave) | 
|---|
| [459] | 14 | { | 
|---|
| [756] | 15 | extern /* Subroutine */ int cfftb1_(int_4 *, r_4 *, r_4 *, r_4 *, | 
|---|
| [717] | 16 | int_4 *); | 
|---|
| [756] | 17 | static int_4 iw1, iw2; | 
|---|
| [459] | 18 |  | 
|---|
|  | 19 | /* Parameter adjustments */ | 
|---|
|  | 20 | --wsave; | 
|---|
|  | 21 | --c__; | 
|---|
|  | 22 |  | 
|---|
|  | 23 | /* Function Body */ | 
|---|
|  | 24 | if (*n == 1) { | 
|---|
|  | 25 | return 0; | 
|---|
|  | 26 | } | 
|---|
|  | 27 | iw1 = *n + *n + 1; | 
|---|
|  | 28 | iw2 = iw1 + *n + *n; | 
|---|
| [753] | 29 | cfftb1_(n, &c__[1], &wsave[1], &wsave[iw1], (int_4 *)&wsave[iw2]);  /* (int *) ajoute - Reza 29/11/99 */ | 
|---|
| [459] | 30 | return 0; | 
|---|
|  | 31 | } /* cfftb_ */ | 
|---|
|  | 32 |  | 
|---|
|  | 33 | /*  ------ File cfftb1.f ------ */ | 
|---|
| [756] | 34 | /* Subroutine */ int cfftb1_(int_4 *n, r_4 *c__, r_4 *ch, r_4 *wa, | 
|---|
| [717] | 35 | int_4 *ifac) | 
|---|
| [459] | 36 | { | 
|---|
|  | 37 | /* System generated locals */ | 
|---|
| [756] | 38 | int_4 i__1; | 
|---|
| [459] | 39 |  | 
|---|
|  | 40 | /* Local variables */ | 
|---|
| [756] | 41 | static int_4 idot, i__; | 
|---|
|  | 42 | extern /* Subroutine */ int passb_(int_4 *, int_4 *, int_4 *, | 
|---|
|  | 43 | int_4 *, int_4 *, r_4 *, r_4 *, r_4 *, r_4 *, r_4 *, | 
|---|
| [717] | 44 | r_4 *); | 
|---|
| [756] | 45 | static int_4 k1, l1, l2, n2; | 
|---|
|  | 46 | extern /* Subroutine */ int passb2_(int_4 *, int_4 *, r_4 *, r_4 *, | 
|---|
|  | 47 | r_4 *), passb3_(int_4 *, int_4 *, r_4 *, r_4 *, r_4 *, | 
|---|
|  | 48 | r_4 *), passb4_(int_4 *, int_4 *, r_4 *, r_4 *, r_4 *, | 
|---|
|  | 49 | r_4 *, r_4 *), passb5_(int_4 *, int_4 *, r_4 *, r_4 *, | 
|---|
| [717] | 50 | r_4 *, r_4 *, r_4 *, r_4 *); | 
|---|
| [756] | 51 | static int_4 na, nf, ip, iw, ix2, ix3, ix4, nac, ido, idl1; | 
|---|
| [459] | 52 |  | 
|---|
|  | 53 | /* Parameter adjustments */ | 
|---|
|  | 54 | --ifac; | 
|---|
|  | 55 | --wa; | 
|---|
|  | 56 | --ch; | 
|---|
|  | 57 | --c__; | 
|---|
|  | 58 |  | 
|---|
|  | 59 | /* Function Body */ | 
|---|
|  | 60 | nf = ifac[2]; | 
|---|
|  | 61 | na = 0; | 
|---|
|  | 62 | l1 = 1; | 
|---|
|  | 63 | iw = 1; | 
|---|
|  | 64 | i__1 = nf; | 
|---|
|  | 65 | for (k1 = 1; k1 <= i__1; ++k1) { | 
|---|
|  | 66 | ip = ifac[k1 + 2]; | 
|---|
|  | 67 | l2 = ip * l1; | 
|---|
|  | 68 | ido = *n / l2; | 
|---|
|  | 69 | idot = ido + ido; | 
|---|
|  | 70 | idl1 = idot * l1; | 
|---|
|  | 71 | if (ip != 4) { | 
|---|
|  | 72 | goto L103; | 
|---|
|  | 73 | } | 
|---|
|  | 74 | ix2 = iw + idot; | 
|---|
|  | 75 | ix3 = ix2 + idot; | 
|---|
|  | 76 | if (na != 0) { | 
|---|
|  | 77 | goto L101; | 
|---|
|  | 78 | } | 
|---|
|  | 79 | passb4_(&idot, &l1, &c__[1], &ch[1], &wa[iw], &wa[ix2], &wa[ix3]); | 
|---|
|  | 80 | goto L102; | 
|---|
|  | 81 | L101: | 
|---|
|  | 82 | passb4_(&idot, &l1, &ch[1], &c__[1], &wa[iw], &wa[ix2], &wa[ix3]); | 
|---|
|  | 83 | L102: | 
|---|
|  | 84 | na = 1 - na; | 
|---|
|  | 85 | goto L115; | 
|---|
|  | 86 | L103: | 
|---|
|  | 87 | if (ip != 2) { | 
|---|
|  | 88 | goto L106; | 
|---|
|  | 89 | } | 
|---|
|  | 90 | if (na != 0) { | 
|---|
|  | 91 | goto L104; | 
|---|
|  | 92 | } | 
|---|
|  | 93 | passb2_(&idot, &l1, &c__[1], &ch[1], &wa[iw]); | 
|---|
|  | 94 | goto L105; | 
|---|
|  | 95 | L104: | 
|---|
|  | 96 | passb2_(&idot, &l1, &ch[1], &c__[1], &wa[iw]); | 
|---|
|  | 97 | L105: | 
|---|
|  | 98 | na = 1 - na; | 
|---|
|  | 99 | goto L115; | 
|---|
|  | 100 | L106: | 
|---|
|  | 101 | if (ip != 3) { | 
|---|
|  | 102 | goto L109; | 
|---|
|  | 103 | } | 
|---|
|  | 104 | ix2 = iw + idot; | 
|---|
|  | 105 | if (na != 0) { | 
|---|
|  | 106 | goto L107; | 
|---|
|  | 107 | } | 
|---|
|  | 108 | passb3_(&idot, &l1, &c__[1], &ch[1], &wa[iw], &wa[ix2]); | 
|---|
|  | 109 | goto L108; | 
|---|
|  | 110 | L107: | 
|---|
|  | 111 | passb3_(&idot, &l1, &ch[1], &c__[1], &wa[iw], &wa[ix2]); | 
|---|
|  | 112 | L108: | 
|---|
|  | 113 | na = 1 - na; | 
|---|
|  | 114 | goto L115; | 
|---|
|  | 115 | L109: | 
|---|
|  | 116 | if (ip != 5) { | 
|---|
|  | 117 | goto L112; | 
|---|
|  | 118 | } | 
|---|
|  | 119 | ix2 = iw + idot; | 
|---|
|  | 120 | ix3 = ix2 + idot; | 
|---|
|  | 121 | ix4 = ix3 + idot; | 
|---|
|  | 122 | if (na != 0) { | 
|---|
|  | 123 | goto L110; | 
|---|
|  | 124 | } | 
|---|
|  | 125 | passb5_(&idot, &l1, &c__[1], &ch[1], &wa[iw], &wa[ix2], &wa[ix3], &wa[ | 
|---|
|  | 126 | ix4]); | 
|---|
|  | 127 | goto L111; | 
|---|
|  | 128 | L110: | 
|---|
|  | 129 | passb5_(&idot, &l1, &ch[1], &c__[1], &wa[iw], &wa[ix2], &wa[ix3], &wa[ | 
|---|
|  | 130 | ix4]); | 
|---|
|  | 131 | L111: | 
|---|
|  | 132 | na = 1 - na; | 
|---|
|  | 133 | goto L115; | 
|---|
|  | 134 | L112: | 
|---|
|  | 135 | if (na != 0) { | 
|---|
|  | 136 | goto L113; | 
|---|
|  | 137 | } | 
|---|
|  | 138 | passb_(&nac, &idot, &ip, &l1, &idl1, &c__[1], &c__[1], &c__[1], &ch[1] | 
|---|
|  | 139 | , &ch[1], &wa[iw]); | 
|---|
|  | 140 | goto L114; | 
|---|
|  | 141 | L113: | 
|---|
|  | 142 | passb_(&nac, &idot, &ip, &l1, &idl1, &ch[1], &ch[1], &ch[1], &c__[1], | 
|---|
|  | 143 | &c__[1], &wa[iw]); | 
|---|
|  | 144 | L114: | 
|---|
|  | 145 | if (nac != 0) { | 
|---|
|  | 146 | na = 1 - na; | 
|---|
|  | 147 | } | 
|---|
|  | 148 | L115: | 
|---|
|  | 149 | l1 = l2; | 
|---|
|  | 150 | iw += (ip - 1) * idot; | 
|---|
|  | 151 | /* L116: */ | 
|---|
|  | 152 | } | 
|---|
|  | 153 | if (na == 0) { | 
|---|
|  | 154 | return 0; | 
|---|
|  | 155 | } | 
|---|
|  | 156 | n2 = *n + *n; | 
|---|
|  | 157 | i__1 = n2; | 
|---|
|  | 158 | for (i__ = 1; i__ <= i__1; ++i__) { | 
|---|
|  | 159 | c__[i__] = ch[i__]; | 
|---|
|  | 160 | /* L117: */ | 
|---|
|  | 161 | } | 
|---|
|  | 162 | return 0; | 
|---|
|  | 163 | } /* cfftb1_ */ | 
|---|
|  | 164 |  | 
|---|
|  | 165 | /*  ------ File cfftf.f ------ */ | 
|---|
| [756] | 166 | /* Subroutine */ int cfftf_(int_4 *n, r_4 *c__, r_4 *wsave) | 
|---|
| [459] | 167 | { | 
|---|
| [756] | 168 | extern /* Subroutine */ int cfftf1_(int_4 *, r_4 *, r_4 *, r_4 *, | 
|---|
| [717] | 169 | int_4 *); | 
|---|
| [756] | 170 | static int_4 iw1, iw2; | 
|---|
| [459] | 171 |  | 
|---|
|  | 172 | /* Parameter adjustments */ | 
|---|
|  | 173 | --wsave; | 
|---|
|  | 174 | --c__; | 
|---|
|  | 175 |  | 
|---|
|  | 176 | /* Function Body */ | 
|---|
|  | 177 | if (*n == 1) { | 
|---|
|  | 178 | return 0; | 
|---|
|  | 179 | } | 
|---|
|  | 180 | iw1 = *n + *n + 1; | 
|---|
|  | 181 | iw2 = iw1 + *n + *n; | 
|---|
| [753] | 182 | cfftf1_(n, &c__[1], &wsave[1], &wsave[iw1], (int_4 *)&wsave[iw2]);   /* (int *) ajoute - Reza 29/11/99 */ | 
|---|
| [459] | 183 | return 0; | 
|---|
|  | 184 | } /* cfftf_ */ | 
|---|
|  | 185 |  | 
|---|
|  | 186 | /*  ------ File cfftf1.f ------ */ | 
|---|
| [756] | 187 | /* Subroutine */ int cfftf1_(int_4 *n, r_4 *c__, r_4 *ch, r_4 *wa, | 
|---|
| [717] | 188 | int_4 *ifac) | 
|---|
| [459] | 189 | { | 
|---|
|  | 190 | /* System generated locals */ | 
|---|
| [756] | 191 | int_4 i__1; | 
|---|
| [459] | 192 |  | 
|---|
|  | 193 | /* Local variables */ | 
|---|
| [756] | 194 | static int_4 idot, i__; | 
|---|
|  | 195 | extern /* Subroutine */ int passf_(int_4 *, int_4 *, int_4 *, | 
|---|
|  | 196 | int_4 *, int_4 *, r_4 *, r_4 *, r_4 *, r_4 *, r_4 *, | 
|---|
| [717] | 197 | r_4 *); | 
|---|
| [756] | 198 | static int_4 k1, l1, l2, n2; | 
|---|
|  | 199 | extern /* Subroutine */ int passf2_(int_4 *, int_4 *, r_4 *, r_4 *, | 
|---|
|  | 200 | r_4 *), passf3_(int_4 *, int_4 *, r_4 *, r_4 *, r_4 *, | 
|---|
|  | 201 | r_4 *), passf4_(int_4 *, int_4 *, r_4 *, r_4 *, r_4 *, | 
|---|
|  | 202 | r_4 *, r_4 *), passf5_(int_4 *, int_4 *, r_4 *, r_4 *, | 
|---|
| [717] | 203 | r_4 *, r_4 *, r_4 *, r_4 *); | 
|---|
| [756] | 204 | static int_4 na, nf, ip, iw, ix2, ix3, ix4, nac, ido, idl1; | 
|---|
| [459] | 205 |  | 
|---|
|  | 206 | /* Parameter adjustments */ | 
|---|
|  | 207 | --ifac; | 
|---|
|  | 208 | --wa; | 
|---|
|  | 209 | --ch; | 
|---|
|  | 210 | --c__; | 
|---|
|  | 211 |  | 
|---|
|  | 212 | /* Function Body */ | 
|---|
|  | 213 | nf = ifac[2]; | 
|---|
|  | 214 | na = 0; | 
|---|
|  | 215 | l1 = 1; | 
|---|
|  | 216 | iw = 1; | 
|---|
|  | 217 | i__1 = nf; | 
|---|
|  | 218 | for (k1 = 1; k1 <= i__1; ++k1) { | 
|---|
|  | 219 | ip = ifac[k1 + 2]; | 
|---|
|  | 220 | l2 = ip * l1; | 
|---|
|  | 221 | ido = *n / l2; | 
|---|
|  | 222 | idot = ido + ido; | 
|---|
|  | 223 | idl1 = idot * l1; | 
|---|
|  | 224 | if (ip != 4) { | 
|---|
|  | 225 | goto L103; | 
|---|
|  | 226 | } | 
|---|
|  | 227 | ix2 = iw + idot; | 
|---|
|  | 228 | ix3 = ix2 + idot; | 
|---|
|  | 229 | if (na != 0) { | 
|---|
|  | 230 | goto L101; | 
|---|
|  | 231 | } | 
|---|
|  | 232 | passf4_(&idot, &l1, &c__[1], &ch[1], &wa[iw], &wa[ix2], &wa[ix3]); | 
|---|
|  | 233 | goto L102; | 
|---|
|  | 234 | L101: | 
|---|
|  | 235 | passf4_(&idot, &l1, &ch[1], &c__[1], &wa[iw], &wa[ix2], &wa[ix3]); | 
|---|
|  | 236 | L102: | 
|---|
|  | 237 | na = 1 - na; | 
|---|
|  | 238 | goto L115; | 
|---|
|  | 239 | L103: | 
|---|
|  | 240 | if (ip != 2) { | 
|---|
|  | 241 | goto L106; | 
|---|
|  | 242 | } | 
|---|
|  | 243 | if (na != 0) { | 
|---|
|  | 244 | goto L104; | 
|---|
|  | 245 | } | 
|---|
|  | 246 | passf2_(&idot, &l1, &c__[1], &ch[1], &wa[iw]); | 
|---|
|  | 247 | goto L105; | 
|---|
|  | 248 | L104: | 
|---|
|  | 249 | passf2_(&idot, &l1, &ch[1], &c__[1], &wa[iw]); | 
|---|
|  | 250 | L105: | 
|---|
|  | 251 | na = 1 - na; | 
|---|
|  | 252 | goto L115; | 
|---|
|  | 253 | L106: | 
|---|
|  | 254 | if (ip != 3) { | 
|---|
|  | 255 | goto L109; | 
|---|
|  | 256 | } | 
|---|
|  | 257 | ix2 = iw + idot; | 
|---|
|  | 258 | if (na != 0) { | 
|---|
|  | 259 | goto L107; | 
|---|
|  | 260 | } | 
|---|
|  | 261 | passf3_(&idot, &l1, &c__[1], &ch[1], &wa[iw], &wa[ix2]); | 
|---|
|  | 262 | goto L108; | 
|---|
|  | 263 | L107: | 
|---|
|  | 264 | passf3_(&idot, &l1, &ch[1], &c__[1], &wa[iw], &wa[ix2]); | 
|---|
|  | 265 | L108: | 
|---|
|  | 266 | na = 1 - na; | 
|---|
|  | 267 | goto L115; | 
|---|
|  | 268 | L109: | 
|---|
|  | 269 | if (ip != 5) { | 
|---|
|  | 270 | goto L112; | 
|---|
|  | 271 | } | 
|---|
|  | 272 | ix2 = iw + idot; | 
|---|
|  | 273 | ix3 = ix2 + idot; | 
|---|
|  | 274 | ix4 = ix3 + idot; | 
|---|
|  | 275 | if (na != 0) { | 
|---|
|  | 276 | goto L110; | 
|---|
|  | 277 | } | 
|---|
|  | 278 | passf5_(&idot, &l1, &c__[1], &ch[1], &wa[iw], &wa[ix2], &wa[ix3], &wa[ | 
|---|
|  | 279 | ix4]); | 
|---|
|  | 280 | goto L111; | 
|---|
|  | 281 | L110: | 
|---|
|  | 282 | passf5_(&idot, &l1, &ch[1], &c__[1], &wa[iw], &wa[ix2], &wa[ix3], &wa[ | 
|---|
|  | 283 | ix4]); | 
|---|
|  | 284 | L111: | 
|---|
|  | 285 | na = 1 - na; | 
|---|
|  | 286 | goto L115; | 
|---|
|  | 287 | L112: | 
|---|
|  | 288 | if (na != 0) { | 
|---|
|  | 289 | goto L113; | 
|---|
|  | 290 | } | 
|---|
|  | 291 | passf_(&nac, &idot, &ip, &l1, &idl1, &c__[1], &c__[1], &c__[1], &ch[1] | 
|---|
|  | 292 | , &ch[1], &wa[iw]); | 
|---|
|  | 293 | goto L114; | 
|---|
|  | 294 | L113: | 
|---|
|  | 295 | passf_(&nac, &idot, &ip, &l1, &idl1, &ch[1], &ch[1], &ch[1], &c__[1], | 
|---|
|  | 296 | &c__[1], &wa[iw]); | 
|---|
|  | 297 | L114: | 
|---|
|  | 298 | if (nac != 0) { | 
|---|
|  | 299 | na = 1 - na; | 
|---|
|  | 300 | } | 
|---|
|  | 301 | L115: | 
|---|
|  | 302 | l1 = l2; | 
|---|
|  | 303 | iw += (ip - 1) * idot; | 
|---|
|  | 304 | /* L116: */ | 
|---|
|  | 305 | } | 
|---|
|  | 306 | if (na == 0) { | 
|---|
|  | 307 | return 0; | 
|---|
|  | 308 | } | 
|---|
|  | 309 | n2 = *n + *n; | 
|---|
|  | 310 | i__1 = n2; | 
|---|
|  | 311 | for (i__ = 1; i__ <= i__1; ++i__) { | 
|---|
|  | 312 | c__[i__] = ch[i__]; | 
|---|
|  | 313 | /* L117: */ | 
|---|
|  | 314 | } | 
|---|
|  | 315 | return 0; | 
|---|
|  | 316 | } /* cfftf1_ */ | 
|---|
|  | 317 |  | 
|---|
|  | 318 | /*  ------ File cffti.f ------ */ | 
|---|
| [756] | 319 | /* Subroutine */ int cffti_(int_4 *n, r_4 *wsave) | 
|---|
| [459] | 320 | { | 
|---|
| [756] | 321 | extern /* Subroutine */ int cffti1_(int_4 *, r_4 *, int_4 *); | 
|---|
|  | 322 | static int_4 iw1, iw2; | 
|---|
| [459] | 323 |  | 
|---|
|  | 324 | /* Parameter adjustments */ | 
|---|
|  | 325 | --wsave; | 
|---|
|  | 326 |  | 
|---|
|  | 327 | /* Function Body */ | 
|---|
|  | 328 | if (*n == 1) { | 
|---|
|  | 329 | return 0; | 
|---|
|  | 330 | } | 
|---|
|  | 331 | iw1 = *n + *n + 1; | 
|---|
|  | 332 | iw2 = iw1 + *n + *n; | 
|---|
| [753] | 333 | cffti1_(n, &wsave[iw1], (int_4 *)&wsave[iw2]);  /*  (int *) ajoute Reza 29/11/99 */ | 
|---|
| [459] | 334 | return 0; | 
|---|
|  | 335 | } /* cffti_ */ | 
|---|
|  | 336 |  | 
|---|
|  | 337 | /*  ------ File cffti1.f ------ */ | 
|---|
| [756] | 338 | /* Subroutine */ int cffti1_(int_4 *n, r_4 *wa, int_4 *ifac) | 
|---|
| [459] | 339 | { | 
|---|
|  | 340 | /* Initialized data */ | 
|---|
|  | 341 |  | 
|---|
| [756] | 342 | static int_4 ntryh[4] = { 3,4,2,5 }; | 
|---|
| [459] | 343 |  | 
|---|
|  | 344 | /* System generated locals */ | 
|---|
| [756] | 345 | int_4 i__1, i__2, i__3; | 
|---|
| [459] | 346 |  | 
|---|
| [663] | 347 | /* Builtin functions */ | 
|---|
| [717] | 348 | /*    r_8 cos(r_8truc), sin(r_8truc);   commente, remplace par math.h - Reza  29/11/99 */ | 
|---|
| [459] | 349 |  | 
|---|
|  | 350 | /* Local variables */ | 
|---|
| [717] | 351 | static r_4 argh; | 
|---|
| [756] | 352 | static int_4 idot, ntry, i__, j; | 
|---|
| [717] | 353 | static r_4 argld; | 
|---|
| [756] | 354 | static int_4 i1, k1, l1, l2, ib; | 
|---|
| [717] | 355 | static r_4 fi; | 
|---|
| [756] | 356 | static int_4 ld, ii, nf, ip, nl, nq, nr; | 
|---|
| [717] | 357 | static r_4 arg; | 
|---|
| [756] | 358 | static int_4 ido, ipm; | 
|---|
| [717] | 359 | static r_4 tpi; | 
|---|
| [459] | 360 |  | 
|---|
|  | 361 | /* Parameter adjustments */ | 
|---|
|  | 362 | --ifac; | 
|---|
|  | 363 | --wa; | 
|---|
|  | 364 |  | 
|---|
|  | 365 | /* Function Body */ | 
|---|
|  | 366 | nl = *n; | 
|---|
|  | 367 | nf = 0; | 
|---|
|  | 368 | j = 0; | 
|---|
|  | 369 | L101: | 
|---|
|  | 370 | ++j; | 
|---|
|  | 371 | if (j - 4 <= 0) { | 
|---|
|  | 372 | goto L102; | 
|---|
|  | 373 | } else { | 
|---|
|  | 374 | goto L103; | 
|---|
|  | 375 | } | 
|---|
|  | 376 | L102: | 
|---|
|  | 377 | ntry = ntryh[j - 1]; | 
|---|
|  | 378 | goto L104; | 
|---|
|  | 379 | L103: | 
|---|
|  | 380 | ntry += 2; | 
|---|
|  | 381 | L104: | 
|---|
|  | 382 | nq = nl / ntry; | 
|---|
|  | 383 | nr = nl - ntry * nq; | 
|---|
|  | 384 | if (nr != 0) { | 
|---|
|  | 385 | goto L101; | 
|---|
|  | 386 | } else { | 
|---|
|  | 387 | goto L105; | 
|---|
|  | 388 | } | 
|---|
|  | 389 | L105: | 
|---|
|  | 390 | ++nf; | 
|---|
|  | 391 | ifac[nf + 2] = ntry; | 
|---|
|  | 392 | nl = nq; | 
|---|
|  | 393 | if (ntry != 2) { | 
|---|
|  | 394 | goto L107; | 
|---|
|  | 395 | } | 
|---|
|  | 396 | if (nf == 1) { | 
|---|
|  | 397 | goto L107; | 
|---|
|  | 398 | } | 
|---|
|  | 399 | i__1 = nf; | 
|---|
|  | 400 | for (i__ = 2; i__ <= i__1; ++i__) { | 
|---|
|  | 401 | ib = nf - i__ + 2; | 
|---|
|  | 402 | ifac[ib + 2] = ifac[ib + 1]; | 
|---|
|  | 403 | /* L106: */ | 
|---|
|  | 404 | } | 
|---|
|  | 405 | ifac[3] = 2; | 
|---|
|  | 406 | L107: | 
|---|
|  | 407 | if (nl != 1) { | 
|---|
|  | 408 | goto L104; | 
|---|
|  | 409 | } | 
|---|
|  | 410 | ifac[1] = *n; | 
|---|
|  | 411 | ifac[2] = nf; | 
|---|
|  | 412 | tpi = 6.28318530717959f; | 
|---|
| [717] | 413 | argh = tpi / (r_4) (*n); | 
|---|
| [459] | 414 | i__ = 2; | 
|---|
|  | 415 | l1 = 1; | 
|---|
|  | 416 | i__1 = nf; | 
|---|
|  | 417 | for (k1 = 1; k1 <= i__1; ++k1) { | 
|---|
|  | 418 | ip = ifac[k1 + 2]; | 
|---|
|  | 419 | ld = 0; | 
|---|
|  | 420 | l2 = l1 * ip; | 
|---|
|  | 421 | ido = *n / l2; | 
|---|
|  | 422 | idot = ido + ido + 2; | 
|---|
|  | 423 | ipm = ip - 1; | 
|---|
|  | 424 | i__2 = ipm; | 
|---|
|  | 425 | for (j = 1; j <= i__2; ++j) { | 
|---|
|  | 426 | i1 = i__; | 
|---|
|  | 427 | wa[i__ - 1] = 1.f; | 
|---|
|  | 428 | wa[i__] = 0.f; | 
|---|
|  | 429 | ld += l1; | 
|---|
|  | 430 | fi = 0.f; | 
|---|
| [717] | 431 | argld = (r_4) ld * argh; | 
|---|
| [459] | 432 | i__3 = idot; | 
|---|
|  | 433 | for (ii = 4; ii <= i__3; ii += 2) { | 
|---|
|  | 434 | i__ += 2; | 
|---|
|  | 435 | fi += 1.f; | 
|---|
|  | 436 | arg = fi * argld; | 
|---|
|  | 437 | wa[i__ - 1] = cos(arg); | 
|---|
|  | 438 | wa[i__] = sin(arg); | 
|---|
|  | 439 | /* L108: */ | 
|---|
|  | 440 | } | 
|---|
|  | 441 | if (ip <= 5) { | 
|---|
|  | 442 | goto L109; | 
|---|
|  | 443 | } | 
|---|
|  | 444 | wa[i1 - 1] = wa[i__ - 1]; | 
|---|
|  | 445 | wa[i1] = wa[i__]; | 
|---|
|  | 446 | L109: | 
|---|
|  | 447 | ; | 
|---|
|  | 448 | } | 
|---|
|  | 449 | l1 = l2; | 
|---|
|  | 450 | /* L110: */ | 
|---|
|  | 451 | } | 
|---|
|  | 452 | return 0; | 
|---|
|  | 453 | } /* cffti1_ */ | 
|---|
|  | 454 |  | 
|---|
|  | 455 | /*  ------ File cosqb.f ------ */ | 
|---|
| [756] | 456 | /* Subroutine */ int cosqb_(int_4 *n, r_4 *x, r_4 *wsave) | 
|---|
| [459] | 457 | { | 
|---|
|  | 458 | /* Initialized data */ | 
|---|
|  | 459 |  | 
|---|
| [717] | 460 | static r_4 tsqrt2 = 2.82842712474619f; | 
|---|
| [459] | 461 |  | 
|---|
|  | 462 | /* System generated locals */ | 
|---|
| [756] | 463 | int_4 i__1; | 
|---|
| [459] | 464 |  | 
|---|
|  | 465 | /* Local variables */ | 
|---|
| [717] | 466 | static r_4 x1; | 
|---|
| [756] | 467 | extern /* Subroutine */ int cosqb1_(int_4 *, r_4 *, r_4 *, r_4 *); | 
|---|
| [459] | 468 |  | 
|---|
|  | 469 | /* Parameter adjustments */ | 
|---|
|  | 470 | --wsave; | 
|---|
|  | 471 | --x; | 
|---|
|  | 472 |  | 
|---|
|  | 473 | /* Function Body */ | 
|---|
|  | 474 | if ((i__1 = *n - 2) < 0) { | 
|---|
|  | 475 | goto L101; | 
|---|
|  | 476 | } else if (i__1 == 0) { | 
|---|
|  | 477 | goto L102; | 
|---|
|  | 478 | } else { | 
|---|
|  | 479 | goto L103; | 
|---|
|  | 480 | } | 
|---|
|  | 481 | L101: | 
|---|
|  | 482 | x[1] *= 4.f; | 
|---|
|  | 483 | return 0; | 
|---|
|  | 484 | L102: | 
|---|
|  | 485 | x1 = (x[1] + x[2]) * 4.f; | 
|---|
|  | 486 | x[2] = tsqrt2 * (x[1] - x[2]); | 
|---|
|  | 487 | x[1] = x1; | 
|---|
|  | 488 | return 0; | 
|---|
|  | 489 | L103: | 
|---|
|  | 490 | cosqb1_(n, &x[1], &wsave[1], &wsave[*n + 1]); | 
|---|
|  | 491 | return 0; | 
|---|
|  | 492 | } /* cosqb_ */ | 
|---|
|  | 493 |  | 
|---|
|  | 494 | /*  ------ File cosqb1.f ------ */ | 
|---|
| [756] | 495 | /* Subroutine */ int cosqb1_(int_4 *n, r_4 *x, r_4 *w, r_4 *xh) | 
|---|
| [459] | 496 | { | 
|---|
|  | 497 | /* System generated locals */ | 
|---|
| [756] | 498 | int_4 i__1; | 
|---|
| [459] | 499 |  | 
|---|
|  | 500 | /* Local variables */ | 
|---|
| [756] | 501 | static int_4 modn, i__, k; | 
|---|
|  | 502 | extern /* Subroutine */ int rfftb_(int_4 *, r_4 *, r_4 *); | 
|---|
|  | 503 | static int_4 kc, np2, ns2; | 
|---|
| [717] | 504 | static r_4 xim1; | 
|---|
| [459] | 505 |  | 
|---|
|  | 506 | /* Parameter adjustments */ | 
|---|
|  | 507 | --xh; | 
|---|
|  | 508 | --w; | 
|---|
|  | 509 | --x; | 
|---|
|  | 510 |  | 
|---|
|  | 511 | /* Function Body */ | 
|---|
|  | 512 | ns2 = (*n + 1) / 2; | 
|---|
|  | 513 | np2 = *n + 2; | 
|---|
|  | 514 | i__1 = *n; | 
|---|
|  | 515 | for (i__ = 3; i__ <= i__1; i__ += 2) { | 
|---|
|  | 516 | xim1 = x[i__ - 1] + x[i__]; | 
|---|
|  | 517 | x[i__] -= x[i__ - 1]; | 
|---|
|  | 518 | x[i__ - 1] = xim1; | 
|---|
|  | 519 | /* L101: */ | 
|---|
|  | 520 | } | 
|---|
|  | 521 | x[1] += x[1]; | 
|---|
|  | 522 | modn = *n % 2; | 
|---|
|  | 523 | if (modn == 0) { | 
|---|
|  | 524 | x[*n] += x[*n]; | 
|---|
|  | 525 | } | 
|---|
|  | 526 | rfftb_(n, &x[1], &xh[1]); | 
|---|
|  | 527 | i__1 = ns2; | 
|---|
|  | 528 | for (k = 2; k <= i__1; ++k) { | 
|---|
|  | 529 | kc = np2 - k; | 
|---|
|  | 530 | xh[k] = w[k - 1] * x[kc] + w[kc - 1] * x[k]; | 
|---|
|  | 531 | xh[kc] = w[k - 1] * x[k] - w[kc - 1] * x[kc]; | 
|---|
|  | 532 | /* L102: */ | 
|---|
|  | 533 | } | 
|---|
|  | 534 | if (modn == 0) { | 
|---|
|  | 535 | x[ns2 + 1] = w[ns2] * (x[ns2 + 1] + x[ns2 + 1]); | 
|---|
|  | 536 | } | 
|---|
|  | 537 | i__1 = ns2; | 
|---|
|  | 538 | for (k = 2; k <= i__1; ++k) { | 
|---|
|  | 539 | kc = np2 - k; | 
|---|
|  | 540 | x[k] = xh[k] + xh[kc]; | 
|---|
|  | 541 | x[kc] = xh[k] - xh[kc]; | 
|---|
|  | 542 | /* L103: */ | 
|---|
|  | 543 | } | 
|---|
|  | 544 | x[1] += x[1]; | 
|---|
|  | 545 | return 0; | 
|---|
|  | 546 | } /* cosqb1_ */ | 
|---|
|  | 547 |  | 
|---|
|  | 548 | /*  ------ File cosqf.f ------ */ | 
|---|
| [756] | 549 | /* Subroutine */ int cosqf_(int_4 *n, r_4 *x, r_4 *wsave) | 
|---|
| [459] | 550 | { | 
|---|
|  | 551 | /* Initialized data */ | 
|---|
|  | 552 |  | 
|---|
| [717] | 553 | static r_4 sqrt2 = 1.4142135623731f; | 
|---|
| [459] | 554 |  | 
|---|
|  | 555 | /* System generated locals */ | 
|---|
| [756] | 556 | int_4 i__1; | 
|---|
| [459] | 557 |  | 
|---|
|  | 558 | /* Local variables */ | 
|---|
| [717] | 559 | static r_4 tsqx; | 
|---|
| [756] | 560 | extern /* Subroutine */ int cosqf1_(int_4 *, r_4 *, r_4 *, r_4 *); | 
|---|
| [459] | 561 |  | 
|---|
|  | 562 | /* Parameter adjustments */ | 
|---|
|  | 563 | --wsave; | 
|---|
|  | 564 | --x; | 
|---|
|  | 565 |  | 
|---|
|  | 566 | /* Function Body */ | 
|---|
|  | 567 | if ((i__1 = *n - 2) < 0) { | 
|---|
|  | 568 | goto L102; | 
|---|
|  | 569 | } else if (i__1 == 0) { | 
|---|
|  | 570 | goto L101; | 
|---|
|  | 571 | } else { | 
|---|
|  | 572 | goto L103; | 
|---|
|  | 573 | } | 
|---|
|  | 574 | L101: | 
|---|
|  | 575 | tsqx = sqrt2 * x[2]; | 
|---|
|  | 576 | x[2] = x[1] - tsqx; | 
|---|
|  | 577 | x[1] += tsqx; | 
|---|
|  | 578 | L102: | 
|---|
|  | 579 | return 0; | 
|---|
|  | 580 | L103: | 
|---|
|  | 581 | cosqf1_(n, &x[1], &wsave[1], &wsave[*n + 1]); | 
|---|
|  | 582 | return 0; | 
|---|
|  | 583 | } /* cosqf_ */ | 
|---|
|  | 584 |  | 
|---|
|  | 585 | /*  ------ File cosqf1.f ------ */ | 
|---|
| [756] | 586 | /* Subroutine */ int cosqf1_(int_4 *n, r_4 *x, r_4 *w, r_4 *xh) | 
|---|
| [459] | 587 | { | 
|---|
|  | 588 | /* System generated locals */ | 
|---|
| [756] | 589 | int_4 i__1; | 
|---|
| [459] | 590 |  | 
|---|
|  | 591 | /* Local variables */ | 
|---|
| [756] | 592 | static int_4 modn, i__, k; | 
|---|
|  | 593 | extern /* Subroutine */ int rfftf_(int_4 *, r_4 *, r_4 *); | 
|---|
|  | 594 | static int_4 kc, np2, ns2; | 
|---|
| [717] | 595 | static r_4 xim1; | 
|---|
| [459] | 596 |  | 
|---|
|  | 597 | /* Parameter adjustments */ | 
|---|
|  | 598 | --xh; | 
|---|
|  | 599 | --w; | 
|---|
|  | 600 | --x; | 
|---|
|  | 601 |  | 
|---|
|  | 602 | /* Function Body */ | 
|---|
|  | 603 | ns2 = (*n + 1) / 2; | 
|---|
|  | 604 | np2 = *n + 2; | 
|---|
|  | 605 | i__1 = ns2; | 
|---|
|  | 606 | for (k = 2; k <= i__1; ++k) { | 
|---|
|  | 607 | kc = np2 - k; | 
|---|
|  | 608 | xh[k] = x[k] + x[kc]; | 
|---|
|  | 609 | xh[kc] = x[k] - x[kc]; | 
|---|
|  | 610 | /* L101: */ | 
|---|
|  | 611 | } | 
|---|
|  | 612 | modn = *n % 2; | 
|---|
|  | 613 | if (modn == 0) { | 
|---|
|  | 614 | xh[ns2 + 1] = x[ns2 + 1] + x[ns2 + 1]; | 
|---|
|  | 615 | } | 
|---|
|  | 616 | i__1 = ns2; | 
|---|
|  | 617 | for (k = 2; k <= i__1; ++k) { | 
|---|
|  | 618 | kc = np2 - k; | 
|---|
|  | 619 | x[k] = w[k - 1] * xh[kc] + w[kc - 1] * xh[k]; | 
|---|
|  | 620 | x[kc] = w[k - 1] * xh[k] - w[kc - 1] * xh[kc]; | 
|---|
|  | 621 | /* L102: */ | 
|---|
|  | 622 | } | 
|---|
|  | 623 | if (modn == 0) { | 
|---|
|  | 624 | x[ns2 + 1] = w[ns2] * xh[ns2 + 1]; | 
|---|
|  | 625 | } | 
|---|
|  | 626 | rfftf_(n, &x[1], &xh[1]); | 
|---|
|  | 627 | i__1 = *n; | 
|---|
|  | 628 | for (i__ = 3; i__ <= i__1; i__ += 2) { | 
|---|
|  | 629 | xim1 = x[i__ - 1] - x[i__]; | 
|---|
|  | 630 | x[i__] = x[i__ - 1] + x[i__]; | 
|---|
|  | 631 | x[i__ - 1] = xim1; | 
|---|
|  | 632 | /* L103: */ | 
|---|
|  | 633 | } | 
|---|
|  | 634 | return 0; | 
|---|
|  | 635 | } /* cosqf1_ */ | 
|---|
|  | 636 |  | 
|---|
|  | 637 | /*  ------ File cosqi.f ------ */ | 
|---|
| [756] | 638 | /* Subroutine */ int cosqi_(int_4 *n, r_4 *wsave) | 
|---|
| [459] | 639 | { | 
|---|
|  | 640 | /* Initialized data */ | 
|---|
|  | 641 |  | 
|---|
| [717] | 642 | static r_4 pih = 1.57079632679491f; | 
|---|
| [459] | 643 |  | 
|---|
|  | 644 | /* System generated locals */ | 
|---|
| [756] | 645 | int_4 i__1; | 
|---|
| [459] | 646 |  | 
|---|
|  | 647 | /* Builtin functions */ | 
|---|
| [717] | 648 | /*    r_8 cos(r_8truc);    commente - Remplace par math.h  Reza 29/11/99 */ | 
|---|
| [459] | 649 |  | 
|---|
|  | 650 | /* Local variables */ | 
|---|
| [756] | 651 | static int_4 k; | 
|---|
|  | 652 | extern /* Subroutine */ int rffti_(int_4 *, r_4 *); | 
|---|
| [717] | 653 | static r_4 fk, dt; | 
|---|
| [459] | 654 |  | 
|---|
|  | 655 | /* Parameter adjustments */ | 
|---|
|  | 656 | --wsave; | 
|---|
|  | 657 |  | 
|---|
|  | 658 | /* Function Body */ | 
|---|
| [717] | 659 | dt = pih / (r_4) (*n); | 
|---|
| [459] | 660 | fk = 0.f; | 
|---|
|  | 661 | i__1 = *n; | 
|---|
|  | 662 | for (k = 1; k <= i__1; ++k) { | 
|---|
|  | 663 | fk += 1.f; | 
|---|
|  | 664 | wsave[k] = cos(fk * dt); | 
|---|
|  | 665 | /* L101: */ | 
|---|
|  | 666 | } | 
|---|
|  | 667 | rffti_(n, &wsave[*n + 1]); | 
|---|
|  | 668 | return 0; | 
|---|
|  | 669 | } /* cosqi_ */ | 
|---|
|  | 670 |  | 
|---|
|  | 671 | /*  ------ File cost.f ------ */ | 
|---|
| [756] | 672 | /* Subroutine */ int cost_(int_4 *n, r_4 *x, r_4 *wsave) | 
|---|
| [459] | 673 | { | 
|---|
|  | 674 | /* System generated locals */ | 
|---|
| [756] | 675 | int_4 i__1; | 
|---|
| [459] | 676 |  | 
|---|
|  | 677 | /* Local variables */ | 
|---|
| [756] | 678 | static int_4 modn, i__, k; | 
|---|
|  | 679 | extern /* Subroutine */ int rfftf_(int_4 *, r_4 *, r_4 *); | 
|---|
| [717] | 680 | static r_4 c1, t1, t2; | 
|---|
| [756] | 681 | static int_4 kc; | 
|---|
| [717] | 682 | static r_4 xi; | 
|---|
| [756] | 683 | static int_4 nm1, np1; | 
|---|
| [717] | 684 | static r_4 x1h; | 
|---|
| [756] | 685 | static int_4 ns2; | 
|---|
| [717] | 686 | static r_4 tx2, x1p3, xim2; | 
|---|
| [459] | 687 |  | 
|---|
|  | 688 | /* Parameter adjustments */ | 
|---|
|  | 689 | --wsave; | 
|---|
|  | 690 | --x; | 
|---|
|  | 691 |  | 
|---|
|  | 692 | /* Function Body */ | 
|---|
|  | 693 | nm1 = *n - 1; | 
|---|
|  | 694 | np1 = *n + 1; | 
|---|
|  | 695 | ns2 = *n / 2; | 
|---|
|  | 696 | if ((i__1 = *n - 2) < 0) { | 
|---|
|  | 697 | goto L106; | 
|---|
|  | 698 | } else if (i__1 == 0) { | 
|---|
|  | 699 | goto L101; | 
|---|
|  | 700 | } else { | 
|---|
|  | 701 | goto L102; | 
|---|
|  | 702 | } | 
|---|
|  | 703 | L101: | 
|---|
|  | 704 | x1h = x[1] + x[2]; | 
|---|
|  | 705 | x[2] = x[1] - x[2]; | 
|---|
|  | 706 | x[1] = x1h; | 
|---|
|  | 707 | return 0; | 
|---|
|  | 708 | L102: | 
|---|
|  | 709 | if (*n > 3) { | 
|---|
|  | 710 | goto L103; | 
|---|
|  | 711 | } | 
|---|
|  | 712 | x1p3 = x[1] + x[3]; | 
|---|
|  | 713 | tx2 = x[2] + x[2]; | 
|---|
|  | 714 | x[2] = x[1] - x[3]; | 
|---|
|  | 715 | x[1] = x1p3 + tx2; | 
|---|
|  | 716 | x[3] = x1p3 - tx2; | 
|---|
|  | 717 | return 0; | 
|---|
|  | 718 | L103: | 
|---|
|  | 719 | c1 = x[1] - x[*n]; | 
|---|
|  | 720 | x[1] += x[*n]; | 
|---|
|  | 721 | i__1 = ns2; | 
|---|
|  | 722 | for (k = 2; k <= i__1; ++k) { | 
|---|
|  | 723 | kc = np1 - k; | 
|---|
|  | 724 | t1 = x[k] + x[kc]; | 
|---|
|  | 725 | t2 = x[k] - x[kc]; | 
|---|
|  | 726 | c1 += wsave[kc] * t2; | 
|---|
|  | 727 | t2 = wsave[k] * t2; | 
|---|
|  | 728 | x[k] = t1 - t2; | 
|---|
|  | 729 | x[kc] = t1 + t2; | 
|---|
|  | 730 | /* L104: */ | 
|---|
|  | 731 | } | 
|---|
|  | 732 | modn = *n % 2; | 
|---|
|  | 733 | if (modn != 0) { | 
|---|
|  | 734 | x[ns2 + 1] += x[ns2 + 1]; | 
|---|
|  | 735 | } | 
|---|
|  | 736 | rfftf_(&nm1, &x[1], &wsave[*n + 1]); | 
|---|
|  | 737 | xim2 = x[2]; | 
|---|
|  | 738 | x[2] = c1; | 
|---|
|  | 739 | i__1 = *n; | 
|---|
|  | 740 | for (i__ = 4; i__ <= i__1; i__ += 2) { | 
|---|
|  | 741 | xi = x[i__]; | 
|---|
|  | 742 | x[i__] = x[i__ - 2] - x[i__ - 1]; | 
|---|
|  | 743 | x[i__ - 1] = xim2; | 
|---|
|  | 744 | xim2 = xi; | 
|---|
|  | 745 | /* L105: */ | 
|---|
|  | 746 | } | 
|---|
|  | 747 | if (modn != 0) { | 
|---|
|  | 748 | x[*n] = xim2; | 
|---|
|  | 749 | } | 
|---|
|  | 750 | L106: | 
|---|
|  | 751 | return 0; | 
|---|
|  | 752 | } /* cost_ */ | 
|---|
|  | 753 |  | 
|---|
|  | 754 | /*  ------ File costi.f ------ */ | 
|---|
| [756] | 755 | /* Subroutine */ int costi_(int_4 *n, r_4 *wsave) | 
|---|
| [459] | 756 | { | 
|---|
|  | 757 | /* Initialized data */ | 
|---|
|  | 758 |  | 
|---|
| [717] | 759 | static r_4 pi = 3.14159265358979f; | 
|---|
| [459] | 760 |  | 
|---|
|  | 761 | /* System generated locals */ | 
|---|
| [756] | 762 | int_4 i__1; | 
|---|
| [459] | 763 |  | 
|---|
|  | 764 | /* Builtin functions */ | 
|---|
| [717] | 765 | /*    r_8 sin(r_8truc), cos(r_8truc);  commente - Remplace par math.h  Reza 29/11/99 */ | 
|---|
| [459] | 766 |  | 
|---|
|  | 767 | /* Local variables */ | 
|---|
| [756] | 768 | static int_4 k; | 
|---|
|  | 769 | extern /* Subroutine */ int rffti_(int_4 *, r_4 *); | 
|---|
|  | 770 | static int_4 kc; | 
|---|
| [717] | 771 | static r_4 fk, dt; | 
|---|
| [756] | 772 | static int_4 nm1, np1, ns2; | 
|---|
| [459] | 773 |  | 
|---|
|  | 774 | /* Parameter adjustments */ | 
|---|
|  | 775 | --wsave; | 
|---|
|  | 776 |  | 
|---|
|  | 777 | /* Function Body */ | 
|---|
|  | 778 | if (*n <= 3) { | 
|---|
|  | 779 | return 0; | 
|---|
|  | 780 | } | 
|---|
|  | 781 | nm1 = *n - 1; | 
|---|
|  | 782 | np1 = *n + 1; | 
|---|
|  | 783 | ns2 = *n / 2; | 
|---|
| [717] | 784 | dt = pi / (r_4) nm1; | 
|---|
| [459] | 785 | fk = 0.f; | 
|---|
|  | 786 | i__1 = ns2; | 
|---|
|  | 787 | for (k = 2; k <= i__1; ++k) { | 
|---|
|  | 788 | kc = np1 - k; | 
|---|
|  | 789 | fk += 1.f; | 
|---|
|  | 790 | wsave[k] = sin(fk * dt) * 2.f; | 
|---|
|  | 791 | wsave[kc] = cos(fk * dt) * 2.f; | 
|---|
|  | 792 | /* L101: */ | 
|---|
|  | 793 | } | 
|---|
|  | 794 | rffti_(&nm1, &wsave[*n + 1]); | 
|---|
|  | 795 | return 0; | 
|---|
|  | 796 | } /* costi_ */ | 
|---|
|  | 797 |  | 
|---|
|  | 798 | /*  ------ File ezfft1.f ------ */ | 
|---|
| [756] | 799 | /* Subroutine */ int ezfft1_(int_4 *n, r_4 *wa, int_4 *ifac) | 
|---|
| [459] | 800 | { | 
|---|
|  | 801 | /* Initialized data */ | 
|---|
|  | 802 |  | 
|---|
| [756] | 803 | static int_4 ntryh[4] = { 4,2,3,5 }; | 
|---|
| [717] | 804 | static r_4 tpi = 6.28318530717959f; | 
|---|
| [459] | 805 |  | 
|---|
|  | 806 | /* System generated locals */ | 
|---|
| [756] | 807 | int_4 i__1, i__2, i__3; | 
|---|
| [459] | 808 |  | 
|---|
|  | 809 | /* Builtin functions */ | 
|---|
| [717] | 810 | /*    r_8 cos(r_8truc), sin(r_8truc);  commente - Remplace par math.h  Reza 29/11/99 */ | 
|---|
| [459] | 811 |  | 
|---|
|  | 812 | /* Local variables */ | 
|---|
| [717] | 813 | static r_4 argh; | 
|---|
| [756] | 814 | static int_4 ntry, i__, j, k1, l1, l2, ib, ii, nf, ip, nl, is, nq, nr; | 
|---|
| [717] | 815 | static r_4 ch1, sh1; | 
|---|
| [756] | 816 | static int_4 ido, ipm; | 
|---|
| [717] | 817 | static r_4 dch1, ch1h, arg1, dsh1; | 
|---|
| [756] | 818 | static int_4 nfm1; | 
|---|
| [459] | 819 |  | 
|---|
|  | 820 | /* Parameter adjustments */ | 
|---|
|  | 821 | --ifac; | 
|---|
|  | 822 | --wa; | 
|---|
|  | 823 |  | 
|---|
|  | 824 | /* Function Body */ | 
|---|
|  | 825 | nl = *n; | 
|---|
|  | 826 | nf = 0; | 
|---|
|  | 827 | j = 0; | 
|---|
|  | 828 | L101: | 
|---|
|  | 829 | ++j; | 
|---|
|  | 830 | if (j - 4 <= 0) { | 
|---|
|  | 831 | goto L102; | 
|---|
|  | 832 | } else { | 
|---|
|  | 833 | goto L103; | 
|---|
|  | 834 | } | 
|---|
|  | 835 | L102: | 
|---|
|  | 836 | ntry = ntryh[j - 1]; | 
|---|
|  | 837 | goto L104; | 
|---|
|  | 838 | L103: | 
|---|
|  | 839 | ntry += 2; | 
|---|
|  | 840 | L104: | 
|---|
|  | 841 | nq = nl / ntry; | 
|---|
|  | 842 | nr = nl - ntry * nq; | 
|---|
|  | 843 | if (nr != 0) { | 
|---|
|  | 844 | goto L101; | 
|---|
|  | 845 | } else { | 
|---|
|  | 846 | goto L105; | 
|---|
|  | 847 | } | 
|---|
|  | 848 | L105: | 
|---|
|  | 849 | ++nf; | 
|---|
|  | 850 | ifac[nf + 2] = ntry; | 
|---|
|  | 851 | nl = nq; | 
|---|
|  | 852 | if (ntry != 2) { | 
|---|
|  | 853 | goto L107; | 
|---|
|  | 854 | } | 
|---|
|  | 855 | if (nf == 1) { | 
|---|
|  | 856 | goto L107; | 
|---|
|  | 857 | } | 
|---|
|  | 858 | i__1 = nf; | 
|---|
|  | 859 | for (i__ = 2; i__ <= i__1; ++i__) { | 
|---|
|  | 860 | ib = nf - i__ + 2; | 
|---|
|  | 861 | ifac[ib + 2] = ifac[ib + 1]; | 
|---|
|  | 862 | /* L106: */ | 
|---|
|  | 863 | } | 
|---|
|  | 864 | ifac[3] = 2; | 
|---|
|  | 865 | L107: | 
|---|
|  | 866 | if (nl != 1) { | 
|---|
|  | 867 | goto L104; | 
|---|
|  | 868 | } | 
|---|
|  | 869 | ifac[1] = *n; | 
|---|
|  | 870 | ifac[2] = nf; | 
|---|
| [717] | 871 | argh = tpi / (r_4) (*n); | 
|---|
| [459] | 872 | is = 0; | 
|---|
|  | 873 | nfm1 = nf - 1; | 
|---|
|  | 874 | l1 = 1; | 
|---|
|  | 875 | if (nfm1 == 0) { | 
|---|
|  | 876 | return 0; | 
|---|
|  | 877 | } | 
|---|
|  | 878 | i__1 = nfm1; | 
|---|
|  | 879 | for (k1 = 1; k1 <= i__1; ++k1) { | 
|---|
|  | 880 | ip = ifac[k1 + 2]; | 
|---|
|  | 881 | l2 = l1 * ip; | 
|---|
|  | 882 | ido = *n / l2; | 
|---|
|  | 883 | ipm = ip - 1; | 
|---|
| [717] | 884 | arg1 = (r_4) l1 * argh; | 
|---|
| [459] | 885 | ch1 = 1.f; | 
|---|
|  | 886 | sh1 = 0.f; | 
|---|
|  | 887 | dch1 = cos(arg1); | 
|---|
|  | 888 | dsh1 = sin(arg1); | 
|---|
|  | 889 | i__2 = ipm; | 
|---|
|  | 890 | for (j = 1; j <= i__2; ++j) { | 
|---|
|  | 891 | ch1h = dch1 * ch1 - dsh1 * sh1; | 
|---|
|  | 892 | sh1 = dch1 * sh1 + dsh1 * ch1; | 
|---|
|  | 893 | ch1 = ch1h; | 
|---|
|  | 894 | i__ = is + 2; | 
|---|
|  | 895 | wa[i__ - 1] = ch1; | 
|---|
|  | 896 | wa[i__] = sh1; | 
|---|
|  | 897 | if (ido < 5) { | 
|---|
|  | 898 | goto L109; | 
|---|
|  | 899 | } | 
|---|
|  | 900 | i__3 = ido; | 
|---|
|  | 901 | for (ii = 5; ii <= i__3; ii += 2) { | 
|---|
|  | 902 | i__ += 2; | 
|---|
|  | 903 | wa[i__ - 1] = ch1 * wa[i__ - 3] - sh1 * wa[i__ - 2]; | 
|---|
|  | 904 | wa[i__] = ch1 * wa[i__ - 2] + sh1 * wa[i__ - 3]; | 
|---|
|  | 905 | /* L108: */ | 
|---|
|  | 906 | } | 
|---|
|  | 907 | L109: | 
|---|
|  | 908 | is += ido; | 
|---|
|  | 909 | /* L110: */ | 
|---|
|  | 910 | } | 
|---|
|  | 911 | l1 = l2; | 
|---|
|  | 912 | /* L111: */ | 
|---|
|  | 913 | } | 
|---|
|  | 914 | return 0; | 
|---|
|  | 915 | } /* ezfft1_ */ | 
|---|
|  | 916 |  | 
|---|
|  | 917 | /*  ------ File ezfftb.f ------ */ | 
|---|
| [756] | 918 | /* Subroutine */ int ezfftb_(int_4 *n, r_4 *r__, r_4 *azero, r_4 *a, | 
|---|
| [717] | 919 | r_4 *b, r_4 *wsave) | 
|---|
| [459] | 920 | { | 
|---|
|  | 921 | /* System generated locals */ | 
|---|
| [756] | 922 | int_4 i__1; | 
|---|
| [459] | 923 |  | 
|---|
|  | 924 | /* Local variables */ | 
|---|
| [756] | 925 | static int_4 i__; | 
|---|
|  | 926 | extern /* Subroutine */ int rfftb_(int_4 *, r_4 *, r_4 *); | 
|---|
|  | 927 | static int_4 ns2; | 
|---|
| [459] | 928 |  | 
|---|
|  | 929 | /* Parameter adjustments */ | 
|---|
|  | 930 | --wsave; | 
|---|
|  | 931 | --b; | 
|---|
|  | 932 | --a; | 
|---|
|  | 933 | --r__; | 
|---|
|  | 934 |  | 
|---|
|  | 935 | /* Function Body */ | 
|---|
|  | 936 | if ((i__1 = *n - 2) < 0) { | 
|---|
|  | 937 | goto L101; | 
|---|
|  | 938 | } else if (i__1 == 0) { | 
|---|
|  | 939 | goto L102; | 
|---|
|  | 940 | } else { | 
|---|
|  | 941 | goto L103; | 
|---|
|  | 942 | } | 
|---|
|  | 943 | L101: | 
|---|
|  | 944 | r__[1] = *azero; | 
|---|
|  | 945 | return 0; | 
|---|
|  | 946 | L102: | 
|---|
|  | 947 | r__[1] = *azero + a[1]; | 
|---|
|  | 948 | r__[2] = *azero - a[1]; | 
|---|
|  | 949 | return 0; | 
|---|
|  | 950 | L103: | 
|---|
|  | 951 | ns2 = (*n - 1) / 2; | 
|---|
|  | 952 | i__1 = ns2; | 
|---|
|  | 953 | for (i__ = 1; i__ <= i__1; ++i__) { | 
|---|
|  | 954 | r__[i__ * 2] = a[i__] * .5f; | 
|---|
|  | 955 | r__[(i__ << 1) + 1] = b[i__] * -.5f; | 
|---|
|  | 956 | /* L104: */ | 
|---|
|  | 957 | } | 
|---|
|  | 958 | r__[1] = *azero; | 
|---|
|  | 959 | if (*n % 2 == 0) { | 
|---|
|  | 960 | r__[*n] = a[ns2 + 1]; | 
|---|
|  | 961 | } | 
|---|
|  | 962 | rfftb_(n, &r__[1], &wsave[*n + 1]); | 
|---|
|  | 963 | return 0; | 
|---|
|  | 964 | } /* ezfftb_ */ | 
|---|
|  | 965 |  | 
|---|
|  | 966 | /*  ------ File ezfftf.f ------ */ | 
|---|
| [756] | 967 | /* Subroutine */ int ezfftf_(int_4 *n, r_4 *r__, r_4 *azero, r_4 *a, | 
|---|
| [717] | 968 | r_4 *b, r_4 *wsave) | 
|---|
| [459] | 969 | { | 
|---|
|  | 970 | /* System generated locals */ | 
|---|
| [756] | 971 | int_4 i__1; | 
|---|
| [459] | 972 |  | 
|---|
|  | 973 | /* Local variables */ | 
|---|
| [756] | 974 | static int_4 i__; | 
|---|
|  | 975 | extern /* Subroutine */ int rfftf_(int_4 *, r_4 *, r_4 *); | 
|---|
| [717] | 976 | static r_4 cf; | 
|---|
| [756] | 977 | static int_4 ns2; | 
|---|
| [717] | 978 | static r_4 cfm; | 
|---|
| [756] | 979 | static int_4 ns2m; | 
|---|
| [459] | 980 |  | 
|---|
|  | 981 |  | 
|---|
|  | 982 | /*                       VERSION 3  JUNE 1979 */ | 
|---|
|  | 983 |  | 
|---|
|  | 984 | /* Parameter adjustments */ | 
|---|
|  | 985 | --wsave; | 
|---|
|  | 986 | --b; | 
|---|
|  | 987 | --a; | 
|---|
|  | 988 | --r__; | 
|---|
|  | 989 |  | 
|---|
|  | 990 | /* Function Body */ | 
|---|
|  | 991 | if ((i__1 = *n - 2) < 0) { | 
|---|
|  | 992 | goto L101; | 
|---|
|  | 993 | } else if (i__1 == 0) { | 
|---|
|  | 994 | goto L102; | 
|---|
|  | 995 | } else { | 
|---|
|  | 996 | goto L103; | 
|---|
|  | 997 | } | 
|---|
|  | 998 | L101: | 
|---|
|  | 999 | *azero = r__[1]; | 
|---|
|  | 1000 | return 0; | 
|---|
|  | 1001 | L102: | 
|---|
|  | 1002 | *azero = (r__[1] + r__[2]) * .5f; | 
|---|
|  | 1003 | a[1] = (r__[1] - r__[2]) * .5f; | 
|---|
|  | 1004 | return 0; | 
|---|
|  | 1005 | L103: | 
|---|
|  | 1006 | i__1 = *n; | 
|---|
|  | 1007 | for (i__ = 1; i__ <= i__1; ++i__) { | 
|---|
|  | 1008 | wsave[i__] = r__[i__]; | 
|---|
|  | 1009 | /* L104: */ | 
|---|
|  | 1010 | } | 
|---|
|  | 1011 | rfftf_(n, &wsave[1], &wsave[*n + 1]); | 
|---|
| [717] | 1012 | cf = 2.f / (r_4) (*n); | 
|---|
| [459] | 1013 | cfm = -cf; | 
|---|
|  | 1014 | *azero = cf * .5f * wsave[1]; | 
|---|
|  | 1015 | ns2 = (*n + 1) / 2; | 
|---|
|  | 1016 | ns2m = ns2 - 1; | 
|---|
|  | 1017 | i__1 = ns2m; | 
|---|
|  | 1018 | for (i__ = 1; i__ <= i__1; ++i__) { | 
|---|
|  | 1019 | a[i__] = cf * wsave[i__ * 2]; | 
|---|
|  | 1020 | b[i__] = cfm * wsave[(i__ << 1) + 1]; | 
|---|
|  | 1021 | /* L105: */ | 
|---|
|  | 1022 | } | 
|---|
|  | 1023 | if (*n % 2 == 1) { | 
|---|
|  | 1024 | return 0; | 
|---|
|  | 1025 | } | 
|---|
|  | 1026 | a[ns2] = cf * .5f * wsave[*n]; | 
|---|
|  | 1027 | b[ns2] = 0.f; | 
|---|
|  | 1028 | return 0; | 
|---|
|  | 1029 | } /* ezfftf_ */ | 
|---|
|  | 1030 |  | 
|---|
|  | 1031 | /*  ------ File ezffti.f ------ */ | 
|---|
| [756] | 1032 | /* Subroutine */ int ezffti_(int_4 *n, r_4 *wsave) | 
|---|
| [459] | 1033 | { | 
|---|
| [756] | 1034 | extern /* Subroutine */ int ezfft1_(int_4 *, r_4 *, int_4 *); | 
|---|
| [459] | 1035 |  | 
|---|
|  | 1036 | /* Parameter adjustments */ | 
|---|
|  | 1037 | --wsave; | 
|---|
|  | 1038 |  | 
|---|
|  | 1039 | /* Function Body */ | 
|---|
|  | 1040 | if (*n == 1) { | 
|---|
|  | 1041 | return 0; | 
|---|
|  | 1042 | } | 
|---|
| [753] | 1043 | ezfft1_(n, &wsave[(*n << 1) + 1], (int_4*)&wsave[*n * 3 + 1]); | 
|---|
| [459] | 1044 | return 0; | 
|---|
|  | 1045 | } /* ezffti_ */ | 
|---|
|  | 1046 |  | 
|---|
|  | 1047 | /*  ------ File passb.f ------ */ | 
|---|
| [756] | 1048 | /* Subroutine */ int passb_(int_4 *nac, int_4 *ido, int_4 *ip, int_4 * | 
|---|
|  | 1049 | l1, int_4 *idl1, r_4 *cc, r_4 *c1, r_4 *c2, r_4 *ch, r_4 *ch2, | 
|---|
| [717] | 1050 | r_4 *wa) | 
|---|
| [459] | 1051 | { | 
|---|
|  | 1052 | /* System generated locals */ | 
|---|
| [756] | 1053 | int_4 ch_dim1, ch_dim2, ch_offset, cc_dim1, cc_dim2, cc_offset, c1_dim1, | 
|---|
| [459] | 1054 | c1_dim2, c1_offset, c2_dim1, c2_offset, ch2_dim1, ch2_offset, | 
|---|
|  | 1055 | i__1, i__2, i__3; | 
|---|
|  | 1056 |  | 
|---|
|  | 1057 | /* Local variables */ | 
|---|
| [756] | 1058 | static int_4 idij, idlj, idot, ipph, i__, j, k, l, jc, lc, ik, nt, idj, | 
|---|
| [459] | 1059 | idl, inc, idp; | 
|---|
| [717] | 1060 | static r_4 wai, war; | 
|---|
| [756] | 1061 | static int_4 ipp2; | 
|---|
| [459] | 1062 |  | 
|---|
|  | 1063 | /* Parameter adjustments */ | 
|---|
|  | 1064 | ch_dim1 = *ido; | 
|---|
|  | 1065 | ch_dim2 = *l1; | 
|---|
|  | 1066 | ch_offset = ch_dim1 * (ch_dim2 + 1) + 1; | 
|---|
|  | 1067 | ch -= ch_offset; | 
|---|
|  | 1068 | c1_dim1 = *ido; | 
|---|
|  | 1069 | c1_dim2 = *l1; | 
|---|
|  | 1070 | c1_offset = c1_dim1 * (c1_dim2 + 1) + 1; | 
|---|
|  | 1071 | c1 -= c1_offset; | 
|---|
|  | 1072 | cc_dim1 = *ido; | 
|---|
|  | 1073 | cc_dim2 = *ip; | 
|---|
|  | 1074 | cc_offset = cc_dim1 * (cc_dim2 + 1) + 1; | 
|---|
|  | 1075 | cc -= cc_offset; | 
|---|
|  | 1076 | ch2_dim1 = *idl1; | 
|---|
|  | 1077 | ch2_offset = ch2_dim1 + 1; | 
|---|
|  | 1078 | ch2 -= ch2_offset; | 
|---|
|  | 1079 | c2_dim1 = *idl1; | 
|---|
|  | 1080 | c2_offset = c2_dim1 + 1; | 
|---|
|  | 1081 | c2 -= c2_offset; | 
|---|
|  | 1082 | --wa; | 
|---|
|  | 1083 |  | 
|---|
|  | 1084 | /* Function Body */ | 
|---|
|  | 1085 | idot = *ido / 2; | 
|---|
|  | 1086 | nt = *ip * *idl1; | 
|---|
|  | 1087 | ipp2 = *ip + 2; | 
|---|
|  | 1088 | ipph = (*ip + 1) / 2; | 
|---|
|  | 1089 | idp = *ip * *ido; | 
|---|
|  | 1090 |  | 
|---|
|  | 1091 | if (*ido < *l1) { | 
|---|
|  | 1092 | goto L106; | 
|---|
|  | 1093 | } | 
|---|
|  | 1094 | i__1 = ipph; | 
|---|
|  | 1095 | for (j = 2; j <= i__1; ++j) { | 
|---|
|  | 1096 | jc = ipp2 - j; | 
|---|
|  | 1097 | i__2 = *l1; | 
|---|
|  | 1098 | for (k = 1; k <= i__2; ++k) { | 
|---|
|  | 1099 | i__3 = *ido; | 
|---|
|  | 1100 | for (i__ = 1; i__ <= i__3; ++i__) { | 
|---|
|  | 1101 | ch[i__ + (k + j * ch_dim2) * ch_dim1] = cc[i__ + (j + k * | 
|---|
|  | 1102 | cc_dim2) * cc_dim1] + cc[i__ + (jc + k * cc_dim2) * | 
|---|
|  | 1103 | cc_dim1]; | 
|---|
|  | 1104 | ch[i__ + (k + jc * ch_dim2) * ch_dim1] = cc[i__ + (j + k * | 
|---|
|  | 1105 | cc_dim2) * cc_dim1] - cc[i__ + (jc + k * cc_dim2) * | 
|---|
|  | 1106 | cc_dim1]; | 
|---|
|  | 1107 | /* L101: */ | 
|---|
|  | 1108 | } | 
|---|
|  | 1109 | /* L102: */ | 
|---|
|  | 1110 | } | 
|---|
|  | 1111 | /* L103: */ | 
|---|
|  | 1112 | } | 
|---|
|  | 1113 | i__1 = *l1; | 
|---|
|  | 1114 | for (k = 1; k <= i__1; ++k) { | 
|---|
|  | 1115 | i__2 = *ido; | 
|---|
|  | 1116 | for (i__ = 1; i__ <= i__2; ++i__) { | 
|---|
|  | 1117 | ch[i__ + (k + ch_dim2) * ch_dim1] = cc[i__ + (k * cc_dim2 + 1) * | 
|---|
|  | 1118 | cc_dim1]; | 
|---|
|  | 1119 | /* L104: */ | 
|---|
|  | 1120 | } | 
|---|
|  | 1121 | /* L105: */ | 
|---|
|  | 1122 | } | 
|---|
|  | 1123 | goto L112; | 
|---|
|  | 1124 | L106: | 
|---|
|  | 1125 | i__1 = ipph; | 
|---|
|  | 1126 | for (j = 2; j <= i__1; ++j) { | 
|---|
|  | 1127 | jc = ipp2 - j; | 
|---|
|  | 1128 | i__2 = *ido; | 
|---|
|  | 1129 | for (i__ = 1; i__ <= i__2; ++i__) { | 
|---|
|  | 1130 | i__3 = *l1; | 
|---|
|  | 1131 | for (k = 1; k <= i__3; ++k) { | 
|---|
|  | 1132 | ch[i__ + (k + j * ch_dim2) * ch_dim1] = cc[i__ + (j + k * | 
|---|
|  | 1133 | cc_dim2) * cc_dim1] + cc[i__ + (jc + k * cc_dim2) * | 
|---|
|  | 1134 | cc_dim1]; | 
|---|
|  | 1135 | ch[i__ + (k + jc * ch_dim2) * ch_dim1] = cc[i__ + (j + k * | 
|---|
|  | 1136 | cc_dim2) * cc_dim1] - cc[i__ + (jc + k * cc_dim2) * | 
|---|
|  | 1137 | cc_dim1]; | 
|---|
|  | 1138 | /* L107: */ | 
|---|
|  | 1139 | } | 
|---|
|  | 1140 | /* L108: */ | 
|---|
|  | 1141 | } | 
|---|
|  | 1142 | /* L109: */ | 
|---|
|  | 1143 | } | 
|---|
|  | 1144 | i__1 = *ido; | 
|---|
|  | 1145 | for (i__ = 1; i__ <= i__1; ++i__) { | 
|---|
|  | 1146 | i__2 = *l1; | 
|---|
|  | 1147 | for (k = 1; k <= i__2; ++k) { | 
|---|
|  | 1148 | ch[i__ + (k + ch_dim2) * ch_dim1] = cc[i__ + (k * cc_dim2 + 1) * | 
|---|
|  | 1149 | cc_dim1]; | 
|---|
|  | 1150 | /* L110: */ | 
|---|
|  | 1151 | } | 
|---|
|  | 1152 | /* L111: */ | 
|---|
|  | 1153 | } | 
|---|
|  | 1154 | L112: | 
|---|
|  | 1155 | idl = 2 - *ido; | 
|---|
|  | 1156 | inc = 0; | 
|---|
|  | 1157 | i__1 = ipph; | 
|---|
|  | 1158 | for (l = 2; l <= i__1; ++l) { | 
|---|
|  | 1159 | lc = ipp2 - l; | 
|---|
|  | 1160 | idl += *ido; | 
|---|
|  | 1161 | i__2 = *idl1; | 
|---|
|  | 1162 | for (ik = 1; ik <= i__2; ++ik) { | 
|---|
|  | 1163 | c2[ik + l * c2_dim1] = ch2[ik + ch2_dim1] + wa[idl - 1] * ch2[ik | 
|---|
|  | 1164 | + (ch2_dim1 << 1)]; | 
|---|
|  | 1165 | c2[ik + lc * c2_dim1] = wa[idl] * ch2[ik + *ip * ch2_dim1]; | 
|---|
|  | 1166 | /* L113: */ | 
|---|
|  | 1167 | } | 
|---|
|  | 1168 | idlj = idl; | 
|---|
|  | 1169 | inc += *ido; | 
|---|
|  | 1170 | i__2 = ipph; | 
|---|
|  | 1171 | for (j = 3; j <= i__2; ++j) { | 
|---|
|  | 1172 | jc = ipp2 - j; | 
|---|
|  | 1173 | idlj += inc; | 
|---|
|  | 1174 | if (idlj > idp) { | 
|---|
|  | 1175 | idlj -= idp; | 
|---|
|  | 1176 | } | 
|---|
|  | 1177 | war = wa[idlj - 1]; | 
|---|
|  | 1178 | wai = wa[idlj]; | 
|---|
|  | 1179 | i__3 = *idl1; | 
|---|
|  | 1180 | for (ik = 1; ik <= i__3; ++ik) { | 
|---|
|  | 1181 | c2[ik + l * c2_dim1] += war * ch2[ik + j * ch2_dim1]; | 
|---|
|  | 1182 | c2[ik + lc * c2_dim1] += wai * ch2[ik + jc * ch2_dim1]; | 
|---|
|  | 1183 | /* L114: */ | 
|---|
|  | 1184 | } | 
|---|
|  | 1185 | /* L115: */ | 
|---|
|  | 1186 | } | 
|---|
|  | 1187 | /* L116: */ | 
|---|
|  | 1188 | } | 
|---|
|  | 1189 | i__1 = ipph; | 
|---|
|  | 1190 | for (j = 2; j <= i__1; ++j) { | 
|---|
|  | 1191 | i__2 = *idl1; | 
|---|
|  | 1192 | for (ik = 1; ik <= i__2; ++ik) { | 
|---|
|  | 1193 | ch2[ik + ch2_dim1] += ch2[ik + j * ch2_dim1]; | 
|---|
|  | 1194 | /* L117: */ | 
|---|
|  | 1195 | } | 
|---|
|  | 1196 | /* L118: */ | 
|---|
|  | 1197 | } | 
|---|
|  | 1198 | i__1 = ipph; | 
|---|
|  | 1199 | for (j = 2; j <= i__1; ++j) { | 
|---|
|  | 1200 | jc = ipp2 - j; | 
|---|
|  | 1201 | i__2 = *idl1; | 
|---|
|  | 1202 | for (ik = 2; ik <= i__2; ik += 2) { | 
|---|
|  | 1203 | ch2[ik - 1 + j * ch2_dim1] = c2[ik - 1 + j * c2_dim1] - c2[ik + | 
|---|
|  | 1204 | jc * c2_dim1]; | 
|---|
|  | 1205 | ch2[ik - 1 + jc * ch2_dim1] = c2[ik - 1 + j * c2_dim1] + c2[ik + | 
|---|
|  | 1206 | jc * c2_dim1]; | 
|---|
|  | 1207 | ch2[ik + j * ch2_dim1] = c2[ik + j * c2_dim1] + c2[ik - 1 + jc * | 
|---|
|  | 1208 | c2_dim1]; | 
|---|
|  | 1209 | ch2[ik + jc * ch2_dim1] = c2[ik + j * c2_dim1] - c2[ik - 1 + jc * | 
|---|
|  | 1210 | c2_dim1]; | 
|---|
|  | 1211 | /* L119: */ | 
|---|
|  | 1212 | } | 
|---|
|  | 1213 | /* L120: */ | 
|---|
|  | 1214 | } | 
|---|
|  | 1215 | *nac = 1; | 
|---|
|  | 1216 | if (*ido == 2) { | 
|---|
|  | 1217 | return 0; | 
|---|
|  | 1218 | } | 
|---|
|  | 1219 | *nac = 0; | 
|---|
|  | 1220 | i__1 = *idl1; | 
|---|
|  | 1221 | for (ik = 1; ik <= i__1; ++ik) { | 
|---|
|  | 1222 | c2[ik + c2_dim1] = ch2[ik + ch2_dim1]; | 
|---|
|  | 1223 | /* L121: */ | 
|---|
|  | 1224 | } | 
|---|
|  | 1225 | i__1 = *ip; | 
|---|
|  | 1226 | for (j = 2; j <= i__1; ++j) { | 
|---|
|  | 1227 | i__2 = *l1; | 
|---|
|  | 1228 | for (k = 1; k <= i__2; ++k) { | 
|---|
|  | 1229 | c1[(k + j * c1_dim2) * c1_dim1 + 1] = ch[(k + j * ch_dim2) * | 
|---|
|  | 1230 | ch_dim1 + 1]; | 
|---|
|  | 1231 | c1[(k + j * c1_dim2) * c1_dim1 + 2] = ch[(k + j * ch_dim2) * | 
|---|
|  | 1232 | ch_dim1 + 2]; | 
|---|
|  | 1233 | /* L122: */ | 
|---|
|  | 1234 | } | 
|---|
|  | 1235 | /* L123: */ | 
|---|
|  | 1236 | } | 
|---|
|  | 1237 | if (idot > *l1) { | 
|---|
|  | 1238 | goto L127; | 
|---|
|  | 1239 | } | 
|---|
|  | 1240 | idij = 0; | 
|---|
|  | 1241 | i__1 = *ip; | 
|---|
|  | 1242 | for (j = 2; j <= i__1; ++j) { | 
|---|
|  | 1243 | idij += 2; | 
|---|
|  | 1244 | i__2 = *ido; | 
|---|
|  | 1245 | for (i__ = 4; i__ <= i__2; i__ += 2) { | 
|---|
|  | 1246 | idij += 2; | 
|---|
|  | 1247 | i__3 = *l1; | 
|---|
|  | 1248 | for (k = 1; k <= i__3; ++k) { | 
|---|
|  | 1249 | c1[i__ - 1 + (k + j * c1_dim2) * c1_dim1] = wa[idij - 1] * ch[ | 
|---|
|  | 1250 | i__ - 1 + (k + j * ch_dim2) * ch_dim1] - wa[idij] * | 
|---|
|  | 1251 | ch[i__ + (k + j * ch_dim2) * ch_dim1]; | 
|---|
|  | 1252 | c1[i__ + (k + j * c1_dim2) * c1_dim1] = wa[idij - 1] * ch[i__ | 
|---|
|  | 1253 | + (k + j * ch_dim2) * ch_dim1] + wa[idij] * ch[i__ - | 
|---|
|  | 1254 | 1 + (k + j * ch_dim2) * ch_dim1]; | 
|---|
|  | 1255 | /* L124: */ | 
|---|
|  | 1256 | } | 
|---|
|  | 1257 | /* L125: */ | 
|---|
|  | 1258 | } | 
|---|
|  | 1259 | /* L126: */ | 
|---|
|  | 1260 | } | 
|---|
|  | 1261 | return 0; | 
|---|
|  | 1262 | L127: | 
|---|
|  | 1263 | idj = 2 - *ido; | 
|---|
|  | 1264 | i__1 = *ip; | 
|---|
|  | 1265 | for (j = 2; j <= i__1; ++j) { | 
|---|
|  | 1266 | idj += *ido; | 
|---|
|  | 1267 | i__2 = *l1; | 
|---|
|  | 1268 | for (k = 1; k <= i__2; ++k) { | 
|---|
|  | 1269 | idij = idj; | 
|---|
|  | 1270 | i__3 = *ido; | 
|---|
|  | 1271 | for (i__ = 4; i__ <= i__3; i__ += 2) { | 
|---|
|  | 1272 | idij += 2; | 
|---|
|  | 1273 | c1[i__ - 1 + (k + j * c1_dim2) * c1_dim1] = wa[idij - 1] * ch[ | 
|---|
|  | 1274 | i__ - 1 + (k + j * ch_dim2) * ch_dim1] - wa[idij] * | 
|---|
|  | 1275 | ch[i__ + (k + j * ch_dim2) * ch_dim1]; | 
|---|
|  | 1276 | c1[i__ + (k + j * c1_dim2) * c1_dim1] = wa[idij - 1] * ch[i__ | 
|---|
|  | 1277 | + (k + j * ch_dim2) * ch_dim1] + wa[idij] * ch[i__ - | 
|---|
|  | 1278 | 1 + (k + j * ch_dim2) * ch_dim1]; | 
|---|
|  | 1279 | /* L128: */ | 
|---|
|  | 1280 | } | 
|---|
|  | 1281 | /* L129: */ | 
|---|
|  | 1282 | } | 
|---|
|  | 1283 | /* L130: */ | 
|---|
|  | 1284 | } | 
|---|
|  | 1285 | return 0; | 
|---|
|  | 1286 | } /* passb_ */ | 
|---|
|  | 1287 |  | 
|---|
|  | 1288 | /*  ------ File passb2.f ------ */ | 
|---|
| [756] | 1289 | /* Subroutine */ int passb2_(int_4 *ido, int_4 *l1, r_4 *cc, r_4 *ch, | 
|---|
| [717] | 1290 | r_4 *wa1) | 
|---|
| [459] | 1291 | { | 
|---|
|  | 1292 | /* System generated locals */ | 
|---|
| [756] | 1293 | int_4 cc_dim1, cc_offset, ch_dim1, ch_dim2, ch_offset, i__1, i__2; | 
|---|
| [459] | 1294 |  | 
|---|
|  | 1295 | /* Local variables */ | 
|---|
| [756] | 1296 | static int_4 i__, k; | 
|---|
| [717] | 1297 | static r_4 ti2, tr2; | 
|---|
| [459] | 1298 |  | 
|---|
|  | 1299 | /* Parameter adjustments */ | 
|---|
|  | 1300 | ch_dim1 = *ido; | 
|---|
|  | 1301 | ch_dim2 = *l1; | 
|---|
|  | 1302 | ch_offset = ch_dim1 * (ch_dim2 + 1) + 1; | 
|---|
|  | 1303 | ch -= ch_offset; | 
|---|
|  | 1304 | cc_dim1 = *ido; | 
|---|
|  | 1305 | cc_offset = cc_dim1 * 3 + 1; | 
|---|
|  | 1306 | cc -= cc_offset; | 
|---|
|  | 1307 | --wa1; | 
|---|
|  | 1308 |  | 
|---|
|  | 1309 | /* Function Body */ | 
|---|
|  | 1310 | if (*ido > 2) { | 
|---|
|  | 1311 | goto L102; | 
|---|
|  | 1312 | } | 
|---|
|  | 1313 | i__1 = *l1; | 
|---|
|  | 1314 | for (k = 1; k <= i__1; ++k) { | 
|---|
|  | 1315 | ch[(k + ch_dim2) * ch_dim1 + 1] = cc[((k << 1) + 1) * cc_dim1 + 1] + | 
|---|
|  | 1316 | cc[((k << 1) + 2) * cc_dim1 + 1]; | 
|---|
|  | 1317 | ch[(k + (ch_dim2 << 1)) * ch_dim1 + 1] = cc[((k << 1) + 1) * cc_dim1 | 
|---|
|  | 1318 | + 1] - cc[((k << 1) + 2) * cc_dim1 + 1]; | 
|---|
|  | 1319 | ch[(k + ch_dim2) * ch_dim1 + 2] = cc[((k << 1) + 1) * cc_dim1 + 2] + | 
|---|
|  | 1320 | cc[((k << 1) + 2) * cc_dim1 + 2]; | 
|---|
|  | 1321 | ch[(k + (ch_dim2 << 1)) * ch_dim1 + 2] = cc[((k << 1) + 1) * cc_dim1 | 
|---|
|  | 1322 | + 2] - cc[((k << 1) + 2) * cc_dim1 + 2]; | 
|---|
|  | 1323 | /* L101: */ | 
|---|
|  | 1324 | } | 
|---|
|  | 1325 | return 0; | 
|---|
|  | 1326 | L102: | 
|---|
|  | 1327 | i__1 = *l1; | 
|---|
|  | 1328 | for (k = 1; k <= i__1; ++k) { | 
|---|
|  | 1329 | i__2 = *ido; | 
|---|
|  | 1330 | for (i__ = 2; i__ <= i__2; i__ += 2) { | 
|---|
|  | 1331 | ch[i__ - 1 + (k + ch_dim2) * ch_dim1] = cc[i__ - 1 + ((k << 1) + | 
|---|
|  | 1332 | 1) * cc_dim1] + cc[i__ - 1 + ((k << 1) + 2) * cc_dim1]; | 
|---|
|  | 1333 | tr2 = cc[i__ - 1 + ((k << 1) + 1) * cc_dim1] - cc[i__ - 1 + ((k << | 
|---|
|  | 1334 | 1) + 2) * cc_dim1]; | 
|---|
|  | 1335 | ch[i__ + (k + ch_dim2) * ch_dim1] = cc[i__ + ((k << 1) + 1) * | 
|---|
|  | 1336 | cc_dim1] + cc[i__ + ((k << 1) + 2) * cc_dim1]; | 
|---|
|  | 1337 | ti2 = cc[i__ + ((k << 1) + 1) * cc_dim1] - cc[i__ + ((k << 1) + 2) | 
|---|
|  | 1338 | * cc_dim1]; | 
|---|
|  | 1339 | ch[i__ + (k + (ch_dim2 << 1)) * ch_dim1] = wa1[i__ - 1] * ti2 + | 
|---|
|  | 1340 | wa1[i__] * tr2; | 
|---|
|  | 1341 | ch[i__ - 1 + (k + (ch_dim2 << 1)) * ch_dim1] = wa1[i__ - 1] * tr2 | 
|---|
|  | 1342 | - wa1[i__] * ti2; | 
|---|
|  | 1343 | /* L103: */ | 
|---|
|  | 1344 | } | 
|---|
|  | 1345 | /* L104: */ | 
|---|
|  | 1346 | } | 
|---|
|  | 1347 | return 0; | 
|---|
|  | 1348 | } /* passb2_ */ | 
|---|
|  | 1349 |  | 
|---|
|  | 1350 | /*  ------ File passb3.f ------ */ | 
|---|
| [756] | 1351 | /* Subroutine */ int passb3_(int_4 *ido, int_4 *l1, r_4 *cc, r_4 *ch, | 
|---|
| [717] | 1352 | r_4 *wa1, r_4 *wa2) | 
|---|
| [459] | 1353 | { | 
|---|
|  | 1354 | /* Initialized data */ | 
|---|
|  | 1355 |  | 
|---|
| [717] | 1356 | static r_4 taur = -.5f; | 
|---|
|  | 1357 | static r_4 taui = .866025403784439f; | 
|---|
| [459] | 1358 |  | 
|---|
|  | 1359 | /* System generated locals */ | 
|---|
| [756] | 1360 | int_4 cc_dim1, cc_offset, ch_dim1, ch_dim2, ch_offset, i__1, i__2; | 
|---|
| [459] | 1361 |  | 
|---|
|  | 1362 | /* Local variables */ | 
|---|
| [756] | 1363 | static int_4 i__, k; | 
|---|
| [717] | 1364 | static r_4 ci2, ci3, di2, di3, cr2, cr3, dr2, dr3, ti2, tr2; | 
|---|
| [459] | 1365 |  | 
|---|
|  | 1366 | /* Parameter adjustments */ | 
|---|
|  | 1367 | ch_dim1 = *ido; | 
|---|
|  | 1368 | ch_dim2 = *l1; | 
|---|
|  | 1369 | ch_offset = ch_dim1 * (ch_dim2 + 1) + 1; | 
|---|
|  | 1370 | ch -= ch_offset; | 
|---|
|  | 1371 | cc_dim1 = *ido; | 
|---|
|  | 1372 | cc_offset = (cc_dim1 << 2) + 1; | 
|---|
|  | 1373 | cc -= cc_offset; | 
|---|
|  | 1374 | --wa1; | 
|---|
|  | 1375 | --wa2; | 
|---|
|  | 1376 |  | 
|---|
|  | 1377 | /* Function Body */ | 
|---|
|  | 1378 | if (*ido != 2) { | 
|---|
|  | 1379 | goto L102; | 
|---|
|  | 1380 | } | 
|---|
|  | 1381 | i__1 = *l1; | 
|---|
|  | 1382 | for (k = 1; k <= i__1; ++k) { | 
|---|
|  | 1383 | tr2 = cc[(k * 3 + 2) * cc_dim1 + 1] + cc[(k * 3 + 3) * cc_dim1 + 1]; | 
|---|
|  | 1384 | cr2 = cc[(k * 3 + 1) * cc_dim1 + 1] + taur * tr2; | 
|---|
|  | 1385 | ch[(k + ch_dim2) * ch_dim1 + 1] = cc[(k * 3 + 1) * cc_dim1 + 1] + tr2; | 
|---|
|  | 1386 | ti2 = cc[(k * 3 + 2) * cc_dim1 + 2] + cc[(k * 3 + 3) * cc_dim1 + 2]; | 
|---|
|  | 1387 | ci2 = cc[(k * 3 + 1) * cc_dim1 + 2] + taur * ti2; | 
|---|
|  | 1388 | ch[(k + ch_dim2) * ch_dim1 + 2] = cc[(k * 3 + 1) * cc_dim1 + 2] + ti2; | 
|---|
|  | 1389 | cr3 = taui * (cc[(k * 3 + 2) * cc_dim1 + 1] - cc[(k * 3 + 3) * | 
|---|
|  | 1390 | cc_dim1 + 1]); | 
|---|
|  | 1391 | ci3 = taui * (cc[(k * 3 + 2) * cc_dim1 + 2] - cc[(k * 3 + 3) * | 
|---|
|  | 1392 | cc_dim1 + 2]); | 
|---|
|  | 1393 | ch[(k + (ch_dim2 << 1)) * ch_dim1 + 1] = cr2 - ci3; | 
|---|
|  | 1394 | ch[(k + ch_dim2 * 3) * ch_dim1 + 1] = cr2 + ci3; | 
|---|
|  | 1395 | ch[(k + (ch_dim2 << 1)) * ch_dim1 + 2] = ci2 + cr3; | 
|---|
|  | 1396 | ch[(k + ch_dim2 * 3) * ch_dim1 + 2] = ci2 - cr3; | 
|---|
|  | 1397 | /* L101: */ | 
|---|
|  | 1398 | } | 
|---|
|  | 1399 | return 0; | 
|---|
|  | 1400 | L102: | 
|---|
|  | 1401 | i__1 = *l1; | 
|---|
|  | 1402 | for (k = 1; k <= i__1; ++k) { | 
|---|
|  | 1403 | i__2 = *ido; | 
|---|
|  | 1404 | for (i__ = 2; i__ <= i__2; i__ += 2) { | 
|---|
|  | 1405 | tr2 = cc[i__ - 1 + (k * 3 + 2) * cc_dim1] + cc[i__ - 1 + (k * 3 + | 
|---|
|  | 1406 | 3) * cc_dim1]; | 
|---|
|  | 1407 | cr2 = cc[i__ - 1 + (k * 3 + 1) * cc_dim1] + taur * tr2; | 
|---|
|  | 1408 | ch[i__ - 1 + (k + ch_dim2) * ch_dim1] = cc[i__ - 1 + (k * 3 + 1) * | 
|---|
|  | 1409 | cc_dim1] + tr2; | 
|---|
|  | 1410 | ti2 = cc[i__ + (k * 3 + 2) * cc_dim1] + cc[i__ + (k * 3 + 3) * | 
|---|
|  | 1411 | cc_dim1]; | 
|---|
|  | 1412 | ci2 = cc[i__ + (k * 3 + 1) * cc_dim1] + taur * ti2; | 
|---|
|  | 1413 | ch[i__ + (k + ch_dim2) * ch_dim1] = cc[i__ + (k * 3 + 1) * | 
|---|
|  | 1414 | cc_dim1] + ti2; | 
|---|
|  | 1415 | cr3 = taui * (cc[i__ - 1 + (k * 3 + 2) * cc_dim1] - cc[i__ - 1 + ( | 
|---|
|  | 1416 | k * 3 + 3) * cc_dim1]); | 
|---|
|  | 1417 | ci3 = taui * (cc[i__ + (k * 3 + 2) * cc_dim1] - cc[i__ + (k * 3 + | 
|---|
|  | 1418 | 3) * cc_dim1]); | 
|---|
|  | 1419 | dr2 = cr2 - ci3; | 
|---|
|  | 1420 | dr3 = cr2 + ci3; | 
|---|
|  | 1421 | di2 = ci2 + cr3; | 
|---|
|  | 1422 | di3 = ci2 - cr3; | 
|---|
|  | 1423 | ch[i__ + (k + (ch_dim2 << 1)) * ch_dim1] = wa1[i__ - 1] * di2 + | 
|---|
|  | 1424 | wa1[i__] * dr2; | 
|---|
|  | 1425 | ch[i__ - 1 + (k + (ch_dim2 << 1)) * ch_dim1] = wa1[i__ - 1] * dr2 | 
|---|
|  | 1426 | - wa1[i__] * di2; | 
|---|
|  | 1427 | ch[i__ + (k + ch_dim2 * 3) * ch_dim1] = wa2[i__ - 1] * di3 + wa2[ | 
|---|
|  | 1428 | i__] * dr3; | 
|---|
|  | 1429 | ch[i__ - 1 + (k + ch_dim2 * 3) * ch_dim1] = wa2[i__ - 1] * dr3 - | 
|---|
|  | 1430 | wa2[i__] * di3; | 
|---|
|  | 1431 | /* L103: */ | 
|---|
|  | 1432 | } | 
|---|
|  | 1433 | /* L104: */ | 
|---|
|  | 1434 | } | 
|---|
|  | 1435 | return 0; | 
|---|
|  | 1436 | } /* passb3_ */ | 
|---|
|  | 1437 |  | 
|---|
|  | 1438 | /*  ------ File passb4.f ------ */ | 
|---|
| [756] | 1439 | /* Subroutine */ int passb4_(int_4 *ido, int_4 *l1, r_4 *cc, r_4 *ch, | 
|---|
| [717] | 1440 | r_4 *wa1, r_4 *wa2, r_4 *wa3) | 
|---|
| [459] | 1441 | { | 
|---|
|  | 1442 | /* System generated locals */ | 
|---|
| [756] | 1443 | int_4 cc_dim1, cc_offset, ch_dim1, ch_dim2, ch_offset, i__1, i__2; | 
|---|
| [459] | 1444 |  | 
|---|
|  | 1445 | /* Local variables */ | 
|---|
| [756] | 1446 | static int_4 i__, k; | 
|---|
| [717] | 1447 | static r_4 ci2, ci3, ci4, cr2, cr3, cr4, ti1, ti2, ti3, ti4, tr1, tr2, | 
|---|
| [459] | 1448 | tr3, tr4; | 
|---|
|  | 1449 |  | 
|---|
|  | 1450 | /* Parameter adjustments */ | 
|---|
|  | 1451 | ch_dim1 = *ido; | 
|---|
|  | 1452 | ch_dim2 = *l1; | 
|---|
|  | 1453 | ch_offset = ch_dim1 * (ch_dim2 + 1) + 1; | 
|---|
|  | 1454 | ch -= ch_offset; | 
|---|
|  | 1455 | cc_dim1 = *ido; | 
|---|
|  | 1456 | cc_offset = cc_dim1 * 5 + 1; | 
|---|
|  | 1457 | cc -= cc_offset; | 
|---|
|  | 1458 | --wa1; | 
|---|
|  | 1459 | --wa2; | 
|---|
|  | 1460 | --wa3; | 
|---|
|  | 1461 |  | 
|---|
|  | 1462 | /* Function Body */ | 
|---|
|  | 1463 | if (*ido != 2) { | 
|---|
|  | 1464 | goto L102; | 
|---|
|  | 1465 | } | 
|---|
|  | 1466 | i__1 = *l1; | 
|---|
|  | 1467 | for (k = 1; k <= i__1; ++k) { | 
|---|
|  | 1468 | ti1 = cc[((k << 2) + 1) * cc_dim1 + 2] - cc[((k << 2) + 3) * cc_dim1 | 
|---|
|  | 1469 | + 2]; | 
|---|
|  | 1470 | ti2 = cc[((k << 2) + 1) * cc_dim1 + 2] + cc[((k << 2) + 3) * cc_dim1 | 
|---|
|  | 1471 | + 2]; | 
|---|
|  | 1472 | tr4 = cc[((k << 2) + 4) * cc_dim1 + 2] - cc[((k << 2) + 2) * cc_dim1 | 
|---|
|  | 1473 | + 2]; | 
|---|
|  | 1474 | ti3 = cc[((k << 2) + 2) * cc_dim1 + 2] + cc[((k << 2) + 4) * cc_dim1 | 
|---|
|  | 1475 | + 2]; | 
|---|
|  | 1476 | tr1 = cc[((k << 2) + 1) * cc_dim1 + 1] - cc[((k << 2) + 3) * cc_dim1 | 
|---|
|  | 1477 | + 1]; | 
|---|
|  | 1478 | tr2 = cc[((k << 2) + 1) * cc_dim1 + 1] + cc[((k << 2) + 3) * cc_dim1 | 
|---|
|  | 1479 | + 1]; | 
|---|
|  | 1480 | ti4 = cc[((k << 2) + 2) * cc_dim1 + 1] - cc[((k << 2) + 4) * cc_dim1 | 
|---|
|  | 1481 | + 1]; | 
|---|
|  | 1482 | tr3 = cc[((k << 2) + 2) * cc_dim1 + 1] + cc[((k << 2) + 4) * cc_dim1 | 
|---|
|  | 1483 | + 1]; | 
|---|
|  | 1484 | ch[(k + ch_dim2) * ch_dim1 + 1] = tr2 + tr3; | 
|---|
|  | 1485 | ch[(k + ch_dim2 * 3) * ch_dim1 + 1] = tr2 - tr3; | 
|---|
|  | 1486 | ch[(k + ch_dim2) * ch_dim1 + 2] = ti2 + ti3; | 
|---|
|  | 1487 | ch[(k + ch_dim2 * 3) * ch_dim1 + 2] = ti2 - ti3; | 
|---|
|  | 1488 | ch[(k + (ch_dim2 << 1)) * ch_dim1 + 1] = tr1 + tr4; | 
|---|
|  | 1489 | ch[(k + (ch_dim2 << 2)) * ch_dim1 + 1] = tr1 - tr4; | 
|---|
|  | 1490 | ch[(k + (ch_dim2 << 1)) * ch_dim1 + 2] = ti1 + ti4; | 
|---|
|  | 1491 | ch[(k + (ch_dim2 << 2)) * ch_dim1 + 2] = ti1 - ti4; | 
|---|
|  | 1492 | /* L101: */ | 
|---|
|  | 1493 | } | 
|---|
|  | 1494 | return 0; | 
|---|
|  | 1495 | L102: | 
|---|
|  | 1496 | i__1 = *l1; | 
|---|
|  | 1497 | for (k = 1; k <= i__1; ++k) { | 
|---|
|  | 1498 | i__2 = *ido; | 
|---|
|  | 1499 | for (i__ = 2; i__ <= i__2; i__ += 2) { | 
|---|
|  | 1500 | ti1 = cc[i__ + ((k << 2) + 1) * cc_dim1] - cc[i__ + ((k << 2) + 3) | 
|---|
|  | 1501 | * cc_dim1]; | 
|---|
|  | 1502 | ti2 = cc[i__ + ((k << 2) + 1) * cc_dim1] + cc[i__ + ((k << 2) + 3) | 
|---|
|  | 1503 | * cc_dim1]; | 
|---|
|  | 1504 | ti3 = cc[i__ + ((k << 2) + 2) * cc_dim1] + cc[i__ + ((k << 2) + 4) | 
|---|
|  | 1505 | * cc_dim1]; | 
|---|
|  | 1506 | tr4 = cc[i__ + ((k << 2) + 4) * cc_dim1] - cc[i__ + ((k << 2) + 2) | 
|---|
|  | 1507 | * cc_dim1]; | 
|---|
|  | 1508 | tr1 = cc[i__ - 1 + ((k << 2) + 1) * cc_dim1] - cc[i__ - 1 + ((k << | 
|---|
|  | 1509 | 2) + 3) * cc_dim1]; | 
|---|
|  | 1510 | tr2 = cc[i__ - 1 + ((k << 2) + 1) * cc_dim1] + cc[i__ - 1 + ((k << | 
|---|
|  | 1511 | 2) + 3) * cc_dim1]; | 
|---|
|  | 1512 | ti4 = cc[i__ - 1 + ((k << 2) + 2) * cc_dim1] - cc[i__ - 1 + ((k << | 
|---|
|  | 1513 | 2) + 4) * cc_dim1]; | 
|---|
|  | 1514 | tr3 = cc[i__ - 1 + ((k << 2) + 2) * cc_dim1] + cc[i__ - 1 + ((k << | 
|---|
|  | 1515 | 2) + 4) * cc_dim1]; | 
|---|
|  | 1516 | ch[i__ - 1 + (k + ch_dim2) * ch_dim1] = tr2 + tr3; | 
|---|
|  | 1517 | cr3 = tr2 - tr3; | 
|---|
|  | 1518 | ch[i__ + (k + ch_dim2) * ch_dim1] = ti2 + ti3; | 
|---|
|  | 1519 | ci3 = ti2 - ti3; | 
|---|
|  | 1520 | cr2 = tr1 + tr4; | 
|---|
|  | 1521 | cr4 = tr1 - tr4; | 
|---|
|  | 1522 | ci2 = ti1 + ti4; | 
|---|
|  | 1523 | ci4 = ti1 - ti4; | 
|---|
|  | 1524 | ch[i__ - 1 + (k + (ch_dim2 << 1)) * ch_dim1] = wa1[i__ - 1] * cr2 | 
|---|
|  | 1525 | - wa1[i__] * ci2; | 
|---|
|  | 1526 | ch[i__ + (k + (ch_dim2 << 1)) * ch_dim1] = wa1[i__ - 1] * ci2 + | 
|---|
|  | 1527 | wa1[i__] * cr2; | 
|---|
|  | 1528 | ch[i__ - 1 + (k + ch_dim2 * 3) * ch_dim1] = wa2[i__ - 1] * cr3 - | 
|---|
|  | 1529 | wa2[i__] * ci3; | 
|---|
|  | 1530 | ch[i__ + (k + ch_dim2 * 3) * ch_dim1] = wa2[i__ - 1] * ci3 + wa2[ | 
|---|
|  | 1531 | i__] * cr3; | 
|---|
|  | 1532 | ch[i__ - 1 + (k + (ch_dim2 << 2)) * ch_dim1] = wa3[i__ - 1] * cr4 | 
|---|
|  | 1533 | - wa3[i__] * ci4; | 
|---|
|  | 1534 | ch[i__ + (k + (ch_dim2 << 2)) * ch_dim1] = wa3[i__ - 1] * ci4 + | 
|---|
|  | 1535 | wa3[i__] * cr4; | 
|---|
|  | 1536 | /* L103: */ | 
|---|
|  | 1537 | } | 
|---|
|  | 1538 | /* L104: */ | 
|---|
|  | 1539 | } | 
|---|
|  | 1540 | return 0; | 
|---|
|  | 1541 | } /* passb4_ */ | 
|---|
|  | 1542 |  | 
|---|
|  | 1543 | /*  ------ File passb5.f ------ */ | 
|---|
| [756] | 1544 | /* Subroutine */ int passb5_(int_4 *ido, int_4 *l1, r_4 *cc, r_4 *ch, | 
|---|
| [717] | 1545 | r_4 *wa1, r_4 *wa2, r_4 *wa3, r_4 *wa4) | 
|---|
| [459] | 1546 | { | 
|---|
|  | 1547 | /* Initialized data */ | 
|---|
|  | 1548 |  | 
|---|
| [717] | 1549 | static r_4 tr11 = .309016994374947f; | 
|---|
|  | 1550 | static r_4 ti11 = .951056516295154f; | 
|---|
|  | 1551 | static r_4 tr12 = -.809016994374947f; | 
|---|
|  | 1552 | static r_4 ti12 = .587785252292473f; | 
|---|
| [459] | 1553 |  | 
|---|
|  | 1554 | /* System generated locals */ | 
|---|
| [756] | 1555 | int_4 cc_dim1, cc_offset, ch_dim1, ch_dim2, ch_offset, i__1, i__2; | 
|---|
| [459] | 1556 |  | 
|---|
|  | 1557 | /* Local variables */ | 
|---|
| [756] | 1558 | static int_4 i__, k; | 
|---|
| [717] | 1559 | static r_4 ci2, ci3, ci4, ci5, di3, di4, di5, di2, cr2, cr3, cr5, cr4, | 
|---|
| [459] | 1560 | ti2, ti3, ti4, ti5, dr3, dr4, dr5, dr2, tr2, tr3, tr4, tr5; | 
|---|
|  | 1561 |  | 
|---|
|  | 1562 | /* Parameter adjustments */ | 
|---|
|  | 1563 | ch_dim1 = *ido; | 
|---|
|  | 1564 | ch_dim2 = *l1; | 
|---|
|  | 1565 | ch_offset = ch_dim1 * (ch_dim2 + 1) + 1; | 
|---|
|  | 1566 | ch -= ch_offset; | 
|---|
|  | 1567 | cc_dim1 = *ido; | 
|---|
|  | 1568 | cc_offset = cc_dim1 * 6 + 1; | 
|---|
|  | 1569 | cc -= cc_offset; | 
|---|
|  | 1570 | --wa1; | 
|---|
|  | 1571 | --wa2; | 
|---|
|  | 1572 | --wa3; | 
|---|
|  | 1573 | --wa4; | 
|---|
|  | 1574 |  | 
|---|
|  | 1575 | /* Function Body */ | 
|---|
|  | 1576 | if (*ido != 2) { | 
|---|
|  | 1577 | goto L102; | 
|---|
|  | 1578 | } | 
|---|
|  | 1579 | i__1 = *l1; | 
|---|
|  | 1580 | for (k = 1; k <= i__1; ++k) { | 
|---|
|  | 1581 | ti5 = cc[(k * 5 + 2) * cc_dim1 + 2] - cc[(k * 5 + 5) * cc_dim1 + 2]; | 
|---|
|  | 1582 | ti2 = cc[(k * 5 + 2) * cc_dim1 + 2] + cc[(k * 5 + 5) * cc_dim1 + 2]; | 
|---|
|  | 1583 | ti4 = cc[(k * 5 + 3) * cc_dim1 + 2] - cc[(k * 5 + 4) * cc_dim1 + 2]; | 
|---|
|  | 1584 | ti3 = cc[(k * 5 + 3) * cc_dim1 + 2] + cc[(k * 5 + 4) * cc_dim1 + 2]; | 
|---|
|  | 1585 | tr5 = cc[(k * 5 + 2) * cc_dim1 + 1] - cc[(k * 5 + 5) * cc_dim1 + 1]; | 
|---|
|  | 1586 | tr2 = cc[(k * 5 + 2) * cc_dim1 + 1] + cc[(k * 5 + 5) * cc_dim1 + 1]; | 
|---|
|  | 1587 | tr4 = cc[(k * 5 + 3) * cc_dim1 + 1] - cc[(k * 5 + 4) * cc_dim1 + 1]; | 
|---|
|  | 1588 | tr3 = cc[(k * 5 + 3) * cc_dim1 + 1] + cc[(k * 5 + 4) * cc_dim1 + 1]; | 
|---|
|  | 1589 | ch[(k + ch_dim2) * ch_dim1 + 1] = cc[(k * 5 + 1) * cc_dim1 + 1] + tr2 | 
|---|
|  | 1590 | + tr3; | 
|---|
|  | 1591 | ch[(k + ch_dim2) * ch_dim1 + 2] = cc[(k * 5 + 1) * cc_dim1 + 2] + ti2 | 
|---|
|  | 1592 | + ti3; | 
|---|
|  | 1593 | cr2 = cc[(k * 5 + 1) * cc_dim1 + 1] + tr11 * tr2 + tr12 * tr3; | 
|---|
|  | 1594 | ci2 = cc[(k * 5 + 1) * cc_dim1 + 2] + tr11 * ti2 + tr12 * ti3; | 
|---|
|  | 1595 | cr3 = cc[(k * 5 + 1) * cc_dim1 + 1] + tr12 * tr2 + tr11 * tr3; | 
|---|
|  | 1596 | ci3 = cc[(k * 5 + 1) * cc_dim1 + 2] + tr12 * ti2 + tr11 * ti3; | 
|---|
|  | 1597 | cr5 = ti11 * tr5 + ti12 * tr4; | 
|---|
|  | 1598 | ci5 = ti11 * ti5 + ti12 * ti4; | 
|---|
|  | 1599 | cr4 = ti12 * tr5 - ti11 * tr4; | 
|---|
|  | 1600 | ci4 = ti12 * ti5 - ti11 * ti4; | 
|---|
|  | 1601 | ch[(k + (ch_dim2 << 1)) * ch_dim1 + 1] = cr2 - ci5; | 
|---|
|  | 1602 | ch[(k + ch_dim2 * 5) * ch_dim1 + 1] = cr2 + ci5; | 
|---|
|  | 1603 | ch[(k + (ch_dim2 << 1)) * ch_dim1 + 2] = ci2 + cr5; | 
|---|
|  | 1604 | ch[(k + ch_dim2 * 3) * ch_dim1 + 2] = ci3 + cr4; | 
|---|
|  | 1605 | ch[(k + ch_dim2 * 3) * ch_dim1 + 1] = cr3 - ci4; | 
|---|
|  | 1606 | ch[(k + (ch_dim2 << 2)) * ch_dim1 + 1] = cr3 + ci4; | 
|---|
|  | 1607 | ch[(k + (ch_dim2 << 2)) * ch_dim1 + 2] = ci3 - cr4; | 
|---|
|  | 1608 | ch[(k + ch_dim2 * 5) * ch_dim1 + 2] = ci2 - cr5; | 
|---|
|  | 1609 | /* L101: */ | 
|---|
|  | 1610 | } | 
|---|
|  | 1611 | return 0; | 
|---|
|  | 1612 | L102: | 
|---|
|  | 1613 | i__1 = *l1; | 
|---|
|  | 1614 | for (k = 1; k <= i__1; ++k) { | 
|---|
|  | 1615 | i__2 = *ido; | 
|---|
|  | 1616 | for (i__ = 2; i__ <= i__2; i__ += 2) { | 
|---|
|  | 1617 | ti5 = cc[i__ + (k * 5 + 2) * cc_dim1] - cc[i__ + (k * 5 + 5) * | 
|---|
|  | 1618 | cc_dim1]; | 
|---|
|  | 1619 | ti2 = cc[i__ + (k * 5 + 2) * cc_dim1] + cc[i__ + (k * 5 + 5) * | 
|---|
|  | 1620 | cc_dim1]; | 
|---|
|  | 1621 | ti4 = cc[i__ + (k * 5 + 3) * cc_dim1] - cc[i__ + (k * 5 + 4) * | 
|---|
|  | 1622 | cc_dim1]; | 
|---|
|  | 1623 | ti3 = cc[i__ + (k * 5 + 3) * cc_dim1] + cc[i__ + (k * 5 + 4) * | 
|---|
|  | 1624 | cc_dim1]; | 
|---|
|  | 1625 | tr5 = cc[i__ - 1 + (k * 5 + 2) * cc_dim1] - cc[i__ - 1 + (k * 5 + | 
|---|
|  | 1626 | 5) * cc_dim1]; | 
|---|
|  | 1627 | tr2 = cc[i__ - 1 + (k * 5 + 2) * cc_dim1] + cc[i__ - 1 + (k * 5 + | 
|---|
|  | 1628 | 5) * cc_dim1]; | 
|---|
|  | 1629 | tr4 = cc[i__ - 1 + (k * 5 + 3) * cc_dim1] - cc[i__ - 1 + (k * 5 + | 
|---|
|  | 1630 | 4) * cc_dim1]; | 
|---|
|  | 1631 | tr3 = cc[i__ - 1 + (k * 5 + 3) * cc_dim1] + cc[i__ - 1 + (k * 5 + | 
|---|
|  | 1632 | 4) * cc_dim1]; | 
|---|
|  | 1633 | ch[i__ - 1 + (k + ch_dim2) * ch_dim1] = cc[i__ - 1 + (k * 5 + 1) * | 
|---|
|  | 1634 | cc_dim1] + tr2 + tr3; | 
|---|
|  | 1635 | ch[i__ + (k + ch_dim2) * ch_dim1] = cc[i__ + (k * 5 + 1) * | 
|---|
|  | 1636 | cc_dim1] + ti2 + ti3; | 
|---|
|  | 1637 | cr2 = cc[i__ - 1 + (k * 5 + 1) * cc_dim1] + tr11 * tr2 + tr12 * | 
|---|
|  | 1638 | tr3; | 
|---|
|  | 1639 | ci2 = cc[i__ + (k * 5 + 1) * cc_dim1] + tr11 * ti2 + tr12 * ti3; | 
|---|
|  | 1640 | cr3 = cc[i__ - 1 + (k * 5 + 1) * cc_dim1] + tr12 * tr2 + tr11 * | 
|---|
|  | 1641 | tr3; | 
|---|
|  | 1642 | ci3 = cc[i__ + (k * 5 + 1) * cc_dim1] + tr12 * ti2 + tr11 * ti3; | 
|---|
|  | 1643 | cr5 = ti11 * tr5 + ti12 * tr4; | 
|---|
|  | 1644 | ci5 = ti11 * ti5 + ti12 * ti4; | 
|---|
|  | 1645 | cr4 = ti12 * tr5 - ti11 * tr4; | 
|---|
|  | 1646 | ci4 = ti12 * ti5 - ti11 * ti4; | 
|---|
|  | 1647 | dr3 = cr3 - ci4; | 
|---|
|  | 1648 | dr4 = cr3 + ci4; | 
|---|
|  | 1649 | di3 = ci3 + cr4; | 
|---|
|  | 1650 | di4 = ci3 - cr4; | 
|---|
|  | 1651 | dr5 = cr2 + ci5; | 
|---|
|  | 1652 | dr2 = cr2 - ci5; | 
|---|
|  | 1653 | di5 = ci2 - cr5; | 
|---|
|  | 1654 | di2 = ci2 + cr5; | 
|---|
|  | 1655 | ch[i__ - 1 + (k + (ch_dim2 << 1)) * ch_dim1] = wa1[i__ - 1] * dr2 | 
|---|
|  | 1656 | - wa1[i__] * di2; | 
|---|
|  | 1657 | ch[i__ + (k + (ch_dim2 << 1)) * ch_dim1] = wa1[i__ - 1] * di2 + | 
|---|
|  | 1658 | wa1[i__] * dr2; | 
|---|
|  | 1659 | ch[i__ - 1 + (k + ch_dim2 * 3) * ch_dim1] = wa2[i__ - 1] * dr3 - | 
|---|
|  | 1660 | wa2[i__] * di3; | 
|---|
|  | 1661 | ch[i__ + (k + ch_dim2 * 3) * ch_dim1] = wa2[i__ - 1] * di3 + wa2[ | 
|---|
|  | 1662 | i__] * dr3; | 
|---|
|  | 1663 | ch[i__ - 1 + (k + (ch_dim2 << 2)) * ch_dim1] = wa3[i__ - 1] * dr4 | 
|---|
|  | 1664 | - wa3[i__] * di4; | 
|---|
|  | 1665 | ch[i__ + (k + (ch_dim2 << 2)) * ch_dim1] = wa3[i__ - 1] * di4 + | 
|---|
|  | 1666 | wa3[i__] * dr4; | 
|---|
|  | 1667 | ch[i__ - 1 + (k + ch_dim2 * 5) * ch_dim1] = wa4[i__ - 1] * dr5 - | 
|---|
|  | 1668 | wa4[i__] * di5; | 
|---|
|  | 1669 | ch[i__ + (k + ch_dim2 * 5) * ch_dim1] = wa4[i__ - 1] * di5 + wa4[ | 
|---|
|  | 1670 | i__] * dr5; | 
|---|
|  | 1671 | /* L103: */ | 
|---|
|  | 1672 | } | 
|---|
|  | 1673 | /* L104: */ | 
|---|
|  | 1674 | } | 
|---|
|  | 1675 | return 0; | 
|---|
|  | 1676 | } /* passb5_ */ | 
|---|
|  | 1677 |  | 
|---|
|  | 1678 | /*  ------ File passf.f ------ */ | 
|---|
| [756] | 1679 | /* Subroutine */ int passf_(int_4 *nac, int_4 *ido, int_4 *ip, int_4 * | 
|---|
|  | 1680 | l1, int_4 *idl1, r_4 *cc, r_4 *c1, r_4 *c2, r_4 *ch, r_4 *ch2, | 
|---|
| [717] | 1681 | r_4 *wa) | 
|---|
| [459] | 1682 | { | 
|---|
|  | 1683 | /* System generated locals */ | 
|---|
| [756] | 1684 | int_4 ch_dim1, ch_dim2, ch_offset, cc_dim1, cc_dim2, cc_offset, c1_dim1, | 
|---|
| [459] | 1685 | c1_dim2, c1_offset, c2_dim1, c2_offset, ch2_dim1, ch2_offset, | 
|---|
|  | 1686 | i__1, i__2, i__3; | 
|---|
|  | 1687 |  | 
|---|
|  | 1688 | /* Local variables */ | 
|---|
| [756] | 1689 | static int_4 idij, idlj, idot, ipph, i__, j, k, l, jc, lc, ik, nt, idj, | 
|---|
| [459] | 1690 | idl, inc, idp; | 
|---|
| [717] | 1691 | static r_4 wai, war; | 
|---|
| [756] | 1692 | static int_4 ipp2; | 
|---|
| [459] | 1693 |  | 
|---|
|  | 1694 | /* Parameter adjustments */ | 
|---|
|  | 1695 | ch_dim1 = *ido; | 
|---|
|  | 1696 | ch_dim2 = *l1; | 
|---|
|  | 1697 | ch_offset = ch_dim1 * (ch_dim2 + 1) + 1; | 
|---|
|  | 1698 | ch -= ch_offset; | 
|---|
|  | 1699 | c1_dim1 = *ido; | 
|---|
|  | 1700 | c1_dim2 = *l1; | 
|---|
|  | 1701 | c1_offset = c1_dim1 * (c1_dim2 + 1) + 1; | 
|---|
|  | 1702 | c1 -= c1_offset; | 
|---|
|  | 1703 | cc_dim1 = *ido; | 
|---|
|  | 1704 | cc_dim2 = *ip; | 
|---|
|  | 1705 | cc_offset = cc_dim1 * (cc_dim2 + 1) + 1; | 
|---|
|  | 1706 | cc -= cc_offset; | 
|---|
|  | 1707 | ch2_dim1 = *idl1; | 
|---|
|  | 1708 | ch2_offset = ch2_dim1 + 1; | 
|---|
|  | 1709 | ch2 -= ch2_offset; | 
|---|
|  | 1710 | c2_dim1 = *idl1; | 
|---|
|  | 1711 | c2_offset = c2_dim1 + 1; | 
|---|
|  | 1712 | c2 -= c2_offset; | 
|---|
|  | 1713 | --wa; | 
|---|
|  | 1714 |  | 
|---|
|  | 1715 | /* Function Body */ | 
|---|
|  | 1716 | idot = *ido / 2; | 
|---|
|  | 1717 | nt = *ip * *idl1; | 
|---|
|  | 1718 | ipp2 = *ip + 2; | 
|---|
|  | 1719 | ipph = (*ip + 1) / 2; | 
|---|
|  | 1720 | idp = *ip * *ido; | 
|---|
|  | 1721 |  | 
|---|
|  | 1722 | if (*ido < *l1) { | 
|---|
|  | 1723 | goto L106; | 
|---|
|  | 1724 | } | 
|---|
|  | 1725 | i__1 = ipph; | 
|---|
|  | 1726 | for (j = 2; j <= i__1; ++j) { | 
|---|
|  | 1727 | jc = ipp2 - j; | 
|---|
|  | 1728 | i__2 = *l1; | 
|---|
|  | 1729 | for (k = 1; k <= i__2; ++k) { | 
|---|
|  | 1730 | i__3 = *ido; | 
|---|
|  | 1731 | for (i__ = 1; i__ <= i__3; ++i__) { | 
|---|
|  | 1732 | ch[i__ + (k + j * ch_dim2) * ch_dim1] = cc[i__ + (j + k * | 
|---|
|  | 1733 | cc_dim2) * cc_dim1] + cc[i__ + (jc + k * cc_dim2) * | 
|---|
|  | 1734 | cc_dim1]; | 
|---|
|  | 1735 | ch[i__ + (k + jc * ch_dim2) * ch_dim1] = cc[i__ + (j + k * | 
|---|
|  | 1736 | cc_dim2) * cc_dim1] - cc[i__ + (jc + k * cc_dim2) * | 
|---|
|  | 1737 | cc_dim1]; | 
|---|
|  | 1738 | /* L101: */ | 
|---|
|  | 1739 | } | 
|---|
|  | 1740 | /* L102: */ | 
|---|
|  | 1741 | } | 
|---|
|  | 1742 | /* L103: */ | 
|---|
|  | 1743 | } | 
|---|
|  | 1744 | i__1 = *l1; | 
|---|
|  | 1745 | for (k = 1; k <= i__1; ++k) { | 
|---|
|  | 1746 | i__2 = *ido; | 
|---|
|  | 1747 | for (i__ = 1; i__ <= i__2; ++i__) { | 
|---|
|  | 1748 | ch[i__ + (k + ch_dim2) * ch_dim1] = cc[i__ + (k * cc_dim2 + 1) * | 
|---|
|  | 1749 | cc_dim1]; | 
|---|
|  | 1750 | /* L104: */ | 
|---|
|  | 1751 | } | 
|---|
|  | 1752 | /* L105: */ | 
|---|
|  | 1753 | } | 
|---|
|  | 1754 | goto L112; | 
|---|
|  | 1755 | L106: | 
|---|
|  | 1756 | i__1 = ipph; | 
|---|
|  | 1757 | for (j = 2; j <= i__1; ++j) { | 
|---|
|  | 1758 | jc = ipp2 - j; | 
|---|
|  | 1759 | i__2 = *ido; | 
|---|
|  | 1760 | for (i__ = 1; i__ <= i__2; ++i__) { | 
|---|
|  | 1761 | i__3 = *l1; | 
|---|
|  | 1762 | for (k = 1; k <= i__3; ++k) { | 
|---|
|  | 1763 | ch[i__ + (k + j * ch_dim2) * ch_dim1] = cc[i__ + (j + k * | 
|---|
|  | 1764 | cc_dim2) * cc_dim1] + cc[i__ + (jc + k * cc_dim2) * | 
|---|
|  | 1765 | cc_dim1]; | 
|---|
|  | 1766 | ch[i__ + (k + jc * ch_dim2) * ch_dim1] = cc[i__ + (j + k * | 
|---|
|  | 1767 | cc_dim2) * cc_dim1] - cc[i__ + (jc + k * cc_dim2) * | 
|---|
|  | 1768 | cc_dim1]; | 
|---|
|  | 1769 | /* L107: */ | 
|---|
|  | 1770 | } | 
|---|
|  | 1771 | /* L108: */ | 
|---|
|  | 1772 | } | 
|---|
|  | 1773 | /* L109: */ | 
|---|
|  | 1774 | } | 
|---|
|  | 1775 | i__1 = *ido; | 
|---|
|  | 1776 | for (i__ = 1; i__ <= i__1; ++i__) { | 
|---|
|  | 1777 | i__2 = *l1; | 
|---|
|  | 1778 | for (k = 1; k <= i__2; ++k) { | 
|---|
|  | 1779 | ch[i__ + (k + ch_dim2) * ch_dim1] = cc[i__ + (k * cc_dim2 + 1) * | 
|---|
|  | 1780 | cc_dim1]; | 
|---|
|  | 1781 | /* L110: */ | 
|---|
|  | 1782 | } | 
|---|
|  | 1783 | /* L111: */ | 
|---|
|  | 1784 | } | 
|---|
|  | 1785 | L112: | 
|---|
|  | 1786 | idl = 2 - *ido; | 
|---|
|  | 1787 | inc = 0; | 
|---|
|  | 1788 | i__1 = ipph; | 
|---|
|  | 1789 | for (l = 2; l <= i__1; ++l) { | 
|---|
|  | 1790 | lc = ipp2 - l; | 
|---|
|  | 1791 | idl += *ido; | 
|---|
|  | 1792 | i__2 = *idl1; | 
|---|
|  | 1793 | for (ik = 1; ik <= i__2; ++ik) { | 
|---|
|  | 1794 | c2[ik + l * c2_dim1] = ch2[ik + ch2_dim1] + wa[idl - 1] * ch2[ik | 
|---|
|  | 1795 | + (ch2_dim1 << 1)]; | 
|---|
|  | 1796 | c2[ik + lc * c2_dim1] = -wa[idl] * ch2[ik + *ip * ch2_dim1]; | 
|---|
|  | 1797 | /* L113: */ | 
|---|
|  | 1798 | } | 
|---|
|  | 1799 | idlj = idl; | 
|---|
|  | 1800 | inc += *ido; | 
|---|
|  | 1801 | i__2 = ipph; | 
|---|
|  | 1802 | for (j = 3; j <= i__2; ++j) { | 
|---|
|  | 1803 | jc = ipp2 - j; | 
|---|
|  | 1804 | idlj += inc; | 
|---|
|  | 1805 | if (idlj > idp) { | 
|---|
|  | 1806 | idlj -= idp; | 
|---|
|  | 1807 | } | 
|---|
|  | 1808 | war = wa[idlj - 1]; | 
|---|
|  | 1809 | wai = wa[idlj]; | 
|---|
|  | 1810 | i__3 = *idl1; | 
|---|
|  | 1811 | for (ik = 1; ik <= i__3; ++ik) { | 
|---|
|  | 1812 | c2[ik + l * c2_dim1] += war * ch2[ik + j * ch2_dim1]; | 
|---|
|  | 1813 | c2[ik + lc * c2_dim1] -= wai * ch2[ik + jc * ch2_dim1]; | 
|---|
|  | 1814 | /* L114: */ | 
|---|
|  | 1815 | } | 
|---|
|  | 1816 | /* L115: */ | 
|---|
|  | 1817 | } | 
|---|
|  | 1818 | /* L116: */ | 
|---|
|  | 1819 | } | 
|---|
|  | 1820 | i__1 = ipph; | 
|---|
|  | 1821 | for (j = 2; j <= i__1; ++j) { | 
|---|
|  | 1822 | i__2 = *idl1; | 
|---|
|  | 1823 | for (ik = 1; ik <= i__2; ++ik) { | 
|---|
|  | 1824 | ch2[ik + ch2_dim1] += ch2[ik + j * ch2_dim1]; | 
|---|
|  | 1825 | /* L117: */ | 
|---|
|  | 1826 | } | 
|---|
|  | 1827 | /* L118: */ | 
|---|
|  | 1828 | } | 
|---|
|  | 1829 | i__1 = ipph; | 
|---|
|  | 1830 | for (j = 2; j <= i__1; ++j) { | 
|---|
|  | 1831 | jc = ipp2 - j; | 
|---|
|  | 1832 | i__2 = *idl1; | 
|---|
|  | 1833 | for (ik = 2; ik <= i__2; ik += 2) { | 
|---|
|  | 1834 | ch2[ik - 1 + j * ch2_dim1] = c2[ik - 1 + j * c2_dim1] - c2[ik + | 
|---|
|  | 1835 | jc * c2_dim1]; | 
|---|
|  | 1836 | ch2[ik - 1 + jc * ch2_dim1] = c2[ik - 1 + j * c2_dim1] + c2[ik + | 
|---|
|  | 1837 | jc * c2_dim1]; | 
|---|
|  | 1838 | ch2[ik + j * ch2_dim1] = c2[ik + j * c2_dim1] + c2[ik - 1 + jc * | 
|---|
|  | 1839 | c2_dim1]; | 
|---|
|  | 1840 | ch2[ik + jc * ch2_dim1] = c2[ik + j * c2_dim1] - c2[ik - 1 + jc * | 
|---|
|  | 1841 | c2_dim1]; | 
|---|
|  | 1842 | /* L119: */ | 
|---|
|  | 1843 | } | 
|---|
|  | 1844 | /* L120: */ | 
|---|
|  | 1845 | } | 
|---|
|  | 1846 | *nac = 1; | 
|---|
|  | 1847 | if (*ido == 2) { | 
|---|
|  | 1848 | return 0; | 
|---|
|  | 1849 | } | 
|---|
|  | 1850 | *nac = 0; | 
|---|
|  | 1851 | i__1 = *idl1; | 
|---|
|  | 1852 | for (ik = 1; ik <= i__1; ++ik) { | 
|---|
|  | 1853 | c2[ik + c2_dim1] = ch2[ik + ch2_dim1]; | 
|---|
|  | 1854 | /* L121: */ | 
|---|
|  | 1855 | } | 
|---|
|  | 1856 | i__1 = *ip; | 
|---|
|  | 1857 | for (j = 2; j <= i__1; ++j) { | 
|---|
|  | 1858 | i__2 = *l1; | 
|---|
|  | 1859 | for (k = 1; k <= i__2; ++k) { | 
|---|
|  | 1860 | c1[(k + j * c1_dim2) * c1_dim1 + 1] = ch[(k + j * ch_dim2) * | 
|---|
|  | 1861 | ch_dim1 + 1]; | 
|---|
|  | 1862 | c1[(k + j * c1_dim2) * c1_dim1 + 2] = ch[(k + j * ch_dim2) * | 
|---|
|  | 1863 | ch_dim1 + 2]; | 
|---|
|  | 1864 | /* L122: */ | 
|---|
|  | 1865 | } | 
|---|
|  | 1866 | /* L123: */ | 
|---|
|  | 1867 | } | 
|---|
|  | 1868 | if (idot > *l1) { | 
|---|
|  | 1869 | goto L127; | 
|---|
|  | 1870 | } | 
|---|
|  | 1871 | idij = 0; | 
|---|
|  | 1872 | i__1 = *ip; | 
|---|
|  | 1873 | for (j = 2; j <= i__1; ++j) { | 
|---|
|  | 1874 | idij += 2; | 
|---|
|  | 1875 | i__2 = *ido; | 
|---|
|  | 1876 | for (i__ = 4; i__ <= i__2; i__ += 2) { | 
|---|
|  | 1877 | idij += 2; | 
|---|
|  | 1878 | i__3 = *l1; | 
|---|
|  | 1879 | for (k = 1; k <= i__3; ++k) { | 
|---|
|  | 1880 | c1[i__ - 1 + (k + j * c1_dim2) * c1_dim1] = wa[idij - 1] * ch[ | 
|---|
|  | 1881 | i__ - 1 + (k + j * ch_dim2) * ch_dim1] + wa[idij] * | 
|---|
|  | 1882 | ch[i__ + (k + j * ch_dim2) * ch_dim1]; | 
|---|
|  | 1883 | c1[i__ + (k + j * c1_dim2) * c1_dim1] = wa[idij - 1] * ch[i__ | 
|---|
|  | 1884 | + (k + j * ch_dim2) * ch_dim1] - wa[idij] * ch[i__ - | 
|---|
|  | 1885 | 1 + (k + j * ch_dim2) * ch_dim1]; | 
|---|
|  | 1886 | /* L124: */ | 
|---|
|  | 1887 | } | 
|---|
|  | 1888 | /* L125: */ | 
|---|
|  | 1889 | } | 
|---|
|  | 1890 | /* L126: */ | 
|---|
|  | 1891 | } | 
|---|
|  | 1892 | return 0; | 
|---|
|  | 1893 | L127: | 
|---|
|  | 1894 | idj = 2 - *ido; | 
|---|
|  | 1895 | i__1 = *ip; | 
|---|
|  | 1896 | for (j = 2; j <= i__1; ++j) { | 
|---|
|  | 1897 | idj += *ido; | 
|---|
|  | 1898 | i__2 = *l1; | 
|---|
|  | 1899 | for (k = 1; k <= i__2; ++k) { | 
|---|
|  | 1900 | idij = idj; | 
|---|
|  | 1901 | i__3 = *ido; | 
|---|
|  | 1902 | for (i__ = 4; i__ <= i__3; i__ += 2) { | 
|---|
|  | 1903 | idij += 2; | 
|---|
|  | 1904 | c1[i__ - 1 + (k + j * c1_dim2) * c1_dim1] = wa[idij - 1] * ch[ | 
|---|
|  | 1905 | i__ - 1 + (k + j * ch_dim2) * ch_dim1] + wa[idij] * | 
|---|
|  | 1906 | ch[i__ + (k + j * ch_dim2) * ch_dim1]; | 
|---|
|  | 1907 | c1[i__ + (k + j * c1_dim2) * c1_dim1] = wa[idij - 1] * ch[i__ | 
|---|
|  | 1908 | + (k + j * ch_dim2) * ch_dim1] - wa[idij] * ch[i__ - | 
|---|
|  | 1909 | 1 + (k + j * ch_dim2) * ch_dim1]; | 
|---|
|  | 1910 | /* L128: */ | 
|---|
|  | 1911 | } | 
|---|
|  | 1912 | /* L129: */ | 
|---|
|  | 1913 | } | 
|---|
|  | 1914 | /* L130: */ | 
|---|
|  | 1915 | } | 
|---|
|  | 1916 | return 0; | 
|---|
|  | 1917 | } /* passf_ */ | 
|---|
|  | 1918 |  | 
|---|
|  | 1919 | /*  ------ File passf2.f ------ */ | 
|---|
| [756] | 1920 | /* Subroutine */ int passf2_(int_4 *ido, int_4 *l1, r_4 *cc, r_4 *ch, | 
|---|
| [717] | 1921 | r_4 *wa1) | 
|---|
| [459] | 1922 | { | 
|---|
|  | 1923 | /* System generated locals */ | 
|---|
| [756] | 1924 | int_4 cc_dim1, cc_offset, ch_dim1, ch_dim2, ch_offset, i__1, i__2; | 
|---|
| [459] | 1925 |  | 
|---|
|  | 1926 | /* Local variables */ | 
|---|
| [756] | 1927 | static int_4 i__, k; | 
|---|
| [717] | 1928 | static r_4 ti2, tr2; | 
|---|
| [459] | 1929 |  | 
|---|
|  | 1930 | /* Parameter adjustments */ | 
|---|
|  | 1931 | ch_dim1 = *ido; | 
|---|
|  | 1932 | ch_dim2 = *l1; | 
|---|
|  | 1933 | ch_offset = ch_dim1 * (ch_dim2 + 1) + 1; | 
|---|
|  | 1934 | ch -= ch_offset; | 
|---|
|  | 1935 | cc_dim1 = *ido; | 
|---|
|  | 1936 | cc_offset = cc_dim1 * 3 + 1; | 
|---|
|  | 1937 | cc -= cc_offset; | 
|---|
|  | 1938 | --wa1; | 
|---|
|  | 1939 |  | 
|---|
|  | 1940 | /* Function Body */ | 
|---|
|  | 1941 | if (*ido > 2) { | 
|---|
|  | 1942 | goto L102; | 
|---|
|  | 1943 | } | 
|---|
|  | 1944 | i__1 = *l1; | 
|---|
|  | 1945 | for (k = 1; k <= i__1; ++k) { | 
|---|
|  | 1946 | ch[(k + ch_dim2) * ch_dim1 + 1] = cc[((k << 1) + 1) * cc_dim1 + 1] + | 
|---|
|  | 1947 | cc[((k << 1) + 2) * cc_dim1 + 1]; | 
|---|
|  | 1948 | ch[(k + (ch_dim2 << 1)) * ch_dim1 + 1] = cc[((k << 1) + 1) * cc_dim1 | 
|---|
|  | 1949 | + 1] - cc[((k << 1) + 2) * cc_dim1 + 1]; | 
|---|
|  | 1950 | ch[(k + ch_dim2) * ch_dim1 + 2] = cc[((k << 1) + 1) * cc_dim1 + 2] + | 
|---|
|  | 1951 | cc[((k << 1) + 2) * cc_dim1 + 2]; | 
|---|
|  | 1952 | ch[(k + (ch_dim2 << 1)) * ch_dim1 + 2] = cc[((k << 1) + 1) * cc_dim1 | 
|---|
|  | 1953 | + 2] - cc[((k << 1) + 2) * cc_dim1 + 2]; | 
|---|
|  | 1954 | /* L101: */ | 
|---|
|  | 1955 | } | 
|---|
|  | 1956 | return 0; | 
|---|
|  | 1957 | L102: | 
|---|
|  | 1958 | i__1 = *l1; | 
|---|
|  | 1959 | for (k = 1; k <= i__1; ++k) { | 
|---|
|  | 1960 | i__2 = *ido; | 
|---|
|  | 1961 | for (i__ = 2; i__ <= i__2; i__ += 2) { | 
|---|
|  | 1962 | ch[i__ - 1 + (k + ch_dim2) * ch_dim1] = cc[i__ - 1 + ((k << 1) + | 
|---|
|  | 1963 | 1) * cc_dim1] + cc[i__ - 1 + ((k << 1) + 2) * cc_dim1]; | 
|---|
|  | 1964 | tr2 = cc[i__ - 1 + ((k << 1) + 1) * cc_dim1] - cc[i__ - 1 + ((k << | 
|---|
|  | 1965 | 1) + 2) * cc_dim1]; | 
|---|
|  | 1966 | ch[i__ + (k + ch_dim2) * ch_dim1] = cc[i__ + ((k << 1) + 1) * | 
|---|
|  | 1967 | cc_dim1] + cc[i__ + ((k << 1) + 2) * cc_dim1]; | 
|---|
|  | 1968 | ti2 = cc[i__ + ((k << 1) + 1) * cc_dim1] - cc[i__ + ((k << 1) + 2) | 
|---|
|  | 1969 | * cc_dim1]; | 
|---|
|  | 1970 | ch[i__ + (k + (ch_dim2 << 1)) * ch_dim1] = wa1[i__ - 1] * ti2 - | 
|---|
|  | 1971 | wa1[i__] * tr2; | 
|---|
|  | 1972 | ch[i__ - 1 + (k + (ch_dim2 << 1)) * ch_dim1] = wa1[i__ - 1] * tr2 | 
|---|
|  | 1973 | + wa1[i__] * ti2; | 
|---|
|  | 1974 | /* L103: */ | 
|---|
|  | 1975 | } | 
|---|
|  | 1976 | /* L104: */ | 
|---|
|  | 1977 | } | 
|---|
|  | 1978 | return 0; | 
|---|
|  | 1979 | } /* passf2_ */ | 
|---|
|  | 1980 |  | 
|---|
|  | 1981 | /*  ------ File passf3.f ------ */ | 
|---|
| [756] | 1982 | /* Subroutine */ int passf3_(int_4 *ido, int_4 *l1, r_4 *cc, r_4 *ch, | 
|---|
| [717] | 1983 | r_4 *wa1, r_4 *wa2) | 
|---|
| [459] | 1984 | { | 
|---|
|  | 1985 | /* Initialized data */ | 
|---|
|  | 1986 |  | 
|---|
| [717] | 1987 | static r_4 taur = -.5f; | 
|---|
|  | 1988 | static r_4 taui = -.866025403784439f; | 
|---|
| [459] | 1989 |  | 
|---|
|  | 1990 | /* System generated locals */ | 
|---|
| [756] | 1991 | int_4 cc_dim1, cc_offset, ch_dim1, ch_dim2, ch_offset, i__1, i__2; | 
|---|
| [459] | 1992 |  | 
|---|
|  | 1993 | /* Local variables */ | 
|---|
| [756] | 1994 | static int_4 i__, k; | 
|---|
| [717] | 1995 | static r_4 ci2, ci3, di2, di3, cr2, cr3, dr2, dr3, ti2, tr2; | 
|---|
| [459] | 1996 |  | 
|---|
|  | 1997 | /* Parameter adjustments */ | 
|---|
|  | 1998 | ch_dim1 = *ido; | 
|---|
|  | 1999 | ch_dim2 = *l1; | 
|---|
|  | 2000 | ch_offset = ch_dim1 * (ch_dim2 + 1) + 1; | 
|---|
|  | 2001 | ch -= ch_offset; | 
|---|
|  | 2002 | cc_dim1 = *ido; | 
|---|
|  | 2003 | cc_offset = (cc_dim1 << 2) + 1; | 
|---|
|  | 2004 | cc -= cc_offset; | 
|---|
|  | 2005 | --wa1; | 
|---|
|  | 2006 | --wa2; | 
|---|
|  | 2007 |  | 
|---|
|  | 2008 | /* Function Body */ | 
|---|
|  | 2009 | if (*ido != 2) { | 
|---|
|  | 2010 | goto L102; | 
|---|
|  | 2011 | } | 
|---|
|  | 2012 | i__1 = *l1; | 
|---|
|  | 2013 | for (k = 1; k <= i__1; ++k) { | 
|---|
|  | 2014 | tr2 = cc[(k * 3 + 2) * cc_dim1 + 1] + cc[(k * 3 + 3) * cc_dim1 + 1]; | 
|---|
|  | 2015 | cr2 = cc[(k * 3 + 1) * cc_dim1 + 1] + taur * tr2; | 
|---|
|  | 2016 | ch[(k + ch_dim2) * ch_dim1 + 1] = cc[(k * 3 + 1) * cc_dim1 + 1] + tr2; | 
|---|
|  | 2017 | ti2 = cc[(k * 3 + 2) * cc_dim1 + 2] + cc[(k * 3 + 3) * cc_dim1 + 2]; | 
|---|
|  | 2018 | ci2 = cc[(k * 3 + 1) * cc_dim1 + 2] + taur * ti2; | 
|---|
|  | 2019 | ch[(k + ch_dim2) * ch_dim1 + 2] = cc[(k * 3 + 1) * cc_dim1 + 2] + ti2; | 
|---|
|  | 2020 | cr3 = taui * (cc[(k * 3 + 2) * cc_dim1 + 1] - cc[(k * 3 + 3) * | 
|---|
|  | 2021 | cc_dim1 + 1]); | 
|---|
|  | 2022 | ci3 = taui * (cc[(k * 3 + 2) * cc_dim1 + 2] - cc[(k * 3 + 3) * | 
|---|
|  | 2023 | cc_dim1 + 2]); | 
|---|
|  | 2024 | ch[(k + (ch_dim2 << 1)) * ch_dim1 + 1] = cr2 - ci3; | 
|---|
|  | 2025 | ch[(k + ch_dim2 * 3) * ch_dim1 + 1] = cr2 + ci3; | 
|---|
|  | 2026 | ch[(k + (ch_dim2 << 1)) * ch_dim1 + 2] = ci2 + cr3; | 
|---|
|  | 2027 | ch[(k + ch_dim2 * 3) * ch_dim1 + 2] = ci2 - cr3; | 
|---|
|  | 2028 | /* L101: */ | 
|---|
|  | 2029 | } | 
|---|
|  | 2030 | return 0; | 
|---|
|  | 2031 | L102: | 
|---|
|  | 2032 | i__1 = *l1; | 
|---|
|  | 2033 | for (k = 1; k <= i__1; ++k) { | 
|---|
|  | 2034 | i__2 = *ido; | 
|---|
|  | 2035 | for (i__ = 2; i__ <= i__2; i__ += 2) { | 
|---|
|  | 2036 | tr2 = cc[i__ - 1 + (k * 3 + 2) * cc_dim1] + cc[i__ - 1 + (k * 3 + | 
|---|
|  | 2037 | 3) * cc_dim1]; | 
|---|
|  | 2038 | cr2 = cc[i__ - 1 + (k * 3 + 1) * cc_dim1] + taur * tr2; | 
|---|
|  | 2039 | ch[i__ - 1 + (k + ch_dim2) * ch_dim1] = cc[i__ - 1 + (k * 3 + 1) * | 
|---|
|  | 2040 | cc_dim1] + tr2; | 
|---|
|  | 2041 | ti2 = cc[i__ + (k * 3 + 2) * cc_dim1] + cc[i__ + (k * 3 + 3) * | 
|---|
|  | 2042 | cc_dim1]; | 
|---|
|  | 2043 | ci2 = cc[i__ + (k * 3 + 1) * cc_dim1] + taur * ti2; | 
|---|
|  | 2044 | ch[i__ + (k + ch_dim2) * ch_dim1] = cc[i__ + (k * 3 + 1) * | 
|---|
|  | 2045 | cc_dim1] + ti2; | 
|---|
|  | 2046 | cr3 = taui * (cc[i__ - 1 + (k * 3 + 2) * cc_dim1] - cc[i__ - 1 + ( | 
|---|
|  | 2047 | k * 3 + 3) * cc_dim1]); | 
|---|
|  | 2048 | ci3 = taui * (cc[i__ + (k * 3 + 2) * cc_dim1] - cc[i__ + (k * 3 + | 
|---|
|  | 2049 | 3) * cc_dim1]); | 
|---|
|  | 2050 | dr2 = cr2 - ci3; | 
|---|
|  | 2051 | dr3 = cr2 + ci3; | 
|---|
|  | 2052 | di2 = ci2 + cr3; | 
|---|
|  | 2053 | di3 = ci2 - cr3; | 
|---|
|  | 2054 | ch[i__ + (k + (ch_dim2 << 1)) * ch_dim1] = wa1[i__ - 1] * di2 - | 
|---|
|  | 2055 | wa1[i__] * dr2; | 
|---|
|  | 2056 | ch[i__ - 1 + (k + (ch_dim2 << 1)) * ch_dim1] = wa1[i__ - 1] * dr2 | 
|---|
|  | 2057 | + wa1[i__] * di2; | 
|---|
|  | 2058 | ch[i__ + (k + ch_dim2 * 3) * ch_dim1] = wa2[i__ - 1] * di3 - wa2[ | 
|---|
|  | 2059 | i__] * dr3; | 
|---|
|  | 2060 | ch[i__ - 1 + (k + ch_dim2 * 3) * ch_dim1] = wa2[i__ - 1] * dr3 + | 
|---|
|  | 2061 | wa2[i__] * di3; | 
|---|
|  | 2062 | /* L103: */ | 
|---|
|  | 2063 | } | 
|---|
|  | 2064 | /* L104: */ | 
|---|
|  | 2065 | } | 
|---|
|  | 2066 | return 0; | 
|---|
|  | 2067 | } /* passf3_ */ | 
|---|
|  | 2068 |  | 
|---|
|  | 2069 | /*  ------ File passf4.f ------ */ | 
|---|
| [756] | 2070 | /* Subroutine */ int passf4_(int_4 *ido, int_4 *l1, r_4 *cc, r_4 *ch, | 
|---|
| [717] | 2071 | r_4 *wa1, r_4 *wa2, r_4 *wa3) | 
|---|
| [459] | 2072 | { | 
|---|
|  | 2073 | /* System generated locals */ | 
|---|
| [756] | 2074 | int_4 cc_dim1, cc_offset, ch_dim1, ch_dim2, ch_offset, i__1, i__2; | 
|---|
| [459] | 2075 |  | 
|---|
|  | 2076 | /* Local variables */ | 
|---|
| [756] | 2077 | static int_4 i__, k; | 
|---|
| [717] | 2078 | static r_4 ci2, ci3, ci4, cr2, cr3, cr4, ti1, ti2, ti3, ti4, tr1, tr2, | 
|---|
| [459] | 2079 | tr3, tr4; | 
|---|
|  | 2080 |  | 
|---|
|  | 2081 | /* Parameter adjustments */ | 
|---|
|  | 2082 | ch_dim1 = *ido; | 
|---|
|  | 2083 | ch_dim2 = *l1; | 
|---|
|  | 2084 | ch_offset = ch_dim1 * (ch_dim2 + 1) + 1; | 
|---|
|  | 2085 | ch -= ch_offset; | 
|---|
|  | 2086 | cc_dim1 = *ido; | 
|---|
|  | 2087 | cc_offset = cc_dim1 * 5 + 1; | 
|---|
|  | 2088 | cc -= cc_offset; | 
|---|
|  | 2089 | --wa1; | 
|---|
|  | 2090 | --wa2; | 
|---|
|  | 2091 | --wa3; | 
|---|
|  | 2092 |  | 
|---|
|  | 2093 | /* Function Body */ | 
|---|
|  | 2094 | if (*ido != 2) { | 
|---|
|  | 2095 | goto L102; | 
|---|
|  | 2096 | } | 
|---|
|  | 2097 | i__1 = *l1; | 
|---|
|  | 2098 | for (k = 1; k <= i__1; ++k) { | 
|---|
|  | 2099 | ti1 = cc[((k << 2) + 1) * cc_dim1 + 2] - cc[((k << 2) + 3) * cc_dim1 | 
|---|
|  | 2100 | + 2]; | 
|---|
|  | 2101 | ti2 = cc[((k << 2) + 1) * cc_dim1 + 2] + cc[((k << 2) + 3) * cc_dim1 | 
|---|
|  | 2102 | + 2]; | 
|---|
|  | 2103 | tr4 = cc[((k << 2) + 2) * cc_dim1 + 2] - cc[((k << 2) + 4) * cc_dim1 | 
|---|
|  | 2104 | + 2]; | 
|---|
|  | 2105 | ti3 = cc[((k << 2) + 2) * cc_dim1 + 2] + cc[((k << 2) + 4) * cc_dim1 | 
|---|
|  | 2106 | + 2]; | 
|---|
|  | 2107 | tr1 = cc[((k << 2) + 1) * cc_dim1 + 1] - cc[((k << 2) + 3) * cc_dim1 | 
|---|
|  | 2108 | + 1]; | 
|---|
|  | 2109 | tr2 = cc[((k << 2) + 1) * cc_dim1 + 1] + cc[((k << 2) + 3) * cc_dim1 | 
|---|
|  | 2110 | + 1]; | 
|---|
|  | 2111 | ti4 = cc[((k << 2) + 4) * cc_dim1 + 1] - cc[((k << 2) + 2) * cc_dim1 | 
|---|
|  | 2112 | + 1]; | 
|---|
|  | 2113 | tr3 = cc[((k << 2) + 2) * cc_dim1 + 1] + cc[((k << 2) + 4) * cc_dim1 | 
|---|
|  | 2114 | + 1]; | 
|---|
|  | 2115 | ch[(k + ch_dim2) * ch_dim1 + 1] = tr2 + tr3; | 
|---|
|  | 2116 | ch[(k + ch_dim2 * 3) * ch_dim1 + 1] = tr2 - tr3; | 
|---|
|  | 2117 | ch[(k + ch_dim2) * ch_dim1 + 2] = ti2 + ti3; | 
|---|
|  | 2118 | ch[(k + ch_dim2 * 3) * ch_dim1 + 2] = ti2 - ti3; | 
|---|
|  | 2119 | ch[(k + (ch_dim2 << 1)) * ch_dim1 + 1] = tr1 + tr4; | 
|---|
|  | 2120 | ch[(k + (ch_dim2 << 2)) * ch_dim1 + 1] = tr1 - tr4; | 
|---|
|  | 2121 | ch[(k + (ch_dim2 << 1)) * ch_dim1 + 2] = ti1 + ti4; | 
|---|
|  | 2122 | ch[(k + (ch_dim2 << 2)) * ch_dim1 + 2] = ti1 - ti4; | 
|---|
|  | 2123 | /* L101: */ | 
|---|
|  | 2124 | } | 
|---|
|  | 2125 | return 0; | 
|---|
|  | 2126 | L102: | 
|---|
|  | 2127 | i__1 = *l1; | 
|---|
|  | 2128 | for (k = 1; k <= i__1; ++k) { | 
|---|
|  | 2129 | i__2 = *ido; | 
|---|
|  | 2130 | for (i__ = 2; i__ <= i__2; i__ += 2) { | 
|---|
|  | 2131 | ti1 = cc[i__ + ((k << 2) + 1) * cc_dim1] - cc[i__ + ((k << 2) + 3) | 
|---|
|  | 2132 | * cc_dim1]; | 
|---|
|  | 2133 | ti2 = cc[i__ + ((k << 2) + 1) * cc_dim1] + cc[i__ + ((k << 2) + 3) | 
|---|
|  | 2134 | * cc_dim1]; | 
|---|
|  | 2135 | ti3 = cc[i__ + ((k << 2) + 2) * cc_dim1] + cc[i__ + ((k << 2) + 4) | 
|---|
|  | 2136 | * cc_dim1]; | 
|---|
|  | 2137 | tr4 = cc[i__ + ((k << 2) + 2) * cc_dim1] - cc[i__ + ((k << 2) + 4) | 
|---|
|  | 2138 | * cc_dim1]; | 
|---|
|  | 2139 | tr1 = cc[i__ - 1 + ((k << 2) + 1) * cc_dim1] - cc[i__ - 1 + ((k << | 
|---|
|  | 2140 | 2) + 3) * cc_dim1]; | 
|---|
|  | 2141 | tr2 = cc[i__ - 1 + ((k << 2) + 1) * cc_dim1] + cc[i__ - 1 + ((k << | 
|---|
|  | 2142 | 2) + 3) * cc_dim1]; | 
|---|
|  | 2143 | ti4 = cc[i__ - 1 + ((k << 2) + 4) * cc_dim1] - cc[i__ - 1 + ((k << | 
|---|
|  | 2144 | 2) + 2) * cc_dim1]; | 
|---|
|  | 2145 | tr3 = cc[i__ - 1 + ((k << 2) + 2) * cc_dim1] + cc[i__ - 1 + ((k << | 
|---|
|  | 2146 | 2) + 4) * cc_dim1]; | 
|---|
|  | 2147 | ch[i__ - 1 + (k + ch_dim2) * ch_dim1] = tr2 + tr3; | 
|---|
|  | 2148 | cr3 = tr2 - tr3; | 
|---|
|  | 2149 | ch[i__ + (k + ch_dim2) * ch_dim1] = ti2 + ti3; | 
|---|
|  | 2150 | ci3 = ti2 - ti3; | 
|---|
|  | 2151 | cr2 = tr1 + tr4; | 
|---|
|  | 2152 | cr4 = tr1 - tr4; | 
|---|
|  | 2153 | ci2 = ti1 + ti4; | 
|---|
|  | 2154 | ci4 = ti1 - ti4; | 
|---|
|  | 2155 | ch[i__ - 1 + (k + (ch_dim2 << 1)) * ch_dim1] = wa1[i__ - 1] * cr2 | 
|---|
|  | 2156 | + wa1[i__] * ci2; | 
|---|
|  | 2157 | ch[i__ + (k + (ch_dim2 << 1)) * ch_dim1] = wa1[i__ - 1] * ci2 - | 
|---|
|  | 2158 | wa1[i__] * cr2; | 
|---|
|  | 2159 | ch[i__ - 1 + (k + ch_dim2 * 3) * ch_dim1] = wa2[i__ - 1] * cr3 + | 
|---|
|  | 2160 | wa2[i__] * ci3; | 
|---|
|  | 2161 | ch[i__ + (k + ch_dim2 * 3) * ch_dim1] = wa2[i__ - 1] * ci3 - wa2[ | 
|---|
|  | 2162 | i__] * cr3; | 
|---|
|  | 2163 | ch[i__ - 1 + (k + (ch_dim2 << 2)) * ch_dim1] = wa3[i__ - 1] * cr4 | 
|---|
|  | 2164 | + wa3[i__] * ci4; | 
|---|
|  | 2165 | ch[i__ + (k + (ch_dim2 << 2)) * ch_dim1] = wa3[i__ - 1] * ci4 - | 
|---|
|  | 2166 | wa3[i__] * cr4; | 
|---|
|  | 2167 | /* L103: */ | 
|---|
|  | 2168 | } | 
|---|
|  | 2169 | /* L104: */ | 
|---|
|  | 2170 | } | 
|---|
|  | 2171 | return 0; | 
|---|
|  | 2172 | } /* passf4_ */ | 
|---|
|  | 2173 |  | 
|---|
|  | 2174 | /*  ------ File passf5.f ------ */ | 
|---|
| [756] | 2175 | /* Subroutine */ int passf5_(int_4 *ido, int_4 *l1, r_4 *cc, r_4 *ch, | 
|---|
| [717] | 2176 | r_4 *wa1, r_4 *wa2, r_4 *wa3, r_4 *wa4) | 
|---|
| [459] | 2177 | { | 
|---|
|  | 2178 | /* Initialized data */ | 
|---|
|  | 2179 |  | 
|---|
| [717] | 2180 | static r_4 tr11 = .309016994374947f; | 
|---|
|  | 2181 | static r_4 ti11 = -.951056516295154f; | 
|---|
|  | 2182 | static r_4 tr12 = -.809016994374947f; | 
|---|
|  | 2183 | static r_4 ti12 = -.587785252292473f; | 
|---|
| [459] | 2184 |  | 
|---|
|  | 2185 | /* System generated locals */ | 
|---|
| [756] | 2186 | int_4 cc_dim1, cc_offset, ch_dim1, ch_dim2, ch_offset, i__1, i__2; | 
|---|
| [459] | 2187 |  | 
|---|
|  | 2188 | /* Local variables */ | 
|---|
| [756] | 2189 | static int_4 i__, k; | 
|---|
| [717] | 2190 | static r_4 ci2, ci3, ci4, ci5, di3, di4, di5, di2, cr2, cr3, cr5, cr4, | 
|---|
| [459] | 2191 | ti2, ti3, ti4, ti5, dr3, dr4, dr5, dr2, tr2, tr3, tr4, tr5; | 
|---|
|  | 2192 |  | 
|---|
|  | 2193 | /* Parameter adjustments */ | 
|---|
|  | 2194 | ch_dim1 = *ido; | 
|---|
|  | 2195 | ch_dim2 = *l1; | 
|---|
|  | 2196 | ch_offset = ch_dim1 * (ch_dim2 + 1) + 1; | 
|---|
|  | 2197 | ch -= ch_offset; | 
|---|
|  | 2198 | cc_dim1 = *ido; | 
|---|
|  | 2199 | cc_offset = cc_dim1 * 6 + 1; | 
|---|
|  | 2200 | cc -= cc_offset; | 
|---|
|  | 2201 | --wa1; | 
|---|
|  | 2202 | --wa2; | 
|---|
|  | 2203 | --wa3; | 
|---|
|  | 2204 | --wa4; | 
|---|
|  | 2205 |  | 
|---|
|  | 2206 | /* Function Body */ | 
|---|
|  | 2207 | if (*ido != 2) { | 
|---|
|  | 2208 | goto L102; | 
|---|
|  | 2209 | } | 
|---|
|  | 2210 | i__1 = *l1; | 
|---|
|  | 2211 | for (k = 1; k <= i__1; ++k) { | 
|---|
|  | 2212 | ti5 = cc[(k * 5 + 2) * cc_dim1 + 2] - cc[(k * 5 + 5) * cc_dim1 + 2]; | 
|---|
|  | 2213 | ti2 = cc[(k * 5 + 2) * cc_dim1 + 2] + cc[(k * 5 + 5) * cc_dim1 + 2]; | 
|---|
|  | 2214 | ti4 = cc[(k * 5 + 3) * cc_dim1 + 2] - cc[(k * 5 + 4) * cc_dim1 + 2]; | 
|---|
|  | 2215 | ti3 = cc[(k * 5 + 3) * cc_dim1 + 2] + cc[(k * 5 + 4) * cc_dim1 + 2]; | 
|---|
|  | 2216 | tr5 = cc[(k * 5 + 2) * cc_dim1 + 1] - cc[(k * 5 + 5) * cc_dim1 + 1]; | 
|---|
|  | 2217 | tr2 = cc[(k * 5 + 2) * cc_dim1 + 1] + cc[(k * 5 + 5) * cc_dim1 + 1]; | 
|---|
|  | 2218 | tr4 = cc[(k * 5 + 3) * cc_dim1 + 1] - cc[(k * 5 + 4) * cc_dim1 + 1]; | 
|---|
|  | 2219 | tr3 = cc[(k * 5 + 3) * cc_dim1 + 1] + cc[(k * 5 + 4) * cc_dim1 + 1]; | 
|---|
|  | 2220 | ch[(k + ch_dim2) * ch_dim1 + 1] = cc[(k * 5 + 1) * cc_dim1 + 1] + tr2 | 
|---|
|  | 2221 | + tr3; | 
|---|
|  | 2222 | ch[(k + ch_dim2) * ch_dim1 + 2] = cc[(k * 5 + 1) * cc_dim1 + 2] + ti2 | 
|---|
|  | 2223 | + ti3; | 
|---|
|  | 2224 | cr2 = cc[(k * 5 + 1) * cc_dim1 + 1] + tr11 * tr2 + tr12 * tr3; | 
|---|
|  | 2225 | ci2 = cc[(k * 5 + 1) * cc_dim1 + 2] + tr11 * ti2 + tr12 * ti3; | 
|---|
|  | 2226 | cr3 = cc[(k * 5 + 1) * cc_dim1 + 1] + tr12 * tr2 + tr11 * tr3; | 
|---|
|  | 2227 | ci3 = cc[(k * 5 + 1) * cc_dim1 + 2] + tr12 * ti2 + tr11 * ti3; | 
|---|
|  | 2228 | cr5 = ti11 * tr5 + ti12 * tr4; | 
|---|
|  | 2229 | ci5 = ti11 * ti5 + ti12 * ti4; | 
|---|
|  | 2230 | cr4 = ti12 * tr5 - ti11 * tr4; | 
|---|
|  | 2231 | ci4 = ti12 * ti5 - ti11 * ti4; | 
|---|
|  | 2232 | ch[(k + (ch_dim2 << 1)) * ch_dim1 + 1] = cr2 - ci5; | 
|---|
|  | 2233 | ch[(k + ch_dim2 * 5) * ch_dim1 + 1] = cr2 + ci5; | 
|---|
|  | 2234 | ch[(k + (ch_dim2 << 1)) * ch_dim1 + 2] = ci2 + cr5; | 
|---|
|  | 2235 | ch[(k + ch_dim2 * 3) * ch_dim1 + 2] = ci3 + cr4; | 
|---|
|  | 2236 | ch[(k + ch_dim2 * 3) * ch_dim1 + 1] = cr3 - ci4; | 
|---|
|  | 2237 | ch[(k + (ch_dim2 << 2)) * ch_dim1 + 1] = cr3 + ci4; | 
|---|
|  | 2238 | ch[(k + (ch_dim2 << 2)) * ch_dim1 + 2] = ci3 - cr4; | 
|---|
|  | 2239 | ch[(k + ch_dim2 * 5) * ch_dim1 + 2] = ci2 - cr5; | 
|---|
|  | 2240 | /* L101: */ | 
|---|
|  | 2241 | } | 
|---|
|  | 2242 | return 0; | 
|---|
|  | 2243 | L102: | 
|---|
|  | 2244 | i__1 = *l1; | 
|---|
|  | 2245 | for (k = 1; k <= i__1; ++k) { | 
|---|
|  | 2246 | i__2 = *ido; | 
|---|
|  | 2247 | for (i__ = 2; i__ <= i__2; i__ += 2) { | 
|---|
|  | 2248 | ti5 = cc[i__ + (k * 5 + 2) * cc_dim1] - cc[i__ + (k * 5 + 5) * | 
|---|
|  | 2249 | cc_dim1]; | 
|---|
|  | 2250 | ti2 = cc[i__ + (k * 5 + 2) * cc_dim1] + cc[i__ + (k * 5 + 5) * | 
|---|
|  | 2251 | cc_dim1]; | 
|---|
|  | 2252 | ti4 = cc[i__ + (k * 5 + 3) * cc_dim1] - cc[i__ + (k * 5 + 4) * | 
|---|
|  | 2253 | cc_dim1]; | 
|---|
|  | 2254 | ti3 = cc[i__ + (k * 5 + 3) * cc_dim1] + cc[i__ + (k * 5 + 4) * | 
|---|
|  | 2255 | cc_dim1]; | 
|---|
|  | 2256 | tr5 = cc[i__ - 1 + (k * 5 + 2) * cc_dim1] - cc[i__ - 1 + (k * 5 + | 
|---|
|  | 2257 | 5) * cc_dim1]; | 
|---|
|  | 2258 | tr2 = cc[i__ - 1 + (k * 5 + 2) * cc_dim1] + cc[i__ - 1 + (k * 5 + | 
|---|
|  | 2259 | 5) * cc_dim1]; | 
|---|
|  | 2260 | tr4 = cc[i__ - 1 + (k * 5 + 3) * cc_dim1] - cc[i__ - 1 + (k * 5 + | 
|---|
|  | 2261 | 4) * cc_dim1]; | 
|---|
|  | 2262 | tr3 = cc[i__ - 1 + (k * 5 + 3) * cc_dim1] + cc[i__ - 1 + (k * 5 + | 
|---|
|  | 2263 | 4) * cc_dim1]; | 
|---|
|  | 2264 | ch[i__ - 1 + (k + ch_dim2) * ch_dim1] = cc[i__ - 1 + (k * 5 + 1) * | 
|---|
|  | 2265 | cc_dim1] + tr2 + tr3; | 
|---|
|  | 2266 | ch[i__ + (k + ch_dim2) * ch_dim1] = cc[i__ + (k * 5 + 1) * | 
|---|
|  | 2267 | cc_dim1] + ti2 + ti3; | 
|---|
|  | 2268 | cr2 = cc[i__ - 1 + (k * 5 + 1) * cc_dim1] + tr11 * tr2 + tr12 * | 
|---|
|  | 2269 | tr3; | 
|---|
|  | 2270 | ci2 = cc[i__ + (k * 5 + 1) * cc_dim1] + tr11 * ti2 + tr12 * ti3; | 
|---|
|  | 2271 | cr3 = cc[i__ - 1 + (k * 5 + 1) * cc_dim1] + tr12 * tr2 + tr11 * | 
|---|
|  | 2272 | tr3; | 
|---|
|  | 2273 | ci3 = cc[i__ + (k * 5 + 1) * cc_dim1] + tr12 * ti2 + tr11 * ti3; | 
|---|
|  | 2274 | cr5 = ti11 * tr5 + ti12 * tr4; | 
|---|
|  | 2275 | ci5 = ti11 * ti5 + ti12 * ti4; | 
|---|
|  | 2276 | cr4 = ti12 * tr5 - ti11 * tr4; | 
|---|
|  | 2277 | ci4 = ti12 * ti5 - ti11 * ti4; | 
|---|
|  | 2278 | dr3 = cr3 - ci4; | 
|---|
|  | 2279 | dr4 = cr3 + ci4; | 
|---|
|  | 2280 | di3 = ci3 + cr4; | 
|---|
|  | 2281 | di4 = ci3 - cr4; | 
|---|
|  | 2282 | dr5 = cr2 + ci5; | 
|---|
|  | 2283 | dr2 = cr2 - ci5; | 
|---|
|  | 2284 | di5 = ci2 - cr5; | 
|---|
|  | 2285 | di2 = ci2 + cr5; | 
|---|
|  | 2286 | ch[i__ - 1 + (k + (ch_dim2 << 1)) * ch_dim1] = wa1[i__ - 1] * dr2 | 
|---|
|  | 2287 | + wa1[i__] * di2; | 
|---|
|  | 2288 | ch[i__ + (k + (ch_dim2 << 1)) * ch_dim1] = wa1[i__ - 1] * di2 - | 
|---|
|  | 2289 | wa1[i__] * dr2; | 
|---|
|  | 2290 | ch[i__ - 1 + (k + ch_dim2 * 3) * ch_dim1] = wa2[i__ - 1] * dr3 + | 
|---|
|  | 2291 | wa2[i__] * di3; | 
|---|
|  | 2292 | ch[i__ + (k + ch_dim2 * 3) * ch_dim1] = wa2[i__ - 1] * di3 - wa2[ | 
|---|
|  | 2293 | i__] * dr3; | 
|---|
|  | 2294 | ch[i__ - 1 + (k + (ch_dim2 << 2)) * ch_dim1] = wa3[i__ - 1] * dr4 | 
|---|
|  | 2295 | + wa3[i__] * di4; | 
|---|
|  | 2296 | ch[i__ + (k + (ch_dim2 << 2)) * ch_dim1] = wa3[i__ - 1] * di4 - | 
|---|
|  | 2297 | wa3[i__] * dr4; | 
|---|
|  | 2298 | ch[i__ - 1 + (k + ch_dim2 * 5) * ch_dim1] = wa4[i__ - 1] * dr5 + | 
|---|
|  | 2299 | wa4[i__] * di5; | 
|---|
|  | 2300 | ch[i__ + (k + ch_dim2 * 5) * ch_dim1] = wa4[i__ - 1] * di5 - wa4[ | 
|---|
|  | 2301 | i__] * dr5; | 
|---|
|  | 2302 | /* L103: */ | 
|---|
|  | 2303 | } | 
|---|
|  | 2304 | /* L104: */ | 
|---|
|  | 2305 | } | 
|---|
|  | 2306 | return 0; | 
|---|
|  | 2307 | } /* passf5_ */ | 
|---|
|  | 2308 |  | 
|---|
|  | 2309 | /*  ------ File radb2.f ------ */ | 
|---|
| [756] | 2310 | /* Subroutine */ int radb2_(int_4 *ido, int_4 *l1, r_4 *cc, r_4 *ch, | 
|---|
| [717] | 2311 | r_4 *wa1) | 
|---|
| [459] | 2312 | { | 
|---|
|  | 2313 | /* System generated locals */ | 
|---|
| [756] | 2314 | int_4 cc_dim1, cc_offset, ch_dim1, ch_dim2, ch_offset, i__1, i__2; | 
|---|
| [459] | 2315 |  | 
|---|
|  | 2316 | /* Local variables */ | 
|---|
| [756] | 2317 | static int_4 i__, k, ic; | 
|---|
| [717] | 2318 | static r_4 ti2, tr2; | 
|---|
| [756] | 2319 | static int_4 idp2; | 
|---|
| [459] | 2320 |  | 
|---|
|  | 2321 | /* Parameter adjustments */ | 
|---|
|  | 2322 | ch_dim1 = *ido; | 
|---|
|  | 2323 | ch_dim2 = *l1; | 
|---|
|  | 2324 | ch_offset = ch_dim1 * (ch_dim2 + 1) + 1; | 
|---|
|  | 2325 | ch -= ch_offset; | 
|---|
|  | 2326 | cc_dim1 = *ido; | 
|---|
|  | 2327 | cc_offset = cc_dim1 * 3 + 1; | 
|---|
|  | 2328 | cc -= cc_offset; | 
|---|
|  | 2329 | --wa1; | 
|---|
|  | 2330 |  | 
|---|
|  | 2331 | /* Function Body */ | 
|---|
|  | 2332 | i__1 = *l1; | 
|---|
|  | 2333 | for (k = 1; k <= i__1; ++k) { | 
|---|
|  | 2334 | ch[(k + ch_dim2) * ch_dim1 + 1] = cc[((k << 1) + 1) * cc_dim1 + 1] + | 
|---|
|  | 2335 | cc[*ido + ((k << 1) + 2) * cc_dim1]; | 
|---|
|  | 2336 | ch[(k + (ch_dim2 << 1)) * ch_dim1 + 1] = cc[((k << 1) + 1) * cc_dim1 | 
|---|
|  | 2337 | + 1] - cc[*ido + ((k << 1) + 2) * cc_dim1]; | 
|---|
|  | 2338 | /* L101: */ | 
|---|
|  | 2339 | } | 
|---|
|  | 2340 | if ((i__1 = *ido - 2) < 0) { | 
|---|
|  | 2341 | goto L107; | 
|---|
|  | 2342 | } else if (i__1 == 0) { | 
|---|
|  | 2343 | goto L105; | 
|---|
|  | 2344 | } else { | 
|---|
|  | 2345 | goto L102; | 
|---|
|  | 2346 | } | 
|---|
|  | 2347 | L102: | 
|---|
|  | 2348 | idp2 = *ido + 2; | 
|---|
|  | 2349 | i__1 = *l1; | 
|---|
|  | 2350 | for (k = 1; k <= i__1; ++k) { | 
|---|
|  | 2351 | i__2 = *ido; | 
|---|
|  | 2352 | for (i__ = 3; i__ <= i__2; i__ += 2) { | 
|---|
|  | 2353 | ic = idp2 - i__; | 
|---|
|  | 2354 | ch[i__ - 1 + (k + ch_dim2) * ch_dim1] = cc[i__ - 1 + ((k << 1) + | 
|---|
|  | 2355 | 1) * cc_dim1] + cc[ic - 1 + ((k << 1) + 2) * cc_dim1]; | 
|---|
|  | 2356 | tr2 = cc[i__ - 1 + ((k << 1) + 1) * cc_dim1] - cc[ic - 1 + ((k << | 
|---|
|  | 2357 | 1) + 2) * cc_dim1]; | 
|---|
|  | 2358 | ch[i__ + (k + ch_dim2) * ch_dim1] = cc[i__ + ((k << 1) + 1) * | 
|---|
|  | 2359 | cc_dim1] - cc[ic + ((k << 1) + 2) * cc_dim1]; | 
|---|
|  | 2360 | ti2 = cc[i__ + ((k << 1) + 1) * cc_dim1] + cc[ic + ((k << 1) + 2) | 
|---|
|  | 2361 | * cc_dim1]; | 
|---|
|  | 2362 | ch[i__ - 1 + (k + (ch_dim2 << 1)) * ch_dim1] = wa1[i__ - 2] * tr2 | 
|---|
|  | 2363 | - wa1[i__ - 1] * ti2; | 
|---|
|  | 2364 | ch[i__ + (k + (ch_dim2 << 1)) * ch_dim1] = wa1[i__ - 2] * ti2 + | 
|---|
|  | 2365 | wa1[i__ - 1] * tr2; | 
|---|
|  | 2366 | /* L103: */ | 
|---|
|  | 2367 | } | 
|---|
|  | 2368 | /* L104: */ | 
|---|
|  | 2369 | } | 
|---|
|  | 2370 | if (*ido % 2 == 1) { | 
|---|
|  | 2371 | return 0; | 
|---|
|  | 2372 | } | 
|---|
|  | 2373 | L105: | 
|---|
|  | 2374 | i__1 = *l1; | 
|---|
|  | 2375 | for (k = 1; k <= i__1; ++k) { | 
|---|
|  | 2376 | ch[*ido + (k + ch_dim2) * ch_dim1] = cc[*ido + ((k << 1) + 1) * | 
|---|
|  | 2377 | cc_dim1] + cc[*ido + ((k << 1) + 1) * cc_dim1]; | 
|---|
|  | 2378 | ch[*ido + (k + (ch_dim2 << 1)) * ch_dim1] = -(cc[((k << 1) + 2) * | 
|---|
|  | 2379 | cc_dim1 + 1] + cc[((k << 1) + 2) * cc_dim1 + 1]); | 
|---|
|  | 2380 | /* L106: */ | 
|---|
|  | 2381 | } | 
|---|
|  | 2382 | L107: | 
|---|
|  | 2383 | return 0; | 
|---|
|  | 2384 | } /* radb2_ */ | 
|---|
|  | 2385 |  | 
|---|
|  | 2386 | /*  ------ File radb3.f ------ */ | 
|---|
| [756] | 2387 | /* Subroutine */ int radb3_(int_4 *ido, int_4 *l1, r_4 *cc, r_4 *ch, | 
|---|
| [717] | 2388 | r_4 *wa1, r_4 *wa2) | 
|---|
| [459] | 2389 | { | 
|---|
|  | 2390 | /* Initialized data */ | 
|---|
|  | 2391 |  | 
|---|
| [717] | 2392 | static r_4 taur = -.5f; | 
|---|
|  | 2393 | static r_4 taui = .866025403784439f; | 
|---|
| [459] | 2394 |  | 
|---|
|  | 2395 | /* System generated locals */ | 
|---|
| [756] | 2396 | int_4 cc_dim1, cc_offset, ch_dim1, ch_dim2, ch_offset, i__1, i__2; | 
|---|
| [459] | 2397 |  | 
|---|
|  | 2398 | /* Local variables */ | 
|---|
| [756] | 2399 | static int_4 i__, k, ic; | 
|---|
| [717] | 2400 | static r_4 ci2, ci3, di2, di3, cr2, cr3, dr2, dr3, ti2, tr2; | 
|---|
| [756] | 2401 | static int_4 idp2; | 
|---|
| [459] | 2402 |  | 
|---|
|  | 2403 | /* Parameter adjustments */ | 
|---|
|  | 2404 | ch_dim1 = *ido; | 
|---|
|  | 2405 | ch_dim2 = *l1; | 
|---|
|  | 2406 | ch_offset = ch_dim1 * (ch_dim2 + 1) + 1; | 
|---|
|  | 2407 | ch -= ch_offset; | 
|---|
|  | 2408 | cc_dim1 = *ido; | 
|---|
|  | 2409 | cc_offset = (cc_dim1 << 2) + 1; | 
|---|
|  | 2410 | cc -= cc_offset; | 
|---|
|  | 2411 | --wa1; | 
|---|
|  | 2412 | --wa2; | 
|---|
|  | 2413 |  | 
|---|
|  | 2414 | /* Function Body */ | 
|---|
|  | 2415 | i__1 = *l1; | 
|---|
|  | 2416 | for (k = 1; k <= i__1; ++k) { | 
|---|
|  | 2417 | tr2 = cc[*ido + (k * 3 + 2) * cc_dim1] + cc[*ido + (k * 3 + 2) * | 
|---|
|  | 2418 | cc_dim1]; | 
|---|
|  | 2419 | cr2 = cc[(k * 3 + 1) * cc_dim1 + 1] + taur * tr2; | 
|---|
|  | 2420 | ch[(k + ch_dim2) * ch_dim1 + 1] = cc[(k * 3 + 1) * cc_dim1 + 1] + tr2; | 
|---|
|  | 2421 | ci3 = taui * (cc[(k * 3 + 3) * cc_dim1 + 1] + cc[(k * 3 + 3) * | 
|---|
|  | 2422 | cc_dim1 + 1]); | 
|---|
|  | 2423 | ch[(k + (ch_dim2 << 1)) * ch_dim1 + 1] = cr2 - ci3; | 
|---|
|  | 2424 | ch[(k + ch_dim2 * 3) * ch_dim1 + 1] = cr2 + ci3; | 
|---|
|  | 2425 | /* L101: */ | 
|---|
|  | 2426 | } | 
|---|
|  | 2427 | if (*ido == 1) { | 
|---|
|  | 2428 | return 0; | 
|---|
|  | 2429 | } | 
|---|
|  | 2430 | idp2 = *ido + 2; | 
|---|
|  | 2431 | i__1 = *l1; | 
|---|
|  | 2432 | for (k = 1; k <= i__1; ++k) { | 
|---|
|  | 2433 | i__2 = *ido; | 
|---|
|  | 2434 | for (i__ = 3; i__ <= i__2; i__ += 2) { | 
|---|
|  | 2435 | ic = idp2 - i__; | 
|---|
|  | 2436 | tr2 = cc[i__ - 1 + (k * 3 + 3) * cc_dim1] + cc[ic - 1 + (k * 3 + | 
|---|
|  | 2437 | 2) * cc_dim1]; | 
|---|
|  | 2438 | cr2 = cc[i__ - 1 + (k * 3 + 1) * cc_dim1] + taur * tr2; | 
|---|
|  | 2439 | ch[i__ - 1 + (k + ch_dim2) * ch_dim1] = cc[i__ - 1 + (k * 3 + 1) * | 
|---|
|  | 2440 | cc_dim1] + tr2; | 
|---|
|  | 2441 | ti2 = cc[i__ + (k * 3 + 3) * cc_dim1] - cc[ic + (k * 3 + 2) * | 
|---|
|  | 2442 | cc_dim1]; | 
|---|
|  | 2443 | ci2 = cc[i__ + (k * 3 + 1) * cc_dim1] + taur * ti2; | 
|---|
|  | 2444 | ch[i__ + (k + ch_dim2) * ch_dim1] = cc[i__ + (k * 3 + 1) * | 
|---|
|  | 2445 | cc_dim1] + ti2; | 
|---|
|  | 2446 | cr3 = taui * (cc[i__ - 1 + (k * 3 + 3) * cc_dim1] - cc[ic - 1 + ( | 
|---|
|  | 2447 | k * 3 + 2) * cc_dim1]); | 
|---|
|  | 2448 | ci3 = taui * (cc[i__ + (k * 3 + 3) * cc_dim1] + cc[ic + (k * 3 + | 
|---|
|  | 2449 | 2) * cc_dim1]); | 
|---|
|  | 2450 | dr2 = cr2 - ci3; | 
|---|
|  | 2451 | dr3 = cr2 + ci3; | 
|---|
|  | 2452 | di2 = ci2 + cr3; | 
|---|
|  | 2453 | di3 = ci2 - cr3; | 
|---|
|  | 2454 | ch[i__ - 1 + (k + (ch_dim2 << 1)) * ch_dim1] = wa1[i__ - 2] * dr2 | 
|---|
|  | 2455 | - wa1[i__ - 1] * di2; | 
|---|
|  | 2456 | ch[i__ + (k + (ch_dim2 << 1)) * ch_dim1] = wa1[i__ - 2] * di2 + | 
|---|
|  | 2457 | wa1[i__ - 1] * dr2; | 
|---|
|  | 2458 | ch[i__ - 1 + (k + ch_dim2 * 3) * ch_dim1] = wa2[i__ - 2] * dr3 - | 
|---|
|  | 2459 | wa2[i__ - 1] * di3; | 
|---|
|  | 2460 | ch[i__ + (k + ch_dim2 * 3) * ch_dim1] = wa2[i__ - 2] * di3 + wa2[ | 
|---|
|  | 2461 | i__ - 1] * dr3; | 
|---|
|  | 2462 | /* L102: */ | 
|---|
|  | 2463 | } | 
|---|
|  | 2464 | /* L103: */ | 
|---|
|  | 2465 | } | 
|---|
|  | 2466 | return 0; | 
|---|
|  | 2467 | } /* radb3_ */ | 
|---|
|  | 2468 |  | 
|---|
|  | 2469 | /*  ------ File radb4.f ------ */ | 
|---|
| [756] | 2470 | /* Subroutine */ int radb4_(int_4 *ido, int_4 *l1, r_4 *cc, r_4 *ch, | 
|---|
| [717] | 2471 | r_4 *wa1, r_4 *wa2, r_4 *wa3) | 
|---|
| [459] | 2472 | { | 
|---|
|  | 2473 | /* Initialized data */ | 
|---|
|  | 2474 |  | 
|---|
| [717] | 2475 | static r_4 sqrt2 = 1.414213562373095f; | 
|---|
| [459] | 2476 |  | 
|---|
|  | 2477 | /* System generated locals */ | 
|---|
| [756] | 2478 | int_4 cc_dim1, cc_offset, ch_dim1, ch_dim2, ch_offset, i__1, i__2; | 
|---|
| [459] | 2479 |  | 
|---|
|  | 2480 | /* Local variables */ | 
|---|
| [756] | 2481 | static int_4 i__, k, ic; | 
|---|
| [717] | 2482 | static r_4 ci2, ci3, ci4, cr2, cr3, cr4, ti1, ti2, ti3, ti4, tr1, tr2, | 
|---|
| [459] | 2483 | tr3, tr4; | 
|---|
| [756] | 2484 | static int_4 idp2; | 
|---|
| [459] | 2485 |  | 
|---|
|  | 2486 | /* Parameter adjustments */ | 
|---|
|  | 2487 | ch_dim1 = *ido; | 
|---|
|  | 2488 | ch_dim2 = *l1; | 
|---|
|  | 2489 | ch_offset = ch_dim1 * (ch_dim2 + 1) + 1; | 
|---|
|  | 2490 | ch -= ch_offset; | 
|---|
|  | 2491 | cc_dim1 = *ido; | 
|---|
|  | 2492 | cc_offset = cc_dim1 * 5 + 1; | 
|---|
|  | 2493 | cc -= cc_offset; | 
|---|
|  | 2494 | --wa1; | 
|---|
|  | 2495 | --wa2; | 
|---|
|  | 2496 | --wa3; | 
|---|
|  | 2497 |  | 
|---|
|  | 2498 | /* Function Body */ | 
|---|
|  | 2499 | i__1 = *l1; | 
|---|
|  | 2500 | for (k = 1; k <= i__1; ++k) { | 
|---|
|  | 2501 | tr1 = cc[((k << 2) + 1) * cc_dim1 + 1] - cc[*ido + ((k << 2) + 4) * | 
|---|
|  | 2502 | cc_dim1]; | 
|---|
|  | 2503 | tr2 = cc[((k << 2) + 1) * cc_dim1 + 1] + cc[*ido + ((k << 2) + 4) * | 
|---|
|  | 2504 | cc_dim1]; | 
|---|
|  | 2505 | tr3 = cc[*ido + ((k << 2) + 2) * cc_dim1] + cc[*ido + ((k << 2) + 2) * | 
|---|
|  | 2506 | cc_dim1]; | 
|---|
|  | 2507 | tr4 = cc[((k << 2) + 3) * cc_dim1 + 1] + cc[((k << 2) + 3) * cc_dim1 | 
|---|
|  | 2508 | + 1]; | 
|---|
|  | 2509 | ch[(k + ch_dim2) * ch_dim1 + 1] = tr2 + tr3; | 
|---|
|  | 2510 | ch[(k + (ch_dim2 << 1)) * ch_dim1 + 1] = tr1 - tr4; | 
|---|
|  | 2511 | ch[(k + ch_dim2 * 3) * ch_dim1 + 1] = tr2 - tr3; | 
|---|
|  | 2512 | ch[(k + (ch_dim2 << 2)) * ch_dim1 + 1] = tr1 + tr4; | 
|---|
|  | 2513 | /* L101: */ | 
|---|
|  | 2514 | } | 
|---|
|  | 2515 | if ((i__1 = *ido - 2) < 0) { | 
|---|
|  | 2516 | goto L107; | 
|---|
|  | 2517 | } else if (i__1 == 0) { | 
|---|
|  | 2518 | goto L105; | 
|---|
|  | 2519 | } else { | 
|---|
|  | 2520 | goto L102; | 
|---|
|  | 2521 | } | 
|---|
|  | 2522 | L102: | 
|---|
|  | 2523 | idp2 = *ido + 2; | 
|---|
|  | 2524 | i__1 = *l1; | 
|---|
|  | 2525 | for (k = 1; k <= i__1; ++k) { | 
|---|
|  | 2526 | i__2 = *ido; | 
|---|
|  | 2527 | for (i__ = 3; i__ <= i__2; i__ += 2) { | 
|---|
|  | 2528 | ic = idp2 - i__; | 
|---|
|  | 2529 | ti1 = cc[i__ + ((k << 2) + 1) * cc_dim1] + cc[ic + ((k << 2) + 4) | 
|---|
|  | 2530 | * cc_dim1]; | 
|---|
|  | 2531 | ti2 = cc[i__ + ((k << 2) + 1) * cc_dim1] - cc[ic + ((k << 2) + 4) | 
|---|
|  | 2532 | * cc_dim1]; | 
|---|
|  | 2533 | ti3 = cc[i__ + ((k << 2) + 3) * cc_dim1] - cc[ic + ((k << 2) + 2) | 
|---|
|  | 2534 | * cc_dim1]; | 
|---|
|  | 2535 | tr4 = cc[i__ + ((k << 2) + 3) * cc_dim1] + cc[ic + ((k << 2) + 2) | 
|---|
|  | 2536 | * cc_dim1]; | 
|---|
|  | 2537 | tr1 = cc[i__ - 1 + ((k << 2) + 1) * cc_dim1] - cc[ic - 1 + ((k << | 
|---|
|  | 2538 | 2) + 4) * cc_dim1]; | 
|---|
|  | 2539 | tr2 = cc[i__ - 1 + ((k << 2) + 1) * cc_dim1] + cc[ic - 1 + ((k << | 
|---|
|  | 2540 | 2) + 4) * cc_dim1]; | 
|---|
|  | 2541 | ti4 = cc[i__ - 1 + ((k << 2) + 3) * cc_dim1] - cc[ic - 1 + ((k << | 
|---|
|  | 2542 | 2) + 2) * cc_dim1]; | 
|---|
|  | 2543 | tr3 = cc[i__ - 1 + ((k << 2) + 3) * cc_dim1] + cc[ic - 1 + ((k << | 
|---|
|  | 2544 | 2) + 2) * cc_dim1]; | 
|---|
|  | 2545 | ch[i__ - 1 + (k + ch_dim2) * ch_dim1] = tr2 + tr3; | 
|---|
|  | 2546 | cr3 = tr2 - tr3; | 
|---|
|  | 2547 | ch[i__ + (k + ch_dim2) * ch_dim1] = ti2 + ti3; | 
|---|
|  | 2548 | ci3 = ti2 - ti3; | 
|---|
|  | 2549 | cr2 = tr1 - tr4; | 
|---|
|  | 2550 | cr4 = tr1 + tr4; | 
|---|
|  | 2551 | ci2 = ti1 + ti4; | 
|---|
|  | 2552 | ci4 = ti1 - ti4; | 
|---|
|  | 2553 | ch[i__ - 1 + (k + (ch_dim2 << 1)) * ch_dim1] = wa1[i__ - 2] * cr2 | 
|---|
|  | 2554 | - wa1[i__ - 1] * ci2; | 
|---|
|  | 2555 | ch[i__ + (k + (ch_dim2 << 1)) * ch_dim1] = wa1[i__ - 2] * ci2 + | 
|---|
|  | 2556 | wa1[i__ - 1] * cr2; | 
|---|
|  | 2557 | ch[i__ - 1 + (k + ch_dim2 * 3) * ch_dim1] = wa2[i__ - 2] * cr3 - | 
|---|
|  | 2558 | wa2[i__ - 1] * ci3; | 
|---|
|  | 2559 | ch[i__ + (k + ch_dim2 * 3) * ch_dim1] = wa2[i__ - 2] * ci3 + wa2[ | 
|---|
|  | 2560 | i__ - 1] * cr3; | 
|---|
|  | 2561 | ch[i__ - 1 + (k + (ch_dim2 << 2)) * ch_dim1] = wa3[i__ - 2] * cr4 | 
|---|
|  | 2562 | - wa3[i__ - 1] * ci4; | 
|---|
|  | 2563 | ch[i__ + (k + (ch_dim2 << 2)) * ch_dim1] = wa3[i__ - 2] * ci4 + | 
|---|
|  | 2564 | wa3[i__ - 1] * cr4; | 
|---|
|  | 2565 | /* L103: */ | 
|---|
|  | 2566 | } | 
|---|
|  | 2567 | /* L104: */ | 
|---|
|  | 2568 | } | 
|---|
|  | 2569 | if (*ido % 2 == 1) { | 
|---|
|  | 2570 | return 0; | 
|---|
|  | 2571 | } | 
|---|
|  | 2572 | L105: | 
|---|
|  | 2573 | i__1 = *l1; | 
|---|
|  | 2574 | for (k = 1; k <= i__1; ++k) { | 
|---|
|  | 2575 | ti1 = cc[((k << 2) + 2) * cc_dim1 + 1] + cc[((k << 2) + 4) * cc_dim1 | 
|---|
|  | 2576 | + 1]; | 
|---|
|  | 2577 | ti2 = cc[((k << 2) + 4) * cc_dim1 + 1] - cc[((k << 2) + 2) * cc_dim1 | 
|---|
|  | 2578 | + 1]; | 
|---|
|  | 2579 | tr1 = cc[*ido + ((k << 2) + 1) * cc_dim1] - cc[*ido + ((k << 2) + 3) * | 
|---|
|  | 2580 | cc_dim1]; | 
|---|
|  | 2581 | tr2 = cc[*ido + ((k << 2) + 1) * cc_dim1] + cc[*ido + ((k << 2) + 3) * | 
|---|
|  | 2582 | cc_dim1]; | 
|---|
|  | 2583 | ch[*ido + (k + ch_dim2) * ch_dim1] = tr2 + tr2; | 
|---|
|  | 2584 | ch[*ido + (k + (ch_dim2 << 1)) * ch_dim1] = sqrt2 * (tr1 - ti1); | 
|---|
|  | 2585 | ch[*ido + (k + ch_dim2 * 3) * ch_dim1] = ti2 + ti2; | 
|---|
|  | 2586 | ch[*ido + (k + (ch_dim2 << 2)) * ch_dim1] = -sqrt2 * (tr1 + ti1); | 
|---|
|  | 2587 | /* L106: */ | 
|---|
|  | 2588 | } | 
|---|
|  | 2589 | L107: | 
|---|
|  | 2590 | return 0; | 
|---|
|  | 2591 | } /* radb4_ */ | 
|---|
|  | 2592 |  | 
|---|
|  | 2593 | /*  ------ File radb5.f ------ */ | 
|---|
| [756] | 2594 | /* Subroutine */ int radb5_(int_4 *ido, int_4 *l1, r_4 *cc, r_4 *ch, | 
|---|
| [717] | 2595 | r_4 *wa1, r_4 *wa2, r_4 *wa3, r_4 *wa4) | 
|---|
| [459] | 2596 | { | 
|---|
|  | 2597 | /* Initialized data */ | 
|---|
|  | 2598 |  | 
|---|
| [717] | 2599 | static r_4 tr11 = .309016994374947f; | 
|---|
|  | 2600 | static r_4 ti11 = .951056516295154f; | 
|---|
|  | 2601 | static r_4 tr12 = -.809016994374947f; | 
|---|
|  | 2602 | static r_4 ti12 = .587785252292473f; | 
|---|
| [459] | 2603 |  | 
|---|
|  | 2604 | /* System generated locals */ | 
|---|
| [756] | 2605 | int_4 cc_dim1, cc_offset, ch_dim1, ch_dim2, ch_offset, i__1, i__2; | 
|---|
| [459] | 2606 |  | 
|---|
|  | 2607 | /* Local variables */ | 
|---|
| [756] | 2608 | static int_4 i__, k, ic; | 
|---|
| [717] | 2609 | static r_4 ci2, ci3, ci4, ci5, di3, di4, di5, di2, cr2, cr3, cr5, cr4, | 
|---|
| [459] | 2610 | ti2, ti3, ti4, ti5, dr3, dr4, dr5, dr2, tr2, tr3, tr4, tr5; | 
|---|
| [756] | 2611 | static int_4 idp2; | 
|---|
| [459] | 2612 |  | 
|---|
|  | 2613 | /* Parameter adjustments */ | 
|---|
|  | 2614 | ch_dim1 = *ido; | 
|---|
|  | 2615 | ch_dim2 = *l1; | 
|---|
|  | 2616 | ch_offset = ch_dim1 * (ch_dim2 + 1) + 1; | 
|---|
|  | 2617 | ch -= ch_offset; | 
|---|
|  | 2618 | cc_dim1 = *ido; | 
|---|
|  | 2619 | cc_offset = cc_dim1 * 6 + 1; | 
|---|
|  | 2620 | cc -= cc_offset; | 
|---|
|  | 2621 | --wa1; | 
|---|
|  | 2622 | --wa2; | 
|---|
|  | 2623 | --wa3; | 
|---|
|  | 2624 | --wa4; | 
|---|
|  | 2625 |  | 
|---|
|  | 2626 | /* Function Body */ | 
|---|
|  | 2627 | i__1 = *l1; | 
|---|
|  | 2628 | for (k = 1; k <= i__1; ++k) { | 
|---|
|  | 2629 | ti5 = cc[(k * 5 + 3) * cc_dim1 + 1] + cc[(k * 5 + 3) * cc_dim1 + 1]; | 
|---|
|  | 2630 | ti4 = cc[(k * 5 + 5) * cc_dim1 + 1] + cc[(k * 5 + 5) * cc_dim1 + 1]; | 
|---|
|  | 2631 | tr2 = cc[*ido + (k * 5 + 2) * cc_dim1] + cc[*ido + (k * 5 + 2) * | 
|---|
|  | 2632 | cc_dim1]; | 
|---|
|  | 2633 | tr3 = cc[*ido + (k * 5 + 4) * cc_dim1] + cc[*ido + (k * 5 + 4) * | 
|---|
|  | 2634 | cc_dim1]; | 
|---|
|  | 2635 | ch[(k + ch_dim2) * ch_dim1 + 1] = cc[(k * 5 + 1) * cc_dim1 + 1] + tr2 | 
|---|
|  | 2636 | + tr3; | 
|---|
|  | 2637 | cr2 = cc[(k * 5 + 1) * cc_dim1 + 1] + tr11 * tr2 + tr12 * tr3; | 
|---|
|  | 2638 | cr3 = cc[(k * 5 + 1) * cc_dim1 + 1] + tr12 * tr2 + tr11 * tr3; | 
|---|
|  | 2639 | ci5 = ti11 * ti5 + ti12 * ti4; | 
|---|
|  | 2640 | ci4 = ti12 * ti5 - ti11 * ti4; | 
|---|
|  | 2641 | ch[(k + (ch_dim2 << 1)) * ch_dim1 + 1] = cr2 - ci5; | 
|---|
|  | 2642 | ch[(k + ch_dim2 * 3) * ch_dim1 + 1] = cr3 - ci4; | 
|---|
|  | 2643 | ch[(k + (ch_dim2 << 2)) * ch_dim1 + 1] = cr3 + ci4; | 
|---|
|  | 2644 | ch[(k + ch_dim2 * 5) * ch_dim1 + 1] = cr2 + ci5; | 
|---|
|  | 2645 | /* L101: */ | 
|---|
|  | 2646 | } | 
|---|
|  | 2647 | if (*ido == 1) { | 
|---|
|  | 2648 | return 0; | 
|---|
|  | 2649 | } | 
|---|
|  | 2650 | idp2 = *ido + 2; | 
|---|
|  | 2651 | i__1 = *l1; | 
|---|
|  | 2652 | for (k = 1; k <= i__1; ++k) { | 
|---|
|  | 2653 | i__2 = *ido; | 
|---|
|  | 2654 | for (i__ = 3; i__ <= i__2; i__ += 2) { | 
|---|
|  | 2655 | ic = idp2 - i__; | 
|---|
|  | 2656 | ti5 = cc[i__ + (k * 5 + 3) * cc_dim1] + cc[ic + (k * 5 + 2) * | 
|---|
|  | 2657 | cc_dim1]; | 
|---|
|  | 2658 | ti2 = cc[i__ + (k * 5 + 3) * cc_dim1] - cc[ic + (k * 5 + 2) * | 
|---|
|  | 2659 | cc_dim1]; | 
|---|
|  | 2660 | ti4 = cc[i__ + (k * 5 + 5) * cc_dim1] + cc[ic + (k * 5 + 4) * | 
|---|
|  | 2661 | cc_dim1]; | 
|---|
|  | 2662 | ti3 = cc[i__ + (k * 5 + 5) * cc_dim1] - cc[ic + (k * 5 + 4) * | 
|---|
|  | 2663 | cc_dim1]; | 
|---|
|  | 2664 | tr5 = cc[i__ - 1 + (k * 5 + 3) * cc_dim1] - cc[ic - 1 + (k * 5 + | 
|---|
|  | 2665 | 2) * cc_dim1]; | 
|---|
|  | 2666 | tr2 = cc[i__ - 1 + (k * 5 + 3) * cc_dim1] + cc[ic - 1 + (k * 5 + | 
|---|
|  | 2667 | 2) * cc_dim1]; | 
|---|
|  | 2668 | tr4 = cc[i__ - 1 + (k * 5 + 5) * cc_dim1] - cc[ic - 1 + (k * 5 + | 
|---|
|  | 2669 | 4) * cc_dim1]; | 
|---|
|  | 2670 | tr3 = cc[i__ - 1 + (k * 5 + 5) * cc_dim1] + cc[ic - 1 + (k * 5 + | 
|---|
|  | 2671 | 4) * cc_dim1]; | 
|---|
|  | 2672 | ch[i__ - 1 + (k + ch_dim2) * ch_dim1] = cc[i__ - 1 + (k * 5 + 1) * | 
|---|
|  | 2673 | cc_dim1] + tr2 + tr3; | 
|---|
|  | 2674 | ch[i__ + (k + ch_dim2) * ch_dim1] = cc[i__ + (k * 5 + 1) * | 
|---|
|  | 2675 | cc_dim1] + ti2 + ti3; | 
|---|
|  | 2676 | cr2 = cc[i__ - 1 + (k * 5 + 1) * cc_dim1] + tr11 * tr2 + tr12 * | 
|---|
|  | 2677 | tr3; | 
|---|
|  | 2678 | ci2 = cc[i__ + (k * 5 + 1) * cc_dim1] + tr11 * ti2 + tr12 * ti3; | 
|---|
|  | 2679 | cr3 = cc[i__ - 1 + (k * 5 + 1) * cc_dim1] + tr12 * tr2 + tr11 * | 
|---|
|  | 2680 | tr3; | 
|---|
|  | 2681 | ci3 = cc[i__ + (k * 5 + 1) * cc_dim1] + tr12 * ti2 + tr11 * ti3; | 
|---|
|  | 2682 | cr5 = ti11 * tr5 + ti12 * tr4; | 
|---|
|  | 2683 | ci5 = ti11 * ti5 + ti12 * ti4; | 
|---|
|  | 2684 | cr4 = ti12 * tr5 - ti11 * tr4; | 
|---|
|  | 2685 | ci4 = ti12 * ti5 - ti11 * ti4; | 
|---|
|  | 2686 | dr3 = cr3 - ci4; | 
|---|
|  | 2687 | dr4 = cr3 + ci4; | 
|---|
|  | 2688 | di3 = ci3 + cr4; | 
|---|
|  | 2689 | di4 = ci3 - cr4; | 
|---|
|  | 2690 | dr5 = cr2 + ci5; | 
|---|
|  | 2691 | dr2 = cr2 - ci5; | 
|---|
|  | 2692 | di5 = ci2 - cr5; | 
|---|
|  | 2693 | di2 = ci2 + cr5; | 
|---|
|  | 2694 | ch[i__ - 1 + (k + (ch_dim2 << 1)) * ch_dim1] = wa1[i__ - 2] * dr2 | 
|---|
|  | 2695 | - wa1[i__ - 1] * di2; | 
|---|
|  | 2696 | ch[i__ + (k + (ch_dim2 << 1)) * ch_dim1] = wa1[i__ - 2] * di2 + | 
|---|
|  | 2697 | wa1[i__ - 1] * dr2; | 
|---|
|  | 2698 | ch[i__ - 1 + (k + ch_dim2 * 3) * ch_dim1] = wa2[i__ - 2] * dr3 - | 
|---|
|  | 2699 | wa2[i__ - 1] * di3; | 
|---|
|  | 2700 | ch[i__ + (k + ch_dim2 * 3) * ch_dim1] = wa2[i__ - 2] * di3 + wa2[ | 
|---|
|  | 2701 | i__ - 1] * dr3; | 
|---|
|  | 2702 | ch[i__ - 1 + (k + (ch_dim2 << 2)) * ch_dim1] = wa3[i__ - 2] * dr4 | 
|---|
|  | 2703 | - wa3[i__ - 1] * di4; | 
|---|
|  | 2704 | ch[i__ + (k + (ch_dim2 << 2)) * ch_dim1] = wa3[i__ - 2] * di4 + | 
|---|
|  | 2705 | wa3[i__ - 1] * dr4; | 
|---|
|  | 2706 | ch[i__ - 1 + (k + ch_dim2 * 5) * ch_dim1] = wa4[i__ - 2] * dr5 - | 
|---|
|  | 2707 | wa4[i__ - 1] * di5; | 
|---|
|  | 2708 | ch[i__ + (k + ch_dim2 * 5) * ch_dim1] = wa4[i__ - 2] * di5 + wa4[ | 
|---|
|  | 2709 | i__ - 1] * dr5; | 
|---|
|  | 2710 | /* L102: */ | 
|---|
|  | 2711 | } | 
|---|
|  | 2712 | /* L103: */ | 
|---|
|  | 2713 | } | 
|---|
|  | 2714 | return 0; | 
|---|
|  | 2715 | } /* radb5_ */ | 
|---|
|  | 2716 |  | 
|---|
|  | 2717 | /*  ------ File radbg.f ------ */ | 
|---|
| [756] | 2718 | /* Subroutine */ int radbg_(int_4 *ido, int_4 *ip, int_4 *l1, int_4 * | 
|---|
| [717] | 2719 | idl1, r_4 *cc, r_4 *c1, r_4 *c2, r_4 *ch, r_4 *ch2, r_4 *wa) | 
|---|
| [459] | 2720 | { | 
|---|
|  | 2721 | /* Initialized data */ | 
|---|
|  | 2722 |  | 
|---|
| [717] | 2723 | static r_4 tpi = 6.28318530717959f; | 
|---|
| [459] | 2724 |  | 
|---|
|  | 2725 | /* System generated locals */ | 
|---|
| [756] | 2726 | int_4 ch_dim1, ch_dim2, ch_offset, cc_dim1, cc_dim2, cc_offset, c1_dim1, | 
|---|
| [459] | 2727 | c1_dim2, c1_offset, c2_dim1, c2_offset, ch2_dim1, ch2_offset, | 
|---|
|  | 2728 | i__1, i__2, i__3; | 
|---|
|  | 2729 |  | 
|---|
|  | 2730 | /* Builtin functions */ | 
|---|
| [717] | 2731 | /*    r_8 cos(r_8truc), sin(r_8truc);  commente - Remplace par math.h  Reza 29/11/99 */ | 
|---|
| [459] | 2732 |  | 
|---|
|  | 2733 | /* Local variables */ | 
|---|
| [756] | 2734 | static int_4 idij, ipph, i__, j, k, l, j2, ic, jc, lc, ik, is; | 
|---|
| [717] | 2735 | static r_4 dc2, ai1, ai2, ar1, ar2, ds2; | 
|---|
| [756] | 2736 | static int_4 nbd; | 
|---|
| [717] | 2737 | static r_4 dcp, arg, dsp, ar1h, ar2h; | 
|---|
| [756] | 2738 | static int_4 idp2, ipp2; | 
|---|
| [459] | 2739 |  | 
|---|
|  | 2740 | /* Parameter adjustments */ | 
|---|
|  | 2741 | ch_dim1 = *ido; | 
|---|
|  | 2742 | ch_dim2 = *l1; | 
|---|
|  | 2743 | ch_offset = ch_dim1 * (ch_dim2 + 1) + 1; | 
|---|
|  | 2744 | ch -= ch_offset; | 
|---|
|  | 2745 | c1_dim1 = *ido; | 
|---|
|  | 2746 | c1_dim2 = *l1; | 
|---|
|  | 2747 | c1_offset = c1_dim1 * (c1_dim2 + 1) + 1; | 
|---|
|  | 2748 | c1 -= c1_offset; | 
|---|
|  | 2749 | cc_dim1 = *ido; | 
|---|
|  | 2750 | cc_dim2 = *ip; | 
|---|
|  | 2751 | cc_offset = cc_dim1 * (cc_dim2 + 1) + 1; | 
|---|
|  | 2752 | cc -= cc_offset; | 
|---|
|  | 2753 | ch2_dim1 = *idl1; | 
|---|
|  | 2754 | ch2_offset = ch2_dim1 + 1; | 
|---|
|  | 2755 | ch2 -= ch2_offset; | 
|---|
|  | 2756 | c2_dim1 = *idl1; | 
|---|
|  | 2757 | c2_offset = c2_dim1 + 1; | 
|---|
|  | 2758 | c2 -= c2_offset; | 
|---|
|  | 2759 | --wa; | 
|---|
|  | 2760 |  | 
|---|
|  | 2761 | /* Function Body */ | 
|---|
| [717] | 2762 | arg = tpi / (r_4) (*ip); | 
|---|
| [459] | 2763 | dcp = cos(arg); | 
|---|
|  | 2764 | dsp = sin(arg); | 
|---|
|  | 2765 | idp2 = *ido + 2; | 
|---|
|  | 2766 | nbd = (*ido - 1) / 2; | 
|---|
|  | 2767 | ipp2 = *ip + 2; | 
|---|
|  | 2768 | ipph = (*ip + 1) / 2; | 
|---|
|  | 2769 | if (*ido < *l1) { | 
|---|
|  | 2770 | goto L103; | 
|---|
|  | 2771 | } | 
|---|
|  | 2772 | i__1 = *l1; | 
|---|
|  | 2773 | for (k = 1; k <= i__1; ++k) { | 
|---|
|  | 2774 | i__2 = *ido; | 
|---|
|  | 2775 | for (i__ = 1; i__ <= i__2; ++i__) { | 
|---|
|  | 2776 | ch[i__ + (k + ch_dim2) * ch_dim1] = cc[i__ + (k * cc_dim2 + 1) * | 
|---|
|  | 2777 | cc_dim1]; | 
|---|
|  | 2778 | /* L101: */ | 
|---|
|  | 2779 | } | 
|---|
|  | 2780 | /* L102: */ | 
|---|
|  | 2781 | } | 
|---|
|  | 2782 | goto L106; | 
|---|
|  | 2783 | L103: | 
|---|
|  | 2784 | i__1 = *ido; | 
|---|
|  | 2785 | for (i__ = 1; i__ <= i__1; ++i__) { | 
|---|
|  | 2786 | i__2 = *l1; | 
|---|
|  | 2787 | for (k = 1; k <= i__2; ++k) { | 
|---|
|  | 2788 | ch[i__ + (k + ch_dim2) * ch_dim1] = cc[i__ + (k * cc_dim2 + 1) * | 
|---|
|  | 2789 | cc_dim1]; | 
|---|
|  | 2790 | /* L104: */ | 
|---|
|  | 2791 | } | 
|---|
|  | 2792 | /* L105: */ | 
|---|
|  | 2793 | } | 
|---|
|  | 2794 | L106: | 
|---|
|  | 2795 | i__1 = ipph; | 
|---|
|  | 2796 | for (j = 2; j <= i__1; ++j) { | 
|---|
|  | 2797 | jc = ipp2 - j; | 
|---|
|  | 2798 | j2 = j + j; | 
|---|
|  | 2799 | i__2 = *l1; | 
|---|
|  | 2800 | for (k = 1; k <= i__2; ++k) { | 
|---|
|  | 2801 | ch[(k + j * ch_dim2) * ch_dim1 + 1] = cc[*ido + (j2 - 2 + k * | 
|---|
|  | 2802 | cc_dim2) * cc_dim1] + cc[*ido + (j2 - 2 + k * cc_dim2) * | 
|---|
|  | 2803 | cc_dim1]; | 
|---|
|  | 2804 | ch[(k + jc * ch_dim2) * ch_dim1 + 1] = cc[(j2 - 1 + k * cc_dim2) * | 
|---|
|  | 2805 | cc_dim1 + 1] + cc[(j2 - 1 + k * cc_dim2) * cc_dim1 + 1]; | 
|---|
|  | 2806 | /* L107: */ | 
|---|
|  | 2807 | } | 
|---|
|  | 2808 | /* L108: */ | 
|---|
|  | 2809 | } | 
|---|
|  | 2810 | if (*ido == 1) { | 
|---|
|  | 2811 | goto L116; | 
|---|
|  | 2812 | } | 
|---|
|  | 2813 | if (nbd < *l1) { | 
|---|
|  | 2814 | goto L112; | 
|---|
|  | 2815 | } | 
|---|
|  | 2816 | i__1 = ipph; | 
|---|
|  | 2817 | for (j = 2; j <= i__1; ++j) { | 
|---|
|  | 2818 | jc = ipp2 - j; | 
|---|
|  | 2819 | i__2 = *l1; | 
|---|
|  | 2820 | for (k = 1; k <= i__2; ++k) { | 
|---|
|  | 2821 | i__3 = *ido; | 
|---|
|  | 2822 | for (i__ = 3; i__ <= i__3; i__ += 2) { | 
|---|
|  | 2823 | ic = idp2 - i__; | 
|---|
|  | 2824 | ch[i__ - 1 + (k + j * ch_dim2) * ch_dim1] = cc[i__ - 1 + ((j | 
|---|
|  | 2825 | << 1) - 1 + k * cc_dim2) * cc_dim1] + cc[ic - 1 + ((j | 
|---|
|  | 2826 | << 1) - 2 + k * cc_dim2) * cc_dim1]; | 
|---|
|  | 2827 | ch[i__ - 1 + (k + jc * ch_dim2) * ch_dim1] = cc[i__ - 1 + ((j | 
|---|
|  | 2828 | << 1) - 1 + k * cc_dim2) * cc_dim1] - cc[ic - 1 + ((j | 
|---|
|  | 2829 | << 1) - 2 + k * cc_dim2) * cc_dim1]; | 
|---|
|  | 2830 | ch[i__ + (k + j * ch_dim2) * ch_dim1] = cc[i__ + ((j << 1) - | 
|---|
|  | 2831 | 1 + k * cc_dim2) * cc_dim1] - cc[ic + ((j << 1) - 2 + | 
|---|
|  | 2832 | k * cc_dim2) * cc_dim1]; | 
|---|
|  | 2833 | ch[i__ + (k + jc * ch_dim2) * ch_dim1] = cc[i__ + ((j << 1) - | 
|---|
|  | 2834 | 1 + k * cc_dim2) * cc_dim1] + cc[ic + ((j << 1) - 2 + | 
|---|
|  | 2835 | k * cc_dim2) * cc_dim1]; | 
|---|
|  | 2836 | /* L109: */ | 
|---|
|  | 2837 | } | 
|---|
|  | 2838 | /* L110: */ | 
|---|
|  | 2839 | } | 
|---|
|  | 2840 | /* L111: */ | 
|---|
|  | 2841 | } | 
|---|
|  | 2842 | goto L116; | 
|---|
|  | 2843 | L112: | 
|---|
|  | 2844 | i__1 = ipph; | 
|---|
|  | 2845 | for (j = 2; j <= i__1; ++j) { | 
|---|
|  | 2846 | jc = ipp2 - j; | 
|---|
|  | 2847 | i__2 = *ido; | 
|---|
|  | 2848 | for (i__ = 3; i__ <= i__2; i__ += 2) { | 
|---|
|  | 2849 | ic = idp2 - i__; | 
|---|
|  | 2850 | i__3 = *l1; | 
|---|
|  | 2851 | for (k = 1; k <= i__3; ++k) { | 
|---|
|  | 2852 | ch[i__ - 1 + (k + j * ch_dim2) * ch_dim1] = cc[i__ - 1 + ((j | 
|---|
|  | 2853 | << 1) - 1 + k * cc_dim2) * cc_dim1] + cc[ic - 1 + ((j | 
|---|
|  | 2854 | << 1) - 2 + k * cc_dim2) * cc_dim1]; | 
|---|
|  | 2855 | ch[i__ - 1 + (k + jc * ch_dim2) * ch_dim1] = cc[i__ - 1 + ((j | 
|---|
|  | 2856 | << 1) - 1 + k * cc_dim2) * cc_dim1] - cc[ic - 1 + ((j | 
|---|
|  | 2857 | << 1) - 2 + k * cc_dim2) * cc_dim1]; | 
|---|
|  | 2858 | ch[i__ + (k + j * ch_dim2) * ch_dim1] = cc[i__ + ((j << 1) - | 
|---|
|  | 2859 | 1 + k * cc_dim2) * cc_dim1] - cc[ic + ((j << 1) - 2 + | 
|---|
|  | 2860 | k * cc_dim2) * cc_dim1]; | 
|---|
|  | 2861 | ch[i__ + (k + jc * ch_dim2) * ch_dim1] = cc[i__ + ((j << 1) - | 
|---|
|  | 2862 | 1 + k * cc_dim2) * cc_dim1] + cc[ic + ((j << 1) - 2 + | 
|---|
|  | 2863 | k * cc_dim2) * cc_dim1]; | 
|---|
|  | 2864 | /* L113: */ | 
|---|
|  | 2865 | } | 
|---|
|  | 2866 | /* L114: */ | 
|---|
|  | 2867 | } | 
|---|
|  | 2868 | /* L115: */ | 
|---|
|  | 2869 | } | 
|---|
|  | 2870 | L116: | 
|---|
|  | 2871 | ar1 = 1.f; | 
|---|
|  | 2872 | ai1 = 0.f; | 
|---|
|  | 2873 | i__1 = ipph; | 
|---|
|  | 2874 | for (l = 2; l <= i__1; ++l) { | 
|---|
|  | 2875 | lc = ipp2 - l; | 
|---|
|  | 2876 | ar1h = dcp * ar1 - dsp * ai1; | 
|---|
|  | 2877 | ai1 = dcp * ai1 + dsp * ar1; | 
|---|
|  | 2878 | ar1 = ar1h; | 
|---|
|  | 2879 | i__2 = *idl1; | 
|---|
|  | 2880 | for (ik = 1; ik <= i__2; ++ik) { | 
|---|
|  | 2881 | c2[ik + l * c2_dim1] = ch2[ik + ch2_dim1] + ar1 * ch2[ik + ( | 
|---|
|  | 2882 | ch2_dim1 << 1)]; | 
|---|
|  | 2883 | c2[ik + lc * c2_dim1] = ai1 * ch2[ik + *ip * ch2_dim1]; | 
|---|
|  | 2884 | /* L117: */ | 
|---|
|  | 2885 | } | 
|---|
|  | 2886 | dc2 = ar1; | 
|---|
|  | 2887 | ds2 = ai1; | 
|---|
|  | 2888 | ar2 = ar1; | 
|---|
|  | 2889 | ai2 = ai1; | 
|---|
|  | 2890 | i__2 = ipph; | 
|---|
|  | 2891 | for (j = 3; j <= i__2; ++j) { | 
|---|
|  | 2892 | jc = ipp2 - j; | 
|---|
|  | 2893 | ar2h = dc2 * ar2 - ds2 * ai2; | 
|---|
|  | 2894 | ai2 = dc2 * ai2 + ds2 * ar2; | 
|---|
|  | 2895 | ar2 = ar2h; | 
|---|
|  | 2896 | i__3 = *idl1; | 
|---|
|  | 2897 | for (ik = 1; ik <= i__3; ++ik) { | 
|---|
|  | 2898 | c2[ik + l * c2_dim1] += ar2 * ch2[ik + j * ch2_dim1]; | 
|---|
|  | 2899 | c2[ik + lc * c2_dim1] += ai2 * ch2[ik + jc * ch2_dim1]; | 
|---|
|  | 2900 | /* L118: */ | 
|---|
|  | 2901 | } | 
|---|
|  | 2902 | /* L119: */ | 
|---|
|  | 2903 | } | 
|---|
|  | 2904 | /* L120: */ | 
|---|
|  | 2905 | } | 
|---|
|  | 2906 | i__1 = ipph; | 
|---|
|  | 2907 | for (j = 2; j <= i__1; ++j) { | 
|---|
|  | 2908 | i__2 = *idl1; | 
|---|
|  | 2909 | for (ik = 1; ik <= i__2; ++ik) { | 
|---|
|  | 2910 | ch2[ik + ch2_dim1] += ch2[ik + j * ch2_dim1]; | 
|---|
|  | 2911 | /* L121: */ | 
|---|
|  | 2912 | } | 
|---|
|  | 2913 | /* L122: */ | 
|---|
|  | 2914 | } | 
|---|
|  | 2915 | i__1 = ipph; | 
|---|
|  | 2916 | for (j = 2; j <= i__1; ++j) { | 
|---|
|  | 2917 | jc = ipp2 - j; | 
|---|
|  | 2918 | i__2 = *l1; | 
|---|
|  | 2919 | for (k = 1; k <= i__2; ++k) { | 
|---|
|  | 2920 | ch[(k + j * ch_dim2) * ch_dim1 + 1] = c1[(k + j * c1_dim2) * | 
|---|
|  | 2921 | c1_dim1 + 1] - c1[(k + jc * c1_dim2) * c1_dim1 + 1]; | 
|---|
|  | 2922 | ch[(k + jc * ch_dim2) * ch_dim1 + 1] = c1[(k + j * c1_dim2) * | 
|---|
|  | 2923 | c1_dim1 + 1] + c1[(k + jc * c1_dim2) * c1_dim1 + 1]; | 
|---|
|  | 2924 | /* L123: */ | 
|---|
|  | 2925 | } | 
|---|
|  | 2926 | /* L124: */ | 
|---|
|  | 2927 | } | 
|---|
|  | 2928 | if (*ido == 1) { | 
|---|
|  | 2929 | goto L132; | 
|---|
|  | 2930 | } | 
|---|
|  | 2931 | if (nbd < *l1) { | 
|---|
|  | 2932 | goto L128; | 
|---|
|  | 2933 | } | 
|---|
|  | 2934 | i__1 = ipph; | 
|---|
|  | 2935 | for (j = 2; j <= i__1; ++j) { | 
|---|
|  | 2936 | jc = ipp2 - j; | 
|---|
|  | 2937 | i__2 = *l1; | 
|---|
|  | 2938 | for (k = 1; k <= i__2; ++k) { | 
|---|
|  | 2939 | i__3 = *ido; | 
|---|
|  | 2940 | for (i__ = 3; i__ <= i__3; i__ += 2) { | 
|---|
|  | 2941 | ch[i__ - 1 + (k + j * ch_dim2) * ch_dim1] = c1[i__ - 1 + (k + | 
|---|
|  | 2942 | j * c1_dim2) * c1_dim1] - c1[i__ + (k + jc * c1_dim2) | 
|---|
|  | 2943 | * c1_dim1]; | 
|---|
|  | 2944 | ch[i__ - 1 + (k + jc * ch_dim2) * ch_dim1] = c1[i__ - 1 + (k | 
|---|
|  | 2945 | + j * c1_dim2) * c1_dim1] + c1[i__ + (k + jc * | 
|---|
|  | 2946 | c1_dim2) * c1_dim1]; | 
|---|
|  | 2947 | ch[i__ + (k + j * ch_dim2) * ch_dim1] = c1[i__ + (k + j * | 
|---|
|  | 2948 | c1_dim2) * c1_dim1] + c1[i__ - 1 + (k + jc * c1_dim2) | 
|---|
|  | 2949 | * c1_dim1]; | 
|---|
|  | 2950 | ch[i__ + (k + jc * ch_dim2) * ch_dim1] = c1[i__ + (k + j * | 
|---|
|  | 2951 | c1_dim2) * c1_dim1] - c1[i__ - 1 + (k + jc * c1_dim2) | 
|---|
|  | 2952 | * c1_dim1]; | 
|---|
|  | 2953 | /* L125: */ | 
|---|
|  | 2954 | } | 
|---|
|  | 2955 | /* L126: */ | 
|---|
|  | 2956 | } | 
|---|
|  | 2957 | /* L127: */ | 
|---|
|  | 2958 | } | 
|---|
|  | 2959 | goto L132; | 
|---|
|  | 2960 | L128: | 
|---|
|  | 2961 | i__1 = ipph; | 
|---|
|  | 2962 | for (j = 2; j <= i__1; ++j) { | 
|---|
|  | 2963 | jc = ipp2 - j; | 
|---|
|  | 2964 | i__2 = *ido; | 
|---|
|  | 2965 | for (i__ = 3; i__ <= i__2; i__ += 2) { | 
|---|
|  | 2966 | i__3 = *l1; | 
|---|
|  | 2967 | for (k = 1; k <= i__3; ++k) { | 
|---|
|  | 2968 | ch[i__ - 1 + (k + j * ch_dim2) * ch_dim1] = c1[i__ - 1 + (k + | 
|---|
|  | 2969 | j * c1_dim2) * c1_dim1] - c1[i__ + (k + jc * c1_dim2) | 
|---|
|  | 2970 | * c1_dim1]; | 
|---|
|  | 2971 | ch[i__ - 1 + (k + jc * ch_dim2) * ch_dim1] = c1[i__ - 1 + (k | 
|---|
|  | 2972 | + j * c1_dim2) * c1_dim1] + c1[i__ + (k + jc * | 
|---|
|  | 2973 | c1_dim2) * c1_dim1]; | 
|---|
|  | 2974 | ch[i__ + (k + j * ch_dim2) * ch_dim1] = c1[i__ + (k + j * | 
|---|
|  | 2975 | c1_dim2) * c1_dim1] + c1[i__ - 1 + (k + jc * c1_dim2) | 
|---|
|  | 2976 | * c1_dim1]; | 
|---|
|  | 2977 | ch[i__ + (k + jc * ch_dim2) * ch_dim1] = c1[i__ + (k + j * | 
|---|
|  | 2978 | c1_dim2) * c1_dim1] - c1[i__ - 1 + (k + jc * c1_dim2) | 
|---|
|  | 2979 | * c1_dim1]; | 
|---|
|  | 2980 | /* L129: */ | 
|---|
|  | 2981 | } | 
|---|
|  | 2982 | /* L130: */ | 
|---|
|  | 2983 | } | 
|---|
|  | 2984 | /* L131: */ | 
|---|
|  | 2985 | } | 
|---|
|  | 2986 | L132: | 
|---|
|  | 2987 | if (*ido == 1) { | 
|---|
|  | 2988 | return 0; | 
|---|
|  | 2989 | } | 
|---|
|  | 2990 | i__1 = *idl1; | 
|---|
|  | 2991 | for (ik = 1; ik <= i__1; ++ik) { | 
|---|
|  | 2992 | c2[ik + c2_dim1] = ch2[ik + ch2_dim1]; | 
|---|
|  | 2993 | /* L133: */ | 
|---|
|  | 2994 | } | 
|---|
|  | 2995 | i__1 = *ip; | 
|---|
|  | 2996 | for (j = 2; j <= i__1; ++j) { | 
|---|
|  | 2997 | i__2 = *l1; | 
|---|
|  | 2998 | for (k = 1; k <= i__2; ++k) { | 
|---|
|  | 2999 | c1[(k + j * c1_dim2) * c1_dim1 + 1] = ch[(k + j * ch_dim2) * | 
|---|
|  | 3000 | ch_dim1 + 1]; | 
|---|
|  | 3001 | /* L134: */ | 
|---|
|  | 3002 | } | 
|---|
|  | 3003 | /* L135: */ | 
|---|
|  | 3004 | } | 
|---|
|  | 3005 | if (nbd > *l1) { | 
|---|
|  | 3006 | goto L139; | 
|---|
|  | 3007 | } | 
|---|
|  | 3008 | is = -(*ido); | 
|---|
|  | 3009 | i__1 = *ip; | 
|---|
|  | 3010 | for (j = 2; j <= i__1; ++j) { | 
|---|
|  | 3011 | is += *ido; | 
|---|
|  | 3012 | idij = is; | 
|---|
|  | 3013 | i__2 = *ido; | 
|---|
|  | 3014 | for (i__ = 3; i__ <= i__2; i__ += 2) { | 
|---|
|  | 3015 | idij += 2; | 
|---|
|  | 3016 | i__3 = *l1; | 
|---|
|  | 3017 | for (k = 1; k <= i__3; ++k) { | 
|---|
|  | 3018 | c1[i__ - 1 + (k + j * c1_dim2) * c1_dim1] = wa[idij - 1] * ch[ | 
|---|
|  | 3019 | i__ - 1 + (k + j * ch_dim2) * ch_dim1] - wa[idij] * | 
|---|
|  | 3020 | ch[i__ + (k + j * ch_dim2) * ch_dim1]; | 
|---|
|  | 3021 | c1[i__ + (k + j * c1_dim2) * c1_dim1] = wa[idij - 1] * ch[i__ | 
|---|
|  | 3022 | + (k + j * ch_dim2) * ch_dim1] + wa[idij] * ch[i__ - | 
|---|
|  | 3023 | 1 + (k + j * ch_dim2) * ch_dim1]; | 
|---|
|  | 3024 | /* L136: */ | 
|---|
|  | 3025 | } | 
|---|
|  | 3026 | /* L137: */ | 
|---|
|  | 3027 | } | 
|---|
|  | 3028 | /* L138: */ | 
|---|
|  | 3029 | } | 
|---|
|  | 3030 | goto L143; | 
|---|
|  | 3031 | L139: | 
|---|
|  | 3032 | is = -(*ido); | 
|---|
|  | 3033 | i__1 = *ip; | 
|---|
|  | 3034 | for (j = 2; j <= i__1; ++j) { | 
|---|
|  | 3035 | is += *ido; | 
|---|
|  | 3036 | i__2 = *l1; | 
|---|
|  | 3037 | for (k = 1; k <= i__2; ++k) { | 
|---|
|  | 3038 | idij = is; | 
|---|
|  | 3039 | i__3 = *ido; | 
|---|
|  | 3040 | for (i__ = 3; i__ <= i__3; i__ += 2) { | 
|---|
|  | 3041 | idij += 2; | 
|---|
|  | 3042 | c1[i__ - 1 + (k + j * c1_dim2) * c1_dim1] = wa[idij - 1] * ch[ | 
|---|
|  | 3043 | i__ - 1 + (k + j * ch_dim2) * ch_dim1] - wa[idij] * | 
|---|
|  | 3044 | ch[i__ + (k + j * ch_dim2) * ch_dim1]; | 
|---|
|  | 3045 | c1[i__ + (k + j * c1_dim2) * c1_dim1] = wa[idij - 1] * ch[i__ | 
|---|
|  | 3046 | + (k + j * ch_dim2) * ch_dim1] + wa[idij] * ch[i__ - | 
|---|
|  | 3047 | 1 + (k + j * ch_dim2) * ch_dim1]; | 
|---|
|  | 3048 | /* L140: */ | 
|---|
|  | 3049 | } | 
|---|
|  | 3050 | /* L141: */ | 
|---|
|  | 3051 | } | 
|---|
|  | 3052 | /* L142: */ | 
|---|
|  | 3053 | } | 
|---|
|  | 3054 | L143: | 
|---|
|  | 3055 | return 0; | 
|---|
|  | 3056 | } /* radbg_ */ | 
|---|
|  | 3057 |  | 
|---|
|  | 3058 | /*  ------ File radf2.f ------ */ | 
|---|
| [756] | 3059 | /* Subroutine */ int radf2_(int_4 *ido, int_4 *l1, r_4 *cc, r_4 *ch, | 
|---|
| [717] | 3060 | r_4 *wa1) | 
|---|
| [459] | 3061 | { | 
|---|
|  | 3062 | /* System generated locals */ | 
|---|
| [756] | 3063 | int_4 ch_dim1, ch_offset, cc_dim1, cc_dim2, cc_offset, i__1, i__2; | 
|---|
| [459] | 3064 |  | 
|---|
|  | 3065 | /* Local variables */ | 
|---|
| [756] | 3066 | static int_4 i__, k, ic; | 
|---|
| [717] | 3067 | static r_4 ti2, tr2; | 
|---|
| [756] | 3068 | static int_4 idp2; | 
|---|
| [459] | 3069 |  | 
|---|
|  | 3070 | /* Parameter adjustments */ | 
|---|
|  | 3071 | ch_dim1 = *ido; | 
|---|
|  | 3072 | ch_offset = ch_dim1 * 3 + 1; | 
|---|
|  | 3073 | ch -= ch_offset; | 
|---|
|  | 3074 | cc_dim1 = *ido; | 
|---|
|  | 3075 | cc_dim2 = *l1; | 
|---|
|  | 3076 | cc_offset = cc_dim1 * (cc_dim2 + 1) + 1; | 
|---|
|  | 3077 | cc -= cc_offset; | 
|---|
|  | 3078 | --wa1; | 
|---|
|  | 3079 |  | 
|---|
|  | 3080 | /* Function Body */ | 
|---|
|  | 3081 | i__1 = *l1; | 
|---|
|  | 3082 | for (k = 1; k <= i__1; ++k) { | 
|---|
|  | 3083 | ch[((k << 1) + 1) * ch_dim1 + 1] = cc[(k + cc_dim2) * cc_dim1 + 1] + | 
|---|
|  | 3084 | cc[(k + (cc_dim2 << 1)) * cc_dim1 + 1]; | 
|---|
|  | 3085 | ch[*ido + ((k << 1) + 2) * ch_dim1] = cc[(k + cc_dim2) * cc_dim1 + 1] | 
|---|
|  | 3086 | - cc[(k + (cc_dim2 << 1)) * cc_dim1 + 1]; | 
|---|
|  | 3087 | /* L101: */ | 
|---|
|  | 3088 | } | 
|---|
|  | 3089 | if ((i__1 = *ido - 2) < 0) { | 
|---|
|  | 3090 | goto L107; | 
|---|
|  | 3091 | } else if (i__1 == 0) { | 
|---|
|  | 3092 | goto L105; | 
|---|
|  | 3093 | } else { | 
|---|
|  | 3094 | goto L102; | 
|---|
|  | 3095 | } | 
|---|
|  | 3096 | L102: | 
|---|
|  | 3097 | idp2 = *ido + 2; | 
|---|
|  | 3098 | i__1 = *l1; | 
|---|
|  | 3099 | for (k = 1; k <= i__1; ++k) { | 
|---|
|  | 3100 | i__2 = *ido; | 
|---|
|  | 3101 | for (i__ = 3; i__ <= i__2; i__ += 2) { | 
|---|
|  | 3102 | ic = idp2 - i__; | 
|---|
|  | 3103 | tr2 = wa1[i__ - 2] * cc[i__ - 1 + (k + (cc_dim2 << 1)) * cc_dim1] | 
|---|
|  | 3104 | + wa1[i__ - 1] * cc[i__ + (k + (cc_dim2 << 1)) * cc_dim1]; | 
|---|
|  | 3105 | ti2 = wa1[i__ - 2] * cc[i__ + (k + (cc_dim2 << 1)) * cc_dim1] - | 
|---|
|  | 3106 | wa1[i__ - 1] * cc[i__ - 1 + (k + (cc_dim2 << 1)) * | 
|---|
|  | 3107 | cc_dim1]; | 
|---|
|  | 3108 | ch[i__ + ((k << 1) + 1) * ch_dim1] = cc[i__ + (k + cc_dim2) * | 
|---|
|  | 3109 | cc_dim1] + ti2; | 
|---|
|  | 3110 | ch[ic + ((k << 1) + 2) * ch_dim1] = ti2 - cc[i__ + (k + cc_dim2) * | 
|---|
|  | 3111 | cc_dim1]; | 
|---|
|  | 3112 | ch[i__ - 1 + ((k << 1) + 1) * ch_dim1] = cc[i__ - 1 + (k + | 
|---|
|  | 3113 | cc_dim2) * cc_dim1] + tr2; | 
|---|
|  | 3114 | ch[ic - 1 + ((k << 1) + 2) * ch_dim1] = cc[i__ - 1 + (k + cc_dim2) | 
|---|
|  | 3115 | * cc_dim1] - tr2; | 
|---|
|  | 3116 | /* L103: */ | 
|---|
|  | 3117 | } | 
|---|
|  | 3118 | /* L104: */ | 
|---|
|  | 3119 | } | 
|---|
|  | 3120 | if (*ido % 2 == 1) { | 
|---|
|  | 3121 | return 0; | 
|---|
|  | 3122 | } | 
|---|
|  | 3123 | L105: | 
|---|
|  | 3124 | i__1 = *l1; | 
|---|
|  | 3125 | for (k = 1; k <= i__1; ++k) { | 
|---|
|  | 3126 | ch[((k << 1) + 2) * ch_dim1 + 1] = -cc[*ido + (k + (cc_dim2 << 1)) * | 
|---|
|  | 3127 | cc_dim1]; | 
|---|
|  | 3128 | ch[*ido + ((k << 1) + 1) * ch_dim1] = cc[*ido + (k + cc_dim2) * | 
|---|
|  | 3129 | cc_dim1]; | 
|---|
|  | 3130 | /* L106: */ | 
|---|
|  | 3131 | } | 
|---|
|  | 3132 | L107: | 
|---|
|  | 3133 | return 0; | 
|---|
|  | 3134 | } /* radf2_ */ | 
|---|
|  | 3135 |  | 
|---|
|  | 3136 | /*  ------ File radf3.f ------ */ | 
|---|
| [756] | 3137 | /* Subroutine */ int radf3_(int_4 *ido, int_4 *l1, r_4 *cc, r_4 *ch, | 
|---|
| [717] | 3138 | r_4 *wa1, r_4 *wa2) | 
|---|
| [459] | 3139 | { | 
|---|
|  | 3140 | /* Initialized data */ | 
|---|
|  | 3141 |  | 
|---|
| [717] | 3142 | static r_4 taur = -.5f; | 
|---|
|  | 3143 | static r_4 taui = .866025403784439f; | 
|---|
| [459] | 3144 |  | 
|---|
|  | 3145 | /* System generated locals */ | 
|---|
| [756] | 3146 | int_4 ch_dim1, ch_offset, cc_dim1, cc_dim2, cc_offset, i__1, i__2; | 
|---|
| [459] | 3147 |  | 
|---|
|  | 3148 | /* Local variables */ | 
|---|
| [756] | 3149 | static int_4 i__, k, ic; | 
|---|
| [717] | 3150 | static r_4 ci2, di2, di3, cr2, dr2, dr3, ti2, ti3, tr2, tr3; | 
|---|
| [756] | 3151 | static int_4 idp2; | 
|---|
| [459] | 3152 |  | 
|---|
|  | 3153 | /* Parameter adjustments */ | 
|---|
|  | 3154 | ch_dim1 = *ido; | 
|---|
|  | 3155 | ch_offset = (ch_dim1 << 2) + 1; | 
|---|
|  | 3156 | ch -= ch_offset; | 
|---|
|  | 3157 | cc_dim1 = *ido; | 
|---|
|  | 3158 | cc_dim2 = *l1; | 
|---|
|  | 3159 | cc_offset = cc_dim1 * (cc_dim2 + 1) + 1; | 
|---|
|  | 3160 | cc -= cc_offset; | 
|---|
|  | 3161 | --wa1; | 
|---|
|  | 3162 | --wa2; | 
|---|
|  | 3163 |  | 
|---|
|  | 3164 | /* Function Body */ | 
|---|
|  | 3165 | i__1 = *l1; | 
|---|
|  | 3166 | for (k = 1; k <= i__1; ++k) { | 
|---|
|  | 3167 | cr2 = cc[(k + (cc_dim2 << 1)) * cc_dim1 + 1] + cc[(k + cc_dim2 * 3) * | 
|---|
|  | 3168 | cc_dim1 + 1]; | 
|---|
|  | 3169 | ch[(k * 3 + 1) * ch_dim1 + 1] = cc[(k + cc_dim2) * cc_dim1 + 1] + cr2; | 
|---|
|  | 3170 | ch[(k * 3 + 3) * ch_dim1 + 1] = taui * (cc[(k + cc_dim2 * 3) * | 
|---|
|  | 3171 | cc_dim1 + 1] - cc[(k + (cc_dim2 << 1)) * cc_dim1 + 1]); | 
|---|
|  | 3172 | ch[*ido + (k * 3 + 2) * ch_dim1] = cc[(k + cc_dim2) * cc_dim1 + 1] + | 
|---|
|  | 3173 | taur * cr2; | 
|---|
|  | 3174 | /* L101: */ | 
|---|
|  | 3175 | } | 
|---|
|  | 3176 | if (*ido == 1) { | 
|---|
|  | 3177 | return 0; | 
|---|
|  | 3178 | } | 
|---|
|  | 3179 | idp2 = *ido + 2; | 
|---|
|  | 3180 | i__1 = *l1; | 
|---|
|  | 3181 | for (k = 1; k <= i__1; ++k) { | 
|---|
|  | 3182 | i__2 = *ido; | 
|---|
|  | 3183 | for (i__ = 3; i__ <= i__2; i__ += 2) { | 
|---|
|  | 3184 | ic = idp2 - i__; | 
|---|
|  | 3185 | dr2 = wa1[i__ - 2] * cc[i__ - 1 + (k + (cc_dim2 << 1)) * cc_dim1] | 
|---|
|  | 3186 | + wa1[i__ - 1] * cc[i__ + (k + (cc_dim2 << 1)) * cc_dim1]; | 
|---|
|  | 3187 | di2 = wa1[i__ - 2] * cc[i__ + (k + (cc_dim2 << 1)) * cc_dim1] - | 
|---|
|  | 3188 | wa1[i__ - 1] * cc[i__ - 1 + (k + (cc_dim2 << 1)) * | 
|---|
|  | 3189 | cc_dim1]; | 
|---|
|  | 3190 | dr3 = wa2[i__ - 2] * cc[i__ - 1 + (k + cc_dim2 * 3) * cc_dim1] + | 
|---|
|  | 3191 | wa2[i__ - 1] * cc[i__ + (k + cc_dim2 * 3) * cc_dim1]; | 
|---|
|  | 3192 | di3 = wa2[i__ - 2] * cc[i__ + (k + cc_dim2 * 3) * cc_dim1] - wa2[ | 
|---|
|  | 3193 | i__ - 1] * cc[i__ - 1 + (k + cc_dim2 * 3) * cc_dim1]; | 
|---|
|  | 3194 | cr2 = dr2 + dr3; | 
|---|
|  | 3195 | ci2 = di2 + di3; | 
|---|
|  | 3196 | ch[i__ - 1 + (k * 3 + 1) * ch_dim1] = cc[i__ - 1 + (k + cc_dim2) * | 
|---|
|  | 3197 | cc_dim1] + cr2; | 
|---|
|  | 3198 | ch[i__ + (k * 3 + 1) * ch_dim1] = cc[i__ + (k + cc_dim2) * | 
|---|
|  | 3199 | cc_dim1] + ci2; | 
|---|
|  | 3200 | tr2 = cc[i__ - 1 + (k + cc_dim2) * cc_dim1] + taur * cr2; | 
|---|
|  | 3201 | ti2 = cc[i__ + (k + cc_dim2) * cc_dim1] + taur * ci2; | 
|---|
|  | 3202 | tr3 = taui * (di2 - di3); | 
|---|
|  | 3203 | ti3 = taui * (dr3 - dr2); | 
|---|
|  | 3204 | ch[i__ - 1 + (k * 3 + 3) * ch_dim1] = tr2 + tr3; | 
|---|
|  | 3205 | ch[ic - 1 + (k * 3 + 2) * ch_dim1] = tr2 - tr3; | 
|---|
|  | 3206 | ch[i__ + (k * 3 + 3) * ch_dim1] = ti2 + ti3; | 
|---|
|  | 3207 | ch[ic + (k * 3 + 2) * ch_dim1] = ti3 - ti2; | 
|---|
|  | 3208 | /* L102: */ | 
|---|
|  | 3209 | } | 
|---|
|  | 3210 | /* L103: */ | 
|---|
|  | 3211 | } | 
|---|
|  | 3212 | return 0; | 
|---|
|  | 3213 | } /* radf3_ */ | 
|---|
|  | 3214 |  | 
|---|
|  | 3215 | /*  ------ File radf4.f ------ */ | 
|---|
| [756] | 3216 | /* Subroutine */ int radf4_(int_4 *ido, int_4 *l1, r_4 *cc, r_4 *ch, | 
|---|
| [717] | 3217 | r_4 *wa1, r_4 *wa2, r_4 *wa3) | 
|---|
| [459] | 3218 | { | 
|---|
|  | 3219 | /* Initialized data */ | 
|---|
|  | 3220 |  | 
|---|
| [717] | 3221 | static r_4 hsqt2 = .7071067811865475f; | 
|---|
| [459] | 3222 |  | 
|---|
|  | 3223 | /* System generated locals */ | 
|---|
| [756] | 3224 | int_4 cc_dim1, cc_dim2, cc_offset, ch_dim1, ch_offset, i__1, i__2; | 
|---|
| [459] | 3225 |  | 
|---|
|  | 3226 | /* Local variables */ | 
|---|
| [756] | 3227 | static int_4 i__, k, ic; | 
|---|
| [717] | 3228 | static r_4 ci2, ci3, ci4, cr2, cr3, cr4, ti1, ti2, ti3, ti4, tr1, tr2, | 
|---|
| [459] | 3229 | tr3, tr4; | 
|---|
| [756] | 3230 | static int_4 idp2; | 
|---|
| [459] | 3231 |  | 
|---|
|  | 3232 | /* Parameter adjustments */ | 
|---|
|  | 3233 | ch_dim1 = *ido; | 
|---|
|  | 3234 | ch_offset = ch_dim1 * 5 + 1; | 
|---|
|  | 3235 | ch -= ch_offset; | 
|---|
|  | 3236 | cc_dim1 = *ido; | 
|---|
|  | 3237 | cc_dim2 = *l1; | 
|---|
|  | 3238 | cc_offset = cc_dim1 * (cc_dim2 + 1) + 1; | 
|---|
|  | 3239 | cc -= cc_offset; | 
|---|
|  | 3240 | --wa1; | 
|---|
|  | 3241 | --wa2; | 
|---|
|  | 3242 | --wa3; | 
|---|
|  | 3243 |  | 
|---|
|  | 3244 | /* Function Body */ | 
|---|
|  | 3245 | i__1 = *l1; | 
|---|
|  | 3246 | for (k = 1; k <= i__1; ++k) { | 
|---|
|  | 3247 | tr1 = cc[(k + (cc_dim2 << 1)) * cc_dim1 + 1] + cc[(k + (cc_dim2 << 2)) | 
|---|
|  | 3248 | * cc_dim1 + 1]; | 
|---|
|  | 3249 | tr2 = cc[(k + cc_dim2) * cc_dim1 + 1] + cc[(k + cc_dim2 * 3) * | 
|---|
|  | 3250 | cc_dim1 + 1]; | 
|---|
|  | 3251 | ch[((k << 2) + 1) * ch_dim1 + 1] = tr1 + tr2; | 
|---|
|  | 3252 | ch[*ido + ((k << 2) + 4) * ch_dim1] = tr2 - tr1; | 
|---|
|  | 3253 | ch[*ido + ((k << 2) + 2) * ch_dim1] = cc[(k + cc_dim2) * cc_dim1 + 1] | 
|---|
|  | 3254 | - cc[(k + cc_dim2 * 3) * cc_dim1 + 1]; | 
|---|
|  | 3255 | ch[((k << 2) + 3) * ch_dim1 + 1] = cc[(k + (cc_dim2 << 2)) * cc_dim1 | 
|---|
|  | 3256 | + 1] - cc[(k + (cc_dim2 << 1)) * cc_dim1 + 1]; | 
|---|
|  | 3257 | /* L101: */ | 
|---|
|  | 3258 | } | 
|---|
|  | 3259 | if ((i__1 = *ido - 2) < 0) { | 
|---|
|  | 3260 | goto L107; | 
|---|
|  | 3261 | } else if (i__1 == 0) { | 
|---|
|  | 3262 | goto L105; | 
|---|
|  | 3263 | } else { | 
|---|
|  | 3264 | goto L102; | 
|---|
|  | 3265 | } | 
|---|
|  | 3266 | L102: | 
|---|
|  | 3267 | idp2 = *ido + 2; | 
|---|
|  | 3268 | i__1 = *l1; | 
|---|
|  | 3269 | for (k = 1; k <= i__1; ++k) { | 
|---|
|  | 3270 | i__2 = *ido; | 
|---|
|  | 3271 | for (i__ = 3; i__ <= i__2; i__ += 2) { | 
|---|
|  | 3272 | ic = idp2 - i__; | 
|---|
|  | 3273 | cr2 = wa1[i__ - 2] * cc[i__ - 1 + (k + (cc_dim2 << 1)) * cc_dim1] | 
|---|
|  | 3274 | + wa1[i__ - 1] * cc[i__ + (k + (cc_dim2 << 1)) * cc_dim1]; | 
|---|
|  | 3275 | ci2 = wa1[i__ - 2] * cc[i__ + (k + (cc_dim2 << 1)) * cc_dim1] - | 
|---|
|  | 3276 | wa1[i__ - 1] * cc[i__ - 1 + (k + (cc_dim2 << 1)) * | 
|---|
|  | 3277 | cc_dim1]; | 
|---|
|  | 3278 | cr3 = wa2[i__ - 2] * cc[i__ - 1 + (k + cc_dim2 * 3) * cc_dim1] + | 
|---|
|  | 3279 | wa2[i__ - 1] * cc[i__ + (k + cc_dim2 * 3) * cc_dim1]; | 
|---|
|  | 3280 | ci3 = wa2[i__ - 2] * cc[i__ + (k + cc_dim2 * 3) * cc_dim1] - wa2[ | 
|---|
|  | 3281 | i__ - 1] * cc[i__ - 1 + (k + cc_dim2 * 3) * cc_dim1]; | 
|---|
|  | 3282 | cr4 = wa3[i__ - 2] * cc[i__ - 1 + (k + (cc_dim2 << 2)) * cc_dim1] | 
|---|
|  | 3283 | + wa3[i__ - 1] * cc[i__ + (k + (cc_dim2 << 2)) * cc_dim1]; | 
|---|
|  | 3284 | ci4 = wa3[i__ - 2] * cc[i__ + (k + (cc_dim2 << 2)) * cc_dim1] - | 
|---|
|  | 3285 | wa3[i__ - 1] * cc[i__ - 1 + (k + (cc_dim2 << 2)) * | 
|---|
|  | 3286 | cc_dim1]; | 
|---|
|  | 3287 | tr1 = cr2 + cr4; | 
|---|
|  | 3288 | tr4 = cr4 - cr2; | 
|---|
|  | 3289 | ti1 = ci2 + ci4; | 
|---|
|  | 3290 | ti4 = ci2 - ci4; | 
|---|
|  | 3291 | ti2 = cc[i__ + (k + cc_dim2) * cc_dim1] + ci3; | 
|---|
|  | 3292 | ti3 = cc[i__ + (k + cc_dim2) * cc_dim1] - ci3; | 
|---|
|  | 3293 | tr2 = cc[i__ - 1 + (k + cc_dim2) * cc_dim1] + cr3; | 
|---|
|  | 3294 | tr3 = cc[i__ - 1 + (k + cc_dim2) * cc_dim1] - cr3; | 
|---|
|  | 3295 | ch[i__ - 1 + ((k << 2) + 1) * ch_dim1] = tr1 + tr2; | 
|---|
|  | 3296 | ch[ic - 1 + ((k << 2) + 4) * ch_dim1] = tr2 - tr1; | 
|---|
|  | 3297 | ch[i__ + ((k << 2) + 1) * ch_dim1] = ti1 + ti2; | 
|---|
|  | 3298 | ch[ic + ((k << 2) + 4) * ch_dim1] = ti1 - ti2; | 
|---|
|  | 3299 | ch[i__ - 1 + ((k << 2) + 3) * ch_dim1] = ti4 + tr3; | 
|---|
|  | 3300 | ch[ic - 1 + ((k << 2) + 2) * ch_dim1] = tr3 - ti4; | 
|---|
|  | 3301 | ch[i__ + ((k << 2) + 3) * ch_dim1] = tr4 + ti3; | 
|---|
|  | 3302 | ch[ic + ((k << 2) + 2) * ch_dim1] = tr4 - ti3; | 
|---|
|  | 3303 | /* L103: */ | 
|---|
|  | 3304 | } | 
|---|
|  | 3305 | /* L104: */ | 
|---|
|  | 3306 | } | 
|---|
|  | 3307 | if (*ido % 2 == 1) { | 
|---|
|  | 3308 | return 0; | 
|---|
|  | 3309 | } | 
|---|
|  | 3310 | L105: | 
|---|
|  | 3311 | i__1 = *l1; | 
|---|
|  | 3312 | for (k = 1; k <= i__1; ++k) { | 
|---|
|  | 3313 | ti1 = -hsqt2 * (cc[*ido + (k + (cc_dim2 << 1)) * cc_dim1] + cc[*ido + | 
|---|
|  | 3314 | (k + (cc_dim2 << 2)) * cc_dim1]); | 
|---|
|  | 3315 | tr1 = hsqt2 * (cc[*ido + (k + (cc_dim2 << 1)) * cc_dim1] - cc[*ido + ( | 
|---|
|  | 3316 | k + (cc_dim2 << 2)) * cc_dim1]); | 
|---|
|  | 3317 | ch[*ido + ((k << 2) + 1) * ch_dim1] = tr1 + cc[*ido + (k + cc_dim2) * | 
|---|
|  | 3318 | cc_dim1]; | 
|---|
|  | 3319 | ch[*ido + ((k << 2) + 3) * ch_dim1] = cc[*ido + (k + cc_dim2) * | 
|---|
|  | 3320 | cc_dim1] - tr1; | 
|---|
|  | 3321 | ch[((k << 2) + 2) * ch_dim1 + 1] = ti1 - cc[*ido + (k + cc_dim2 * 3) * | 
|---|
|  | 3322 | cc_dim1]; | 
|---|
|  | 3323 | ch[((k << 2) + 4) * ch_dim1 + 1] = ti1 + cc[*ido + (k + cc_dim2 * 3) * | 
|---|
|  | 3324 | cc_dim1]; | 
|---|
|  | 3325 | /* L106: */ | 
|---|
|  | 3326 | } | 
|---|
|  | 3327 | L107: | 
|---|
|  | 3328 | return 0; | 
|---|
|  | 3329 | } /* radf4_ */ | 
|---|
|  | 3330 |  | 
|---|
|  | 3331 | /*  ------ File radf5.f ------ */ | 
|---|
| [756] | 3332 | /* Subroutine */ int radf5_(int_4 *ido, int_4 *l1, r_4 *cc, r_4 *ch, | 
|---|
| [717] | 3333 | r_4 *wa1, r_4 *wa2, r_4 *wa3, r_4 *wa4) | 
|---|
| [459] | 3334 | { | 
|---|
|  | 3335 | /* Initialized data */ | 
|---|
|  | 3336 |  | 
|---|
| [717] | 3337 | static r_4 tr11 = .309016994374947f; | 
|---|
|  | 3338 | static r_4 ti11 = .951056516295154f; | 
|---|
|  | 3339 | static r_4 tr12 = -.809016994374947f; | 
|---|
|  | 3340 | static r_4 ti12 = .587785252292473f; | 
|---|
| [459] | 3341 |  | 
|---|
|  | 3342 | /* System generated locals */ | 
|---|
| [756] | 3343 | int_4 cc_dim1, cc_dim2, cc_offset, ch_dim1, ch_offset, i__1, i__2; | 
|---|
| [459] | 3344 |  | 
|---|
|  | 3345 | /* Local variables */ | 
|---|
| [756] | 3346 | static int_4 i__, k, ic; | 
|---|
| [717] | 3347 | static r_4 ci2, di2, ci4, ci5, di3, di4, di5, ci3, cr2, cr3, dr2, dr3, | 
|---|
| [459] | 3348 | dr4, dr5, cr5, cr4, ti2, ti3, ti5, ti4, tr2, tr3, tr4, tr5; | 
|---|
| [756] | 3349 | static int_4 idp2; | 
|---|
| [459] | 3350 |  | 
|---|
|  | 3351 | /* Parameter adjustments */ | 
|---|
|  | 3352 | ch_dim1 = *ido; | 
|---|
|  | 3353 | ch_offset = ch_dim1 * 6 + 1; | 
|---|
|  | 3354 | ch -= ch_offset; | 
|---|
|  | 3355 | cc_dim1 = *ido; | 
|---|
|  | 3356 | cc_dim2 = *l1; | 
|---|
|  | 3357 | cc_offset = cc_dim1 * (cc_dim2 + 1) + 1; | 
|---|
|  | 3358 | cc -= cc_offset; | 
|---|
|  | 3359 | --wa1; | 
|---|
|  | 3360 | --wa2; | 
|---|
|  | 3361 | --wa3; | 
|---|
|  | 3362 | --wa4; | 
|---|
|  | 3363 |  | 
|---|
|  | 3364 | /* Function Body */ | 
|---|
|  | 3365 | i__1 = *l1; | 
|---|
|  | 3366 | for (k = 1; k <= i__1; ++k) { | 
|---|
|  | 3367 | cr2 = cc[(k + cc_dim2 * 5) * cc_dim1 + 1] + cc[(k + (cc_dim2 << 1)) * | 
|---|
|  | 3368 | cc_dim1 + 1]; | 
|---|
|  | 3369 | ci5 = cc[(k + cc_dim2 * 5) * cc_dim1 + 1] - cc[(k + (cc_dim2 << 1)) * | 
|---|
|  | 3370 | cc_dim1 + 1]; | 
|---|
|  | 3371 | cr3 = cc[(k + (cc_dim2 << 2)) * cc_dim1 + 1] + cc[(k + cc_dim2 * 3) * | 
|---|
|  | 3372 | cc_dim1 + 1]; | 
|---|
|  | 3373 | ci4 = cc[(k + (cc_dim2 << 2)) * cc_dim1 + 1] - cc[(k + cc_dim2 * 3) * | 
|---|
|  | 3374 | cc_dim1 + 1]; | 
|---|
|  | 3375 | ch[(k * 5 + 1) * ch_dim1 + 1] = cc[(k + cc_dim2) * cc_dim1 + 1] + cr2 | 
|---|
|  | 3376 | + cr3; | 
|---|
|  | 3377 | ch[*ido + (k * 5 + 2) * ch_dim1] = cc[(k + cc_dim2) * cc_dim1 + 1] + | 
|---|
|  | 3378 | tr11 * cr2 + tr12 * cr3; | 
|---|
|  | 3379 | ch[(k * 5 + 3) * ch_dim1 + 1] = ti11 * ci5 + ti12 * ci4; | 
|---|
|  | 3380 | ch[*ido + (k * 5 + 4) * ch_dim1] = cc[(k + cc_dim2) * cc_dim1 + 1] + | 
|---|
|  | 3381 | tr12 * cr2 + tr11 * cr3; | 
|---|
|  | 3382 | ch[(k * 5 + 5) * ch_dim1 + 1] = ti12 * ci5 - ti11 * ci4; | 
|---|
|  | 3383 | /* L101: */ | 
|---|
|  | 3384 | } | 
|---|
|  | 3385 | if (*ido == 1) { | 
|---|
|  | 3386 | return 0; | 
|---|
|  | 3387 | } | 
|---|
|  | 3388 | idp2 = *ido + 2; | 
|---|
|  | 3389 | i__1 = *l1; | 
|---|
|  | 3390 | for (k = 1; k <= i__1; ++k) { | 
|---|
|  | 3391 | i__2 = *ido; | 
|---|
|  | 3392 | for (i__ = 3; i__ <= i__2; i__ += 2) { | 
|---|
|  | 3393 | ic = idp2 - i__; | 
|---|
|  | 3394 | dr2 = wa1[i__ - 2] * cc[i__ - 1 + (k + (cc_dim2 << 1)) * cc_dim1] | 
|---|
|  | 3395 | + wa1[i__ - 1] * cc[i__ + (k + (cc_dim2 << 1)) * cc_dim1]; | 
|---|
|  | 3396 | di2 = wa1[i__ - 2] * cc[i__ + (k + (cc_dim2 << 1)) * cc_dim1] - | 
|---|
|  | 3397 | wa1[i__ - 1] * cc[i__ - 1 + (k + (cc_dim2 << 1)) * | 
|---|
|  | 3398 | cc_dim1]; | 
|---|
|  | 3399 | dr3 = wa2[i__ - 2] * cc[i__ - 1 + (k + cc_dim2 * 3) * cc_dim1] + | 
|---|
|  | 3400 | wa2[i__ - 1] * cc[i__ + (k + cc_dim2 * 3) * cc_dim1]; | 
|---|
|  | 3401 | di3 = wa2[i__ - 2] * cc[i__ + (k + cc_dim2 * 3) * cc_dim1] - wa2[ | 
|---|
|  | 3402 | i__ - 1] * cc[i__ - 1 + (k + cc_dim2 * 3) * cc_dim1]; | 
|---|
|  | 3403 | dr4 = wa3[i__ - 2] * cc[i__ - 1 + (k + (cc_dim2 << 2)) * cc_dim1] | 
|---|
|  | 3404 | + wa3[i__ - 1] * cc[i__ + (k + (cc_dim2 << 2)) * cc_dim1]; | 
|---|
|  | 3405 | di4 = wa3[i__ - 2] * cc[i__ + (k + (cc_dim2 << 2)) * cc_dim1] - | 
|---|
|  | 3406 | wa3[i__ - 1] * cc[i__ - 1 + (k + (cc_dim2 << 2)) * | 
|---|
|  | 3407 | cc_dim1]; | 
|---|
|  | 3408 | dr5 = wa4[i__ - 2] * cc[i__ - 1 + (k + cc_dim2 * 5) * cc_dim1] + | 
|---|
|  | 3409 | wa4[i__ - 1] * cc[i__ + (k + cc_dim2 * 5) * cc_dim1]; | 
|---|
|  | 3410 | di5 = wa4[i__ - 2] * cc[i__ + (k + cc_dim2 * 5) * cc_dim1] - wa4[ | 
|---|
|  | 3411 | i__ - 1] * cc[i__ - 1 + (k + cc_dim2 * 5) * cc_dim1]; | 
|---|
|  | 3412 | cr2 = dr2 + dr5; | 
|---|
|  | 3413 | ci5 = dr5 - dr2; | 
|---|
|  | 3414 | cr5 = di2 - di5; | 
|---|
|  | 3415 | ci2 = di2 + di5; | 
|---|
|  | 3416 | cr3 = dr3 + dr4; | 
|---|
|  | 3417 | ci4 = dr4 - dr3; | 
|---|
|  | 3418 | cr4 = di3 - di4; | 
|---|
|  | 3419 | ci3 = di3 + di4; | 
|---|
|  | 3420 | ch[i__ - 1 + (k * 5 + 1) * ch_dim1] = cc[i__ - 1 + (k + cc_dim2) * | 
|---|
|  | 3421 | cc_dim1] + cr2 + cr3; | 
|---|
|  | 3422 | ch[i__ + (k * 5 + 1) * ch_dim1] = cc[i__ + (k + cc_dim2) * | 
|---|
|  | 3423 | cc_dim1] + ci2 + ci3; | 
|---|
|  | 3424 | tr2 = cc[i__ - 1 + (k + cc_dim2) * cc_dim1] + tr11 * cr2 + tr12 * | 
|---|
|  | 3425 | cr3; | 
|---|
|  | 3426 | ti2 = cc[i__ + (k + cc_dim2) * cc_dim1] + tr11 * ci2 + tr12 * ci3; | 
|---|
|  | 3427 | tr3 = cc[i__ - 1 + (k + cc_dim2) * cc_dim1] + tr12 * cr2 + tr11 * | 
|---|
|  | 3428 | cr3; | 
|---|
|  | 3429 | ti3 = cc[i__ + (k + cc_dim2) * cc_dim1] + tr12 * ci2 + tr11 * ci3; | 
|---|
|  | 3430 | tr5 = ti11 * cr5 + ti12 * cr4; | 
|---|
|  | 3431 | ti5 = ti11 * ci5 + ti12 * ci4; | 
|---|
|  | 3432 | tr4 = ti12 * cr5 - ti11 * cr4; | 
|---|
|  | 3433 | ti4 = ti12 * ci5 - ti11 * ci4; | 
|---|
|  | 3434 | ch[i__ - 1 + (k * 5 + 3) * ch_dim1] = tr2 + tr5; | 
|---|
|  | 3435 | ch[ic - 1 + (k * 5 + 2) * ch_dim1] = tr2 - tr5; | 
|---|
|  | 3436 | ch[i__ + (k * 5 + 3) * ch_dim1] = ti2 + ti5; | 
|---|
|  | 3437 | ch[ic + (k * 5 + 2) * ch_dim1] = ti5 - ti2; | 
|---|
|  | 3438 | ch[i__ - 1 + (k * 5 + 5) * ch_dim1] = tr3 + tr4; | 
|---|
|  | 3439 | ch[ic - 1 + (k * 5 + 4) * ch_dim1] = tr3 - tr4; | 
|---|
|  | 3440 | ch[i__ + (k * 5 + 5) * ch_dim1] = ti3 + ti4; | 
|---|
|  | 3441 | ch[ic + (k * 5 + 4) * ch_dim1] = ti4 - ti3; | 
|---|
|  | 3442 | /* L102: */ | 
|---|
|  | 3443 | } | 
|---|
|  | 3444 | /* L103: */ | 
|---|
|  | 3445 | } | 
|---|
|  | 3446 | return 0; | 
|---|
|  | 3447 | } /* radf5_ */ | 
|---|
|  | 3448 |  | 
|---|
|  | 3449 | /*  ------ File radfg.f ------ */ | 
|---|
| [756] | 3450 | /* Subroutine */ int radfg_(int_4 *ido, int_4 *ip, int_4 *l1, int_4 * | 
|---|
| [717] | 3451 | idl1, r_4 *cc, r_4 *c1, r_4 *c2, r_4 *ch, r_4 *ch2, r_4 *wa) | 
|---|
| [459] | 3452 | { | 
|---|
|  | 3453 | /* Initialized data */ | 
|---|
|  | 3454 |  | 
|---|
| [717] | 3455 | static r_4 tpi = 6.28318530717959f; | 
|---|
| [459] | 3456 |  | 
|---|
|  | 3457 | /* System generated locals */ | 
|---|
| [756] | 3458 | int_4 ch_dim1, ch_dim2, ch_offset, cc_dim1, cc_dim2, cc_offset, c1_dim1, | 
|---|
| [459] | 3459 | c1_dim2, c1_offset, c2_dim1, c2_offset, ch2_dim1, ch2_offset, | 
|---|
|  | 3460 | i__1, i__2, i__3; | 
|---|
|  | 3461 |  | 
|---|
|  | 3462 | /* Builtin functions */ | 
|---|
| [717] | 3463 | /*    r_8 cos(r_8truc), sin(r_8truc);    */ | 
|---|
| [459] | 3464 |  | 
|---|
|  | 3465 | /* Local variables */ | 
|---|
| [756] | 3466 | static int_4 idij, ipph, i__, j, k, l, j2, ic, jc, lc, ik, is; | 
|---|
| [717] | 3467 | static r_4 dc2, ai1, ai2, ar1, ar2, ds2; | 
|---|
| [756] | 3468 | static int_4 nbd; | 
|---|
| [717] | 3469 | static r_4 dcp, arg, dsp, ar1h, ar2h; | 
|---|
| [756] | 3470 | static int_4 idp2, ipp2; | 
|---|
| [459] | 3471 |  | 
|---|
|  | 3472 | /* Parameter adjustments */ | 
|---|
|  | 3473 | ch_dim1 = *ido; | 
|---|
|  | 3474 | ch_dim2 = *l1; | 
|---|
|  | 3475 | ch_offset = ch_dim1 * (ch_dim2 + 1) + 1; | 
|---|
|  | 3476 | ch -= ch_offset; | 
|---|
|  | 3477 | c1_dim1 = *ido; | 
|---|
|  | 3478 | c1_dim2 = *l1; | 
|---|
|  | 3479 | c1_offset = c1_dim1 * (c1_dim2 + 1) + 1; | 
|---|
|  | 3480 | c1 -= c1_offset; | 
|---|
|  | 3481 | cc_dim1 = *ido; | 
|---|
|  | 3482 | cc_dim2 = *ip; | 
|---|
|  | 3483 | cc_offset = cc_dim1 * (cc_dim2 + 1) + 1; | 
|---|
|  | 3484 | cc -= cc_offset; | 
|---|
|  | 3485 | ch2_dim1 = *idl1; | 
|---|
|  | 3486 | ch2_offset = ch2_dim1 + 1; | 
|---|
|  | 3487 | ch2 -= ch2_offset; | 
|---|
|  | 3488 | c2_dim1 = *idl1; | 
|---|
|  | 3489 | c2_offset = c2_dim1 + 1; | 
|---|
|  | 3490 | c2 -= c2_offset; | 
|---|
|  | 3491 | --wa; | 
|---|
|  | 3492 |  | 
|---|
|  | 3493 | /* Function Body */ | 
|---|
| [717] | 3494 | arg = tpi / (r_4) (*ip); | 
|---|
| [459] | 3495 | dcp = cos(arg); | 
|---|
|  | 3496 | dsp = sin(arg); | 
|---|
|  | 3497 | ipph = (*ip + 1) / 2; | 
|---|
|  | 3498 | ipp2 = *ip + 2; | 
|---|
|  | 3499 | idp2 = *ido + 2; | 
|---|
|  | 3500 | nbd = (*ido - 1) / 2; | 
|---|
|  | 3501 | if (*ido == 1) { | 
|---|
|  | 3502 | goto L119; | 
|---|
|  | 3503 | } | 
|---|
|  | 3504 | i__1 = *idl1; | 
|---|
|  | 3505 | for (ik = 1; ik <= i__1; ++ik) { | 
|---|
|  | 3506 | ch2[ik + ch2_dim1] = c2[ik + c2_dim1]; | 
|---|
|  | 3507 | /* L101: */ | 
|---|
|  | 3508 | } | 
|---|
|  | 3509 | i__1 = *ip; | 
|---|
|  | 3510 | for (j = 2; j <= i__1; ++j) { | 
|---|
|  | 3511 | i__2 = *l1; | 
|---|
|  | 3512 | for (k = 1; k <= i__2; ++k) { | 
|---|
|  | 3513 | ch[(k + j * ch_dim2) * ch_dim1 + 1] = c1[(k + j * c1_dim2) * | 
|---|
|  | 3514 | c1_dim1 + 1]; | 
|---|
|  | 3515 | /* L102: */ | 
|---|
|  | 3516 | } | 
|---|
|  | 3517 | /* L103: */ | 
|---|
|  | 3518 | } | 
|---|
|  | 3519 | if (nbd > *l1) { | 
|---|
|  | 3520 | goto L107; | 
|---|
|  | 3521 | } | 
|---|
|  | 3522 | is = -(*ido); | 
|---|
|  | 3523 | i__1 = *ip; | 
|---|
|  | 3524 | for (j = 2; j <= i__1; ++j) { | 
|---|
|  | 3525 | is += *ido; | 
|---|
|  | 3526 | idij = is; | 
|---|
|  | 3527 | i__2 = *ido; | 
|---|
|  | 3528 | for (i__ = 3; i__ <= i__2; i__ += 2) { | 
|---|
|  | 3529 | idij += 2; | 
|---|
|  | 3530 | i__3 = *l1; | 
|---|
|  | 3531 | for (k = 1; k <= i__3; ++k) { | 
|---|
|  | 3532 | ch[i__ - 1 + (k + j * ch_dim2) * ch_dim1] = wa[idij - 1] * c1[ | 
|---|
|  | 3533 | i__ - 1 + (k + j * c1_dim2) * c1_dim1] + wa[idij] * | 
|---|
|  | 3534 | c1[i__ + (k + j * c1_dim2) * c1_dim1]; | 
|---|
|  | 3535 | ch[i__ + (k + j * ch_dim2) * ch_dim1] = wa[idij - 1] * c1[i__ | 
|---|
|  | 3536 | + (k + j * c1_dim2) * c1_dim1] - wa[idij] * c1[i__ - | 
|---|
|  | 3537 | 1 + (k + j * c1_dim2) * c1_dim1]; | 
|---|
|  | 3538 | /* L104: */ | 
|---|
|  | 3539 | } | 
|---|
|  | 3540 | /* L105: */ | 
|---|
|  | 3541 | } | 
|---|
|  | 3542 | /* L106: */ | 
|---|
|  | 3543 | } | 
|---|
|  | 3544 | goto L111; | 
|---|
|  | 3545 | L107: | 
|---|
|  | 3546 | is = -(*ido); | 
|---|
|  | 3547 | i__1 = *ip; | 
|---|
|  | 3548 | for (j = 2; j <= i__1; ++j) { | 
|---|
|  | 3549 | is += *ido; | 
|---|
|  | 3550 | i__2 = *l1; | 
|---|
|  | 3551 | for (k = 1; k <= i__2; ++k) { | 
|---|
|  | 3552 | idij = is; | 
|---|
|  | 3553 | i__3 = *ido; | 
|---|
|  | 3554 | for (i__ = 3; i__ <= i__3; i__ += 2) { | 
|---|
|  | 3555 | idij += 2; | 
|---|
|  | 3556 | ch[i__ - 1 + (k + j * ch_dim2) * ch_dim1] = wa[idij - 1] * c1[ | 
|---|
|  | 3557 | i__ - 1 + (k + j * c1_dim2) * c1_dim1] + wa[idij] * | 
|---|
|  | 3558 | c1[i__ + (k + j * c1_dim2) * c1_dim1]; | 
|---|
|  | 3559 | ch[i__ + (k + j * ch_dim2) * ch_dim1] = wa[idij - 1] * c1[i__ | 
|---|
|  | 3560 | + (k + j * c1_dim2) * c1_dim1] - wa[idij] * c1[i__ - | 
|---|
|  | 3561 | 1 + (k + j * c1_dim2) * c1_dim1]; | 
|---|
|  | 3562 | /* L108: */ | 
|---|
|  | 3563 | } | 
|---|
|  | 3564 | /* L109: */ | 
|---|
|  | 3565 | } | 
|---|
|  | 3566 | /* L110: */ | 
|---|
|  | 3567 | } | 
|---|
|  | 3568 | L111: | 
|---|
|  | 3569 | if (nbd < *l1) { | 
|---|
|  | 3570 | goto L115; | 
|---|
|  | 3571 | } | 
|---|
|  | 3572 | i__1 = ipph; | 
|---|
|  | 3573 | for (j = 2; j <= i__1; ++j) { | 
|---|
|  | 3574 | jc = ipp2 - j; | 
|---|
|  | 3575 | i__2 = *l1; | 
|---|
|  | 3576 | for (k = 1; k <= i__2; ++k) { | 
|---|
|  | 3577 | i__3 = *ido; | 
|---|
|  | 3578 | for (i__ = 3; i__ <= i__3; i__ += 2) { | 
|---|
|  | 3579 | c1[i__ - 1 + (k + j * c1_dim2) * c1_dim1] = ch[i__ - 1 + (k + | 
|---|
|  | 3580 | j * ch_dim2) * ch_dim1] + ch[i__ - 1 + (k + jc * | 
|---|
|  | 3581 | ch_dim2) * ch_dim1]; | 
|---|
|  | 3582 | c1[i__ - 1 + (k + jc * c1_dim2) * c1_dim1] = ch[i__ + (k + j * | 
|---|
|  | 3583 | ch_dim2) * ch_dim1] - ch[i__ + (k + jc * ch_dim2) * | 
|---|
|  | 3584 | ch_dim1]; | 
|---|
|  | 3585 | c1[i__ + (k + j * c1_dim2) * c1_dim1] = ch[i__ + (k + j * | 
|---|
|  | 3586 | ch_dim2) * ch_dim1] + ch[i__ + (k + jc * ch_dim2) * | 
|---|
|  | 3587 | ch_dim1]; | 
|---|
|  | 3588 | c1[i__ + (k + jc * c1_dim2) * c1_dim1] = ch[i__ - 1 + (k + jc | 
|---|
|  | 3589 | * ch_dim2) * ch_dim1] - ch[i__ - 1 + (k + j * ch_dim2) | 
|---|
|  | 3590 | * ch_dim1]; | 
|---|
|  | 3591 | /* L112: */ | 
|---|
|  | 3592 | } | 
|---|
|  | 3593 | /* L113: */ | 
|---|
|  | 3594 | } | 
|---|
|  | 3595 | /* L114: */ | 
|---|
|  | 3596 | } | 
|---|
|  | 3597 | goto L121; | 
|---|
|  | 3598 | L115: | 
|---|
|  | 3599 | i__1 = ipph; | 
|---|
|  | 3600 | for (j = 2; j <= i__1; ++j) { | 
|---|
|  | 3601 | jc = ipp2 - j; | 
|---|
|  | 3602 | i__2 = *ido; | 
|---|
|  | 3603 | for (i__ = 3; i__ <= i__2; i__ += 2) { | 
|---|
|  | 3604 | i__3 = *l1; | 
|---|
|  | 3605 | for (k = 1; k <= i__3; ++k) { | 
|---|
|  | 3606 | c1[i__ - 1 + (k + j * c1_dim2) * c1_dim1] = ch[i__ - 1 + (k + | 
|---|
|  | 3607 | j * ch_dim2) * ch_dim1] + ch[i__ - 1 + (k + jc * | 
|---|
|  | 3608 | ch_dim2) * ch_dim1]; | 
|---|
|  | 3609 | c1[i__ - 1 + (k + jc * c1_dim2) * c1_dim1] = ch[i__ + (k + j * | 
|---|
|  | 3610 | ch_dim2) * ch_dim1] - ch[i__ + (k + jc * ch_dim2) * | 
|---|
|  | 3611 | ch_dim1]; | 
|---|
|  | 3612 | c1[i__ + (k + j * c1_dim2) * c1_dim1] = ch[i__ + (k + j * | 
|---|
|  | 3613 | ch_dim2) * ch_dim1] + ch[i__ + (k + jc * ch_dim2) * | 
|---|
|  | 3614 | ch_dim1]; | 
|---|
|  | 3615 | c1[i__ + (k + jc * c1_dim2) * c1_dim1] = ch[i__ - 1 + (k + jc | 
|---|
|  | 3616 | * ch_dim2) * ch_dim1] - ch[i__ - 1 + (k + j * ch_dim2) | 
|---|
|  | 3617 | * ch_dim1]; | 
|---|
|  | 3618 | /* L116: */ | 
|---|
|  | 3619 | } | 
|---|
|  | 3620 | /* L117: */ | 
|---|
|  | 3621 | } | 
|---|
|  | 3622 | /* L118: */ | 
|---|
|  | 3623 | } | 
|---|
|  | 3624 | goto L121; | 
|---|
|  | 3625 | L119: | 
|---|
|  | 3626 | i__1 = *idl1; | 
|---|
|  | 3627 | for (ik = 1; ik <= i__1; ++ik) { | 
|---|
|  | 3628 | c2[ik + c2_dim1] = ch2[ik + ch2_dim1]; | 
|---|
|  | 3629 | /* L120: */ | 
|---|
|  | 3630 | } | 
|---|
|  | 3631 | L121: | 
|---|
|  | 3632 | i__1 = ipph; | 
|---|
|  | 3633 | for (j = 2; j <= i__1; ++j) { | 
|---|
|  | 3634 | jc = ipp2 - j; | 
|---|
|  | 3635 | i__2 = *l1; | 
|---|
|  | 3636 | for (k = 1; k <= i__2; ++k) { | 
|---|
|  | 3637 | c1[(k + j * c1_dim2) * c1_dim1 + 1] = ch[(k + j * ch_dim2) * | 
|---|
|  | 3638 | ch_dim1 + 1] + ch[(k + jc * ch_dim2) * ch_dim1 + 1]; | 
|---|
|  | 3639 | c1[(k + jc * c1_dim2) * c1_dim1 + 1] = ch[(k + jc * ch_dim2) * | 
|---|
|  | 3640 | ch_dim1 + 1] - ch[(k + j * ch_dim2) * ch_dim1 + 1]; | 
|---|
|  | 3641 | /* L122: */ | 
|---|
|  | 3642 | } | 
|---|
|  | 3643 | /* L123: */ | 
|---|
|  | 3644 | } | 
|---|
|  | 3645 |  | 
|---|
|  | 3646 | ar1 = 1.f; | 
|---|
|  | 3647 | ai1 = 0.f; | 
|---|
|  | 3648 | i__1 = ipph; | 
|---|
|  | 3649 | for (l = 2; l <= i__1; ++l) { | 
|---|
|  | 3650 | lc = ipp2 - l; | 
|---|
|  | 3651 | ar1h = dcp * ar1 - dsp * ai1; | 
|---|
|  | 3652 | ai1 = dcp * ai1 + dsp * ar1; | 
|---|
|  | 3653 | ar1 = ar1h; | 
|---|
|  | 3654 | i__2 = *idl1; | 
|---|
|  | 3655 | for (ik = 1; ik <= i__2; ++ik) { | 
|---|
|  | 3656 | ch2[ik + l * ch2_dim1] = c2[ik + c2_dim1] + ar1 * c2[ik + ( | 
|---|
|  | 3657 | c2_dim1 << 1)]; | 
|---|
|  | 3658 | ch2[ik + lc * ch2_dim1] = ai1 * c2[ik + *ip * c2_dim1]; | 
|---|
|  | 3659 | /* L124: */ | 
|---|
|  | 3660 | } | 
|---|
|  | 3661 | dc2 = ar1; | 
|---|
|  | 3662 | ds2 = ai1; | 
|---|
|  | 3663 | ar2 = ar1; | 
|---|
|  | 3664 | ai2 = ai1; | 
|---|
|  | 3665 | i__2 = ipph; | 
|---|
|  | 3666 | for (j = 3; j <= i__2; ++j) { | 
|---|
|  | 3667 | jc = ipp2 - j; | 
|---|
|  | 3668 | ar2h = dc2 * ar2 - ds2 * ai2; | 
|---|
|  | 3669 | ai2 = dc2 * ai2 + ds2 * ar2; | 
|---|
|  | 3670 | ar2 = ar2h; | 
|---|
|  | 3671 | i__3 = *idl1; | 
|---|
|  | 3672 | for (ik = 1; ik <= i__3; ++ik) { | 
|---|
|  | 3673 | ch2[ik + l * ch2_dim1] += ar2 * c2[ik + j * c2_dim1]; | 
|---|
|  | 3674 | ch2[ik + lc * ch2_dim1] += ai2 * c2[ik + jc * c2_dim1]; | 
|---|
|  | 3675 | /* L125: */ | 
|---|
|  | 3676 | } | 
|---|
|  | 3677 | /* L126: */ | 
|---|
|  | 3678 | } | 
|---|
|  | 3679 | /* L127: */ | 
|---|
|  | 3680 | } | 
|---|
|  | 3681 | i__1 = ipph; | 
|---|
|  | 3682 | for (j = 2; j <= i__1; ++j) { | 
|---|
|  | 3683 | i__2 = *idl1; | 
|---|
|  | 3684 | for (ik = 1; ik <= i__2; ++ik) { | 
|---|
|  | 3685 | ch2[ik + ch2_dim1] += c2[ik + j * c2_dim1]; | 
|---|
|  | 3686 | /* L128: */ | 
|---|
|  | 3687 | } | 
|---|
|  | 3688 | /* L129: */ | 
|---|
|  | 3689 | } | 
|---|
|  | 3690 |  | 
|---|
|  | 3691 | if (*ido < *l1) { | 
|---|
|  | 3692 | goto L132; | 
|---|
|  | 3693 | } | 
|---|
|  | 3694 | i__1 = *l1; | 
|---|
|  | 3695 | for (k = 1; k <= i__1; ++k) { | 
|---|
|  | 3696 | i__2 = *ido; | 
|---|
|  | 3697 | for (i__ = 1; i__ <= i__2; ++i__) { | 
|---|
|  | 3698 | cc[i__ + (k * cc_dim2 + 1) * cc_dim1] = ch[i__ + (k + ch_dim2) * | 
|---|
|  | 3699 | ch_dim1]; | 
|---|
|  | 3700 | /* L130: */ | 
|---|
|  | 3701 | } | 
|---|
|  | 3702 | /* L131: */ | 
|---|
|  | 3703 | } | 
|---|
|  | 3704 | goto L135; | 
|---|
|  | 3705 | L132: | 
|---|
|  | 3706 | i__1 = *ido; | 
|---|
|  | 3707 | for (i__ = 1; i__ <= i__1; ++i__) { | 
|---|
|  | 3708 | i__2 = *l1; | 
|---|
|  | 3709 | for (k = 1; k <= i__2; ++k) { | 
|---|
|  | 3710 | cc[i__ + (k * cc_dim2 + 1) * cc_dim1] = ch[i__ + (k + ch_dim2) * | 
|---|
|  | 3711 | ch_dim1]; | 
|---|
|  | 3712 | /* L133: */ | 
|---|
|  | 3713 | } | 
|---|
|  | 3714 | /* L134: */ | 
|---|
|  | 3715 | } | 
|---|
|  | 3716 | L135: | 
|---|
|  | 3717 | i__1 = ipph; | 
|---|
|  | 3718 | for (j = 2; j <= i__1; ++j) { | 
|---|
|  | 3719 | jc = ipp2 - j; | 
|---|
|  | 3720 | j2 = j + j; | 
|---|
|  | 3721 | i__2 = *l1; | 
|---|
|  | 3722 | for (k = 1; k <= i__2; ++k) { | 
|---|
|  | 3723 | cc[*ido + (j2 - 2 + k * cc_dim2) * cc_dim1] = ch[(k + j * ch_dim2) | 
|---|
|  | 3724 | * ch_dim1 + 1]; | 
|---|
|  | 3725 | cc[(j2 - 1 + k * cc_dim2) * cc_dim1 + 1] = ch[(k + jc * ch_dim2) * | 
|---|
|  | 3726 | ch_dim1 + 1]; | 
|---|
|  | 3727 | /* L136: */ | 
|---|
|  | 3728 | } | 
|---|
|  | 3729 | /* L137: */ | 
|---|
|  | 3730 | } | 
|---|
|  | 3731 | if (*ido == 1) { | 
|---|
|  | 3732 | return 0; | 
|---|
|  | 3733 | } | 
|---|
|  | 3734 | if (nbd < *l1) { | 
|---|
|  | 3735 | goto L141; | 
|---|
|  | 3736 | } | 
|---|
|  | 3737 | i__1 = ipph; | 
|---|
|  | 3738 | for (j = 2; j <= i__1; ++j) { | 
|---|
|  | 3739 | jc = ipp2 - j; | 
|---|
|  | 3740 | j2 = j + j; | 
|---|
|  | 3741 | i__2 = *l1; | 
|---|
|  | 3742 | for (k = 1; k <= i__2; ++k) { | 
|---|
|  | 3743 | i__3 = *ido; | 
|---|
|  | 3744 | for (i__ = 3; i__ <= i__3; i__ += 2) { | 
|---|
|  | 3745 | ic = idp2 - i__; | 
|---|
|  | 3746 | cc[i__ - 1 + (j2 - 1 + k * cc_dim2) * cc_dim1] = ch[i__ - 1 + | 
|---|
|  | 3747 | (k + j * ch_dim2) * ch_dim1] + ch[i__ - 1 + (k + jc * | 
|---|
|  | 3748 | ch_dim2) * ch_dim1]; | 
|---|
|  | 3749 | cc[ic - 1 + (j2 - 2 + k * cc_dim2) * cc_dim1] = ch[i__ - 1 + ( | 
|---|
|  | 3750 | k + j * ch_dim2) * ch_dim1] - ch[i__ - 1 + (k + jc * | 
|---|
|  | 3751 | ch_dim2) * ch_dim1]; | 
|---|
|  | 3752 | cc[i__ + (j2 - 1 + k * cc_dim2) * cc_dim1] = ch[i__ + (k + j * | 
|---|
|  | 3753 | ch_dim2) * ch_dim1] + ch[i__ + (k + jc * ch_dim2) * | 
|---|
|  | 3754 | ch_dim1]; | 
|---|
|  | 3755 | cc[ic + (j2 - 2 + k * cc_dim2) * cc_dim1] = ch[i__ + (k + jc * | 
|---|
|  | 3756 | ch_dim2) * ch_dim1] - ch[i__ + (k + j * ch_dim2) * | 
|---|
|  | 3757 | ch_dim1]; | 
|---|
|  | 3758 | /* L138: */ | 
|---|
|  | 3759 | } | 
|---|
|  | 3760 | /* L139: */ | 
|---|
|  | 3761 | } | 
|---|
|  | 3762 | /* L140: */ | 
|---|
|  | 3763 | } | 
|---|
|  | 3764 | return 0; | 
|---|
|  | 3765 | L141: | 
|---|
|  | 3766 | i__1 = ipph; | 
|---|
|  | 3767 | for (j = 2; j <= i__1; ++j) { | 
|---|
|  | 3768 | jc = ipp2 - j; | 
|---|
|  | 3769 | j2 = j + j; | 
|---|
|  | 3770 | i__2 = *ido; | 
|---|
|  | 3771 | for (i__ = 3; i__ <= i__2; i__ += 2) { | 
|---|
|  | 3772 | ic = idp2 - i__; | 
|---|
|  | 3773 | i__3 = *l1; | 
|---|
|  | 3774 | for (k = 1; k <= i__3; ++k) { | 
|---|
|  | 3775 | cc[i__ - 1 + (j2 - 1 + k * cc_dim2) * cc_dim1] = ch[i__ - 1 + | 
|---|
|  | 3776 | (k + j * ch_dim2) * ch_dim1] + ch[i__ - 1 + (k + jc * | 
|---|
|  | 3777 | ch_dim2) * ch_dim1]; | 
|---|
|  | 3778 | cc[ic - 1 + (j2 - 2 + k * cc_dim2) * cc_dim1] = ch[i__ - 1 + ( | 
|---|
|  | 3779 | k + j * ch_dim2) * ch_dim1] - ch[i__ - 1 + (k + jc * | 
|---|
|  | 3780 | ch_dim2) * ch_dim1]; | 
|---|
|  | 3781 | cc[i__ + (j2 - 1 + k * cc_dim2) * cc_dim1] = ch[i__ + (k + j * | 
|---|
|  | 3782 | ch_dim2) * ch_dim1] + ch[i__ + (k + jc * ch_dim2) * | 
|---|
|  | 3783 | ch_dim1]; | 
|---|
|  | 3784 | cc[ic + (j2 - 2 + k * cc_dim2) * cc_dim1] = ch[i__ + (k + jc * | 
|---|
|  | 3785 | ch_dim2) * ch_dim1] - ch[i__ + (k + j * ch_dim2) * | 
|---|
|  | 3786 | ch_dim1]; | 
|---|
|  | 3787 | /* L142: */ | 
|---|
|  | 3788 | } | 
|---|
|  | 3789 | /* L143: */ | 
|---|
|  | 3790 | } | 
|---|
|  | 3791 | /* L144: */ | 
|---|
|  | 3792 | } | 
|---|
|  | 3793 | return 0; | 
|---|
|  | 3794 | } /* radfg_ */ | 
|---|
|  | 3795 |  | 
|---|
|  | 3796 | /*  ------ File rfftb.f ------ */ | 
|---|
| [756] | 3797 | /* Subroutine */ int rfftb_(int_4 *n, r_4 *r__, r_4 *wsave) | 
|---|
| [459] | 3798 | { | 
|---|
| [756] | 3799 | extern /* Subroutine */ int rfftb1_(int_4 *, r_4 *, r_4 *, r_4 *, | 
|---|
| [717] | 3800 | int_4 *); | 
|---|
| [459] | 3801 |  | 
|---|
|  | 3802 | /* Parameter adjustments */ | 
|---|
|  | 3803 | --wsave; | 
|---|
|  | 3804 | --r__; | 
|---|
|  | 3805 |  | 
|---|
|  | 3806 | /* Function Body */ | 
|---|
|  | 3807 | if (*n == 1) { | 
|---|
|  | 3808 | return 0; | 
|---|
|  | 3809 | } | 
|---|
| [717] | 3810 | rfftb1_(n, &r__[1], &wsave[1], &wsave[*n + 1], (int_4 *)&wsave[(*n << 1) + 1]);   /* (int *) rajoute Reza 29/11/99 */ | 
|---|
| [459] | 3811 | return 0; | 
|---|
|  | 3812 | } /* rfftb_ */ | 
|---|
|  | 3813 |  | 
|---|
|  | 3814 | /*  ------ File rfftb1.f ------ */ | 
|---|
| [756] | 3815 | /* Subroutine */ int rfftb1_(int_4 *n, r_4 *c__, r_4 *ch, r_4 *wa, | 
|---|
| [717] | 3816 | int_4 *ifac) | 
|---|
| [459] | 3817 | { | 
|---|
|  | 3818 | /* System generated locals */ | 
|---|
| [756] | 3819 | int_4 i__1; | 
|---|
| [459] | 3820 |  | 
|---|
|  | 3821 | /* Local variables */ | 
|---|
| [756] | 3822 | extern /* Subroutine */ int radb2_(int_4 *, int_4 *, r_4 *, r_4 *, | 
|---|
|  | 3823 | r_4 *), radb3_(int_4 *, int_4 *, r_4 *, r_4 *, r_4 *, | 
|---|
|  | 3824 | r_4 *), radb4_(int_4 *, int_4 *, r_4 *, r_4 *, r_4 *, | 
|---|
|  | 3825 | r_4 *, r_4 *), radb5_(int_4 *, int_4 *, r_4 *, r_4 *, | 
|---|
| [717] | 3826 | r_4 *, r_4 *, r_4 *, r_4 *); | 
|---|
| [756] | 3827 | static int_4 i__; | 
|---|
|  | 3828 | extern /* Subroutine */ int radbg_(int_4 *, int_4 *, int_4 *, | 
|---|
|  | 3829 | int_4 *, r_4 *, r_4 *, r_4 *, r_4 *, r_4 *, r_4 *); | 
|---|
|  | 3830 | static int_4 k1, l1, l2, na, nf, ip, iw, ix2, ix3, ix4, ido, idl1; | 
|---|
| [459] | 3831 |  | 
|---|
|  | 3832 | /* Parameter adjustments */ | 
|---|
|  | 3833 | --ifac; | 
|---|
|  | 3834 | --wa; | 
|---|
|  | 3835 | --ch; | 
|---|
|  | 3836 | --c__; | 
|---|
|  | 3837 |  | 
|---|
|  | 3838 | /* Function Body */ | 
|---|
|  | 3839 | nf = ifac[2]; | 
|---|
|  | 3840 | na = 0; | 
|---|
|  | 3841 | l1 = 1; | 
|---|
|  | 3842 | iw = 1; | 
|---|
|  | 3843 | i__1 = nf; | 
|---|
|  | 3844 | for (k1 = 1; k1 <= i__1; ++k1) { | 
|---|
|  | 3845 | ip = ifac[k1 + 2]; | 
|---|
|  | 3846 | l2 = ip * l1; | 
|---|
|  | 3847 | ido = *n / l2; | 
|---|
|  | 3848 | idl1 = ido * l1; | 
|---|
|  | 3849 | if (ip != 4) { | 
|---|
|  | 3850 | goto L103; | 
|---|
|  | 3851 | } | 
|---|
|  | 3852 | ix2 = iw + ido; | 
|---|
|  | 3853 | ix3 = ix2 + ido; | 
|---|
|  | 3854 | if (na != 0) { | 
|---|
|  | 3855 | goto L101; | 
|---|
|  | 3856 | } | 
|---|
|  | 3857 | radb4_(&ido, &l1, &c__[1], &ch[1], &wa[iw], &wa[ix2], &wa[ix3]); | 
|---|
|  | 3858 | goto L102; | 
|---|
|  | 3859 | L101: | 
|---|
|  | 3860 | radb4_(&ido, &l1, &ch[1], &c__[1], &wa[iw], &wa[ix2], &wa[ix3]); | 
|---|
|  | 3861 | L102: | 
|---|
|  | 3862 | na = 1 - na; | 
|---|
|  | 3863 | goto L115; | 
|---|
|  | 3864 | L103: | 
|---|
|  | 3865 | if (ip != 2) { | 
|---|
|  | 3866 | goto L106; | 
|---|
|  | 3867 | } | 
|---|
|  | 3868 | if (na != 0) { | 
|---|
|  | 3869 | goto L104; | 
|---|
|  | 3870 | } | 
|---|
|  | 3871 | radb2_(&ido, &l1, &c__[1], &ch[1], &wa[iw]); | 
|---|
|  | 3872 | goto L105; | 
|---|
|  | 3873 | L104: | 
|---|
|  | 3874 | radb2_(&ido, &l1, &ch[1], &c__[1], &wa[iw]); | 
|---|
|  | 3875 | L105: | 
|---|
|  | 3876 | na = 1 - na; | 
|---|
|  | 3877 | goto L115; | 
|---|
|  | 3878 | L106: | 
|---|
|  | 3879 | if (ip != 3) { | 
|---|
|  | 3880 | goto L109; | 
|---|
|  | 3881 | } | 
|---|
|  | 3882 | ix2 = iw + ido; | 
|---|
|  | 3883 | if (na != 0) { | 
|---|
|  | 3884 | goto L107; | 
|---|
|  | 3885 | } | 
|---|
|  | 3886 | radb3_(&ido, &l1, &c__[1], &ch[1], &wa[iw], &wa[ix2]); | 
|---|
|  | 3887 | goto L108; | 
|---|
|  | 3888 | L107: | 
|---|
|  | 3889 | radb3_(&ido, &l1, &ch[1], &c__[1], &wa[iw], &wa[ix2]); | 
|---|
|  | 3890 | L108: | 
|---|
|  | 3891 | na = 1 - na; | 
|---|
|  | 3892 | goto L115; | 
|---|
|  | 3893 | L109: | 
|---|
|  | 3894 | if (ip != 5) { | 
|---|
|  | 3895 | goto L112; | 
|---|
|  | 3896 | } | 
|---|
|  | 3897 | ix2 = iw + ido; | 
|---|
|  | 3898 | ix3 = ix2 + ido; | 
|---|
|  | 3899 | ix4 = ix3 + ido; | 
|---|
|  | 3900 | if (na != 0) { | 
|---|
|  | 3901 | goto L110; | 
|---|
|  | 3902 | } | 
|---|
|  | 3903 | radb5_(&ido, &l1, &c__[1], &ch[1], &wa[iw], &wa[ix2], &wa[ix3], &wa[ | 
|---|
|  | 3904 | ix4]); | 
|---|
|  | 3905 | goto L111; | 
|---|
|  | 3906 | L110: | 
|---|
|  | 3907 | radb5_(&ido, &l1, &ch[1], &c__[1], &wa[iw], &wa[ix2], &wa[ix3], &wa[ | 
|---|
|  | 3908 | ix4]); | 
|---|
|  | 3909 | L111: | 
|---|
|  | 3910 | na = 1 - na; | 
|---|
|  | 3911 | goto L115; | 
|---|
|  | 3912 | L112: | 
|---|
|  | 3913 | if (na != 0) { | 
|---|
|  | 3914 | goto L113; | 
|---|
|  | 3915 | } | 
|---|
|  | 3916 | radbg_(&ido, &ip, &l1, &idl1, &c__[1], &c__[1], &c__[1], &ch[1], &ch[ | 
|---|
|  | 3917 | 1], &wa[iw]); | 
|---|
|  | 3918 | goto L114; | 
|---|
|  | 3919 | L113: | 
|---|
|  | 3920 | radbg_(&ido, &ip, &l1, &idl1, &ch[1], &ch[1], &ch[1], &c__[1], &c__[1] | 
|---|
|  | 3921 | , &wa[iw]); | 
|---|
|  | 3922 | L114: | 
|---|
|  | 3923 | if (ido == 1) { | 
|---|
|  | 3924 | na = 1 - na; | 
|---|
|  | 3925 | } | 
|---|
|  | 3926 | L115: | 
|---|
|  | 3927 | l1 = l2; | 
|---|
|  | 3928 | iw += (ip - 1) * ido; | 
|---|
|  | 3929 | /* L116: */ | 
|---|
|  | 3930 | } | 
|---|
|  | 3931 | if (na == 0) { | 
|---|
|  | 3932 | return 0; | 
|---|
|  | 3933 | } | 
|---|
|  | 3934 | i__1 = *n; | 
|---|
|  | 3935 | for (i__ = 1; i__ <= i__1; ++i__) { | 
|---|
|  | 3936 | c__[i__] = ch[i__]; | 
|---|
|  | 3937 | /* L117: */ | 
|---|
|  | 3938 | } | 
|---|
|  | 3939 | return 0; | 
|---|
|  | 3940 | } /* rfftb1_ */ | 
|---|
|  | 3941 |  | 
|---|
|  | 3942 | /*  ------ File rfftf.f ------ */ | 
|---|
| [756] | 3943 | /* Subroutine */ int rfftf_(int_4 *n, r_4 *r__, r_4 *wsave) | 
|---|
| [459] | 3944 | { | 
|---|
| [756] | 3945 | extern /* Subroutine */ int rfftf1_(int_4 *, r_4 *, r_4 *, r_4 *, | 
|---|
| [717] | 3946 | int_4 *); | 
|---|
| [459] | 3947 |  | 
|---|
|  | 3948 | /* Parameter adjustments */ | 
|---|
|  | 3949 | --wsave; | 
|---|
|  | 3950 | --r__; | 
|---|
|  | 3951 |  | 
|---|
|  | 3952 | /* Function Body */ | 
|---|
|  | 3953 | if (*n == 1) { | 
|---|
|  | 3954 | return 0; | 
|---|
|  | 3955 | } | 
|---|
| [717] | 3956 | rfftf1_(n, &r__[1], &wsave[1], &wsave[*n + 1], (int_4 *)&wsave[(*n << 1) + 1]); /* (int *) rajoute Reza 29/11/99 */ | 
|---|
| [459] | 3957 | return 0; | 
|---|
|  | 3958 | } /* rfftf_ */ | 
|---|
|  | 3959 |  | 
|---|
|  | 3960 | /*  ------ File rfftf1.f ------ */ | 
|---|
| [756] | 3961 | /* Subroutine */ int rfftf1_(int_4 *n, r_4 *c__, r_4 *ch, r_4 *wa, | 
|---|
| [717] | 3962 | int_4 *ifac) | 
|---|
| [459] | 3963 | { | 
|---|
|  | 3964 | /* System generated locals */ | 
|---|
| [756] | 3965 | int_4 i__1; | 
|---|
| [459] | 3966 |  | 
|---|
|  | 3967 | /* Local variables */ | 
|---|
| [756] | 3968 | extern /* Subroutine */ int radf2_(int_4 *, int_4 *, r_4 *, r_4 *, | 
|---|
|  | 3969 | r_4 *), radf3_(int_4 *, int_4 *, r_4 *, r_4 *, r_4 *, | 
|---|
|  | 3970 | r_4 *), radf4_(int_4 *, int_4 *, r_4 *, r_4 *, r_4 *, | 
|---|
|  | 3971 | r_4 *, r_4 *), radf5_(int_4 *, int_4 *, r_4 *, r_4 *, | 
|---|
| [717] | 3972 | r_4 *, r_4 *, r_4 *, r_4 *); | 
|---|
| [756] | 3973 | static int_4 i__; | 
|---|
|  | 3974 | extern /* Subroutine */ int radfg_(int_4 *, int_4 *, int_4 *, | 
|---|
|  | 3975 | int_4 *, r_4 *, r_4 *, r_4 *, r_4 *, r_4 *, r_4 *); | 
|---|
|  | 3976 | static int_4 k1, l1, l2, na, kh, nf, ip, iw, ix2, ix3, ix4, ido, idl1; | 
|---|
| [459] | 3977 |  | 
|---|
|  | 3978 | /* Parameter adjustments */ | 
|---|
|  | 3979 | --ifac; | 
|---|
|  | 3980 | --wa; | 
|---|
|  | 3981 | --ch; | 
|---|
|  | 3982 | --c__; | 
|---|
|  | 3983 |  | 
|---|
|  | 3984 | /* Function Body */ | 
|---|
|  | 3985 | nf = ifac[2]; | 
|---|
|  | 3986 | na = 1; | 
|---|
|  | 3987 | l2 = *n; | 
|---|
|  | 3988 | iw = *n; | 
|---|
|  | 3989 | i__1 = nf; | 
|---|
|  | 3990 | for (k1 = 1; k1 <= i__1; ++k1) { | 
|---|
|  | 3991 | kh = nf - k1; | 
|---|
|  | 3992 | ip = ifac[kh + 3]; | 
|---|
|  | 3993 | l1 = l2 / ip; | 
|---|
|  | 3994 | ido = *n / l2; | 
|---|
|  | 3995 | idl1 = ido * l1; | 
|---|
|  | 3996 | iw -= (ip - 1) * ido; | 
|---|
|  | 3997 | na = 1 - na; | 
|---|
|  | 3998 | if (ip != 4) { | 
|---|
|  | 3999 | goto L102; | 
|---|
|  | 4000 | } | 
|---|
|  | 4001 | ix2 = iw + ido; | 
|---|
|  | 4002 | ix3 = ix2 + ido; | 
|---|
|  | 4003 | if (na != 0) { | 
|---|
|  | 4004 | goto L101; | 
|---|
|  | 4005 | } | 
|---|
|  | 4006 | radf4_(&ido, &l1, &c__[1], &ch[1], &wa[iw], &wa[ix2], &wa[ix3]); | 
|---|
|  | 4007 | goto L110; | 
|---|
|  | 4008 | L101: | 
|---|
|  | 4009 | radf4_(&ido, &l1, &ch[1], &c__[1], &wa[iw], &wa[ix2], &wa[ix3]); | 
|---|
|  | 4010 | goto L110; | 
|---|
|  | 4011 | L102: | 
|---|
|  | 4012 | if (ip != 2) { | 
|---|
|  | 4013 | goto L104; | 
|---|
|  | 4014 | } | 
|---|
|  | 4015 | if (na != 0) { | 
|---|
|  | 4016 | goto L103; | 
|---|
|  | 4017 | } | 
|---|
|  | 4018 | radf2_(&ido, &l1, &c__[1], &ch[1], &wa[iw]); | 
|---|
|  | 4019 | goto L110; | 
|---|
|  | 4020 | L103: | 
|---|
|  | 4021 | radf2_(&ido, &l1, &ch[1], &c__[1], &wa[iw]); | 
|---|
|  | 4022 | goto L110; | 
|---|
|  | 4023 | L104: | 
|---|
|  | 4024 | if (ip != 3) { | 
|---|
|  | 4025 | goto L106; | 
|---|
|  | 4026 | } | 
|---|
|  | 4027 | ix2 = iw + ido; | 
|---|
|  | 4028 | if (na != 0) { | 
|---|
|  | 4029 | goto L105; | 
|---|
|  | 4030 | } | 
|---|
|  | 4031 | radf3_(&ido, &l1, &c__[1], &ch[1], &wa[iw], &wa[ix2]); | 
|---|
|  | 4032 | goto L110; | 
|---|
|  | 4033 | L105: | 
|---|
|  | 4034 | radf3_(&ido, &l1, &ch[1], &c__[1], &wa[iw], &wa[ix2]); | 
|---|
|  | 4035 | goto L110; | 
|---|
|  | 4036 | L106: | 
|---|
|  | 4037 | if (ip != 5) { | 
|---|
|  | 4038 | goto L108; | 
|---|
|  | 4039 | } | 
|---|
|  | 4040 | ix2 = iw + ido; | 
|---|
|  | 4041 | ix3 = ix2 + ido; | 
|---|
|  | 4042 | ix4 = ix3 + ido; | 
|---|
|  | 4043 | if (na != 0) { | 
|---|
|  | 4044 | goto L107; | 
|---|
|  | 4045 | } | 
|---|
|  | 4046 | radf5_(&ido, &l1, &c__[1], &ch[1], &wa[iw], &wa[ix2], &wa[ix3], &wa[ | 
|---|
|  | 4047 | ix4]); | 
|---|
|  | 4048 | goto L110; | 
|---|
|  | 4049 | L107: | 
|---|
|  | 4050 | radf5_(&ido, &l1, &ch[1], &c__[1], &wa[iw], &wa[ix2], &wa[ix3], &wa[ | 
|---|
|  | 4051 | ix4]); | 
|---|
|  | 4052 | goto L110; | 
|---|
|  | 4053 | L108: | 
|---|
|  | 4054 | if (ido == 1) { | 
|---|
|  | 4055 | na = 1 - na; | 
|---|
|  | 4056 | } | 
|---|
|  | 4057 | if (na != 0) { | 
|---|
|  | 4058 | goto L109; | 
|---|
|  | 4059 | } | 
|---|
|  | 4060 | radfg_(&ido, &ip, &l1, &idl1, &c__[1], &c__[1], &c__[1], &ch[1], &ch[ | 
|---|
|  | 4061 | 1], &wa[iw]); | 
|---|
|  | 4062 | na = 1; | 
|---|
|  | 4063 | goto L110; | 
|---|
|  | 4064 | L109: | 
|---|
|  | 4065 | radfg_(&ido, &ip, &l1, &idl1, &ch[1], &ch[1], &ch[1], &c__[1], &c__[1] | 
|---|
|  | 4066 | , &wa[iw]); | 
|---|
|  | 4067 | na = 0; | 
|---|
|  | 4068 | L110: | 
|---|
|  | 4069 | l2 = l1; | 
|---|
|  | 4070 | /* L111: */ | 
|---|
|  | 4071 | } | 
|---|
|  | 4072 | if (na == 1) { | 
|---|
|  | 4073 | return 0; | 
|---|
|  | 4074 | } | 
|---|
|  | 4075 | i__1 = *n; | 
|---|
|  | 4076 | for (i__ = 1; i__ <= i__1; ++i__) { | 
|---|
|  | 4077 | c__[i__] = ch[i__]; | 
|---|
|  | 4078 | /* L112: */ | 
|---|
|  | 4079 | } | 
|---|
|  | 4080 | return 0; | 
|---|
|  | 4081 | } /* rfftf1_ */ | 
|---|
|  | 4082 |  | 
|---|
|  | 4083 | /*  ------ File rffti.f ------ */ | 
|---|
| [756] | 4084 | /* Subroutine */ int rffti_(int_4 *n, r_4 *wsave) | 
|---|
| [459] | 4085 | { | 
|---|
| [756] | 4086 | extern /* Subroutine */ int rffti1_(int_4 *, r_4 *, int_4 *); | 
|---|
| [459] | 4087 |  | 
|---|
|  | 4088 | /* Parameter adjustments */ | 
|---|
|  | 4089 | --wsave; | 
|---|
|  | 4090 |  | 
|---|
|  | 4091 | /* Function Body */ | 
|---|
|  | 4092 | if (*n == 1) { | 
|---|
|  | 4093 | return 0; | 
|---|
|  | 4094 | } | 
|---|
| [717] | 4095 | rffti1_(n, &wsave[*n + 1], (int_4 *)&wsave[(*n << 1) + 1]); /* (int *) rajoute Reza 29/11/99 */ | 
|---|
| [459] | 4096 | return 0; | 
|---|
|  | 4097 | } /* rffti_ */ | 
|---|
|  | 4098 |  | 
|---|
|  | 4099 | /*  ------ File rffti1.f ------ */ | 
|---|
| [756] | 4100 | /* Subroutine */ int rffti1_(int_4 *n, r_4 *wa, int_4 *ifac) | 
|---|
| [459] | 4101 | { | 
|---|
|  | 4102 | /* Initialized data */ | 
|---|
|  | 4103 |  | 
|---|
| [756] | 4104 | static int_4 ntryh[4] = { 4,2,3,5 }; | 
|---|
| [459] | 4105 |  | 
|---|
|  | 4106 | /* System generated locals */ | 
|---|
| [756] | 4107 | int_4 i__1, i__2, i__3; | 
|---|
| [459] | 4108 |  | 
|---|
|  | 4109 | /* Builtin functions */ | 
|---|
| [717] | 4110 | /*   r_8 cos(r_8truc), sin(r_8truc);  Remplace par math.h , Reza 29/11/99 */ | 
|---|
| [459] | 4111 |  | 
|---|
|  | 4112 | /* Local variables */ | 
|---|
| [717] | 4113 | static r_4 argh; | 
|---|
| [756] | 4114 | static int_4 ntry, i__, j; | 
|---|
| [717] | 4115 | static r_4 argld; | 
|---|
| [756] | 4116 | static int_4 k1, l1, l2, ib; | 
|---|
| [717] | 4117 | static r_4 fi; | 
|---|
| [756] | 4118 | static int_4 ld, ii, nf, ip, nl, is, nq, nr; | 
|---|
| [717] | 4119 | static r_4 arg; | 
|---|
| [756] | 4120 | static int_4 ido, ipm; | 
|---|
| [717] | 4121 | static r_4 tpi; | 
|---|
| [756] | 4122 | static int_4 nfm1; | 
|---|
| [459] | 4123 |  | 
|---|
|  | 4124 | /* Parameter adjustments */ | 
|---|
|  | 4125 | --ifac; | 
|---|
|  | 4126 | --wa; | 
|---|
|  | 4127 |  | 
|---|
|  | 4128 | /* Function Body */ | 
|---|
|  | 4129 | nl = *n; | 
|---|
|  | 4130 | nf = 0; | 
|---|
|  | 4131 | j = 0; | 
|---|
|  | 4132 | L101: | 
|---|
|  | 4133 | ++j; | 
|---|
|  | 4134 | if (j - 4 <= 0) { | 
|---|
|  | 4135 | goto L102; | 
|---|
|  | 4136 | } else { | 
|---|
|  | 4137 | goto L103; | 
|---|
|  | 4138 | } | 
|---|
|  | 4139 | L102: | 
|---|
|  | 4140 | ntry = ntryh[j - 1]; | 
|---|
|  | 4141 | goto L104; | 
|---|
|  | 4142 | L103: | 
|---|
|  | 4143 | ntry += 2; | 
|---|
|  | 4144 | L104: | 
|---|
|  | 4145 | nq = nl / ntry; | 
|---|
|  | 4146 | nr = nl - ntry * nq; | 
|---|
|  | 4147 | if (nr != 0) { | 
|---|
|  | 4148 | goto L101; | 
|---|
|  | 4149 | } else { | 
|---|
|  | 4150 | goto L105; | 
|---|
|  | 4151 | } | 
|---|
|  | 4152 | L105: | 
|---|
|  | 4153 | ++nf; | 
|---|
|  | 4154 | ifac[nf + 2] = ntry; | 
|---|
|  | 4155 | nl = nq; | 
|---|
|  | 4156 | if (ntry != 2) { | 
|---|
|  | 4157 | goto L107; | 
|---|
|  | 4158 | } | 
|---|
|  | 4159 | if (nf == 1) { | 
|---|
|  | 4160 | goto L107; | 
|---|
|  | 4161 | } | 
|---|
|  | 4162 | i__1 = nf; | 
|---|
|  | 4163 | for (i__ = 2; i__ <= i__1; ++i__) { | 
|---|
|  | 4164 | ib = nf - i__ + 2; | 
|---|
|  | 4165 | ifac[ib + 2] = ifac[ib + 1]; | 
|---|
|  | 4166 | /* L106: */ | 
|---|
|  | 4167 | } | 
|---|
|  | 4168 | ifac[3] = 2; | 
|---|
|  | 4169 | L107: | 
|---|
|  | 4170 | if (nl != 1) { | 
|---|
|  | 4171 | goto L104; | 
|---|
|  | 4172 | } | 
|---|
|  | 4173 | ifac[1] = *n; | 
|---|
|  | 4174 | ifac[2] = nf; | 
|---|
|  | 4175 | tpi = 6.28318530717959f; | 
|---|
| [717] | 4176 | argh = tpi / (r_4) (*n); | 
|---|
| [459] | 4177 | is = 0; | 
|---|
|  | 4178 | nfm1 = nf - 1; | 
|---|
|  | 4179 | l1 = 1; | 
|---|
|  | 4180 | if (nfm1 == 0) { | 
|---|
|  | 4181 | return 0; | 
|---|
|  | 4182 | } | 
|---|
|  | 4183 | i__1 = nfm1; | 
|---|
|  | 4184 | for (k1 = 1; k1 <= i__1; ++k1) { | 
|---|
|  | 4185 | ip = ifac[k1 + 2]; | 
|---|
|  | 4186 | ld = 0; | 
|---|
|  | 4187 | l2 = l1 * ip; | 
|---|
|  | 4188 | ido = *n / l2; | 
|---|
|  | 4189 | ipm = ip - 1; | 
|---|
|  | 4190 | i__2 = ipm; | 
|---|
|  | 4191 | for (j = 1; j <= i__2; ++j) { | 
|---|
|  | 4192 | ld += l1; | 
|---|
|  | 4193 | i__ = is; | 
|---|
| [717] | 4194 | argld = (r_4) ld * argh; | 
|---|
| [459] | 4195 | fi = 0.f; | 
|---|
|  | 4196 | i__3 = ido; | 
|---|
|  | 4197 | for (ii = 3; ii <= i__3; ii += 2) { | 
|---|
|  | 4198 | i__ += 2; | 
|---|
|  | 4199 | fi += 1.f; | 
|---|
|  | 4200 | arg = fi * argld; | 
|---|
|  | 4201 | wa[i__ - 1] = cos(arg); | 
|---|
|  | 4202 | wa[i__] = sin(arg); | 
|---|
|  | 4203 | /* L108: */ | 
|---|
|  | 4204 | } | 
|---|
|  | 4205 | is += ido; | 
|---|
|  | 4206 | /* L109: */ | 
|---|
|  | 4207 | } | 
|---|
|  | 4208 | l1 = l2; | 
|---|
|  | 4209 | /* L110: */ | 
|---|
|  | 4210 | } | 
|---|
|  | 4211 | return 0; | 
|---|
|  | 4212 | } /* rffti1_ */ | 
|---|
|  | 4213 |  | 
|---|
|  | 4214 | /*  ------ File sinqb.f ------ */ | 
|---|
| [756] | 4215 | /* Subroutine */ int sinqb_(int_4 *n, r_4 *x, r_4 *wsave) | 
|---|
| [459] | 4216 | { | 
|---|
|  | 4217 | /* System generated locals */ | 
|---|
| [756] | 4218 | int_4 i__1; | 
|---|
| [459] | 4219 |  | 
|---|
|  | 4220 | /* Local variables */ | 
|---|
| [756] | 4221 | static int_4 k; | 
|---|
|  | 4222 | extern /* Subroutine */ int cosqb_(int_4 *, r_4 *, r_4 *); | 
|---|
| [717] | 4223 | static r_4 xhold; | 
|---|
| [756] | 4224 | static int_4 kc, ns2; | 
|---|
| [459] | 4225 |  | 
|---|
|  | 4226 | /* Parameter adjustments */ | 
|---|
|  | 4227 | --wsave; | 
|---|
|  | 4228 | --x; | 
|---|
|  | 4229 |  | 
|---|
|  | 4230 | /* Function Body */ | 
|---|
|  | 4231 | if (*n > 1) { | 
|---|
|  | 4232 | goto L101; | 
|---|
|  | 4233 | } | 
|---|
|  | 4234 | x[1] *= 4.f; | 
|---|
|  | 4235 | return 0; | 
|---|
|  | 4236 | L101: | 
|---|
|  | 4237 | ns2 = *n / 2; | 
|---|
|  | 4238 | i__1 = *n; | 
|---|
|  | 4239 | for (k = 2; k <= i__1; k += 2) { | 
|---|
|  | 4240 | x[k] = -x[k]; | 
|---|
|  | 4241 | /* L102: */ | 
|---|
|  | 4242 | } | 
|---|
|  | 4243 | cosqb_(n, &x[1], &wsave[1]); | 
|---|
|  | 4244 | i__1 = ns2; | 
|---|
|  | 4245 | for (k = 1; k <= i__1; ++k) { | 
|---|
|  | 4246 | kc = *n - k; | 
|---|
|  | 4247 | xhold = x[k]; | 
|---|
|  | 4248 | x[k] = x[kc + 1]; | 
|---|
|  | 4249 | x[kc + 1] = xhold; | 
|---|
|  | 4250 | /* L103: */ | 
|---|
|  | 4251 | } | 
|---|
|  | 4252 | return 0; | 
|---|
|  | 4253 | } /* sinqb_ */ | 
|---|
|  | 4254 |  | 
|---|
|  | 4255 | /*  ------ File sinqf.f ------ */ | 
|---|
| [756] | 4256 | /* Subroutine */ int sinqf_(int_4 *n, r_4 *x, r_4 *wsave) | 
|---|
| [459] | 4257 | { | 
|---|
|  | 4258 | /* System generated locals */ | 
|---|
| [756] | 4259 | int_4 i__1; | 
|---|
| [459] | 4260 |  | 
|---|
|  | 4261 | /* Local variables */ | 
|---|
| [756] | 4262 | static int_4 k; | 
|---|
|  | 4263 | extern /* Subroutine */ int cosqf_(int_4 *, r_4 *, r_4 *); | 
|---|
| [717] | 4264 | static r_4 xhold; | 
|---|
| [756] | 4265 | static int_4 kc, ns2; | 
|---|
| [459] | 4266 |  | 
|---|
|  | 4267 | /* Parameter adjustments */ | 
|---|
|  | 4268 | --wsave; | 
|---|
|  | 4269 | --x; | 
|---|
|  | 4270 |  | 
|---|
|  | 4271 | /* Function Body */ | 
|---|
|  | 4272 | if (*n == 1) { | 
|---|
|  | 4273 | return 0; | 
|---|
|  | 4274 | } | 
|---|
|  | 4275 | ns2 = *n / 2; | 
|---|
|  | 4276 | i__1 = ns2; | 
|---|
|  | 4277 | for (k = 1; k <= i__1; ++k) { | 
|---|
|  | 4278 | kc = *n - k; | 
|---|
|  | 4279 | xhold = x[k]; | 
|---|
|  | 4280 | x[k] = x[kc + 1]; | 
|---|
|  | 4281 | x[kc + 1] = xhold; | 
|---|
|  | 4282 | /* L101: */ | 
|---|
|  | 4283 | } | 
|---|
|  | 4284 | cosqf_(n, &x[1], &wsave[1]); | 
|---|
|  | 4285 | i__1 = *n; | 
|---|
|  | 4286 | for (k = 2; k <= i__1; k += 2) { | 
|---|
|  | 4287 | x[k] = -x[k]; | 
|---|
|  | 4288 | /* L102: */ | 
|---|
|  | 4289 | } | 
|---|
|  | 4290 | return 0; | 
|---|
|  | 4291 | } /* sinqf_ */ | 
|---|
|  | 4292 |  | 
|---|
|  | 4293 | /*  ------ File sinqi.f ------ */ | 
|---|
| [756] | 4294 | /* Subroutine */ int sinqi_(int_4 *n, r_4 *wsave) | 
|---|
| [459] | 4295 | { | 
|---|
| [756] | 4296 | extern /* Subroutine */ int cosqi_(int_4 *, r_4 *); | 
|---|
| [459] | 4297 |  | 
|---|
|  | 4298 | /* Parameter adjustments */ | 
|---|
|  | 4299 | --wsave; | 
|---|
|  | 4300 |  | 
|---|
|  | 4301 | /* Function Body */ | 
|---|
|  | 4302 | cosqi_(n, &wsave[1]); | 
|---|
|  | 4303 | return 0; | 
|---|
|  | 4304 | } /* sinqi_ */ | 
|---|
|  | 4305 |  | 
|---|
|  | 4306 | /*  ------ File sint.f ------ */ | 
|---|
| [756] | 4307 | /* Subroutine */ int sint_(int_4 *n, r_4 *x, r_4 *wsave) | 
|---|
| [459] | 4308 | { | 
|---|
| [756] | 4309 | extern /* Subroutine */ int sint1_(int_4 *, r_4 *, r_4 *, r_4 *, | 
|---|
| [717] | 4310 | r_4 *, int_4 *); | 
|---|
| [756] | 4311 | static int_4 np1, iw1, iw2, iw3; | 
|---|
| [459] | 4312 |  | 
|---|
|  | 4313 | /* Parameter adjustments */ | 
|---|
|  | 4314 | --wsave; | 
|---|
|  | 4315 | --x; | 
|---|
|  | 4316 |  | 
|---|
|  | 4317 | /* Function Body */ | 
|---|
|  | 4318 | np1 = *n + 1; | 
|---|
|  | 4319 | iw1 = *n / 2 + 1; | 
|---|
|  | 4320 | iw2 = iw1 + np1; | 
|---|
|  | 4321 | iw3 = iw2 + np1; | 
|---|
| [717] | 4322 | sint1_(n, &x[1], &wsave[1], &wsave[iw1], &wsave[iw2], (int_4 *)&wsave[iw3]);  /* (int *) rajoute Reza 29/11/99 */ | 
|---|
| [459] | 4323 | return 0; | 
|---|
|  | 4324 | } /* sint_ */ | 
|---|
|  | 4325 |  | 
|---|
|  | 4326 | /*  ------ File sint1.f ------ */ | 
|---|
| [756] | 4327 | /* Subroutine */ int sint1_(int_4 *n, r_4 *war, r_4 *was, r_4 *xh, r_4 * | 
|---|
| [717] | 4328 | x, int_4 *ifac) | 
|---|
| [459] | 4329 | { | 
|---|
|  | 4330 | /* Initialized data */ | 
|---|
|  | 4331 |  | 
|---|
| [717] | 4332 | static r_4 sqrt3 = 1.73205080756888f; | 
|---|
| [459] | 4333 |  | 
|---|
|  | 4334 | /* System generated locals */ | 
|---|
| [756] | 4335 | int_4 i__1; | 
|---|
| [459] | 4336 |  | 
|---|
|  | 4337 | /* Local variables */ | 
|---|
| [756] | 4338 | static int_4 modn, i__, k; | 
|---|
| [717] | 4339 | static r_4 xhold, t1, t2; | 
|---|
| [756] | 4340 | extern /* Subroutine */ int rfftf1_(int_4 *, r_4 *, r_4 *, r_4 *, | 
|---|
| [717] | 4341 | int_4 *); | 
|---|
| [756] | 4342 | static int_4 kc, np1, ns2; | 
|---|
| [459] | 4343 |  | 
|---|
|  | 4344 | /* Parameter adjustments */ | 
|---|
|  | 4345 | --ifac; | 
|---|
|  | 4346 | --x; | 
|---|
|  | 4347 | --xh; | 
|---|
|  | 4348 | --was; | 
|---|
|  | 4349 | --war; | 
|---|
|  | 4350 |  | 
|---|
|  | 4351 | /* Function Body */ | 
|---|
|  | 4352 | i__1 = *n; | 
|---|
|  | 4353 | for (i__ = 1; i__ <= i__1; ++i__) { | 
|---|
|  | 4354 | xh[i__] = war[i__]; | 
|---|
|  | 4355 | war[i__] = x[i__]; | 
|---|
|  | 4356 | /* L100: */ | 
|---|
|  | 4357 | } | 
|---|
|  | 4358 | if ((i__1 = *n - 2) < 0) { | 
|---|
|  | 4359 | goto L101; | 
|---|
|  | 4360 | } else if (i__1 == 0) { | 
|---|
|  | 4361 | goto L102; | 
|---|
|  | 4362 | } else { | 
|---|
|  | 4363 | goto L103; | 
|---|
|  | 4364 | } | 
|---|
|  | 4365 | L101: | 
|---|
|  | 4366 | xh[1] += xh[1]; | 
|---|
|  | 4367 | goto L106; | 
|---|
|  | 4368 | L102: | 
|---|
|  | 4369 | xhold = sqrt3 * (xh[1] + xh[2]); | 
|---|
|  | 4370 | xh[2] = sqrt3 * (xh[1] - xh[2]); | 
|---|
|  | 4371 | xh[1] = xhold; | 
|---|
|  | 4372 | goto L106; | 
|---|
|  | 4373 | L103: | 
|---|
|  | 4374 | np1 = *n + 1; | 
|---|
|  | 4375 | ns2 = *n / 2; | 
|---|
|  | 4376 | x[1] = 0.f; | 
|---|
|  | 4377 | i__1 = ns2; | 
|---|
|  | 4378 | for (k = 1; k <= i__1; ++k) { | 
|---|
|  | 4379 | kc = np1 - k; | 
|---|
|  | 4380 | t1 = xh[k] - xh[kc]; | 
|---|
|  | 4381 | t2 = was[k] * (xh[k] + xh[kc]); | 
|---|
|  | 4382 | x[k + 1] = t1 + t2; | 
|---|
|  | 4383 | x[kc + 1] = t2 - t1; | 
|---|
|  | 4384 | /* L104: */ | 
|---|
|  | 4385 | } | 
|---|
|  | 4386 | modn = *n % 2; | 
|---|
|  | 4387 | if (modn != 0) { | 
|---|
|  | 4388 | x[ns2 + 2] = xh[ns2 + 1] * 4.f; | 
|---|
|  | 4389 | } | 
|---|
|  | 4390 | rfftf1_(&np1, &x[1], &xh[1], &war[1], &ifac[1]); | 
|---|
|  | 4391 | xh[1] = x[1] * .5f; | 
|---|
|  | 4392 | i__1 = *n; | 
|---|
|  | 4393 | for (i__ = 3; i__ <= i__1; i__ += 2) { | 
|---|
|  | 4394 | xh[i__ - 1] = -x[i__]; | 
|---|
|  | 4395 | xh[i__] = xh[i__ - 2] + x[i__ - 1]; | 
|---|
|  | 4396 | /* L105: */ | 
|---|
|  | 4397 | } | 
|---|
|  | 4398 | if (modn != 0) { | 
|---|
|  | 4399 | goto L106; | 
|---|
|  | 4400 | } | 
|---|
|  | 4401 | xh[*n] = -x[*n + 1]; | 
|---|
|  | 4402 | L106: | 
|---|
|  | 4403 | i__1 = *n; | 
|---|
|  | 4404 | for (i__ = 1; i__ <= i__1; ++i__) { | 
|---|
|  | 4405 | x[i__] = war[i__]; | 
|---|
|  | 4406 | war[i__] = xh[i__]; | 
|---|
|  | 4407 | /* L107: */ | 
|---|
|  | 4408 | } | 
|---|
|  | 4409 | return 0; | 
|---|
|  | 4410 | } /* sint1_ */ | 
|---|
|  | 4411 |  | 
|---|
|  | 4412 | /*  ------ File sinti.f ------ */ | 
|---|
| [756] | 4413 | /* Subroutine */ int sinti_(int_4 *n, r_4 *wsave) | 
|---|
| [459] | 4414 | { | 
|---|
|  | 4415 | /* Initialized data */ | 
|---|
|  | 4416 |  | 
|---|
| [717] | 4417 | static r_4 pi = 3.14159265358979f; | 
|---|
| [459] | 4418 |  | 
|---|
|  | 4419 | /* System generated locals */ | 
|---|
| [756] | 4420 | int_4 i__1; | 
|---|
| [459] | 4421 |  | 
|---|
|  | 4422 | /* Builtin functions */ | 
|---|
| [717] | 4423 | /*    r_8 sin(r_8truc);  remplace par math.h , Reza 29/11/99 */ | 
|---|
| [459] | 4424 |  | 
|---|
|  | 4425 | /* Local variables */ | 
|---|
| [756] | 4426 | static int_4 k; | 
|---|
|  | 4427 | extern /* Subroutine */ int rffti_(int_4 *, r_4 *); | 
|---|
| [717] | 4428 | static r_4 dt; | 
|---|
| [756] | 4429 | static int_4 np1, ns2; | 
|---|
| [459] | 4430 |  | 
|---|
|  | 4431 | /* Parameter adjustments */ | 
|---|
|  | 4432 | --wsave; | 
|---|
|  | 4433 |  | 
|---|
|  | 4434 | /* Function Body */ | 
|---|
|  | 4435 | if (*n <= 1) { | 
|---|
|  | 4436 | return 0; | 
|---|
|  | 4437 | } | 
|---|
|  | 4438 | ns2 = *n / 2; | 
|---|
|  | 4439 | np1 = *n + 1; | 
|---|
| [717] | 4440 | dt = pi / (r_4) np1; | 
|---|
| [459] | 4441 | i__1 = ns2; | 
|---|
|  | 4442 | for (k = 1; k <= i__1; ++k) { | 
|---|
|  | 4443 | wsave[k] = sin(k * dt) * 2.f; | 
|---|
|  | 4444 | /* L101: */ | 
|---|
|  | 4445 | } | 
|---|
|  | 4446 | rffti_(&np1, &wsave[ns2 + 1]); | 
|---|
|  | 4447 | return 0; | 
|---|
|  | 4448 | } /* sinti_ */ | 
|---|
|  | 4449 |  | 
|---|
| [717] | 4450 | /* --------------------------------------------------------------- */ | 
|---|
|  | 4451 | /* -------------- make a r_8 version of the library ----------- */ | 
|---|
|  | 4452 | /* --------------------------------------------------------------- */ | 
|---|
| [459] | 4453 |  | 
|---|
| [756] | 4454 | /* Subroutine */ int cdfftb_(int_4 *n, r_8 *c__, r_8 *wsave) | 
|---|
| [459] | 4455 | { | 
|---|
| [756] | 4456 | extern /* Subroutine */ int cdfftb1_(int_4 *, r_8 *, r_8 *, r_8 *, | 
|---|
| [717] | 4457 | int_8 *); | 
|---|
| [756] | 4458 | static int_4 iw1, iw2; | 
|---|
| [459] | 4459 |  | 
|---|
|  | 4460 | /* Parameter adjustments */ | 
|---|
|  | 4461 | --wsave; | 
|---|
|  | 4462 | --c__; | 
|---|
|  | 4463 |  | 
|---|
|  | 4464 | /* Function Body */ | 
|---|
|  | 4465 | if (*n == 1) { | 
|---|
|  | 4466 | return 0; | 
|---|
|  | 4467 | } | 
|---|
|  | 4468 | iw1 = *n + *n + 1; | 
|---|
|  | 4469 | iw2 = iw1 + *n + *n; | 
|---|
| [717] | 4470 | cdfftb1_(n, &c__[1], &wsave[1], &wsave[iw1], (int_8 *)&wsave[iw2]); /* (int *) rajoute Reza 29/11/99 */ | 
|---|
| [459] | 4471 | return 0; | 
|---|
|  | 4472 | } /* cdfftb_ */ | 
|---|
|  | 4473 |  | 
|---|
|  | 4474 | /*  ------ File cdfftb1.f ------ */ | 
|---|
| [756] | 4475 | /* Subroutine */ int cdfftb1_(int_4 *n, r_8 *c__, r_8 *ch, r_8 *wa, | 
|---|
| [717] | 4476 | int_8 *ifac) | 
|---|
| [459] | 4477 | { | 
|---|
|  | 4478 | /* System generated locals */ | 
|---|
| [756] | 4479 | int_4 i__1; | 
|---|
| [459] | 4480 |  | 
|---|
|  | 4481 | /* Local variables */ | 
|---|
| [756] | 4482 | static int_4 idot, i__; | 
|---|
|  | 4483 | extern /* Subroutine */ int dpassb_(int_4 *, int_4 *, int_4 *, | 
|---|
|  | 4484 | int_4 *, int_4 *, r_8 *, r_8 *, r_8 *, r_8 *, r_8 *, | 
|---|
| [717] | 4485 | r_8 *); | 
|---|
| [756] | 4486 | static int_4 k1, l1, l2, n2; | 
|---|
|  | 4487 | extern /* Subroutine */ int dpassb2_(int_4 *, int_4 *, r_8 *, r_8 *, | 
|---|
|  | 4488 | r_8 *), dpassb3_(int_4 *, int_4 *, r_8 *, r_8 *, r_8 *, | 
|---|
|  | 4489 | r_8 *), dpassb4_(int_4 *, int_4 *, r_8 *, r_8 *, r_8 *, | 
|---|
|  | 4490 | r_8 *, r_8 *), dpassb5_(int_4 *, int_4 *, r_8 *, r_8 *, | 
|---|
| [717] | 4491 | r_8 *, r_8 *, r_8 *, r_8 *); | 
|---|
| [756] | 4492 | static int_4 na, nf, ip, iw, ix2, ix3, ix4, nac, ido, idl1; | 
|---|
| [459] | 4493 |  | 
|---|
|  | 4494 | /* Parameter adjustments */ | 
|---|
|  | 4495 | --ifac; | 
|---|
|  | 4496 | --wa; | 
|---|
|  | 4497 | --ch; | 
|---|
|  | 4498 | --c__; | 
|---|
|  | 4499 |  | 
|---|
|  | 4500 | /* Function Body */ | 
|---|
|  | 4501 | nf = ifac[2]; | 
|---|
|  | 4502 | na = 0; | 
|---|
|  | 4503 | l1 = 1; | 
|---|
|  | 4504 | iw = 1; | 
|---|
|  | 4505 | i__1 = nf; | 
|---|
|  | 4506 | for (k1 = 1; k1 <= i__1; ++k1) { | 
|---|
|  | 4507 | ip = ifac[k1 + 2]; | 
|---|
|  | 4508 | l2 = ip * l1; | 
|---|
|  | 4509 | ido = *n / l2; | 
|---|
|  | 4510 | idot = ido + ido; | 
|---|
|  | 4511 | idl1 = idot * l1; | 
|---|
|  | 4512 | if (ip != 4) { | 
|---|
|  | 4513 | goto L103; | 
|---|
|  | 4514 | } | 
|---|
|  | 4515 | ix2 = iw + idot; | 
|---|
|  | 4516 | ix3 = ix2 + idot; | 
|---|
|  | 4517 | if (na != 0) { | 
|---|
|  | 4518 | goto L101; | 
|---|
|  | 4519 | } | 
|---|
|  | 4520 | dpassb4_(&idot, &l1, &c__[1], &ch[1], &wa[iw], &wa[ix2], &wa[ix3]); | 
|---|
|  | 4521 | goto L102; | 
|---|
|  | 4522 | L101: | 
|---|
|  | 4523 | dpassb4_(&idot, &l1, &ch[1], &c__[1], &wa[iw], &wa[ix2], &wa[ix3]); | 
|---|
|  | 4524 | L102: | 
|---|
|  | 4525 | na = 1 - na; | 
|---|
|  | 4526 | goto L115; | 
|---|
|  | 4527 | L103: | 
|---|
|  | 4528 | if (ip != 2) { | 
|---|
|  | 4529 | goto L106; | 
|---|
|  | 4530 | } | 
|---|
|  | 4531 | if (na != 0) { | 
|---|
|  | 4532 | goto L104; | 
|---|
|  | 4533 | } | 
|---|
|  | 4534 | dpassb2_(&idot, &l1, &c__[1], &ch[1], &wa[iw]); | 
|---|
|  | 4535 | goto L105; | 
|---|
|  | 4536 | L104: | 
|---|
|  | 4537 | dpassb2_(&idot, &l1, &ch[1], &c__[1], &wa[iw]); | 
|---|
|  | 4538 | L105: | 
|---|
|  | 4539 | na = 1 - na; | 
|---|
|  | 4540 | goto L115; | 
|---|
|  | 4541 | L106: | 
|---|
|  | 4542 | if (ip != 3) { | 
|---|
|  | 4543 | goto L109; | 
|---|
|  | 4544 | } | 
|---|
|  | 4545 | ix2 = iw + idot; | 
|---|
|  | 4546 | if (na != 0) { | 
|---|
|  | 4547 | goto L107; | 
|---|
|  | 4548 | } | 
|---|
|  | 4549 | dpassb3_(&idot, &l1, &c__[1], &ch[1], &wa[iw], &wa[ix2]); | 
|---|
|  | 4550 | goto L108; | 
|---|
|  | 4551 | L107: | 
|---|
|  | 4552 | dpassb3_(&idot, &l1, &ch[1], &c__[1], &wa[iw], &wa[ix2]); | 
|---|
|  | 4553 | L108: | 
|---|
|  | 4554 | na = 1 - na; | 
|---|
|  | 4555 | goto L115; | 
|---|
|  | 4556 | L109: | 
|---|
|  | 4557 | if (ip != 5) { | 
|---|
|  | 4558 | goto L112; | 
|---|
|  | 4559 | } | 
|---|
|  | 4560 | ix2 = iw + idot; | 
|---|
|  | 4561 | ix3 = ix2 + idot; | 
|---|
|  | 4562 | ix4 = ix3 + idot; | 
|---|
|  | 4563 | if (na != 0) { | 
|---|
|  | 4564 | goto L110; | 
|---|
|  | 4565 | } | 
|---|
|  | 4566 | dpassb5_(&idot, &l1, &c__[1], &ch[1], &wa[iw], &wa[ix2], &wa[ix3], &wa[ | 
|---|
|  | 4567 | ix4]); | 
|---|
|  | 4568 | goto L111; | 
|---|
|  | 4569 | L110: | 
|---|
|  | 4570 | dpassb5_(&idot, &l1, &ch[1], &c__[1], &wa[iw], &wa[ix2], &wa[ix3], &wa[ | 
|---|
|  | 4571 | ix4]); | 
|---|
|  | 4572 | L111: | 
|---|
|  | 4573 | na = 1 - na; | 
|---|
|  | 4574 | goto L115; | 
|---|
|  | 4575 | L112: | 
|---|
|  | 4576 | if (na != 0) { | 
|---|
|  | 4577 | goto L113; | 
|---|
|  | 4578 | } | 
|---|
|  | 4579 | dpassb_(&nac, &idot, &ip, &l1, &idl1, &c__[1], &c__[1], &c__[1], &ch[1] | 
|---|
|  | 4580 | , &ch[1], &wa[iw]); | 
|---|
|  | 4581 | goto L114; | 
|---|
|  | 4582 | L113: | 
|---|
|  | 4583 | dpassb_(&nac, &idot, &ip, &l1, &idl1, &ch[1], &ch[1], &ch[1], &c__[1], | 
|---|
|  | 4584 | &c__[1], &wa[iw]); | 
|---|
|  | 4585 | L114: | 
|---|
|  | 4586 | if (nac != 0) { | 
|---|
|  | 4587 | na = 1 - na; | 
|---|
|  | 4588 | } | 
|---|
|  | 4589 | L115: | 
|---|
|  | 4590 | l1 = l2; | 
|---|
|  | 4591 | iw += (ip - 1) * idot; | 
|---|
|  | 4592 | /* L116: */ | 
|---|
|  | 4593 | } | 
|---|
|  | 4594 | if (na == 0) { | 
|---|
|  | 4595 | return 0; | 
|---|
|  | 4596 | } | 
|---|
|  | 4597 | n2 = *n + *n; | 
|---|
|  | 4598 | i__1 = n2; | 
|---|
|  | 4599 | for (i__ = 1; i__ <= i__1; ++i__) { | 
|---|
|  | 4600 | c__[i__] = ch[i__]; | 
|---|
|  | 4601 | /* L117: */ | 
|---|
|  | 4602 | } | 
|---|
|  | 4603 | return 0; | 
|---|
|  | 4604 | } /* cdfftb1_ */ | 
|---|
|  | 4605 |  | 
|---|
|  | 4606 | /*  ------ File cdfftf.f ------ */ | 
|---|
| [756] | 4607 | /* Subroutine */ int cdfftf_(int_4 *n, r_8 *c__, r_8 *wsave) | 
|---|
| [459] | 4608 | { | 
|---|
| [756] | 4609 | extern /* Subroutine */ int cdfftf1_(int_4 *, r_8 *, r_8 *, r_8 *, | 
|---|
| [717] | 4610 | int_8 *); | 
|---|
| [756] | 4611 | static int_4 iw1, iw2; | 
|---|
| [459] | 4612 |  | 
|---|
|  | 4613 | /* Parameter adjustments */ | 
|---|
|  | 4614 | --wsave; | 
|---|
|  | 4615 | --c__; | 
|---|
|  | 4616 |  | 
|---|
|  | 4617 | /* Function Body */ | 
|---|
|  | 4618 | if (*n == 1) { | 
|---|
|  | 4619 | return 0; | 
|---|
|  | 4620 | } | 
|---|
|  | 4621 | iw1 = *n + *n + 1; | 
|---|
|  | 4622 | iw2 = iw1 + *n + *n; | 
|---|
| [717] | 4623 | cdfftf1_(n, &c__[1], &wsave[1], &wsave[iw1], (int_8 *)&wsave[iw2]); /* (int *) rajoute Reza 29/11/99 */ | 
|---|
| [459] | 4624 | return 0; | 
|---|
|  | 4625 | } /* cdfftf_ */ | 
|---|
|  | 4626 |  | 
|---|
|  | 4627 | /*  ------ File cdfftf1.f ------ */ | 
|---|
| [756] | 4628 | /* Subroutine */ int cdfftf1_(int_4 *n, r_8 *c__, r_8 *ch, r_8 *wa, | 
|---|
| [717] | 4629 | int_8 *ifac) | 
|---|
| [459] | 4630 | { | 
|---|
|  | 4631 | /* System generated locals */ | 
|---|
| [756] | 4632 | int_4 i__1; | 
|---|
| [459] | 4633 |  | 
|---|
|  | 4634 | /* Local variables */ | 
|---|
| [756] | 4635 | static int_4 idot, i__; | 
|---|
|  | 4636 | extern /* Subroutine */ int dpassf_(int_4 *, int_4 *, int_4 *, | 
|---|
|  | 4637 | int_4 *, int_4 *, r_8 *, r_8 *, r_8 *, r_8 *, r_8 *, | 
|---|
| [717] | 4638 | r_8 *); | 
|---|
| [756] | 4639 | static int_4 k1, l1, l2, n2; | 
|---|
|  | 4640 | extern /* Subroutine */ int dpassf2_(int_4 *, int_4 *, r_8 *, r_8 *, | 
|---|
|  | 4641 | r_8 *), dpassf3_(int_4 *, int_4 *, r_8 *, r_8 *, r_8 *, | 
|---|
|  | 4642 | r_8 *), dpassf4_(int_4 *, int_4 *, r_8 *, r_8 *, r_8 *, | 
|---|
|  | 4643 | r_8 *, r_8 *), dpassf5_(int_4 *, int_4 *, r_8 *, r_8 *, | 
|---|
| [717] | 4644 | r_8 *, r_8 *, r_8 *, r_8 *); | 
|---|
| [756] | 4645 | static int_4 na, nf, ip, iw, ix2, ix3, ix4, nac, ido, idl1; | 
|---|
| [459] | 4646 |  | 
|---|
|  | 4647 | /* Parameter adjustments */ | 
|---|
|  | 4648 | --ifac; | 
|---|
|  | 4649 | --wa; | 
|---|
|  | 4650 | --ch; | 
|---|
|  | 4651 | --c__; | 
|---|
|  | 4652 |  | 
|---|
|  | 4653 | /* Function Body */ | 
|---|
|  | 4654 | nf = ifac[2]; | 
|---|
|  | 4655 | na = 0; | 
|---|
|  | 4656 | l1 = 1; | 
|---|
|  | 4657 | iw = 1; | 
|---|
|  | 4658 | i__1 = nf; | 
|---|
|  | 4659 | for (k1 = 1; k1 <= i__1; ++k1) { | 
|---|
|  | 4660 | ip = ifac[k1 + 2]; | 
|---|
|  | 4661 | l2 = ip * l1; | 
|---|
|  | 4662 | ido = *n / l2; | 
|---|
|  | 4663 | idot = ido + ido; | 
|---|
|  | 4664 | idl1 = idot * l1; | 
|---|
|  | 4665 | if (ip != 4) { | 
|---|
|  | 4666 | goto L103; | 
|---|
|  | 4667 | } | 
|---|
|  | 4668 | ix2 = iw + idot; | 
|---|
|  | 4669 | ix3 = ix2 + idot; | 
|---|
|  | 4670 | if (na != 0) { | 
|---|
|  | 4671 | goto L101; | 
|---|
|  | 4672 | } | 
|---|
|  | 4673 | dpassf4_(&idot, &l1, &c__[1], &ch[1], &wa[iw], &wa[ix2], &wa[ix3]); | 
|---|
|  | 4674 | goto L102; | 
|---|
|  | 4675 | L101: | 
|---|
|  | 4676 | dpassf4_(&idot, &l1, &ch[1], &c__[1], &wa[iw], &wa[ix2], &wa[ix3]); | 
|---|
|  | 4677 | L102: | 
|---|
|  | 4678 | na = 1 - na; | 
|---|
|  | 4679 | goto L115; | 
|---|
|  | 4680 | L103: | 
|---|
|  | 4681 | if (ip != 2) { | 
|---|
|  | 4682 | goto L106; | 
|---|
|  | 4683 | } | 
|---|
|  | 4684 | if (na != 0) { | 
|---|
|  | 4685 | goto L104; | 
|---|
|  | 4686 | } | 
|---|
|  | 4687 | dpassf2_(&idot, &l1, &c__[1], &ch[1], &wa[iw]); | 
|---|
|  | 4688 | goto L105; | 
|---|
|  | 4689 | L104: | 
|---|
|  | 4690 | dpassf2_(&idot, &l1, &ch[1], &c__[1], &wa[iw]); | 
|---|
|  | 4691 | L105: | 
|---|
|  | 4692 | na = 1 - na; | 
|---|
|  | 4693 | goto L115; | 
|---|
|  | 4694 | L106: | 
|---|
|  | 4695 | if (ip != 3) { | 
|---|
|  | 4696 | goto L109; | 
|---|
|  | 4697 | } | 
|---|
|  | 4698 | ix2 = iw + idot; | 
|---|
|  | 4699 | if (na != 0) { | 
|---|
|  | 4700 | goto L107; | 
|---|
|  | 4701 | } | 
|---|
|  | 4702 | dpassf3_(&idot, &l1, &c__[1], &ch[1], &wa[iw], &wa[ix2]); | 
|---|
|  | 4703 | goto L108; | 
|---|
|  | 4704 | L107: | 
|---|
|  | 4705 | dpassf3_(&idot, &l1, &ch[1], &c__[1], &wa[iw], &wa[ix2]); | 
|---|
|  | 4706 | L108: | 
|---|
|  | 4707 | na = 1 - na; | 
|---|
|  | 4708 | goto L115; | 
|---|
|  | 4709 | L109: | 
|---|
|  | 4710 | if (ip != 5) { | 
|---|
|  | 4711 | goto L112; | 
|---|
|  | 4712 | } | 
|---|
|  | 4713 | ix2 = iw + idot; | 
|---|
|  | 4714 | ix3 = ix2 + idot; | 
|---|
|  | 4715 | ix4 = ix3 + idot; | 
|---|
|  | 4716 | if (na != 0) { | 
|---|
|  | 4717 | goto L110; | 
|---|
|  | 4718 | } | 
|---|
|  | 4719 | dpassf5_(&idot, &l1, &c__[1], &ch[1], &wa[iw], &wa[ix2], &wa[ix3], &wa[ | 
|---|
|  | 4720 | ix4]); | 
|---|
|  | 4721 | goto L111; | 
|---|
|  | 4722 | L110: | 
|---|
|  | 4723 | dpassf5_(&idot, &l1, &ch[1], &c__[1], &wa[iw], &wa[ix2], &wa[ix3], &wa[ | 
|---|
|  | 4724 | ix4]); | 
|---|
|  | 4725 | L111: | 
|---|
|  | 4726 | na = 1 - na; | 
|---|
|  | 4727 | goto L115; | 
|---|
|  | 4728 | L112: | 
|---|
|  | 4729 | if (na != 0) { | 
|---|
|  | 4730 | goto L113; | 
|---|
|  | 4731 | } | 
|---|
|  | 4732 | dpassf_(&nac, &idot, &ip, &l1, &idl1, &c__[1], &c__[1], &c__[1], &ch[1] | 
|---|
|  | 4733 | , &ch[1], &wa[iw]); | 
|---|
|  | 4734 | goto L114; | 
|---|
|  | 4735 | L113: | 
|---|
|  | 4736 | dpassf_(&nac, &idot, &ip, &l1, &idl1, &ch[1], &ch[1], &ch[1], &c__[1], | 
|---|
|  | 4737 | &c__[1], &wa[iw]); | 
|---|
|  | 4738 | L114: | 
|---|
|  | 4739 | if (nac != 0) { | 
|---|
|  | 4740 | na = 1 - na; | 
|---|
|  | 4741 | } | 
|---|
|  | 4742 | L115: | 
|---|
|  | 4743 | l1 = l2; | 
|---|
|  | 4744 | iw += (ip - 1) * idot; | 
|---|
|  | 4745 | /* L116: */ | 
|---|
|  | 4746 | } | 
|---|
|  | 4747 | if (na == 0) { | 
|---|
|  | 4748 | return 0; | 
|---|
|  | 4749 | } | 
|---|
|  | 4750 | n2 = *n + *n; | 
|---|
|  | 4751 | i__1 = n2; | 
|---|
|  | 4752 | for (i__ = 1; i__ <= i__1; ++i__) { | 
|---|
|  | 4753 | c__[i__] = ch[i__]; | 
|---|
|  | 4754 | /* L117: */ | 
|---|
|  | 4755 | } | 
|---|
|  | 4756 | return 0; | 
|---|
|  | 4757 | } /* cdfftf1_ */ | 
|---|
|  | 4758 |  | 
|---|
|  | 4759 | /*  ------ File cdffti.f ------ */ | 
|---|
| [756] | 4760 | /* Subroutine */ int cdffti_(int_4 *n, r_8 *wsave) | 
|---|
| [459] | 4761 | { | 
|---|
| [756] | 4762 | extern /* Subroutine */ int cdffti1_(int_4 *, r_8 *, int_8 *); | 
|---|
|  | 4763 | static int_4 iw1, iw2; | 
|---|
| [459] | 4764 |  | 
|---|
|  | 4765 | /* Parameter adjustments */ | 
|---|
|  | 4766 | --wsave; | 
|---|
|  | 4767 |  | 
|---|
|  | 4768 | /* Function Body */ | 
|---|
|  | 4769 | if (*n == 1) { | 
|---|
|  | 4770 | return 0; | 
|---|
|  | 4771 | } | 
|---|
|  | 4772 | iw1 = *n + *n + 1; | 
|---|
|  | 4773 | iw2 = iw1 + *n + *n; | 
|---|
| [717] | 4774 | cdffti1_(n, &wsave[iw1], (int_8 *)&wsave[iw2]); /* (int *) rajoute Reza 29/11/99 */ | 
|---|
| [459] | 4775 | return 0; | 
|---|
|  | 4776 | } /* cdffti_ */ | 
|---|
|  | 4777 |  | 
|---|
|  | 4778 | /*  ------ File cdffti1.f ------ */ | 
|---|
| [756] | 4779 | /* Subroutine */ int cdffti1_(int_4 *n, r_8 *wa, int_8 *ifac) | 
|---|
| [459] | 4780 | { | 
|---|
|  | 4781 | /* Initialized data */ | 
|---|
|  | 4782 |  | 
|---|
| [756] | 4783 | static int_4 ntryh[4] = { 3,4,2,5 }; | 
|---|
| [459] | 4784 |  | 
|---|
|  | 4785 | /* System generated locals */ | 
|---|
| [756] | 4786 | int_4 i__1, i__2, i__3; | 
|---|
| [459] | 4787 |  | 
|---|
|  | 4788 | /* Builtin functions */ | 
|---|
| [717] | 4789 | /*    r_8 cos(r_8truc), sin(r_8truc);  remplace par math.h  Reza 29/11/99 */ | 
|---|
| [459] | 4790 |  | 
|---|
|  | 4791 | /* Local variables */ | 
|---|
| [717] | 4792 | static r_8 argh; | 
|---|
| [756] | 4793 | static int_4 idot, ntry, i__, j; | 
|---|
| [717] | 4794 | static r_8 argld; | 
|---|
| [756] | 4795 | static int_4 i1, k1, l1, l2, ib; | 
|---|
| [717] | 4796 | static r_8 fi; | 
|---|
| [756] | 4797 | static int_4 ld, ii, nf, ip, nl, nq, nr; | 
|---|
| [717] | 4798 | static r_8 arg; | 
|---|
| [756] | 4799 | static int_4 ido, ipm; | 
|---|
| [717] | 4800 | static r_8 tpi; | 
|---|
| [459] | 4801 |  | 
|---|
|  | 4802 | /* Parameter adjustments */ | 
|---|
|  | 4803 | --ifac; | 
|---|
|  | 4804 | --wa; | 
|---|
|  | 4805 |  | 
|---|
|  | 4806 | /* Function Body */ | 
|---|
|  | 4807 | nl = *n; | 
|---|
|  | 4808 | nf = 0; | 
|---|
|  | 4809 | j = 0; | 
|---|
|  | 4810 | L101: | 
|---|
|  | 4811 | ++j; | 
|---|
|  | 4812 | if (j - 4 <= 0) { | 
|---|
|  | 4813 | goto L102; | 
|---|
|  | 4814 | } else { | 
|---|
|  | 4815 | goto L103; | 
|---|
|  | 4816 | } | 
|---|
|  | 4817 | L102: | 
|---|
|  | 4818 | ntry = ntryh[j - 1]; | 
|---|
|  | 4819 | goto L104; | 
|---|
|  | 4820 | L103: | 
|---|
|  | 4821 | ntry += 2; | 
|---|
|  | 4822 | L104: | 
|---|
|  | 4823 | nq = nl / ntry; | 
|---|
|  | 4824 | nr = nl - ntry * nq; | 
|---|
|  | 4825 | if (nr != 0) { | 
|---|
|  | 4826 | goto L101; | 
|---|
|  | 4827 | } else { | 
|---|
|  | 4828 | goto L105; | 
|---|
|  | 4829 | } | 
|---|
|  | 4830 | L105: | 
|---|
|  | 4831 | ++nf; | 
|---|
|  | 4832 | ifac[nf + 2] = ntry; | 
|---|
|  | 4833 | nl = nq; | 
|---|
|  | 4834 | if (ntry != 2) { | 
|---|
|  | 4835 | goto L107; | 
|---|
|  | 4836 | } | 
|---|
|  | 4837 | if (nf == 1) { | 
|---|
|  | 4838 | goto L107; | 
|---|
|  | 4839 | } | 
|---|
|  | 4840 | i__1 = nf; | 
|---|
|  | 4841 | for (i__ = 2; i__ <= i__1; ++i__) { | 
|---|
|  | 4842 | ib = nf - i__ + 2; | 
|---|
|  | 4843 | ifac[ib + 2] = ifac[ib + 1]; | 
|---|
|  | 4844 | /* L106: */ | 
|---|
|  | 4845 | } | 
|---|
|  | 4846 | ifac[3] = 2; | 
|---|
|  | 4847 | L107: | 
|---|
|  | 4848 | if (nl != 1) { | 
|---|
|  | 4849 | goto L104; | 
|---|
|  | 4850 | } | 
|---|
|  | 4851 | ifac[1] = *n; | 
|---|
|  | 4852 | ifac[2] = nf; | 
|---|
|  | 4853 | tpi = 6.28318530717959f; | 
|---|
| [717] | 4854 | argh = tpi / (r_8) (*n); | 
|---|
| [459] | 4855 | i__ = 2; | 
|---|
|  | 4856 | l1 = 1; | 
|---|
|  | 4857 | i__1 = nf; | 
|---|
|  | 4858 | for (k1 = 1; k1 <= i__1; ++k1) { | 
|---|
|  | 4859 | ip = ifac[k1 + 2]; | 
|---|
|  | 4860 | ld = 0; | 
|---|
|  | 4861 | l2 = l1 * ip; | 
|---|
|  | 4862 | ido = *n / l2; | 
|---|
|  | 4863 | idot = ido + ido + 2; | 
|---|
|  | 4864 | ipm = ip - 1; | 
|---|
|  | 4865 | i__2 = ipm; | 
|---|
|  | 4866 | for (j = 1; j <= i__2; ++j) { | 
|---|
|  | 4867 | i1 = i__; | 
|---|
|  | 4868 | wa[i__ - 1] = 1.f; | 
|---|
|  | 4869 | wa[i__] = 0.f; | 
|---|
|  | 4870 | ld += l1; | 
|---|
|  | 4871 | fi = 0.f; | 
|---|
| [717] | 4872 | argld = (r_8) ld * argh; | 
|---|
| [459] | 4873 | i__3 = idot; | 
|---|
|  | 4874 | for (ii = 4; ii <= i__3; ii += 2) { | 
|---|
|  | 4875 | i__ += 2; | 
|---|
|  | 4876 | fi += 1.f; | 
|---|
|  | 4877 | arg = fi * argld; | 
|---|
|  | 4878 | wa[i__ - 1] = cos(arg); | 
|---|
|  | 4879 | wa[i__] = sin(arg); | 
|---|
|  | 4880 | /* L108: */ | 
|---|
|  | 4881 | } | 
|---|
|  | 4882 | if (ip <= 5) { | 
|---|
|  | 4883 | goto L109; | 
|---|
|  | 4884 | } | 
|---|
|  | 4885 | wa[i1 - 1] = wa[i__ - 1]; | 
|---|
|  | 4886 | wa[i1] = wa[i__]; | 
|---|
|  | 4887 | L109: | 
|---|
|  | 4888 | ; | 
|---|
|  | 4889 | } | 
|---|
|  | 4890 | l1 = l2; | 
|---|
|  | 4891 | /* L110: */ | 
|---|
|  | 4892 | } | 
|---|
|  | 4893 | return 0; | 
|---|
|  | 4894 | } /* cdffti1_ */ | 
|---|
|  | 4895 |  | 
|---|
|  | 4896 | /*  ------ File dcosqb.f ------ */ | 
|---|
| [756] | 4897 | /* Subroutine */ int dcosqb_(int_4 *n, r_8 *x, r_8 *wsave) | 
|---|
| [459] | 4898 | { | 
|---|
|  | 4899 | /* Initialized data */ | 
|---|
|  | 4900 |  | 
|---|
| [717] | 4901 | static r_8 tsqrt2 = 2.82842712474619f; | 
|---|
| [459] | 4902 |  | 
|---|
|  | 4903 | /* System generated locals */ | 
|---|
| [756] | 4904 | int_4 i__1; | 
|---|
| [459] | 4905 |  | 
|---|
|  | 4906 | /* Local variables */ | 
|---|
| [717] | 4907 | static r_8 x1; | 
|---|
| [756] | 4908 | extern /* Subroutine */ int dcosqb1_(int_4 *, r_8 *, r_8 *, r_8 *); | 
|---|
| [459] | 4909 |  | 
|---|
|  | 4910 | /* Parameter adjustments */ | 
|---|
|  | 4911 | --wsave; | 
|---|
|  | 4912 | --x; | 
|---|
|  | 4913 |  | 
|---|
|  | 4914 | /* Function Body */ | 
|---|
|  | 4915 | if ((i__1 = *n - 2) < 0) { | 
|---|
|  | 4916 | goto L101; | 
|---|
|  | 4917 | } else if (i__1 == 0) { | 
|---|
|  | 4918 | goto L102; | 
|---|
|  | 4919 | } else { | 
|---|
|  | 4920 | goto L103; | 
|---|
|  | 4921 | } | 
|---|
|  | 4922 | L101: | 
|---|
|  | 4923 | x[1] *= 4.f; | 
|---|
|  | 4924 | return 0; | 
|---|
|  | 4925 | L102: | 
|---|
|  | 4926 | x1 = (x[1] + x[2]) * 4.f; | 
|---|
|  | 4927 | x[2] = tsqrt2 * (x[1] - x[2]); | 
|---|
|  | 4928 | x[1] = x1; | 
|---|
|  | 4929 | return 0; | 
|---|
|  | 4930 | L103: | 
|---|
|  | 4931 | dcosqb1_(n, &x[1], &wsave[1], &wsave[*n + 1]); | 
|---|
|  | 4932 | return 0; | 
|---|
|  | 4933 | } /* dcosqb_ */ | 
|---|
|  | 4934 |  | 
|---|
|  | 4935 | /*  ------ File dcosqb1.f ------ */ | 
|---|
| [756] | 4936 | /* Subroutine */ int dcosqb1_(int_4 *n, r_8 *x, r_8 *w, r_8 *xh) | 
|---|
| [459] | 4937 | { | 
|---|
|  | 4938 | /* System generated locals */ | 
|---|
| [756] | 4939 | int_4 i__1; | 
|---|
| [459] | 4940 |  | 
|---|
|  | 4941 | /* Local variables */ | 
|---|
| [756] | 4942 | static int_4 modn, i__, k; | 
|---|
|  | 4943 | extern /* Subroutine */ int dfftb_(int_4 *, r_8 *, r_8 *); | 
|---|
|  | 4944 | static int_4 kc, np2, ns2; | 
|---|
| [717] | 4945 | static r_8 xim1; | 
|---|
| [459] | 4946 |  | 
|---|
|  | 4947 | /* Parameter adjustments */ | 
|---|
|  | 4948 | --xh; | 
|---|
|  | 4949 | --w; | 
|---|
|  | 4950 | --x; | 
|---|
|  | 4951 |  | 
|---|
|  | 4952 | /* Function Body */ | 
|---|
|  | 4953 | ns2 = (*n + 1) / 2; | 
|---|
|  | 4954 | np2 = *n + 2; | 
|---|
|  | 4955 | i__1 = *n; | 
|---|
|  | 4956 | for (i__ = 3; i__ <= i__1; i__ += 2) { | 
|---|
|  | 4957 | xim1 = x[i__ - 1] + x[i__]; | 
|---|
|  | 4958 | x[i__] -= x[i__ - 1]; | 
|---|
|  | 4959 | x[i__ - 1] = xim1; | 
|---|
|  | 4960 | /* L101: */ | 
|---|
|  | 4961 | } | 
|---|
|  | 4962 | x[1] += x[1]; | 
|---|
|  | 4963 | modn = *n % 2; | 
|---|
|  | 4964 | if (modn == 0) { | 
|---|
|  | 4965 | x[*n] += x[*n]; | 
|---|
|  | 4966 | } | 
|---|
|  | 4967 | dfftb_(n, &x[1], &xh[1]); | 
|---|
|  | 4968 | i__1 = ns2; | 
|---|
|  | 4969 | for (k = 2; k <= i__1; ++k) { | 
|---|
|  | 4970 | kc = np2 - k; | 
|---|
|  | 4971 | xh[k] = w[k - 1] * x[kc] + w[kc - 1] * x[k]; | 
|---|
|  | 4972 | xh[kc] = w[k - 1] * x[k] - w[kc - 1] * x[kc]; | 
|---|
|  | 4973 | /* L102: */ | 
|---|
|  | 4974 | } | 
|---|
|  | 4975 | if (modn == 0) { | 
|---|
|  | 4976 | x[ns2 + 1] = w[ns2] * (x[ns2 + 1] + x[ns2 + 1]); | 
|---|
|  | 4977 | } | 
|---|
|  | 4978 | i__1 = ns2; | 
|---|
|  | 4979 | for (k = 2; k <= i__1; ++k) { | 
|---|
|  | 4980 | kc = np2 - k; | 
|---|
|  | 4981 | x[k] = xh[k] + xh[kc]; | 
|---|
|  | 4982 | x[kc] = xh[k] - xh[kc]; | 
|---|
|  | 4983 | /* L103: */ | 
|---|
|  | 4984 | } | 
|---|
|  | 4985 | x[1] += x[1]; | 
|---|
|  | 4986 | return 0; | 
|---|
|  | 4987 | } /* dcosqb1_ */ | 
|---|
|  | 4988 |  | 
|---|
|  | 4989 | /*  ------ File dcosqf.f ------ */ | 
|---|
| [756] | 4990 | /* Subroutine */ int dcosqf_(int_4 *n, r_8 *x, r_8 *wsave) | 
|---|
| [459] | 4991 | { | 
|---|
|  | 4992 | /* Initialized data */ | 
|---|
|  | 4993 |  | 
|---|
| [717] | 4994 | static r_8 sqrt2 = 1.4142135623731f; | 
|---|
| [459] | 4995 |  | 
|---|
|  | 4996 | /* System generated locals */ | 
|---|
| [756] | 4997 | int_4 i__1; | 
|---|
| [459] | 4998 |  | 
|---|
|  | 4999 | /* Local variables */ | 
|---|
| [717] | 5000 | static r_8 tsqx; | 
|---|
| [756] | 5001 | extern /* Subroutine */ int dcosqf1_(int_4 *, r_8 *, r_8 *, r_8 *); | 
|---|
| [459] | 5002 |  | 
|---|
|  | 5003 | /* Parameter adjustments */ | 
|---|
|  | 5004 | --wsave; | 
|---|
|  | 5005 | --x; | 
|---|
|  | 5006 |  | 
|---|
|  | 5007 | /* Function Body */ | 
|---|
|  | 5008 | if ((i__1 = *n - 2) < 0) { | 
|---|
|  | 5009 | goto L102; | 
|---|
|  | 5010 | } else if (i__1 == 0) { | 
|---|
|  | 5011 | goto L101; | 
|---|
|  | 5012 | } else { | 
|---|
|  | 5013 | goto L103; | 
|---|
|  | 5014 | } | 
|---|
|  | 5015 | L101: | 
|---|
|  | 5016 | tsqx = sqrt2 * x[2]; | 
|---|
|  | 5017 | x[2] = x[1] - tsqx; | 
|---|
|  | 5018 | x[1] += tsqx; | 
|---|
|  | 5019 | L102: | 
|---|
|  | 5020 | return 0; | 
|---|
|  | 5021 | L103: | 
|---|
|  | 5022 | dcosqf1_(n, &x[1], &wsave[1], &wsave[*n + 1]); | 
|---|
|  | 5023 | return 0; | 
|---|
|  | 5024 | } /* dcosqf_ */ | 
|---|
|  | 5025 |  | 
|---|
|  | 5026 | /*  ------ File dcosqf1.f ------ */ | 
|---|
| [756] | 5027 | /* Subroutine */ int dcosqf1_(int_4 *n, r_8 *x, r_8 *w, r_8 *xh) | 
|---|
| [459] | 5028 | { | 
|---|
|  | 5029 | /* System generated locals */ | 
|---|
| [756] | 5030 | int_4 i__1; | 
|---|
| [459] | 5031 |  | 
|---|
|  | 5032 | /* Local variables */ | 
|---|
| [756] | 5033 | static int_4 modn, i__, k; | 
|---|
|  | 5034 | extern /* Subroutine */ int dfftf_(int_4 *, r_8 *, r_8 *); | 
|---|
|  | 5035 | static int_4 kc, np2, ns2; | 
|---|
| [717] | 5036 | static r_8 xim1; | 
|---|
| [459] | 5037 |  | 
|---|
|  | 5038 | /* Parameter adjustments */ | 
|---|
|  | 5039 | --xh; | 
|---|
|  | 5040 | --w; | 
|---|
|  | 5041 | --x; | 
|---|
|  | 5042 |  | 
|---|
|  | 5043 | /* Function Body */ | 
|---|
|  | 5044 | ns2 = (*n + 1) / 2; | 
|---|
|  | 5045 | np2 = *n + 2; | 
|---|
|  | 5046 | i__1 = ns2; | 
|---|
|  | 5047 | for (k = 2; k <= i__1; ++k) { | 
|---|
|  | 5048 | kc = np2 - k; | 
|---|
|  | 5049 | xh[k] = x[k] + x[kc]; | 
|---|
|  | 5050 | xh[kc] = x[k] - x[kc]; | 
|---|
|  | 5051 | /* L101: */ | 
|---|
|  | 5052 | } | 
|---|
|  | 5053 | modn = *n % 2; | 
|---|
|  | 5054 | if (modn == 0) { | 
|---|
|  | 5055 | xh[ns2 + 1] = x[ns2 + 1] + x[ns2 + 1]; | 
|---|
|  | 5056 | } | 
|---|
|  | 5057 | i__1 = ns2; | 
|---|
|  | 5058 | for (k = 2; k <= i__1; ++k) { | 
|---|
|  | 5059 | kc = np2 - k; | 
|---|
|  | 5060 | x[k] = w[k - 1] * xh[kc] + w[kc - 1] * xh[k]; | 
|---|
|  | 5061 | x[kc] = w[k - 1] * xh[k] - w[kc - 1] * xh[kc]; | 
|---|
|  | 5062 | /* L102: */ | 
|---|
|  | 5063 | } | 
|---|
|  | 5064 | if (modn == 0) { | 
|---|
|  | 5065 | x[ns2 + 1] = w[ns2] * xh[ns2 + 1]; | 
|---|
|  | 5066 | } | 
|---|
|  | 5067 | dfftf_(n, &x[1], &xh[1]); | 
|---|
|  | 5068 | i__1 = *n; | 
|---|
|  | 5069 | for (i__ = 3; i__ <= i__1; i__ += 2) { | 
|---|
|  | 5070 | xim1 = x[i__ - 1] - x[i__]; | 
|---|
|  | 5071 | x[i__] = x[i__ - 1] + x[i__]; | 
|---|
|  | 5072 | x[i__ - 1] = xim1; | 
|---|
|  | 5073 | /* L103: */ | 
|---|
|  | 5074 | } | 
|---|
|  | 5075 | return 0; | 
|---|
|  | 5076 | } /* dcosqf1_ */ | 
|---|
|  | 5077 |  | 
|---|
|  | 5078 | /*  ------ File dcosqi.f ------ */ | 
|---|
| [756] | 5079 | /* Subroutine */ int dcosqi_(int_4 *n, r_8 *wsave) | 
|---|
| [459] | 5080 | { | 
|---|
|  | 5081 | /* Initialized data */ | 
|---|
|  | 5082 |  | 
|---|
| [717] | 5083 | static r_8 pih = 1.57079632679491f; | 
|---|
| [459] | 5084 |  | 
|---|
|  | 5085 | /* System generated locals */ | 
|---|
| [756] | 5086 | int_4 i__1; | 
|---|
| [459] | 5087 |  | 
|---|
|  | 5088 | /* Builtin functions */ | 
|---|
| [717] | 5089 | /*    r_8 cos(r_8truc); remplace par math.h  Reza 29/11/99 */ | 
|---|
| [459] | 5090 |  | 
|---|
|  | 5091 | /* Local variables */ | 
|---|
| [756] | 5092 | static int_4 k; | 
|---|
|  | 5093 | extern /* Subroutine */ int dffti_(int_4 *, r_8 *); | 
|---|
| [717] | 5094 | static r_8 fk, dt; | 
|---|
| [459] | 5095 |  | 
|---|
|  | 5096 | /* Parameter adjustments */ | 
|---|
|  | 5097 | --wsave; | 
|---|
|  | 5098 |  | 
|---|
|  | 5099 | /* Function Body */ | 
|---|
| [717] | 5100 | dt = pih / (r_8) (*n); | 
|---|
| [459] | 5101 | fk = 0.f; | 
|---|
|  | 5102 | i__1 = *n; | 
|---|
|  | 5103 | for (k = 1; k <= i__1; ++k) { | 
|---|
|  | 5104 | fk += 1.f; | 
|---|
|  | 5105 | wsave[k] = cos(fk * dt); | 
|---|
|  | 5106 | /* L101: */ | 
|---|
|  | 5107 | } | 
|---|
|  | 5108 | dffti_(n, &wsave[*n + 1]); | 
|---|
|  | 5109 | return 0; | 
|---|
|  | 5110 | } /* dcosqi_ */ | 
|---|
|  | 5111 |  | 
|---|
|  | 5112 | /*  ------ File dcost.f ------ */ | 
|---|
| [756] | 5113 | /* Subroutine */ int dcost_(int_4 *n, r_8 *x, r_8 *wsave) | 
|---|
| [459] | 5114 | { | 
|---|
|  | 5115 | /* System generated locals */ | 
|---|
| [756] | 5116 | int_4 i__1; | 
|---|
| [459] | 5117 |  | 
|---|
|  | 5118 | /* Local variables */ | 
|---|
| [756] | 5119 | static int_4 modn, i__, k; | 
|---|
|  | 5120 | extern /* Subroutine */ int dfftf_(int_4 *, r_8 *, r_8 *); | 
|---|
| [717] | 5121 | static r_8 c1, t1, t2; | 
|---|
| [756] | 5122 | static int_4 kc; | 
|---|
| [717] | 5123 | static r_8 xi; | 
|---|
| [756] | 5124 | static int_4 nm1, np1; | 
|---|
| [717] | 5125 | static r_8 x1h; | 
|---|
| [756] | 5126 | static int_4 ns2; | 
|---|
| [717] | 5127 | static r_8 tx2, x1p3, xim2; | 
|---|
| [459] | 5128 |  | 
|---|
|  | 5129 | /* Parameter adjustments */ | 
|---|
|  | 5130 | --wsave; | 
|---|
|  | 5131 | --x; | 
|---|
|  | 5132 |  | 
|---|
|  | 5133 | /* Function Body */ | 
|---|
|  | 5134 | nm1 = *n - 1; | 
|---|
|  | 5135 | np1 = *n + 1; | 
|---|
|  | 5136 | ns2 = *n / 2; | 
|---|
|  | 5137 | if ((i__1 = *n - 2) < 0) { | 
|---|
|  | 5138 | goto L106; | 
|---|
|  | 5139 | } else if (i__1 == 0) { | 
|---|
|  | 5140 | goto L101; | 
|---|
|  | 5141 | } else { | 
|---|
|  | 5142 | goto L102; | 
|---|
|  | 5143 | } | 
|---|
|  | 5144 | L101: | 
|---|
|  | 5145 | x1h = x[1] + x[2]; | 
|---|
|  | 5146 | x[2] = x[1] - x[2]; | 
|---|
|  | 5147 | x[1] = x1h; | 
|---|
|  | 5148 | return 0; | 
|---|
|  | 5149 | L102: | 
|---|
|  | 5150 | if (*n > 3) { | 
|---|
|  | 5151 | goto L103; | 
|---|
|  | 5152 | } | 
|---|
|  | 5153 | x1p3 = x[1] + x[3]; | 
|---|
|  | 5154 | tx2 = x[2] + x[2]; | 
|---|
|  | 5155 | x[2] = x[1] - x[3]; | 
|---|
|  | 5156 | x[1] = x1p3 + tx2; | 
|---|
|  | 5157 | x[3] = x1p3 - tx2; | 
|---|
|  | 5158 | return 0; | 
|---|
|  | 5159 | L103: | 
|---|
|  | 5160 | c1 = x[1] - x[*n]; | 
|---|
|  | 5161 | x[1] += x[*n]; | 
|---|
|  | 5162 | i__1 = ns2; | 
|---|
|  | 5163 | for (k = 2; k <= i__1; ++k) { | 
|---|
|  | 5164 | kc = np1 - k; | 
|---|
|  | 5165 | t1 = x[k] + x[kc]; | 
|---|
|  | 5166 | t2 = x[k] - x[kc]; | 
|---|
|  | 5167 | c1 += wsave[kc] * t2; | 
|---|
|  | 5168 | t2 = wsave[k] * t2; | 
|---|
|  | 5169 | x[k] = t1 - t2; | 
|---|
|  | 5170 | x[kc] = t1 + t2; | 
|---|
|  | 5171 | /* L104: */ | 
|---|
|  | 5172 | } | 
|---|
|  | 5173 | modn = *n % 2; | 
|---|
|  | 5174 | if (modn != 0) { | 
|---|
|  | 5175 | x[ns2 + 1] += x[ns2 + 1]; | 
|---|
|  | 5176 | } | 
|---|
|  | 5177 | dfftf_(&nm1, &x[1], &wsave[*n + 1]); | 
|---|
|  | 5178 | xim2 = x[2]; | 
|---|
|  | 5179 | x[2] = c1; | 
|---|
|  | 5180 | i__1 = *n; | 
|---|
|  | 5181 | for (i__ = 4; i__ <= i__1; i__ += 2) { | 
|---|
|  | 5182 | xi = x[i__]; | 
|---|
|  | 5183 | x[i__] = x[i__ - 2] - x[i__ - 1]; | 
|---|
|  | 5184 | x[i__ - 1] = xim2; | 
|---|
|  | 5185 | xim2 = xi; | 
|---|
|  | 5186 | /* L105: */ | 
|---|
|  | 5187 | } | 
|---|
|  | 5188 | if (modn != 0) { | 
|---|
|  | 5189 | x[*n] = xim2; | 
|---|
|  | 5190 | } | 
|---|
|  | 5191 | L106: | 
|---|
|  | 5192 | return 0; | 
|---|
|  | 5193 | } /* dcost_ */ | 
|---|
|  | 5194 |  | 
|---|
|  | 5195 | /*  ------ File dcosti.f ------ */ | 
|---|
| [756] | 5196 | /* Subroutine */ int dcosti_(int_4 *n, r_8 *wsave) | 
|---|
| [459] | 5197 | { | 
|---|
|  | 5198 | /* Initialized data */ | 
|---|
|  | 5199 |  | 
|---|
| [717] | 5200 | static r_8 pi = 3.14159265358979f; | 
|---|
| [459] | 5201 |  | 
|---|
|  | 5202 | /* System generated locals */ | 
|---|
| [756] | 5203 | int_4 i__1; | 
|---|
| [459] | 5204 |  | 
|---|
|  | 5205 | /* Builtin functions */ | 
|---|
| [717] | 5206 | /*    r_8 sin(r_8truc), cos(r_8truc);  remplace par math.h  Reza 29/11/99 */ | 
|---|
| [459] | 5207 |  | 
|---|
|  | 5208 | /* Local variables */ | 
|---|
| [756] | 5209 | static int_4 k; | 
|---|
|  | 5210 | extern /* Subroutine */ int dffti_(int_4 *, r_8 *); | 
|---|
|  | 5211 | static int_4 kc; | 
|---|
| [717] | 5212 | static r_8 fk, dt; | 
|---|
| [756] | 5213 | static int_4 nm1, np1, ns2; | 
|---|
| [459] | 5214 |  | 
|---|
|  | 5215 | /* Parameter adjustments */ | 
|---|
|  | 5216 | --wsave; | 
|---|
|  | 5217 |  | 
|---|
|  | 5218 | /* Function Body */ | 
|---|
|  | 5219 | if (*n <= 3) { | 
|---|
|  | 5220 | return 0; | 
|---|
|  | 5221 | } | 
|---|
|  | 5222 | nm1 = *n - 1; | 
|---|
|  | 5223 | np1 = *n + 1; | 
|---|
|  | 5224 | ns2 = *n / 2; | 
|---|
| [717] | 5225 | dt = pi / (r_8) nm1; | 
|---|
| [459] | 5226 | fk = 0.f; | 
|---|
|  | 5227 | i__1 = ns2; | 
|---|
|  | 5228 | for (k = 2; k <= i__1; ++k) { | 
|---|
|  | 5229 | kc = np1 - k; | 
|---|
|  | 5230 | fk += 1.f; | 
|---|
|  | 5231 | wsave[k] = sin(fk * dt) * 2.f; | 
|---|
|  | 5232 | wsave[kc] = cos(fk * dt) * 2.f; | 
|---|
|  | 5233 | /* L101: */ | 
|---|
|  | 5234 | } | 
|---|
|  | 5235 | dffti_(&nm1, &wsave[*n + 1]); | 
|---|
|  | 5236 | return 0; | 
|---|
|  | 5237 | } /* dcosti_ */ | 
|---|
|  | 5238 |  | 
|---|
|  | 5239 | /*  ------ File dezfft1.f ------ */ | 
|---|
| [756] | 5240 | /* Subroutine */ int dezfft1_(int_4 *n, r_8 *wa, int_8 *ifac) | 
|---|
| [459] | 5241 | { | 
|---|
|  | 5242 | /* Initialized data */ | 
|---|
|  | 5243 |  | 
|---|
| [756] | 5244 | static int_4 ntryh[4] = { 4,2,3,5 }; | 
|---|
| [717] | 5245 | static r_8 tpi = 6.28318530717959f; | 
|---|
| [459] | 5246 |  | 
|---|
|  | 5247 | /* System generated locals */ | 
|---|
| [756] | 5248 | int_4 i__1, i__2, i__3; | 
|---|
| [459] | 5249 |  | 
|---|
|  | 5250 | /* Builtin functions */ | 
|---|
| [717] | 5251 | /*    r_8 cos(r_8truc), sin(r_8truc);  remplace par math.h  Reza 29/11/99  */ | 
|---|
| [459] | 5252 |  | 
|---|
|  | 5253 | /* Local variables */ | 
|---|
| [717] | 5254 | static r_8 argh; | 
|---|
| [756] | 5255 | static int_4 ntry, i__, j, k1, l1, l2, ib, ii, nf, ip, nl, is, nq, nr; | 
|---|
| [717] | 5256 | static r_8 ch1, sh1; | 
|---|
| [756] | 5257 | static int_4 ido, ipm; | 
|---|
| [717] | 5258 | static r_8 dch1, ch1h, arg1, dsh1; | 
|---|
| [756] | 5259 | static int_4 nfm1; | 
|---|
| [459] | 5260 |  | 
|---|
|  | 5261 | /* Parameter adjustments */ | 
|---|
|  | 5262 | --ifac; | 
|---|
|  | 5263 | --wa; | 
|---|
|  | 5264 |  | 
|---|
|  | 5265 | /* Function Body */ | 
|---|
|  | 5266 | nl = *n; | 
|---|
|  | 5267 | nf = 0; | 
|---|
|  | 5268 | j = 0; | 
|---|
|  | 5269 | L101: | 
|---|
|  | 5270 | ++j; | 
|---|
|  | 5271 | if (j - 4 <= 0) { | 
|---|
|  | 5272 | goto L102; | 
|---|
|  | 5273 | } else { | 
|---|
|  | 5274 | goto L103; | 
|---|
|  | 5275 | } | 
|---|
|  | 5276 | L102: | 
|---|
|  | 5277 | ntry = ntryh[j - 1]; | 
|---|
|  | 5278 | goto L104; | 
|---|
|  | 5279 | L103: | 
|---|
|  | 5280 | ntry += 2; | 
|---|
|  | 5281 | L104: | 
|---|
|  | 5282 | nq = nl / ntry; | 
|---|
|  | 5283 | nr = nl - ntry * nq; | 
|---|
|  | 5284 | if (nr != 0) { | 
|---|
|  | 5285 | goto L101; | 
|---|
|  | 5286 | } else { | 
|---|
|  | 5287 | goto L105; | 
|---|
|  | 5288 | } | 
|---|
|  | 5289 | L105: | 
|---|
|  | 5290 | ++nf; | 
|---|
|  | 5291 | ifac[nf + 2] = ntry; | 
|---|
|  | 5292 | nl = nq; | 
|---|
|  | 5293 | if (ntry != 2) { | 
|---|
|  | 5294 | goto L107; | 
|---|
|  | 5295 | } | 
|---|
|  | 5296 | if (nf == 1) { | 
|---|
|  | 5297 | goto L107; | 
|---|
|  | 5298 | } | 
|---|
|  | 5299 | i__1 = nf; | 
|---|
|  | 5300 | for (i__ = 2; i__ <= i__1; ++i__) { | 
|---|
|  | 5301 | ib = nf - i__ + 2; | 
|---|
|  | 5302 | ifac[ib + 2] = ifac[ib + 1]; | 
|---|
|  | 5303 | /* L106: */ | 
|---|
|  | 5304 | } | 
|---|
|  | 5305 | ifac[3] = 2; | 
|---|
|  | 5306 | L107: | 
|---|
|  | 5307 | if (nl != 1) { | 
|---|
|  | 5308 | goto L104; | 
|---|
|  | 5309 | } | 
|---|
|  | 5310 | ifac[1] = *n; | 
|---|
|  | 5311 | ifac[2] = nf; | 
|---|
| [717] | 5312 | argh = tpi / (r_8) (*n); | 
|---|
| [459] | 5313 | is = 0; | 
|---|
|  | 5314 | nfm1 = nf - 1; | 
|---|
|  | 5315 | l1 = 1; | 
|---|
|  | 5316 | if (nfm1 == 0) { | 
|---|
|  | 5317 | return 0; | 
|---|
|  | 5318 | } | 
|---|
|  | 5319 | i__1 = nfm1; | 
|---|
|  | 5320 | for (k1 = 1; k1 <= i__1; ++k1) { | 
|---|
|  | 5321 | ip = ifac[k1 + 2]; | 
|---|
|  | 5322 | l2 = l1 * ip; | 
|---|
|  | 5323 | ido = *n / l2; | 
|---|
|  | 5324 | ipm = ip - 1; | 
|---|
| [717] | 5325 | arg1 = (r_8) l1 * argh; | 
|---|
| [459] | 5326 | ch1 = 1.f; | 
|---|
|  | 5327 | sh1 = 0.f; | 
|---|
|  | 5328 | dch1 = cos(arg1); | 
|---|
|  | 5329 | dsh1 = sin(arg1); | 
|---|
|  | 5330 | i__2 = ipm; | 
|---|
|  | 5331 | for (j = 1; j <= i__2; ++j) { | 
|---|
|  | 5332 | ch1h = dch1 * ch1 - dsh1 * sh1; | 
|---|
|  | 5333 | sh1 = dch1 * sh1 + dsh1 * ch1; | 
|---|
|  | 5334 | ch1 = ch1h; | 
|---|
|  | 5335 | i__ = is + 2; | 
|---|
|  | 5336 | wa[i__ - 1] = ch1; | 
|---|
|  | 5337 | wa[i__] = sh1; | 
|---|
|  | 5338 | if (ido < 5) { | 
|---|
|  | 5339 | goto L109; | 
|---|
|  | 5340 | } | 
|---|
|  | 5341 | i__3 = ido; | 
|---|
|  | 5342 | for (ii = 5; ii <= i__3; ii += 2) { | 
|---|
|  | 5343 | i__ += 2; | 
|---|
|  | 5344 | wa[i__ - 1] = ch1 * wa[i__ - 3] - sh1 * wa[i__ - 2]; | 
|---|
|  | 5345 | wa[i__] = ch1 * wa[i__ - 2] + sh1 * wa[i__ - 3]; | 
|---|
|  | 5346 | /* L108: */ | 
|---|
|  | 5347 | } | 
|---|
|  | 5348 | L109: | 
|---|
|  | 5349 | is += ido; | 
|---|
|  | 5350 | /* L110: */ | 
|---|
|  | 5351 | } | 
|---|
|  | 5352 | l1 = l2; | 
|---|
|  | 5353 | /* L111: */ | 
|---|
|  | 5354 | } | 
|---|
|  | 5355 | return 0; | 
|---|
|  | 5356 | } /* dezfft1_ */ | 
|---|
|  | 5357 |  | 
|---|
|  | 5358 | /*  ------ File dezfftb.f ------ */ | 
|---|
| [756] | 5359 | /* Subroutine */ int dezfftb_(int_4 *n, r_8 *r__, r_8 *azero, r_8 *a, | 
|---|
| [717] | 5360 | r_8 *b, r_8 *wsave) | 
|---|
| [459] | 5361 | { | 
|---|
|  | 5362 | /* System generated locals */ | 
|---|
| [756] | 5363 | int_4 i__1; | 
|---|
| [459] | 5364 |  | 
|---|
|  | 5365 | /* Local variables */ | 
|---|
| [756] | 5366 | static int_4 i__; | 
|---|
|  | 5367 | extern /* Subroutine */ int dfftb_(int_4 *, r_8 *, r_8 *); | 
|---|
|  | 5368 | static int_4 ns2; | 
|---|
| [459] | 5369 |  | 
|---|
|  | 5370 | /* Parameter adjustments */ | 
|---|
|  | 5371 | --wsave; | 
|---|
|  | 5372 | --b; | 
|---|
|  | 5373 | --a; | 
|---|
|  | 5374 | --r__; | 
|---|
|  | 5375 |  | 
|---|
|  | 5376 | /* Function Body */ | 
|---|
|  | 5377 | if ((i__1 = *n - 2) < 0) { | 
|---|
|  | 5378 | goto L101; | 
|---|
|  | 5379 | } else if (i__1 == 0) { | 
|---|
|  | 5380 | goto L102; | 
|---|
|  | 5381 | } else { | 
|---|
|  | 5382 | goto L103; | 
|---|
|  | 5383 | } | 
|---|
|  | 5384 | L101: | 
|---|
|  | 5385 | r__[1] = *azero; | 
|---|
|  | 5386 | return 0; | 
|---|
|  | 5387 | L102: | 
|---|
|  | 5388 | r__[1] = *azero + a[1]; | 
|---|
|  | 5389 | r__[2] = *azero - a[1]; | 
|---|
|  | 5390 | return 0; | 
|---|
|  | 5391 | L103: | 
|---|
|  | 5392 | ns2 = (*n - 1) / 2; | 
|---|
|  | 5393 | i__1 = ns2; | 
|---|
|  | 5394 | for (i__ = 1; i__ <= i__1; ++i__) { | 
|---|
|  | 5395 | r__[i__ * 2] = a[i__] * .5f; | 
|---|
|  | 5396 | r__[(i__ << 1) + 1] = b[i__] * -.5f; | 
|---|
|  | 5397 | /* L104: */ | 
|---|
|  | 5398 | } | 
|---|
|  | 5399 | r__[1] = *azero; | 
|---|
|  | 5400 | if (*n % 2 == 0) { | 
|---|
|  | 5401 | r__[*n] = a[ns2 + 1]; | 
|---|
|  | 5402 | } | 
|---|
|  | 5403 | dfftb_(n, &r__[1], &wsave[*n + 1]); | 
|---|
|  | 5404 | return 0; | 
|---|
|  | 5405 | } /* dezfftb_ */ | 
|---|
|  | 5406 |  | 
|---|
|  | 5407 | /*  ------ File dezfftf.f ------ */ | 
|---|
| [756] | 5408 | /* Subroutine */ int dezfftf_(int_4 *n, r_8 *r__, r_8 *azero, r_8 *a, | 
|---|
| [717] | 5409 | r_8 *b, r_8 *wsave) | 
|---|
| [459] | 5410 | { | 
|---|
|  | 5411 | /* System generated locals */ | 
|---|
| [756] | 5412 | int_4 i__1; | 
|---|
| [459] | 5413 |  | 
|---|
|  | 5414 | /* Local variables */ | 
|---|
| [756] | 5415 | static int_4 i__; | 
|---|
|  | 5416 | extern /* Subroutine */ int dfftf_(int_4 *, r_8 *, r_8 *); | 
|---|
| [717] | 5417 | static r_8 cf; | 
|---|
| [756] | 5418 | static int_4 ns2; | 
|---|
| [717] | 5419 | static r_8 cfm; | 
|---|
| [756] | 5420 | static int_4 ns2m; | 
|---|
| [459] | 5421 |  | 
|---|
|  | 5422 |  | 
|---|
|  | 5423 | /*                       VERSION 3  JUNE 1979 */ | 
|---|
|  | 5424 |  | 
|---|
|  | 5425 | /* Parameter adjustments */ | 
|---|
|  | 5426 | --wsave; | 
|---|
|  | 5427 | --b; | 
|---|
|  | 5428 | --a; | 
|---|
|  | 5429 | --r__; | 
|---|
|  | 5430 |  | 
|---|
|  | 5431 | /* Function Body */ | 
|---|
|  | 5432 | if ((i__1 = *n - 2) < 0) { | 
|---|
|  | 5433 | goto L101; | 
|---|
|  | 5434 | } else if (i__1 == 0) { | 
|---|
|  | 5435 | goto L102; | 
|---|
|  | 5436 | } else { | 
|---|
|  | 5437 | goto L103; | 
|---|
|  | 5438 | } | 
|---|
|  | 5439 | L101: | 
|---|
|  | 5440 | *azero = r__[1]; | 
|---|
|  | 5441 | return 0; | 
|---|
|  | 5442 | L102: | 
|---|
|  | 5443 | *azero = (r__[1] + r__[2]) * .5f; | 
|---|
|  | 5444 | a[1] = (r__[1] - r__[2]) * .5f; | 
|---|
|  | 5445 | return 0; | 
|---|
|  | 5446 | L103: | 
|---|
|  | 5447 | i__1 = *n; | 
|---|
|  | 5448 | for (i__ = 1; i__ <= i__1; ++i__) { | 
|---|
|  | 5449 | wsave[i__] = r__[i__]; | 
|---|
|  | 5450 | /* L104: */ | 
|---|
|  | 5451 | } | 
|---|
|  | 5452 | dfftf_(n, &wsave[1], &wsave[*n + 1]); | 
|---|
| [717] | 5453 | cf = 2.f / (r_8) (*n); | 
|---|
| [459] | 5454 | cfm = -cf; | 
|---|
|  | 5455 | *azero = cf * .5f * wsave[1]; | 
|---|
|  | 5456 | ns2 = (*n + 1) / 2; | 
|---|
|  | 5457 | ns2m = ns2 - 1; | 
|---|
|  | 5458 | i__1 = ns2m; | 
|---|
|  | 5459 | for (i__ = 1; i__ <= i__1; ++i__) { | 
|---|
|  | 5460 | a[i__] = cf * wsave[i__ * 2]; | 
|---|
|  | 5461 | b[i__] = cfm * wsave[(i__ << 1) + 1]; | 
|---|
|  | 5462 | /* L105: */ | 
|---|
|  | 5463 | } | 
|---|
|  | 5464 | if (*n % 2 == 1) { | 
|---|
|  | 5465 | return 0; | 
|---|
|  | 5466 | } | 
|---|
|  | 5467 | a[ns2] = cf * .5f * wsave[*n]; | 
|---|
|  | 5468 | b[ns2] = 0.f; | 
|---|
|  | 5469 | return 0; | 
|---|
|  | 5470 | } /* dezfftf_ */ | 
|---|
|  | 5471 |  | 
|---|
|  | 5472 | /*  ------ File dezffti.f ------ */ | 
|---|
| [756] | 5473 | /* Subroutine */ int dezffti_(int_4 *n, r_8 *wsave) | 
|---|
| [459] | 5474 | { | 
|---|
| [756] | 5475 | extern /* Subroutine */ int dezfft1_(int_4 *, r_8 *, int_8 *); | 
|---|
| [459] | 5476 |  | 
|---|
|  | 5477 | /* Parameter adjustments */ | 
|---|
|  | 5478 | --wsave; | 
|---|
|  | 5479 |  | 
|---|
|  | 5480 | /* Function Body */ | 
|---|
|  | 5481 | if (*n == 1) { | 
|---|
|  | 5482 | return 0; | 
|---|
|  | 5483 | } | 
|---|
| [717] | 5484 | dezfft1_(n, &wsave[(*n << 1) + 1], (int_8 *)&wsave[*n * 3 + 1]); | 
|---|
| [459] | 5485 | return 0; | 
|---|
|  | 5486 | } /* dezffti_ */ | 
|---|
|  | 5487 |  | 
|---|
|  | 5488 | /*  ------ File dpassb.f ------ */ | 
|---|
| [756] | 5489 | /* Subroutine */ int dpassb_(int_4 *nac, int_4 *ido, int_4 *ip, int_4 * | 
|---|
|  | 5490 | l1, int_4 *idl1, r_8 *cc, r_8 *c1, r_8 *c2, r_8 *ch, r_8 *ch2, | 
|---|
| [717] | 5491 | r_8 *wa) | 
|---|
| [459] | 5492 | { | 
|---|
|  | 5493 | /* System generated locals */ | 
|---|
| [756] | 5494 | int_4 ch_dim1, ch_dim2, ch_offset, cc_dim1, cc_dim2, cc_offset, c1_dim1, | 
|---|
| [459] | 5495 | c1_dim2, c1_offset, c2_dim1, c2_offset, ch2_dim1, ch2_offset, | 
|---|
|  | 5496 | i__1, i__2, i__3; | 
|---|
|  | 5497 |  | 
|---|
|  | 5498 | /* Local variables */ | 
|---|
| [756] | 5499 | static int_4 idij, idlj, idot, ipph, i__, j, k, l, jc, lc, ik, nt, idj, | 
|---|
| [459] | 5500 | idl, inc, idp; | 
|---|
| [717] | 5501 | static r_8 wai, war; | 
|---|
| [756] | 5502 | static int_4 ipp2; | 
|---|
| [459] | 5503 |  | 
|---|
|  | 5504 | /* Parameter adjustments */ | 
|---|
|  | 5505 | ch_dim1 = *ido; | 
|---|
|  | 5506 | ch_dim2 = *l1; | 
|---|
|  | 5507 | ch_offset = ch_dim1 * (ch_dim2 + 1) + 1; | 
|---|
|  | 5508 | ch -= ch_offset; | 
|---|
|  | 5509 | c1_dim1 = *ido; | 
|---|
|  | 5510 | c1_dim2 = *l1; | 
|---|
|  | 5511 | c1_offset = c1_dim1 * (c1_dim2 + 1) + 1; | 
|---|
|  | 5512 | c1 -= c1_offset; | 
|---|
|  | 5513 | cc_dim1 = *ido; | 
|---|
|  | 5514 | cc_dim2 = *ip; | 
|---|
|  | 5515 | cc_offset = cc_dim1 * (cc_dim2 + 1) + 1; | 
|---|
|  | 5516 | cc -= cc_offset; | 
|---|
|  | 5517 | ch2_dim1 = *idl1; | 
|---|
|  | 5518 | ch2_offset = ch2_dim1 + 1; | 
|---|
|  | 5519 | ch2 -= ch2_offset; | 
|---|
|  | 5520 | c2_dim1 = *idl1; | 
|---|
|  | 5521 | c2_offset = c2_dim1 + 1; | 
|---|
|  | 5522 | c2 -= c2_offset; | 
|---|
|  | 5523 | --wa; | 
|---|
|  | 5524 |  | 
|---|
|  | 5525 | /* Function Body */ | 
|---|
|  | 5526 | idot = *ido / 2; | 
|---|
|  | 5527 | nt = *ip * *idl1; | 
|---|
|  | 5528 | ipp2 = *ip + 2; | 
|---|
|  | 5529 | ipph = (*ip + 1) / 2; | 
|---|
|  | 5530 | idp = *ip * *ido; | 
|---|
|  | 5531 |  | 
|---|
|  | 5532 | if (*ido < *l1) { | 
|---|
|  | 5533 | goto L106; | 
|---|
|  | 5534 | } | 
|---|
|  | 5535 | i__1 = ipph; | 
|---|
|  | 5536 | for (j = 2; j <= i__1; ++j) { | 
|---|
|  | 5537 | jc = ipp2 - j; | 
|---|
|  | 5538 | i__2 = *l1; | 
|---|
|  | 5539 | for (k = 1; k <= i__2; ++k) { | 
|---|
|  | 5540 | i__3 = *ido; | 
|---|
|  | 5541 | for (i__ = 1; i__ <= i__3; ++i__) { | 
|---|
|  | 5542 | ch[i__ + (k + j * ch_dim2) * ch_dim1] = cc[i__ + (j + k * | 
|---|
|  | 5543 | cc_dim2) * cc_dim1] + cc[i__ + (jc + k * cc_dim2) * | 
|---|
|  | 5544 | cc_dim1]; | 
|---|
|  | 5545 | ch[i__ + (k + jc * ch_dim2) * ch_dim1] = cc[i__ + (j + k * | 
|---|
|  | 5546 | cc_dim2) * cc_dim1] - cc[i__ + (jc + k * cc_dim2) * | 
|---|
|  | 5547 | cc_dim1]; | 
|---|
|  | 5548 | /* L101: */ | 
|---|
|  | 5549 | } | 
|---|
|  | 5550 | /* L102: */ | 
|---|
|  | 5551 | } | 
|---|
|  | 5552 | /* L103: */ | 
|---|
|  | 5553 | } | 
|---|
|  | 5554 | i__1 = *l1; | 
|---|
|  | 5555 | for (k = 1; k <= i__1; ++k) { | 
|---|
|  | 5556 | i__2 = *ido; | 
|---|
|  | 5557 | for (i__ = 1; i__ <= i__2; ++i__) { | 
|---|
|  | 5558 | ch[i__ + (k + ch_dim2) * ch_dim1] = cc[i__ + (k * cc_dim2 + 1) * | 
|---|
|  | 5559 | cc_dim1]; | 
|---|
|  | 5560 | /* L104: */ | 
|---|
|  | 5561 | } | 
|---|
|  | 5562 | /* L105: */ | 
|---|
|  | 5563 | } | 
|---|
|  | 5564 | goto L112; | 
|---|
|  | 5565 | L106: | 
|---|
|  | 5566 | i__1 = ipph; | 
|---|
|  | 5567 | for (j = 2; j <= i__1; ++j) { | 
|---|
|  | 5568 | jc = ipp2 - j; | 
|---|
|  | 5569 | i__2 = *ido; | 
|---|
|  | 5570 | for (i__ = 1; i__ <= i__2; ++i__) { | 
|---|
|  | 5571 | i__3 = *l1; | 
|---|
|  | 5572 | for (k = 1; k <= i__3; ++k) { | 
|---|
|  | 5573 | ch[i__ + (k + j * ch_dim2) * ch_dim1] = cc[i__ + (j + k * | 
|---|
|  | 5574 | cc_dim2) * cc_dim1] + cc[i__ + (jc + k * cc_dim2) * | 
|---|
|  | 5575 | cc_dim1]; | 
|---|
|  | 5576 | ch[i__ + (k + jc * ch_dim2) * ch_dim1] = cc[i__ + (j + k * | 
|---|
|  | 5577 | cc_dim2) * cc_dim1] - cc[i__ + (jc + k * cc_dim2) * | 
|---|
|  | 5578 | cc_dim1]; | 
|---|
|  | 5579 | /* L107: */ | 
|---|
|  | 5580 | } | 
|---|
|  | 5581 | /* L108: */ | 
|---|
|  | 5582 | } | 
|---|
|  | 5583 | /* L109: */ | 
|---|
|  | 5584 | } | 
|---|
|  | 5585 | i__1 = *ido; | 
|---|
|  | 5586 | for (i__ = 1; i__ <= i__1; ++i__) { | 
|---|
|  | 5587 | i__2 = *l1; | 
|---|
|  | 5588 | for (k = 1; k <= i__2; ++k) { | 
|---|
|  | 5589 | ch[i__ + (k + ch_dim2) * ch_dim1] = cc[i__ + (k * cc_dim2 + 1) * | 
|---|
|  | 5590 | cc_dim1]; | 
|---|
|  | 5591 | /* L110: */ | 
|---|
|  | 5592 | } | 
|---|
|  | 5593 | /* L111: */ | 
|---|
|  | 5594 | } | 
|---|
|  | 5595 | L112: | 
|---|
|  | 5596 | idl = 2 - *ido; | 
|---|
|  | 5597 | inc = 0; | 
|---|
|  | 5598 | i__1 = ipph; | 
|---|
|  | 5599 | for (l = 2; l <= i__1; ++l) { | 
|---|
|  | 5600 | lc = ipp2 - l; | 
|---|
|  | 5601 | idl += *ido; | 
|---|
|  | 5602 | i__2 = *idl1; | 
|---|
|  | 5603 | for (ik = 1; ik <= i__2; ++ik) { | 
|---|
|  | 5604 | c2[ik + l * c2_dim1] = ch2[ik + ch2_dim1] + wa[idl - 1] * ch2[ik | 
|---|
|  | 5605 | + (ch2_dim1 << 1)]; | 
|---|
|  | 5606 | c2[ik + lc * c2_dim1] = wa[idl] * ch2[ik + *ip * ch2_dim1]; | 
|---|
|  | 5607 | /* L113: */ | 
|---|
|  | 5608 | } | 
|---|
|  | 5609 | idlj = idl; | 
|---|
|  | 5610 | inc += *ido; | 
|---|
|  | 5611 | i__2 = ipph; | 
|---|
|  | 5612 | for (j = 3; j <= i__2; ++j) { | 
|---|
|  | 5613 | jc = ipp2 - j; | 
|---|
|  | 5614 | idlj += inc; | 
|---|
|  | 5615 | if (idlj > idp) { | 
|---|
|  | 5616 | idlj -= idp; | 
|---|
|  | 5617 | } | 
|---|
|  | 5618 | war = wa[idlj - 1]; | 
|---|
|  | 5619 | wai = wa[idlj]; | 
|---|
|  | 5620 | i__3 = *idl1; | 
|---|
|  | 5621 | for (ik = 1; ik <= i__3; ++ik) { | 
|---|
|  | 5622 | c2[ik + l * c2_dim1] += war * ch2[ik + j * ch2_dim1]; | 
|---|
|  | 5623 | c2[ik + lc * c2_dim1] += wai * ch2[ik + jc * ch2_dim1]; | 
|---|
|  | 5624 | /* L114: */ | 
|---|
|  | 5625 | } | 
|---|
|  | 5626 | /* L115: */ | 
|---|
|  | 5627 | } | 
|---|
|  | 5628 | /* L116: */ | 
|---|
|  | 5629 | } | 
|---|
|  | 5630 | i__1 = ipph; | 
|---|
|  | 5631 | for (j = 2; j <= i__1; ++j) { | 
|---|
|  | 5632 | i__2 = *idl1; | 
|---|
|  | 5633 | for (ik = 1; ik <= i__2; ++ik) { | 
|---|
|  | 5634 | ch2[ik + ch2_dim1] += ch2[ik + j * ch2_dim1]; | 
|---|
|  | 5635 | /* L117: */ | 
|---|
|  | 5636 | } | 
|---|
|  | 5637 | /* L118: */ | 
|---|
|  | 5638 | } | 
|---|
|  | 5639 | i__1 = ipph; | 
|---|
|  | 5640 | for (j = 2; j <= i__1; ++j) { | 
|---|
|  | 5641 | jc = ipp2 - j; | 
|---|
|  | 5642 | i__2 = *idl1; | 
|---|
|  | 5643 | for (ik = 2; ik <= i__2; ik += 2) { | 
|---|
|  | 5644 | ch2[ik - 1 + j * ch2_dim1] = c2[ik - 1 + j * c2_dim1] - c2[ik + | 
|---|
|  | 5645 | jc * c2_dim1]; | 
|---|
|  | 5646 | ch2[ik - 1 + jc * ch2_dim1] = c2[ik - 1 + j * c2_dim1] + c2[ik + | 
|---|
|  | 5647 | jc * c2_dim1]; | 
|---|
|  | 5648 | ch2[ik + j * ch2_dim1] = c2[ik + j * c2_dim1] + c2[ik - 1 + jc * | 
|---|
|  | 5649 | c2_dim1]; | 
|---|
|  | 5650 | ch2[ik + jc * ch2_dim1] = c2[ik + j * c2_dim1] - c2[ik - 1 + jc * | 
|---|
|  | 5651 | c2_dim1]; | 
|---|
|  | 5652 | /* L119: */ | 
|---|
|  | 5653 | } | 
|---|
|  | 5654 | /* L120: */ | 
|---|
|  | 5655 | } | 
|---|
|  | 5656 | *nac = 1; | 
|---|
|  | 5657 | if (*ido == 2) { | 
|---|
|  | 5658 | return 0; | 
|---|
|  | 5659 | } | 
|---|
|  | 5660 | *nac = 0; | 
|---|
|  | 5661 | i__1 = *idl1; | 
|---|
|  | 5662 | for (ik = 1; ik <= i__1; ++ik) { | 
|---|
|  | 5663 | c2[ik + c2_dim1] = ch2[ik + ch2_dim1]; | 
|---|
|  | 5664 | /* L121: */ | 
|---|
|  | 5665 | } | 
|---|
|  | 5666 | i__1 = *ip; | 
|---|
|  | 5667 | for (j = 2; j <= i__1; ++j) { | 
|---|
|  | 5668 | i__2 = *l1; | 
|---|
|  | 5669 | for (k = 1; k <= i__2; ++k) { | 
|---|
|  | 5670 | c1[(k + j * c1_dim2) * c1_dim1 + 1] = ch[(k + j * ch_dim2) * | 
|---|
|  | 5671 | ch_dim1 + 1]; | 
|---|
|  | 5672 | c1[(k + j * c1_dim2) * c1_dim1 + 2] = ch[(k + j * ch_dim2) * | 
|---|
|  | 5673 | ch_dim1 + 2]; | 
|---|
|  | 5674 | /* L122: */ | 
|---|
|  | 5675 | } | 
|---|
|  | 5676 | /* L123: */ | 
|---|
|  | 5677 | } | 
|---|
|  | 5678 | if (idot > *l1) { | 
|---|
|  | 5679 | goto L127; | 
|---|
|  | 5680 | } | 
|---|
|  | 5681 | idij = 0; | 
|---|
|  | 5682 | i__1 = *ip; | 
|---|
|  | 5683 | for (j = 2; j <= i__1; ++j) { | 
|---|
|  | 5684 | idij += 2; | 
|---|
|  | 5685 | i__2 = *ido; | 
|---|
|  | 5686 | for (i__ = 4; i__ <= i__2; i__ += 2) { | 
|---|
|  | 5687 | idij += 2; | 
|---|
|  | 5688 | i__3 = *l1; | 
|---|
|  | 5689 | for (k = 1; k <= i__3; ++k) { | 
|---|
|  | 5690 | c1[i__ - 1 + (k + j * c1_dim2) * c1_dim1] = wa[idij - 1] * ch[ | 
|---|
|  | 5691 | i__ - 1 + (k + j * ch_dim2) * ch_dim1] - wa[idij] * | 
|---|
|  | 5692 | ch[i__ + (k + j * ch_dim2) * ch_dim1]; | 
|---|
|  | 5693 | c1[i__ + (k + j * c1_dim2) * c1_dim1] = wa[idij - 1] * ch[i__ | 
|---|
|  | 5694 | + (k + j * ch_dim2) * ch_dim1] + wa[idij] * ch[i__ - | 
|---|
|  | 5695 | 1 + (k + j * ch_dim2) * ch_dim1]; | 
|---|
|  | 5696 | /* L124: */ | 
|---|
|  | 5697 | } | 
|---|
|  | 5698 | /* L125: */ | 
|---|
|  | 5699 | } | 
|---|
|  | 5700 | /* L126: */ | 
|---|
|  | 5701 | } | 
|---|
|  | 5702 | return 0; | 
|---|
|  | 5703 | L127: | 
|---|
|  | 5704 | idj = 2 - *ido; | 
|---|
|  | 5705 | i__1 = *ip; | 
|---|
|  | 5706 | for (j = 2; j <= i__1; ++j) { | 
|---|
|  | 5707 | idj += *ido; | 
|---|
|  | 5708 | i__2 = *l1; | 
|---|
|  | 5709 | for (k = 1; k <= i__2; ++k) { | 
|---|
|  | 5710 | idij = idj; | 
|---|
|  | 5711 | i__3 = *ido; | 
|---|
|  | 5712 | for (i__ = 4; i__ <= i__3; i__ += 2) { | 
|---|
|  | 5713 | idij += 2; | 
|---|
|  | 5714 | c1[i__ - 1 + (k + j * c1_dim2) * c1_dim1] = wa[idij - 1] * ch[ | 
|---|
|  | 5715 | i__ - 1 + (k + j * ch_dim2) * ch_dim1] - wa[idij] * | 
|---|
|  | 5716 | ch[i__ + (k + j * ch_dim2) * ch_dim1]; | 
|---|
|  | 5717 | c1[i__ + (k + j * c1_dim2) * c1_dim1] = wa[idij - 1] * ch[i__ | 
|---|
|  | 5718 | + (k + j * ch_dim2) * ch_dim1] + wa[idij] * ch[i__ - | 
|---|
|  | 5719 | 1 + (k + j * ch_dim2) * ch_dim1]; | 
|---|
|  | 5720 | /* L128: */ | 
|---|
|  | 5721 | } | 
|---|
|  | 5722 | /* L129: */ | 
|---|
|  | 5723 | } | 
|---|
|  | 5724 | /* L130: */ | 
|---|
|  | 5725 | } | 
|---|
|  | 5726 | return 0; | 
|---|
|  | 5727 | } /* dpassb_ */ | 
|---|
|  | 5728 |  | 
|---|
|  | 5729 | /*  ------ File dpassb2.f ------ */ | 
|---|
| [756] | 5730 | /* Subroutine */ int dpassb2_(int_4 *ido, int_4 *l1, r_8 *cc, r_8 *ch, | 
|---|
| [717] | 5731 | r_8 *wa1) | 
|---|
| [459] | 5732 | { | 
|---|
|  | 5733 | /* System generated locals */ | 
|---|
| [756] | 5734 | int_4 cc_dim1, cc_offset, ch_dim1, ch_dim2, ch_offset, i__1, i__2; | 
|---|
| [459] | 5735 |  | 
|---|
|  | 5736 | /* Local variables */ | 
|---|
| [756] | 5737 | static int_4 i__, k; | 
|---|
| [717] | 5738 | static r_8 ti2, tr2; | 
|---|
| [459] | 5739 |  | 
|---|
|  | 5740 | /* Parameter adjustments */ | 
|---|
|  | 5741 | ch_dim1 = *ido; | 
|---|
|  | 5742 | ch_dim2 = *l1; | 
|---|
|  | 5743 | ch_offset = ch_dim1 * (ch_dim2 + 1) + 1; | 
|---|
|  | 5744 | ch -= ch_offset; | 
|---|
|  | 5745 | cc_dim1 = *ido; | 
|---|
|  | 5746 | cc_offset = cc_dim1 * 3 + 1; | 
|---|
|  | 5747 | cc -= cc_offset; | 
|---|
|  | 5748 | --wa1; | 
|---|
|  | 5749 |  | 
|---|
|  | 5750 | /* Function Body */ | 
|---|
|  | 5751 | if (*ido > 2) { | 
|---|
|  | 5752 | goto L102; | 
|---|
|  | 5753 | } | 
|---|
|  | 5754 | i__1 = *l1; | 
|---|
|  | 5755 | for (k = 1; k <= i__1; ++k) { | 
|---|
|  | 5756 | ch[(k + ch_dim2) * ch_dim1 + 1] = cc[((k << 1) + 1) * cc_dim1 + 1] + | 
|---|
|  | 5757 | cc[((k << 1) + 2) * cc_dim1 + 1]; | 
|---|
|  | 5758 | ch[(k + (ch_dim2 << 1)) * ch_dim1 + 1] = cc[((k << 1) + 1) * cc_dim1 | 
|---|
|  | 5759 | + 1] - cc[((k << 1) + 2) * cc_dim1 + 1]; | 
|---|
|  | 5760 | ch[(k + ch_dim2) * ch_dim1 + 2] = cc[((k << 1) + 1) * cc_dim1 + 2] + | 
|---|
|  | 5761 | cc[((k << 1) + 2) * cc_dim1 + 2]; | 
|---|
|  | 5762 | ch[(k + (ch_dim2 << 1)) * ch_dim1 + 2] = cc[((k << 1) + 1) * cc_dim1 | 
|---|
|  | 5763 | + 2] - cc[((k << 1) + 2) * cc_dim1 + 2]; | 
|---|
|  | 5764 | /* L101: */ | 
|---|
|  | 5765 | } | 
|---|
|  | 5766 | return 0; | 
|---|
|  | 5767 | L102: | 
|---|
|  | 5768 | i__1 = *l1; | 
|---|
|  | 5769 | for (k = 1; k <= i__1; ++k) { | 
|---|
|  | 5770 | i__2 = *ido; | 
|---|
|  | 5771 | for (i__ = 2; i__ <= i__2; i__ += 2) { | 
|---|
|  | 5772 | ch[i__ - 1 + (k + ch_dim2) * ch_dim1] = cc[i__ - 1 + ((k << 1) + | 
|---|
|  | 5773 | 1) * cc_dim1] + cc[i__ - 1 + ((k << 1) + 2) * cc_dim1]; | 
|---|
|  | 5774 | tr2 = cc[i__ - 1 + ((k << 1) + 1) * cc_dim1] - cc[i__ - 1 + ((k << | 
|---|
|  | 5775 | 1) + 2) * cc_dim1]; | 
|---|
|  | 5776 | ch[i__ + (k + ch_dim2) * ch_dim1] = cc[i__ + ((k << 1) + 1) * | 
|---|
|  | 5777 | cc_dim1] + cc[i__ + ((k << 1) + 2) * cc_dim1]; | 
|---|
|  | 5778 | ti2 = cc[i__ + ((k << 1) + 1) * cc_dim1] - cc[i__ + ((k << 1) + 2) | 
|---|
|  | 5779 | * cc_dim1]; | 
|---|
|  | 5780 | ch[i__ + (k + (ch_dim2 << 1)) * ch_dim1] = wa1[i__ - 1] * ti2 + | 
|---|
|  | 5781 | wa1[i__] * tr2; | 
|---|
|  | 5782 | ch[i__ - 1 + (k + (ch_dim2 << 1)) * ch_dim1] = wa1[i__ - 1] * tr2 | 
|---|
|  | 5783 | - wa1[i__] * ti2; | 
|---|
|  | 5784 | /* L103: */ | 
|---|
|  | 5785 | } | 
|---|
|  | 5786 | /* L104: */ | 
|---|
|  | 5787 | } | 
|---|
|  | 5788 | return 0; | 
|---|
|  | 5789 | } /* dpassb2_ */ | 
|---|
|  | 5790 |  | 
|---|
|  | 5791 | /*  ------ File dpassb3.f ------ */ | 
|---|
| [756] | 5792 | /* Subroutine */ int dpassb3_(int_4 *ido, int_4 *l1, r_8 *cc, r_8 *ch, | 
|---|
| [717] | 5793 | r_8 *wa1, r_8 *wa2) | 
|---|
| [459] | 5794 | { | 
|---|
|  | 5795 | /* Initialized data */ | 
|---|
|  | 5796 |  | 
|---|
| [717] | 5797 | static r_8 taur = -.5f; | 
|---|
|  | 5798 | static r_8 taui = .866025403784439f; | 
|---|
| [459] | 5799 |  | 
|---|
|  | 5800 | /* System generated locals */ | 
|---|
| [756] | 5801 | int_4 cc_dim1, cc_offset, ch_dim1, ch_dim2, ch_offset, i__1, i__2; | 
|---|
| [459] | 5802 |  | 
|---|
|  | 5803 | /* Local variables */ | 
|---|
| [756] | 5804 | static int_4 i__, k; | 
|---|
| [717] | 5805 | static r_8 ci2, ci3, di2, di3, cr2, cr3, dr2, dr3, ti2, tr2; | 
|---|
| [459] | 5806 |  | 
|---|
|  | 5807 | /* Parameter adjustments */ | 
|---|
|  | 5808 | ch_dim1 = *ido; | 
|---|
|  | 5809 | ch_dim2 = *l1; | 
|---|
|  | 5810 | ch_offset = ch_dim1 * (ch_dim2 + 1) + 1; | 
|---|
|  | 5811 | ch -= ch_offset; | 
|---|
|  | 5812 | cc_dim1 = *ido; | 
|---|
|  | 5813 | cc_offset = (cc_dim1 << 2) + 1; | 
|---|
|  | 5814 | cc -= cc_offset; | 
|---|
|  | 5815 | --wa1; | 
|---|
|  | 5816 | --wa2; | 
|---|
|  | 5817 |  | 
|---|
|  | 5818 | /* Function Body */ | 
|---|
|  | 5819 | if (*ido != 2) { | 
|---|
|  | 5820 | goto L102; | 
|---|
|  | 5821 | } | 
|---|
|  | 5822 | i__1 = *l1; | 
|---|
|  | 5823 | for (k = 1; k <= i__1; ++k) { | 
|---|
|  | 5824 | tr2 = cc[(k * 3 + 2) * cc_dim1 + 1] + cc[(k * 3 + 3) * cc_dim1 + 1]; | 
|---|
|  | 5825 | cr2 = cc[(k * 3 + 1) * cc_dim1 + 1] + taur * tr2; | 
|---|
|  | 5826 | ch[(k + ch_dim2) * ch_dim1 + 1] = cc[(k * 3 + 1) * cc_dim1 + 1] + tr2; | 
|---|
|  | 5827 | ti2 = cc[(k * 3 + 2) * cc_dim1 + 2] + cc[(k * 3 + 3) * cc_dim1 + 2]; | 
|---|
|  | 5828 | ci2 = cc[(k * 3 + 1) * cc_dim1 + 2] + taur * ti2; | 
|---|
|  | 5829 | ch[(k + ch_dim2) * ch_dim1 + 2] = cc[(k * 3 + 1) * cc_dim1 + 2] + ti2; | 
|---|
|  | 5830 | cr3 = taui * (cc[(k * 3 + 2) * cc_dim1 + 1] - cc[(k * 3 + 3) * | 
|---|
|  | 5831 | cc_dim1 + 1]); | 
|---|
|  | 5832 | ci3 = taui * (cc[(k * 3 + 2) * cc_dim1 + 2] - cc[(k * 3 + 3) * | 
|---|
|  | 5833 | cc_dim1 + 2]); | 
|---|
|  | 5834 | ch[(k + (ch_dim2 << 1)) * ch_dim1 + 1] = cr2 - ci3; | 
|---|
|  | 5835 | ch[(k + ch_dim2 * 3) * ch_dim1 + 1] = cr2 + ci3; | 
|---|
|  | 5836 | ch[(k + (ch_dim2 << 1)) * ch_dim1 + 2] = ci2 + cr3; | 
|---|
|  | 5837 | ch[(k + ch_dim2 * 3) * ch_dim1 + 2] = ci2 - cr3; | 
|---|
|  | 5838 | /* L101: */ | 
|---|
|  | 5839 | } | 
|---|
|  | 5840 | return 0; | 
|---|
|  | 5841 | L102: | 
|---|
|  | 5842 | i__1 = *l1; | 
|---|
|  | 5843 | for (k = 1; k <= i__1; ++k) { | 
|---|
|  | 5844 | i__2 = *ido; | 
|---|
|  | 5845 | for (i__ = 2; i__ <= i__2; i__ += 2) { | 
|---|
|  | 5846 | tr2 = cc[i__ - 1 + (k * 3 + 2) * cc_dim1] + cc[i__ - 1 + (k * 3 + | 
|---|
|  | 5847 | 3) * cc_dim1]; | 
|---|
|  | 5848 | cr2 = cc[i__ - 1 + (k * 3 + 1) * cc_dim1] + taur * tr2; | 
|---|
|  | 5849 | ch[i__ - 1 + (k + ch_dim2) * ch_dim1] = cc[i__ - 1 + (k * 3 + 1) * | 
|---|
|  | 5850 | cc_dim1] + tr2; | 
|---|
|  | 5851 | ti2 = cc[i__ + (k * 3 + 2) * cc_dim1] + cc[i__ + (k * 3 + 3) * | 
|---|
|  | 5852 | cc_dim1]; | 
|---|
|  | 5853 | ci2 = cc[i__ + (k * 3 + 1) * cc_dim1] + taur * ti2; | 
|---|
|  | 5854 | ch[i__ + (k + ch_dim2) * ch_dim1] = cc[i__ + (k * 3 + 1) * | 
|---|
|  | 5855 | cc_dim1] + ti2; | 
|---|
|  | 5856 | cr3 = taui * (cc[i__ - 1 + (k * 3 + 2) * cc_dim1] - cc[i__ - 1 + ( | 
|---|
|  | 5857 | k * 3 + 3) * cc_dim1]); | 
|---|
|  | 5858 | ci3 = taui * (cc[i__ + (k * 3 + 2) * cc_dim1] - cc[i__ + (k * 3 + | 
|---|
|  | 5859 | 3) * cc_dim1]); | 
|---|
|  | 5860 | dr2 = cr2 - ci3; | 
|---|
|  | 5861 | dr3 = cr2 + ci3; | 
|---|
|  | 5862 | di2 = ci2 + cr3; | 
|---|
|  | 5863 | di3 = ci2 - cr3; | 
|---|
|  | 5864 | ch[i__ + (k + (ch_dim2 << 1)) * ch_dim1] = wa1[i__ - 1] * di2 + | 
|---|
|  | 5865 | wa1[i__] * dr2; | 
|---|
|  | 5866 | ch[i__ - 1 + (k + (ch_dim2 << 1)) * ch_dim1] = wa1[i__ - 1] * dr2 | 
|---|
|  | 5867 | - wa1[i__] * di2; | 
|---|
|  | 5868 | ch[i__ + (k + ch_dim2 * 3) * ch_dim1] = wa2[i__ - 1] * di3 + wa2[ | 
|---|
|  | 5869 | i__] * dr3; | 
|---|
|  | 5870 | ch[i__ - 1 + (k + ch_dim2 * 3) * ch_dim1] = wa2[i__ - 1] * dr3 - | 
|---|
|  | 5871 | wa2[i__] * di3; | 
|---|
|  | 5872 | /* L103: */ | 
|---|
|  | 5873 | } | 
|---|
|  | 5874 | /* L104: */ | 
|---|
|  | 5875 | } | 
|---|
|  | 5876 | return 0; | 
|---|
|  | 5877 | } /* dpassb3_ */ | 
|---|
|  | 5878 |  | 
|---|
|  | 5879 | /*  ------ File dpassb4.f ------ */ | 
|---|
| [756] | 5880 | /* Subroutine */ int dpassb4_(int_4 *ido, int_4 *l1, r_8 *cc, r_8 *ch, | 
|---|
| [717] | 5881 | r_8 *wa1, r_8 *wa2, r_8 *wa3) | 
|---|
| [459] | 5882 | { | 
|---|
|  | 5883 | /* System generated locals */ | 
|---|
| [756] | 5884 | int_4 cc_dim1, cc_offset, ch_dim1, ch_dim2, ch_offset, i__1, i__2; | 
|---|
| [459] | 5885 |  | 
|---|
|  | 5886 | /* Local variables */ | 
|---|
| [756] | 5887 | static int_4 i__, k; | 
|---|
| [717] | 5888 | static r_8 ci2, ci3, ci4, cr2, cr3, cr4, ti1, ti2, ti3, ti4, tr1, tr2, | 
|---|
| [459] | 5889 | tr3, tr4; | 
|---|
|  | 5890 |  | 
|---|
|  | 5891 | /* Parameter adjustments */ | 
|---|
|  | 5892 | ch_dim1 = *ido; | 
|---|
|  | 5893 | ch_dim2 = *l1; | 
|---|
|  | 5894 | ch_offset = ch_dim1 * (ch_dim2 + 1) + 1; | 
|---|
|  | 5895 | ch -= ch_offset; | 
|---|
|  | 5896 | cc_dim1 = *ido; | 
|---|
|  | 5897 | cc_offset = cc_dim1 * 5 + 1; | 
|---|
|  | 5898 | cc -= cc_offset; | 
|---|
|  | 5899 | --wa1; | 
|---|
|  | 5900 | --wa2; | 
|---|
|  | 5901 | --wa3; | 
|---|
|  | 5902 |  | 
|---|
|  | 5903 | /* Function Body */ | 
|---|
|  | 5904 | if (*ido != 2) { | 
|---|
|  | 5905 | goto L102; | 
|---|
|  | 5906 | } | 
|---|
|  | 5907 | i__1 = *l1; | 
|---|
|  | 5908 | for (k = 1; k <= i__1; ++k) { | 
|---|
|  | 5909 | ti1 = cc[((k << 2) + 1) * cc_dim1 + 2] - cc[((k << 2) + 3) * cc_dim1 | 
|---|
|  | 5910 | + 2]; | 
|---|
|  | 5911 | ti2 = cc[((k << 2) + 1) * cc_dim1 + 2] + cc[((k << 2) + 3) * cc_dim1 | 
|---|
|  | 5912 | + 2]; | 
|---|
|  | 5913 | tr4 = cc[((k << 2) + 4) * cc_dim1 + 2] - cc[((k << 2) + 2) * cc_dim1 | 
|---|
|  | 5914 | + 2]; | 
|---|
|  | 5915 | ti3 = cc[((k << 2) + 2) * cc_dim1 + 2] + cc[((k << 2) + 4) * cc_dim1 | 
|---|
|  | 5916 | + 2]; | 
|---|
|  | 5917 | tr1 = cc[((k << 2) + 1) * cc_dim1 + 1] - cc[((k << 2) + 3) * cc_dim1 | 
|---|
|  | 5918 | + 1]; | 
|---|
|  | 5919 | tr2 = cc[((k << 2) + 1) * cc_dim1 + 1] + cc[((k << 2) + 3) * cc_dim1 | 
|---|
|  | 5920 | + 1]; | 
|---|
|  | 5921 | ti4 = cc[((k << 2) + 2) * cc_dim1 + 1] - cc[((k << 2) + 4) * cc_dim1 | 
|---|
|  | 5922 | + 1]; | 
|---|
|  | 5923 | tr3 = cc[((k << 2) + 2) * cc_dim1 + 1] + cc[((k << 2) + 4) * cc_dim1 | 
|---|
|  | 5924 | + 1]; | 
|---|
|  | 5925 | ch[(k + ch_dim2) * ch_dim1 + 1] = tr2 + tr3; | 
|---|
|  | 5926 | ch[(k + ch_dim2 * 3) * ch_dim1 + 1] = tr2 - tr3; | 
|---|
|  | 5927 | ch[(k + ch_dim2) * ch_dim1 + 2] = ti2 + ti3; | 
|---|
|  | 5928 | ch[(k + ch_dim2 * 3) * ch_dim1 + 2] = ti2 - ti3; | 
|---|
|  | 5929 | ch[(k + (ch_dim2 << 1)) * ch_dim1 + 1] = tr1 + tr4; | 
|---|
|  | 5930 | ch[(k + (ch_dim2 << 2)) * ch_dim1 + 1] = tr1 - tr4; | 
|---|
|  | 5931 | ch[(k + (ch_dim2 << 1)) * ch_dim1 + 2] = ti1 + ti4; | 
|---|
|  | 5932 | ch[(k + (ch_dim2 << 2)) * ch_dim1 + 2] = ti1 - ti4; | 
|---|
|  | 5933 | /* L101: */ | 
|---|
|  | 5934 | } | 
|---|
|  | 5935 | return 0; | 
|---|
|  | 5936 | L102: | 
|---|
|  | 5937 | i__1 = *l1; | 
|---|
|  | 5938 | for (k = 1; k <= i__1; ++k) { | 
|---|
|  | 5939 | i__2 = *ido; | 
|---|
|  | 5940 | for (i__ = 2; i__ <= i__2; i__ += 2) { | 
|---|
|  | 5941 | ti1 = cc[i__ + ((k << 2) + 1) * cc_dim1] - cc[i__ + ((k << 2) + 3) | 
|---|
|  | 5942 | * cc_dim1]; | 
|---|
|  | 5943 | ti2 = cc[i__ + ((k << 2) + 1) * cc_dim1] + cc[i__ + ((k << 2) + 3) | 
|---|
|  | 5944 | * cc_dim1]; | 
|---|
|  | 5945 | ti3 = cc[i__ + ((k << 2) + 2) * cc_dim1] + cc[i__ + ((k << 2) + 4) | 
|---|
|  | 5946 | * cc_dim1]; | 
|---|
|  | 5947 | tr4 = cc[i__ + ((k << 2) + 4) * cc_dim1] - cc[i__ + ((k << 2) + 2) | 
|---|
|  | 5948 | * cc_dim1]; | 
|---|
|  | 5949 | tr1 = cc[i__ - 1 + ((k << 2) + 1) * cc_dim1] - cc[i__ - 1 + ((k << | 
|---|
|  | 5950 | 2) + 3) * cc_dim1]; | 
|---|
|  | 5951 | tr2 = cc[i__ - 1 + ((k << 2) + 1) * cc_dim1] + cc[i__ - 1 + ((k << | 
|---|
|  | 5952 | 2) + 3) * cc_dim1]; | 
|---|
|  | 5953 | ti4 = cc[i__ - 1 + ((k << 2) + 2) * cc_dim1] - cc[i__ - 1 + ((k << | 
|---|
|  | 5954 | 2) + 4) * cc_dim1]; | 
|---|
|  | 5955 | tr3 = cc[i__ - 1 + ((k << 2) + 2) * cc_dim1] + cc[i__ - 1 + ((k << | 
|---|
|  | 5956 | 2) + 4) * cc_dim1]; | 
|---|
|  | 5957 | ch[i__ - 1 + (k + ch_dim2) * ch_dim1] = tr2 + tr3; | 
|---|
|  | 5958 | cr3 = tr2 - tr3; | 
|---|
|  | 5959 | ch[i__ + (k + ch_dim2) * ch_dim1] = ti2 + ti3; | 
|---|
|  | 5960 | ci3 = ti2 - ti3; | 
|---|
|  | 5961 | cr2 = tr1 + tr4; | 
|---|
|  | 5962 | cr4 = tr1 - tr4; | 
|---|
|  | 5963 | ci2 = ti1 + ti4; | 
|---|
|  | 5964 | ci4 = ti1 - ti4; | 
|---|
|  | 5965 | ch[i__ - 1 + (k + (ch_dim2 << 1)) * ch_dim1] = wa1[i__ - 1] * cr2 | 
|---|
|  | 5966 | - wa1[i__] * ci2; | 
|---|
|  | 5967 | ch[i__ + (k + (ch_dim2 << 1)) * ch_dim1] = wa1[i__ - 1] * ci2 + | 
|---|
|  | 5968 | wa1[i__] * cr2; | 
|---|
|  | 5969 | ch[i__ - 1 + (k + ch_dim2 * 3) * ch_dim1] = wa2[i__ - 1] * cr3 - | 
|---|
|  | 5970 | wa2[i__] * ci3; | 
|---|
|  | 5971 | ch[i__ + (k + ch_dim2 * 3) * ch_dim1] = wa2[i__ - 1] * ci3 + wa2[ | 
|---|
|  | 5972 | i__] * cr3; | 
|---|
|  | 5973 | ch[i__ - 1 + (k + (ch_dim2 << 2)) * ch_dim1] = wa3[i__ - 1] * cr4 | 
|---|
|  | 5974 | - wa3[i__] * ci4; | 
|---|
|  | 5975 | ch[i__ + (k + (ch_dim2 << 2)) * ch_dim1] = wa3[i__ - 1] * ci4 + | 
|---|
|  | 5976 | wa3[i__] * cr4; | 
|---|
|  | 5977 | /* L103: */ | 
|---|
|  | 5978 | } | 
|---|
|  | 5979 | /* L104: */ | 
|---|
|  | 5980 | } | 
|---|
|  | 5981 | return 0; | 
|---|
|  | 5982 | } /* dpassb4_ */ | 
|---|
|  | 5983 |  | 
|---|
|  | 5984 | /*  ------ File dpassb5.f ------ */ | 
|---|
| [756] | 5985 | /* Subroutine */ int dpassb5_(int_4 *ido, int_4 *l1, r_8 *cc, r_8 *ch, | 
|---|
| [717] | 5986 | r_8 *wa1, r_8 *wa2, r_8 *wa3, r_8 *wa4) | 
|---|
| [459] | 5987 | { | 
|---|
|  | 5988 | /* Initialized data */ | 
|---|
|  | 5989 |  | 
|---|
| [717] | 5990 | static r_8 tr11 = .309016994374947f; | 
|---|
|  | 5991 | static r_8 ti11 = .951056516295154f; | 
|---|
|  | 5992 | static r_8 tr12 = -.809016994374947f; | 
|---|
|  | 5993 | static r_8 ti12 = .587785252292473f; | 
|---|
| [459] | 5994 |  | 
|---|
|  | 5995 | /* System generated locals */ | 
|---|
| [756] | 5996 | int_4 cc_dim1, cc_offset, ch_dim1, ch_dim2, ch_offset, i__1, i__2; | 
|---|
| [459] | 5997 |  | 
|---|
|  | 5998 | /* Local variables */ | 
|---|
| [756] | 5999 | static int_4 i__, k; | 
|---|
| [717] | 6000 | static r_8 ci2, ci3, ci4, ci5, di3, di4, di5, di2, cr2, cr3, cr5, cr4, | 
|---|
| [459] | 6001 | ti2, ti3, ti4, ti5, dr3, dr4, dr5, dr2, tr2, tr3, tr4, tr5; | 
|---|
|  | 6002 |  | 
|---|
|  | 6003 | /* Parameter adjustments */ | 
|---|
|  | 6004 | ch_dim1 = *ido; | 
|---|
|  | 6005 | ch_dim2 = *l1; | 
|---|
|  | 6006 | ch_offset = ch_dim1 * (ch_dim2 + 1) + 1; | 
|---|
|  | 6007 | ch -= ch_offset; | 
|---|
|  | 6008 | cc_dim1 = *ido; | 
|---|
|  | 6009 | cc_offset = cc_dim1 * 6 + 1; | 
|---|
|  | 6010 | cc -= cc_offset; | 
|---|
|  | 6011 | --wa1; | 
|---|
|  | 6012 | --wa2; | 
|---|
|  | 6013 | --wa3; | 
|---|
|  | 6014 | --wa4; | 
|---|
|  | 6015 |  | 
|---|
|  | 6016 | /* Function Body */ | 
|---|
|  | 6017 | if (*ido != 2) { | 
|---|
|  | 6018 | goto L102; | 
|---|
|  | 6019 | } | 
|---|
|  | 6020 | i__1 = *l1; | 
|---|
|  | 6021 | for (k = 1; k <= i__1; ++k) { | 
|---|
|  | 6022 | ti5 = cc[(k * 5 + 2) * cc_dim1 + 2] - cc[(k * 5 + 5) * cc_dim1 + 2]; | 
|---|
|  | 6023 | ti2 = cc[(k * 5 + 2) * cc_dim1 + 2] + cc[(k * 5 + 5) * cc_dim1 + 2]; | 
|---|
|  | 6024 | ti4 = cc[(k * 5 + 3) * cc_dim1 + 2] - cc[(k * 5 + 4) * cc_dim1 + 2]; | 
|---|
|  | 6025 | ti3 = cc[(k * 5 + 3) * cc_dim1 + 2] + cc[(k * 5 + 4) * cc_dim1 + 2]; | 
|---|
|  | 6026 | tr5 = cc[(k * 5 + 2) * cc_dim1 + 1] - cc[(k * 5 + 5) * cc_dim1 + 1]; | 
|---|
|  | 6027 | tr2 = cc[(k * 5 + 2) * cc_dim1 + 1] + cc[(k * 5 + 5) * cc_dim1 + 1]; | 
|---|
|  | 6028 | tr4 = cc[(k * 5 + 3) * cc_dim1 + 1] - cc[(k * 5 + 4) * cc_dim1 + 1]; | 
|---|
|  | 6029 | tr3 = cc[(k * 5 + 3) * cc_dim1 + 1] + cc[(k * 5 + 4) * cc_dim1 + 1]; | 
|---|
|  | 6030 | ch[(k + ch_dim2) * ch_dim1 + 1] = cc[(k * 5 + 1) * cc_dim1 + 1] + tr2 | 
|---|
|  | 6031 | + tr3; | 
|---|
|  | 6032 | ch[(k + ch_dim2) * ch_dim1 + 2] = cc[(k * 5 + 1) * cc_dim1 + 2] + ti2 | 
|---|
|  | 6033 | + ti3; | 
|---|
|  | 6034 | cr2 = cc[(k * 5 + 1) * cc_dim1 + 1] + tr11 * tr2 + tr12 * tr3; | 
|---|
|  | 6035 | ci2 = cc[(k * 5 + 1) * cc_dim1 + 2] + tr11 * ti2 + tr12 * ti3; | 
|---|
|  | 6036 | cr3 = cc[(k * 5 + 1) * cc_dim1 + 1] + tr12 * tr2 + tr11 * tr3; | 
|---|
|  | 6037 | ci3 = cc[(k * 5 + 1) * cc_dim1 + 2] + tr12 * ti2 + tr11 * ti3; | 
|---|
|  | 6038 | cr5 = ti11 * tr5 + ti12 * tr4; | 
|---|
|  | 6039 | ci5 = ti11 * ti5 + ti12 * ti4; | 
|---|
|  | 6040 | cr4 = ti12 * tr5 - ti11 * tr4; | 
|---|
|  | 6041 | ci4 = ti12 * ti5 - ti11 * ti4; | 
|---|
|  | 6042 | ch[(k + (ch_dim2 << 1)) * ch_dim1 + 1] = cr2 - ci5; | 
|---|
|  | 6043 | ch[(k + ch_dim2 * 5) * ch_dim1 + 1] = cr2 + ci5; | 
|---|
|  | 6044 | ch[(k + (ch_dim2 << 1)) * ch_dim1 + 2] = ci2 + cr5; | 
|---|
|  | 6045 | ch[(k + ch_dim2 * 3) * ch_dim1 + 2] = ci3 + cr4; | 
|---|
|  | 6046 | ch[(k + ch_dim2 * 3) * ch_dim1 + 1] = cr3 - ci4; | 
|---|
|  | 6047 | ch[(k + (ch_dim2 << 2)) * ch_dim1 + 1] = cr3 + ci4; | 
|---|
|  | 6048 | ch[(k + (ch_dim2 << 2)) * ch_dim1 + 2] = ci3 - cr4; | 
|---|
|  | 6049 | ch[(k + ch_dim2 * 5) * ch_dim1 + 2] = ci2 - cr5; | 
|---|
|  | 6050 | /* L101: */ | 
|---|
|  | 6051 | } | 
|---|
|  | 6052 | return 0; | 
|---|
|  | 6053 | L102: | 
|---|
|  | 6054 | i__1 = *l1; | 
|---|
|  | 6055 | for (k = 1; k <= i__1; ++k) { | 
|---|
|  | 6056 | i__2 = *ido; | 
|---|
|  | 6057 | for (i__ = 2; i__ <= i__2; i__ += 2) { | 
|---|
|  | 6058 | ti5 = cc[i__ + (k * 5 + 2) * cc_dim1] - cc[i__ + (k * 5 + 5) * | 
|---|
|  | 6059 | cc_dim1]; | 
|---|
|  | 6060 | ti2 = cc[i__ + (k * 5 + 2) * cc_dim1] + cc[i__ + (k * 5 + 5) * | 
|---|
|  | 6061 | cc_dim1]; | 
|---|
|  | 6062 | ti4 = cc[i__ + (k * 5 + 3) * cc_dim1] - cc[i__ + (k * 5 + 4) * | 
|---|
|  | 6063 | cc_dim1]; | 
|---|
|  | 6064 | ti3 = cc[i__ + (k * 5 + 3) * cc_dim1] + cc[i__ + (k * 5 + 4) * | 
|---|
|  | 6065 | cc_dim1]; | 
|---|
|  | 6066 | tr5 = cc[i__ - 1 + (k * 5 + 2) * cc_dim1] - cc[i__ - 1 + (k * 5 + | 
|---|
|  | 6067 | 5) * cc_dim1]; | 
|---|
|  | 6068 | tr2 = cc[i__ - 1 + (k * 5 + 2) * cc_dim1] + cc[i__ - 1 + (k * 5 + | 
|---|
|  | 6069 | 5) * cc_dim1]; | 
|---|
|  | 6070 | tr4 = cc[i__ - 1 + (k * 5 + 3) * cc_dim1] - cc[i__ - 1 + (k * 5 + | 
|---|
|  | 6071 | 4) * cc_dim1]; | 
|---|
|  | 6072 | tr3 = cc[i__ - 1 + (k * 5 + 3) * cc_dim1] + cc[i__ - 1 + (k * 5 + | 
|---|
|  | 6073 | 4) * cc_dim1]; | 
|---|
|  | 6074 | ch[i__ - 1 + (k + ch_dim2) * ch_dim1] = cc[i__ - 1 + (k * 5 + 1) * | 
|---|
|  | 6075 | cc_dim1] + tr2 + tr3; | 
|---|
|  | 6076 | ch[i__ + (k + ch_dim2) * ch_dim1] = cc[i__ + (k * 5 + 1) * | 
|---|
|  | 6077 | cc_dim1] + ti2 + ti3; | 
|---|
|  | 6078 | cr2 = cc[i__ - 1 + (k * 5 + 1) * cc_dim1] + tr11 * tr2 + tr12 * | 
|---|
|  | 6079 | tr3; | 
|---|
|  | 6080 | ci2 = cc[i__ + (k * 5 + 1) * cc_dim1] + tr11 * ti2 + tr12 * ti3; | 
|---|
|  | 6081 | cr3 = cc[i__ - 1 + (k * 5 + 1) * cc_dim1] + tr12 * tr2 + tr11 * | 
|---|
|  | 6082 | tr3; | 
|---|
|  | 6083 | ci3 = cc[i__ + (k * 5 + 1) * cc_dim1] + tr12 * ti2 + tr11 * ti3; | 
|---|
|  | 6084 | cr5 = ti11 * tr5 + ti12 * tr4; | 
|---|
|  | 6085 | ci5 = ti11 * ti5 + ti12 * ti4; | 
|---|
|  | 6086 | cr4 = ti12 * tr5 - ti11 * tr4; | 
|---|
|  | 6087 | ci4 = ti12 * ti5 - ti11 * ti4; | 
|---|
|  | 6088 | dr3 = cr3 - ci4; | 
|---|
|  | 6089 | dr4 = cr3 + ci4; | 
|---|
|  | 6090 | di3 = ci3 + cr4; | 
|---|
|  | 6091 | di4 = ci3 - cr4; | 
|---|
|  | 6092 | dr5 = cr2 + ci5; | 
|---|
|  | 6093 | dr2 = cr2 - ci5; | 
|---|
|  | 6094 | di5 = ci2 - cr5; | 
|---|
|  | 6095 | di2 = ci2 + cr5; | 
|---|
|  | 6096 | ch[i__ - 1 + (k + (ch_dim2 << 1)) * ch_dim1] = wa1[i__ - 1] * dr2 | 
|---|
|  | 6097 | - wa1[i__] * di2; | 
|---|
|  | 6098 | ch[i__ + (k + (ch_dim2 << 1)) * ch_dim1] = wa1[i__ - 1] * di2 + | 
|---|
|  | 6099 | wa1[i__] * dr2; | 
|---|
|  | 6100 | ch[i__ - 1 + (k + ch_dim2 * 3) * ch_dim1] = wa2[i__ - 1] * dr3 - | 
|---|
|  | 6101 | wa2[i__] * di3; | 
|---|
|  | 6102 | ch[i__ + (k + ch_dim2 * 3) * ch_dim1] = wa2[i__ - 1] * di3 + wa2[ | 
|---|
|  | 6103 | i__] * dr3; | 
|---|
|  | 6104 | ch[i__ - 1 + (k + (ch_dim2 << 2)) * ch_dim1] = wa3[i__ - 1] * dr4 | 
|---|
|  | 6105 | - wa3[i__] * di4; | 
|---|
|  | 6106 | ch[i__ + (k + (ch_dim2 << 2)) * ch_dim1] = wa3[i__ - 1] * di4 + | 
|---|
|  | 6107 | wa3[i__] * dr4; | 
|---|
|  | 6108 | ch[i__ - 1 + (k + ch_dim2 * 5) * ch_dim1] = wa4[i__ - 1] * dr5 - | 
|---|
|  | 6109 | wa4[i__] * di5; | 
|---|
|  | 6110 | ch[i__ + (k + ch_dim2 * 5) * ch_dim1] = wa4[i__ - 1] * di5 + wa4[ | 
|---|
|  | 6111 | i__] * dr5; | 
|---|
|  | 6112 | /* L103: */ | 
|---|
|  | 6113 | } | 
|---|
|  | 6114 | /* L104: */ | 
|---|
|  | 6115 | } | 
|---|
|  | 6116 | return 0; | 
|---|
|  | 6117 | } /* dpassb5_ */ | 
|---|
|  | 6118 |  | 
|---|
|  | 6119 | /*  ------ File dpassf.f ------ */ | 
|---|
| [756] | 6120 | /* Subroutine */ int dpassf_(int_4 *nac, int_4 *ido, int_4 *ip, int_4 * | 
|---|
|  | 6121 | l1, int_4 *idl1, r_8 *cc, r_8 *c1, r_8 *c2, r_8 *ch, r_8 *ch2, | 
|---|
| [717] | 6122 | r_8 *wa) | 
|---|
| [459] | 6123 | { | 
|---|
|  | 6124 | /* System generated locals */ | 
|---|
| [756] | 6125 | int_4 ch_dim1, ch_dim2, ch_offset, cc_dim1, cc_dim2, cc_offset, c1_dim1, | 
|---|
| [459] | 6126 | c1_dim2, c1_offset, c2_dim1, c2_offset, ch2_dim1, ch2_offset, | 
|---|
|  | 6127 | i__1, i__2, i__3; | 
|---|
|  | 6128 |  | 
|---|
|  | 6129 | /* Local variables */ | 
|---|
| [756] | 6130 | static int_4 idij, idlj, idot, ipph, i__, j, k, l, jc, lc, ik, nt, idj, | 
|---|
| [459] | 6131 | idl, inc, idp; | 
|---|
| [717] | 6132 | static r_8 wai, war; | 
|---|
| [756] | 6133 | static int_4 ipp2; | 
|---|
| [459] | 6134 |  | 
|---|
|  | 6135 | /* Parameter adjustments */ | 
|---|
|  | 6136 | ch_dim1 = *ido; | 
|---|
|  | 6137 | ch_dim2 = *l1; | 
|---|
|  | 6138 | ch_offset = ch_dim1 * (ch_dim2 + 1) + 1; | 
|---|
|  | 6139 | ch -= ch_offset; | 
|---|
|  | 6140 | c1_dim1 = *ido; | 
|---|
|  | 6141 | c1_dim2 = *l1; | 
|---|
|  | 6142 | c1_offset = c1_dim1 * (c1_dim2 + 1) + 1; | 
|---|
|  | 6143 | c1 -= c1_offset; | 
|---|
|  | 6144 | cc_dim1 = *ido; | 
|---|
|  | 6145 | cc_dim2 = *ip; | 
|---|
|  | 6146 | cc_offset = cc_dim1 * (cc_dim2 + 1) + 1; | 
|---|
|  | 6147 | cc -= cc_offset; | 
|---|
|  | 6148 | ch2_dim1 = *idl1; | 
|---|
|  | 6149 | ch2_offset = ch2_dim1 + 1; | 
|---|
|  | 6150 | ch2 -= ch2_offset; | 
|---|
|  | 6151 | c2_dim1 = *idl1; | 
|---|
|  | 6152 | c2_offset = c2_dim1 + 1; | 
|---|
|  | 6153 | c2 -= c2_offset; | 
|---|
|  | 6154 | --wa; | 
|---|
|  | 6155 |  | 
|---|
|  | 6156 | /* Function Body */ | 
|---|
|  | 6157 | idot = *ido / 2; | 
|---|
|  | 6158 | nt = *ip * *idl1; | 
|---|
|  | 6159 | ipp2 = *ip + 2; | 
|---|
|  | 6160 | ipph = (*ip + 1) / 2; | 
|---|
|  | 6161 | idp = *ip * *ido; | 
|---|
|  | 6162 |  | 
|---|
|  | 6163 | if (*ido < *l1) { | 
|---|
|  | 6164 | goto L106; | 
|---|
|  | 6165 | } | 
|---|
|  | 6166 | i__1 = ipph; | 
|---|
|  | 6167 | for (j = 2; j <= i__1; ++j) { | 
|---|
|  | 6168 | jc = ipp2 - j; | 
|---|
|  | 6169 | i__2 = *l1; | 
|---|
|  | 6170 | for (k = 1; k <= i__2; ++k) { | 
|---|
|  | 6171 | i__3 = *ido; | 
|---|
|  | 6172 | for (i__ = 1; i__ <= i__3; ++i__) { | 
|---|
|  | 6173 | ch[i__ + (k + j * ch_dim2) * ch_dim1] = cc[i__ + (j + k * | 
|---|
|  | 6174 | cc_dim2) * cc_dim1] + cc[i__ + (jc + k * cc_dim2) * | 
|---|
|  | 6175 | cc_dim1]; | 
|---|
|  | 6176 | ch[i__ + (k + jc * ch_dim2) * ch_dim1] = cc[i__ + (j + k * | 
|---|
|  | 6177 | cc_dim2) * cc_dim1] - cc[i__ + (jc + k * cc_dim2) * | 
|---|
|  | 6178 | cc_dim1]; | 
|---|
|  | 6179 | /* L101: */ | 
|---|
|  | 6180 | } | 
|---|
|  | 6181 | /* L102: */ | 
|---|
|  | 6182 | } | 
|---|
|  | 6183 | /* L103: */ | 
|---|
|  | 6184 | } | 
|---|
|  | 6185 | i__1 = *l1; | 
|---|
|  | 6186 | for (k = 1; k <= i__1; ++k) { | 
|---|
|  | 6187 | i__2 = *ido; | 
|---|
|  | 6188 | for (i__ = 1; i__ <= i__2; ++i__) { | 
|---|
|  | 6189 | ch[i__ + (k + ch_dim2) * ch_dim1] = cc[i__ + (k * cc_dim2 + 1) * | 
|---|
|  | 6190 | cc_dim1]; | 
|---|
|  | 6191 | /* L104: */ | 
|---|
|  | 6192 | } | 
|---|
|  | 6193 | /* L105: */ | 
|---|
|  | 6194 | } | 
|---|
|  | 6195 | goto L112; | 
|---|
|  | 6196 | L106: | 
|---|
|  | 6197 | i__1 = ipph; | 
|---|
|  | 6198 | for (j = 2; j <= i__1; ++j) { | 
|---|
|  | 6199 | jc = ipp2 - j; | 
|---|
|  | 6200 | i__2 = *ido; | 
|---|
|  | 6201 | for (i__ = 1; i__ <= i__2; ++i__) { | 
|---|
|  | 6202 | i__3 = *l1; | 
|---|
|  | 6203 | for (k = 1; k <= i__3; ++k) { | 
|---|
|  | 6204 | ch[i__ + (k + j * ch_dim2) * ch_dim1] = cc[i__ + (j + k * | 
|---|
|  | 6205 | cc_dim2) * cc_dim1] + cc[i__ + (jc + k * cc_dim2) * | 
|---|
|  | 6206 | cc_dim1]; | 
|---|
|  | 6207 | ch[i__ + (k + jc * ch_dim2) * ch_dim1] = cc[i__ + (j + k * | 
|---|
|  | 6208 | cc_dim2) * cc_dim1] - cc[i__ + (jc + k * cc_dim2) * | 
|---|
|  | 6209 | cc_dim1]; | 
|---|
|  | 6210 | /* L107: */ | 
|---|
|  | 6211 | } | 
|---|
|  | 6212 | /* L108: */ | 
|---|
|  | 6213 | } | 
|---|
|  | 6214 | /* L109: */ | 
|---|
|  | 6215 | } | 
|---|
|  | 6216 | i__1 = *ido; | 
|---|
|  | 6217 | for (i__ = 1; i__ <= i__1; ++i__) { | 
|---|
|  | 6218 | i__2 = *l1; | 
|---|
|  | 6219 | for (k = 1; k <= i__2; ++k) { | 
|---|
|  | 6220 | ch[i__ + (k + ch_dim2) * ch_dim1] = cc[i__ + (k * cc_dim2 + 1) * | 
|---|
|  | 6221 | cc_dim1]; | 
|---|
|  | 6222 | /* L110: */ | 
|---|
|  | 6223 | } | 
|---|
|  | 6224 | /* L111: */ | 
|---|
|  | 6225 | } | 
|---|
|  | 6226 | L112: | 
|---|
|  | 6227 | idl = 2 - *ido; | 
|---|
|  | 6228 | inc = 0; | 
|---|
|  | 6229 | i__1 = ipph; | 
|---|
|  | 6230 | for (l = 2; l <= i__1; ++l) { | 
|---|
|  | 6231 | lc = ipp2 - l; | 
|---|
|  | 6232 | idl += *ido; | 
|---|
|  | 6233 | i__2 = *idl1; | 
|---|
|  | 6234 | for (ik = 1; ik <= i__2; ++ik) { | 
|---|
|  | 6235 | c2[ik + l * c2_dim1] = ch2[ik + ch2_dim1] + wa[idl - 1] * ch2[ik | 
|---|
|  | 6236 | + (ch2_dim1 << 1)]; | 
|---|
|  | 6237 | c2[ik + lc * c2_dim1] = -wa[idl] * ch2[ik + *ip * ch2_dim1]; | 
|---|
|  | 6238 | /* L113: */ | 
|---|
|  | 6239 | } | 
|---|
|  | 6240 | idlj = idl; | 
|---|
|  | 6241 | inc += *ido; | 
|---|
|  | 6242 | i__2 = ipph; | 
|---|
|  | 6243 | for (j = 3; j <= i__2; ++j) { | 
|---|
|  | 6244 | jc = ipp2 - j; | 
|---|
|  | 6245 | idlj += inc; | 
|---|
|  | 6246 | if (idlj > idp) { | 
|---|
|  | 6247 | idlj -= idp; | 
|---|
|  | 6248 | } | 
|---|
|  | 6249 | war = wa[idlj - 1]; | 
|---|
|  | 6250 | wai = wa[idlj]; | 
|---|
|  | 6251 | i__3 = *idl1; | 
|---|
|  | 6252 | for (ik = 1; ik <= i__3; ++ik) { | 
|---|
|  | 6253 | c2[ik + l * c2_dim1] += war * ch2[ik + j * ch2_dim1]; | 
|---|
|  | 6254 | c2[ik + lc * c2_dim1] -= wai * ch2[ik + jc * ch2_dim1]; | 
|---|
|  | 6255 | /* L114: */ | 
|---|
|  | 6256 | } | 
|---|
|  | 6257 | /* L115: */ | 
|---|
|  | 6258 | } | 
|---|
|  | 6259 | /* L116: */ | 
|---|
|  | 6260 | } | 
|---|
|  | 6261 | i__1 = ipph; | 
|---|
|  | 6262 | for (j = 2; j <= i__1; ++j) { | 
|---|
|  | 6263 | i__2 = *idl1; | 
|---|
|  | 6264 | for (ik = 1; ik <= i__2; ++ik) { | 
|---|
|  | 6265 | ch2[ik + ch2_dim1] += ch2[ik + j * ch2_dim1]; | 
|---|
|  | 6266 | /* L117: */ | 
|---|
|  | 6267 | } | 
|---|
|  | 6268 | /* L118: */ | 
|---|
|  | 6269 | } | 
|---|
|  | 6270 | i__1 = ipph; | 
|---|
|  | 6271 | for (j = 2; j <= i__1; ++j) { | 
|---|
|  | 6272 | jc = ipp2 - j; | 
|---|
|  | 6273 | i__2 = *idl1; | 
|---|
|  | 6274 | for (ik = 2; ik <= i__2; ik += 2) { | 
|---|
|  | 6275 | ch2[ik - 1 + j * ch2_dim1] = c2[ik - 1 + j * c2_dim1] - c2[ik + | 
|---|
|  | 6276 | jc * c2_dim1]; | 
|---|
|  | 6277 | ch2[ik - 1 + jc * ch2_dim1] = c2[ik - 1 + j * c2_dim1] + c2[ik + | 
|---|
|  | 6278 | jc * c2_dim1]; | 
|---|
|  | 6279 | ch2[ik + j * ch2_dim1] = c2[ik + j * c2_dim1] + c2[ik - 1 + jc * | 
|---|
|  | 6280 | c2_dim1]; | 
|---|
|  | 6281 | ch2[ik + jc * ch2_dim1] = c2[ik + j * c2_dim1] - c2[ik - 1 + jc * | 
|---|
|  | 6282 | c2_dim1]; | 
|---|
|  | 6283 | /* L119: */ | 
|---|
|  | 6284 | } | 
|---|
|  | 6285 | /* L120: */ | 
|---|
|  | 6286 | } | 
|---|
|  | 6287 | *nac = 1; | 
|---|
|  | 6288 | if (*ido == 2) { | 
|---|
|  | 6289 | return 0; | 
|---|
|  | 6290 | } | 
|---|
|  | 6291 | *nac = 0; | 
|---|
|  | 6292 | i__1 = *idl1; | 
|---|
|  | 6293 | for (ik = 1; ik <= i__1; ++ik) { | 
|---|
|  | 6294 | c2[ik + c2_dim1] = ch2[ik + ch2_dim1]; | 
|---|
|  | 6295 | /* L121: */ | 
|---|
|  | 6296 | } | 
|---|
|  | 6297 | i__1 = *ip; | 
|---|
|  | 6298 | for (j = 2; j <= i__1; ++j) { | 
|---|
|  | 6299 | i__2 = *l1; | 
|---|
|  | 6300 | for (k = 1; k <= i__2; ++k) { | 
|---|
|  | 6301 | c1[(k + j * c1_dim2) * c1_dim1 + 1] = ch[(k + j * ch_dim2) * | 
|---|
|  | 6302 | ch_dim1 + 1]; | 
|---|
|  | 6303 | c1[(k + j * c1_dim2) * c1_dim1 + 2] = ch[(k + j * ch_dim2) * | 
|---|
|  | 6304 | ch_dim1 + 2]; | 
|---|
|  | 6305 | /* L122: */ | 
|---|
|  | 6306 | } | 
|---|
|  | 6307 | /* L123: */ | 
|---|
|  | 6308 | } | 
|---|
|  | 6309 | if (idot > *l1) { | 
|---|
|  | 6310 | goto L127; | 
|---|
|  | 6311 | } | 
|---|
|  | 6312 | idij = 0; | 
|---|
|  | 6313 | i__1 = *ip; | 
|---|
|  | 6314 | for (j = 2; j <= i__1; ++j) { | 
|---|
|  | 6315 | idij += 2; | 
|---|
|  | 6316 | i__2 = *ido; | 
|---|
|  | 6317 | for (i__ = 4; i__ <= i__2; i__ += 2) { | 
|---|
|  | 6318 | idij += 2; | 
|---|
|  | 6319 | i__3 = *l1; | 
|---|
|  | 6320 | for (k = 1; k <= i__3; ++k) { | 
|---|
|  | 6321 | c1[i__ - 1 + (k + j * c1_dim2) * c1_dim1] = wa[idij - 1] * ch[ | 
|---|
|  | 6322 | i__ - 1 + (k + j * ch_dim2) * ch_dim1] + wa[idij] * | 
|---|
|  | 6323 | ch[i__ + (k + j * ch_dim2) * ch_dim1]; | 
|---|
|  | 6324 | c1[i__ + (k + j * c1_dim2) * c1_dim1] = wa[idij - 1] * ch[i__ | 
|---|
|  | 6325 | + (k + j * ch_dim2) * ch_dim1] - wa[idij] * ch[i__ - | 
|---|
|  | 6326 | 1 + (k + j * ch_dim2) * ch_dim1]; | 
|---|
|  | 6327 | /* L124: */ | 
|---|
|  | 6328 | } | 
|---|
|  | 6329 | /* L125: */ | 
|---|
|  | 6330 | } | 
|---|
|  | 6331 | /* L126: */ | 
|---|
|  | 6332 | } | 
|---|
|  | 6333 | return 0; | 
|---|
|  | 6334 | L127: | 
|---|
|  | 6335 | idj = 2 - *ido; | 
|---|
|  | 6336 | i__1 = *ip; | 
|---|
|  | 6337 | for (j = 2; j <= i__1; ++j) { | 
|---|
|  | 6338 | idj += *ido; | 
|---|
|  | 6339 | i__2 = *l1; | 
|---|
|  | 6340 | for (k = 1; k <= i__2; ++k) { | 
|---|
|  | 6341 | idij = idj; | 
|---|
|  | 6342 | i__3 = *ido; | 
|---|
|  | 6343 | for (i__ = 4; i__ <= i__3; i__ += 2) { | 
|---|
|  | 6344 | idij += 2; | 
|---|
|  | 6345 | c1[i__ - 1 + (k + j * c1_dim2) * c1_dim1] = wa[idij - 1] * ch[ | 
|---|
|  | 6346 | i__ - 1 + (k + j * ch_dim2) * ch_dim1] + wa[idij] * | 
|---|
|  | 6347 | ch[i__ + (k + j * ch_dim2) * ch_dim1]; | 
|---|
|  | 6348 | c1[i__ + (k + j * c1_dim2) * c1_dim1] = wa[idij - 1] * ch[i__ | 
|---|
|  | 6349 | + (k + j * ch_dim2) * ch_dim1] - wa[idij] * ch[i__ - | 
|---|
|  | 6350 | 1 + (k + j * ch_dim2) * ch_dim1]; | 
|---|
|  | 6351 | /* L128: */ | 
|---|
|  | 6352 | } | 
|---|
|  | 6353 | /* L129: */ | 
|---|
|  | 6354 | } | 
|---|
|  | 6355 | /* L130: */ | 
|---|
|  | 6356 | } | 
|---|
|  | 6357 | return 0; | 
|---|
|  | 6358 | } /* dpassf_ */ | 
|---|
|  | 6359 |  | 
|---|
|  | 6360 | /*  ------ File dpassf2.f ------ */ | 
|---|
| [756] | 6361 | /* Subroutine */ int dpassf2_(int_4 *ido, int_4 *l1, r_8 *cc, r_8 *ch, | 
|---|
| [717] | 6362 | r_8 *wa1) | 
|---|
| [459] | 6363 | { | 
|---|
|  | 6364 | /* System generated locals */ | 
|---|
| [756] | 6365 | int_4 cc_dim1, cc_offset, ch_dim1, ch_dim2, ch_offset, i__1, i__2; | 
|---|
| [459] | 6366 |  | 
|---|
|  | 6367 | /* Local variables */ | 
|---|
| [756] | 6368 | static int_4 i__, k; | 
|---|
| [717] | 6369 | static r_8 ti2, tr2; | 
|---|
| [459] | 6370 |  | 
|---|
|  | 6371 | /* Parameter adjustments */ | 
|---|
|  | 6372 | ch_dim1 = *ido; | 
|---|
|  | 6373 | ch_dim2 = *l1; | 
|---|
|  | 6374 | ch_offset = ch_dim1 * (ch_dim2 + 1) + 1; | 
|---|
|  | 6375 | ch -= ch_offset; | 
|---|
|  | 6376 | cc_dim1 = *ido; | 
|---|
|  | 6377 | cc_offset = cc_dim1 * 3 + 1; | 
|---|
|  | 6378 | cc -= cc_offset; | 
|---|
|  | 6379 | --wa1; | 
|---|
|  | 6380 |  | 
|---|
|  | 6381 | /* Function Body */ | 
|---|
|  | 6382 | if (*ido > 2) { | 
|---|
|  | 6383 | goto L102; | 
|---|
|  | 6384 | } | 
|---|
|  | 6385 | i__1 = *l1; | 
|---|
|  | 6386 | for (k = 1; k <= i__1; ++k) { | 
|---|
|  | 6387 | ch[(k + ch_dim2) * ch_dim1 + 1] = cc[((k << 1) + 1) * cc_dim1 + 1] + | 
|---|
|  | 6388 | cc[((k << 1) + 2) * cc_dim1 + 1]; | 
|---|
|  | 6389 | ch[(k + (ch_dim2 << 1)) * ch_dim1 + 1] = cc[((k << 1) + 1) * cc_dim1 | 
|---|
|  | 6390 | + 1] - cc[((k << 1) + 2) * cc_dim1 + 1]; | 
|---|
|  | 6391 | ch[(k + ch_dim2) * ch_dim1 + 2] = cc[((k << 1) + 1) * cc_dim1 + 2] + | 
|---|
|  | 6392 | cc[((k << 1) + 2) * cc_dim1 + 2]; | 
|---|
|  | 6393 | ch[(k + (ch_dim2 << 1)) * ch_dim1 + 2] = cc[((k << 1) + 1) * cc_dim1 | 
|---|
|  | 6394 | + 2] - cc[((k << 1) + 2) * cc_dim1 + 2]; | 
|---|
|  | 6395 | /* L101: */ | 
|---|
|  | 6396 | } | 
|---|
|  | 6397 | return 0; | 
|---|
|  | 6398 | L102: | 
|---|
|  | 6399 | i__1 = *l1; | 
|---|
|  | 6400 | for (k = 1; k <= i__1; ++k) { | 
|---|
|  | 6401 | i__2 = *ido; | 
|---|
|  | 6402 | for (i__ = 2; i__ <= i__2; i__ += 2) { | 
|---|
|  | 6403 | ch[i__ - 1 + (k + ch_dim2) * ch_dim1] = cc[i__ - 1 + ((k << 1) + | 
|---|
|  | 6404 | 1) * cc_dim1] + cc[i__ - 1 + ((k << 1) + 2) * cc_dim1]; | 
|---|
|  | 6405 | tr2 = cc[i__ - 1 + ((k << 1) + 1) * cc_dim1] - cc[i__ - 1 + ((k << | 
|---|
|  | 6406 | 1) + 2) * cc_dim1]; | 
|---|
|  | 6407 | ch[i__ + (k + ch_dim2) * ch_dim1] = cc[i__ + ((k << 1) + 1) * | 
|---|
|  | 6408 | cc_dim1] + cc[i__ + ((k << 1) + 2) * cc_dim1]; | 
|---|
|  | 6409 | ti2 = cc[i__ + ((k << 1) + 1) * cc_dim1] - cc[i__ + ((k << 1) + 2) | 
|---|
|  | 6410 | * cc_dim1]; | 
|---|
|  | 6411 | ch[i__ + (k + (ch_dim2 << 1)) * ch_dim1] = wa1[i__ - 1] * ti2 - | 
|---|
|  | 6412 | wa1[i__] * tr2; | 
|---|
|  | 6413 | ch[i__ - 1 + (k + (ch_dim2 << 1)) * ch_dim1] = wa1[i__ - 1] * tr2 | 
|---|
|  | 6414 | + wa1[i__] * ti2; | 
|---|
|  | 6415 | /* L103: */ | 
|---|
|  | 6416 | } | 
|---|
|  | 6417 | /* L104: */ | 
|---|
|  | 6418 | } | 
|---|
|  | 6419 | return 0; | 
|---|
|  | 6420 | } /* dpassf2_ */ | 
|---|
|  | 6421 |  | 
|---|
|  | 6422 | /*  ------ File dpassf3.f ------ */ | 
|---|
| [756] | 6423 | /* Subroutine */ int dpassf3_(int_4 *ido, int_4 *l1, r_8 *cc, r_8 *ch, | 
|---|
| [717] | 6424 | r_8 *wa1, r_8 *wa2) | 
|---|
| [459] | 6425 | { | 
|---|
|  | 6426 | /* Initialized data */ | 
|---|
|  | 6427 |  | 
|---|
| [717] | 6428 | static r_8 taur = -.5f; | 
|---|
|  | 6429 | static r_8 taui = -.866025403784439f; | 
|---|
| [459] | 6430 |  | 
|---|
|  | 6431 | /* System generated locals */ | 
|---|
| [756] | 6432 | int_4 cc_dim1, cc_offset, ch_dim1, ch_dim2, ch_offset, i__1, i__2; | 
|---|
| [459] | 6433 |  | 
|---|
|  | 6434 | /* Local variables */ | 
|---|
| [756] | 6435 | static int_4 i__, k; | 
|---|
| [717] | 6436 | static r_8 ci2, ci3, di2, di3, cr2, cr3, dr2, dr3, ti2, tr2; | 
|---|
| [459] | 6437 |  | 
|---|
|  | 6438 | /* Parameter adjustments */ | 
|---|
|  | 6439 | ch_dim1 = *ido; | 
|---|
|  | 6440 | ch_dim2 = *l1; | 
|---|
|  | 6441 | ch_offset = ch_dim1 * (ch_dim2 + 1) + 1; | 
|---|
|  | 6442 | ch -= ch_offset; | 
|---|
|  | 6443 | cc_dim1 = *ido; | 
|---|
|  | 6444 | cc_offset = (cc_dim1 << 2) + 1; | 
|---|
|  | 6445 | cc -= cc_offset; | 
|---|
|  | 6446 | --wa1; | 
|---|
|  | 6447 | --wa2; | 
|---|
|  | 6448 |  | 
|---|
|  | 6449 | /* Function Body */ | 
|---|
|  | 6450 | if (*ido != 2) { | 
|---|
|  | 6451 | goto L102; | 
|---|
|  | 6452 | } | 
|---|
|  | 6453 | i__1 = *l1; | 
|---|
|  | 6454 | for (k = 1; k <= i__1; ++k) { | 
|---|
|  | 6455 | tr2 = cc[(k * 3 + 2) * cc_dim1 + 1] + cc[(k * 3 + 3) * cc_dim1 + 1]; | 
|---|
|  | 6456 | cr2 = cc[(k * 3 + 1) * cc_dim1 + 1] + taur * tr2; | 
|---|
|  | 6457 | ch[(k + ch_dim2) * ch_dim1 + 1] = cc[(k * 3 + 1) * cc_dim1 + 1] + tr2; | 
|---|
|  | 6458 | ti2 = cc[(k * 3 + 2) * cc_dim1 + 2] + cc[(k * 3 + 3) * cc_dim1 + 2]; | 
|---|
|  | 6459 | ci2 = cc[(k * 3 + 1) * cc_dim1 + 2] + taur * ti2; | 
|---|
|  | 6460 | ch[(k + ch_dim2) * ch_dim1 + 2] = cc[(k * 3 + 1) * cc_dim1 + 2] + ti2; | 
|---|
|  | 6461 | cr3 = taui * (cc[(k * 3 + 2) * cc_dim1 + 1] - cc[(k * 3 + 3) * | 
|---|
|  | 6462 | cc_dim1 + 1]); | 
|---|
|  | 6463 | ci3 = taui * (cc[(k * 3 + 2) * cc_dim1 + 2] - cc[(k * 3 + 3) * | 
|---|
|  | 6464 | cc_dim1 + 2]); | 
|---|
|  | 6465 | ch[(k + (ch_dim2 << 1)) * ch_dim1 + 1] = cr2 - ci3; | 
|---|
|  | 6466 | ch[(k + ch_dim2 * 3) * ch_dim1 + 1] = cr2 + ci3; | 
|---|
|  | 6467 | ch[(k + (ch_dim2 << 1)) * ch_dim1 + 2] = ci2 + cr3; | 
|---|
|  | 6468 | ch[(k + ch_dim2 * 3) * ch_dim1 + 2] = ci2 - cr3; | 
|---|
|  | 6469 | /* L101: */ | 
|---|
|  | 6470 | } | 
|---|
|  | 6471 | return 0; | 
|---|
|  | 6472 | L102: | 
|---|
|  | 6473 | i__1 = *l1; | 
|---|
|  | 6474 | for (k = 1; k <= i__1; ++k) { | 
|---|
|  | 6475 | i__2 = *ido; | 
|---|
|  | 6476 | for (i__ = 2; i__ <= i__2; i__ += 2) { | 
|---|
|  | 6477 | tr2 = cc[i__ - 1 + (k * 3 + 2) * cc_dim1] + cc[i__ - 1 + (k * 3 + | 
|---|
|  | 6478 | 3) * cc_dim1]; | 
|---|
|  | 6479 | cr2 = cc[i__ - 1 + (k * 3 + 1) * cc_dim1] + taur * tr2; | 
|---|
|  | 6480 | ch[i__ - 1 + (k + ch_dim2) * ch_dim1] = cc[i__ - 1 + (k * 3 + 1) * | 
|---|
|  | 6481 | cc_dim1] + tr2; | 
|---|
|  | 6482 | ti2 = cc[i__ + (k * 3 + 2) * cc_dim1] + cc[i__ + (k * 3 + 3) * | 
|---|
|  | 6483 | cc_dim1]; | 
|---|
|  | 6484 | ci2 = cc[i__ + (k * 3 + 1) * cc_dim1] + taur * ti2; | 
|---|
|  | 6485 | ch[i__ + (k + ch_dim2) * ch_dim1] = cc[i__ + (k * 3 + 1) * | 
|---|
|  | 6486 | cc_dim1] + ti2; | 
|---|
|  | 6487 | cr3 = taui * (cc[i__ - 1 + (k * 3 + 2) * cc_dim1] - cc[i__ - 1 + ( | 
|---|
|  | 6488 | k * 3 + 3) * cc_dim1]); | 
|---|
|  | 6489 | ci3 = taui * (cc[i__ + (k * 3 + 2) * cc_dim1] - cc[i__ + (k * 3 + | 
|---|
|  | 6490 | 3) * cc_dim1]); | 
|---|
|  | 6491 | dr2 = cr2 - ci3; | 
|---|
|  | 6492 | dr3 = cr2 + ci3; | 
|---|
|  | 6493 | di2 = ci2 + cr3; | 
|---|
|  | 6494 | di3 = ci2 - cr3; | 
|---|
|  | 6495 | ch[i__ + (k + (ch_dim2 << 1)) * ch_dim1] = wa1[i__ - 1] * di2 - | 
|---|
|  | 6496 | wa1[i__] * dr2; | 
|---|
|  | 6497 | ch[i__ - 1 + (k + (ch_dim2 << 1)) * ch_dim1] = wa1[i__ - 1] * dr2 | 
|---|
|  | 6498 | + wa1[i__] * di2; | 
|---|
|  | 6499 | ch[i__ + (k + ch_dim2 * 3) * ch_dim1] = wa2[i__ - 1] * di3 - wa2[ | 
|---|
|  | 6500 | i__] * dr3; | 
|---|
|  | 6501 | ch[i__ - 1 + (k + ch_dim2 * 3) * ch_dim1] = wa2[i__ - 1] * dr3 + | 
|---|
|  | 6502 | wa2[i__] * di3; | 
|---|
|  | 6503 | /* L103: */ | 
|---|
|  | 6504 | } | 
|---|
|  | 6505 | /* L104: */ | 
|---|
|  | 6506 | } | 
|---|
|  | 6507 | return 0; | 
|---|
|  | 6508 | } /* dpassf3_ */ | 
|---|
|  | 6509 |  | 
|---|
|  | 6510 | /*  ------ File dpassf4.f ------ */ | 
|---|
| [756] | 6511 | /* Subroutine */ int dpassf4_(int_4 *ido, int_4 *l1, r_8 *cc, r_8 *ch, | 
|---|
| [717] | 6512 | r_8 *wa1, r_8 *wa2, r_8 *wa3) | 
|---|
| [459] | 6513 | { | 
|---|
|  | 6514 | /* System generated locals */ | 
|---|
| [756] | 6515 | int_4 cc_dim1, cc_offset, ch_dim1, ch_dim2, ch_offset, i__1, i__2; | 
|---|
| [459] | 6516 |  | 
|---|
|  | 6517 | /* Local variables */ | 
|---|
| [756] | 6518 | static int_4 i__, k; | 
|---|
| [717] | 6519 | static r_8 ci2, ci3, ci4, cr2, cr3, cr4, ti1, ti2, ti3, ti4, tr1, tr2, | 
|---|
| [459] | 6520 | tr3, tr4; | 
|---|
|  | 6521 |  | 
|---|
|  | 6522 | /* Parameter adjustments */ | 
|---|
|  | 6523 | ch_dim1 = *ido; | 
|---|
|  | 6524 | ch_dim2 = *l1; | 
|---|
|  | 6525 | ch_offset = ch_dim1 * (ch_dim2 + 1) + 1; | 
|---|
|  | 6526 | ch -= ch_offset; | 
|---|
|  | 6527 | cc_dim1 = *ido; | 
|---|
|  | 6528 | cc_offset = cc_dim1 * 5 + 1; | 
|---|
|  | 6529 | cc -= cc_offset; | 
|---|
|  | 6530 | --wa1; | 
|---|
|  | 6531 | --wa2; | 
|---|
|  | 6532 | --wa3; | 
|---|
|  | 6533 |  | 
|---|
|  | 6534 | /* Function Body */ | 
|---|
|  | 6535 | if (*ido != 2) { | 
|---|
|  | 6536 | goto L102; | 
|---|
|  | 6537 | } | 
|---|
|  | 6538 | i__1 = *l1; | 
|---|
|  | 6539 | for (k = 1; k <= i__1; ++k) { | 
|---|
|  | 6540 | ti1 = cc[((k << 2) + 1) * cc_dim1 + 2] - cc[((k << 2) + 3) * cc_dim1 | 
|---|
|  | 6541 | + 2]; | 
|---|
|  | 6542 | ti2 = cc[((k << 2) + 1) * cc_dim1 + 2] + cc[((k << 2) + 3) * cc_dim1 | 
|---|
|  | 6543 | + 2]; | 
|---|
|  | 6544 | tr4 = cc[((k << 2) + 2) * cc_dim1 + 2] - cc[((k << 2) + 4) * cc_dim1 | 
|---|
|  | 6545 | + 2]; | 
|---|
|  | 6546 | ti3 = cc[((k << 2) + 2) * cc_dim1 + 2] + cc[((k << 2) + 4) * cc_dim1 | 
|---|
|  | 6547 | + 2]; | 
|---|
|  | 6548 | tr1 = cc[((k << 2) + 1) * cc_dim1 + 1] - cc[((k << 2) + 3) * cc_dim1 | 
|---|
|  | 6549 | + 1]; | 
|---|
|  | 6550 | tr2 = cc[((k << 2) + 1) * cc_dim1 + 1] + cc[((k << 2) + 3) * cc_dim1 | 
|---|
|  | 6551 | + 1]; | 
|---|
|  | 6552 | ti4 = cc[((k << 2) + 4) * cc_dim1 + 1] - cc[((k << 2) + 2) * cc_dim1 | 
|---|
|  | 6553 | + 1]; | 
|---|
|  | 6554 | tr3 = cc[((k << 2) + 2) * cc_dim1 + 1] + cc[((k << 2) + 4) * cc_dim1 | 
|---|
|  | 6555 | + 1]; | 
|---|
|  | 6556 | ch[(k + ch_dim2) * ch_dim1 + 1] = tr2 + tr3; | 
|---|
|  | 6557 | ch[(k + ch_dim2 * 3) * ch_dim1 + 1] = tr2 - tr3; | 
|---|
|  | 6558 | ch[(k + ch_dim2) * ch_dim1 + 2] = ti2 + ti3; | 
|---|
|  | 6559 | ch[(k + ch_dim2 * 3) * ch_dim1 + 2] = ti2 - ti3; | 
|---|
|  | 6560 | ch[(k + (ch_dim2 << 1)) * ch_dim1 + 1] = tr1 + tr4; | 
|---|
|  | 6561 | ch[(k + (ch_dim2 << 2)) * ch_dim1 + 1] = tr1 - tr4; | 
|---|
|  | 6562 | ch[(k + (ch_dim2 << 1)) * ch_dim1 + 2] = ti1 + ti4; | 
|---|
|  | 6563 | ch[(k + (ch_dim2 << 2)) * ch_dim1 + 2] = ti1 - ti4; | 
|---|
|  | 6564 | /* L101: */ | 
|---|
|  | 6565 | } | 
|---|
|  | 6566 | return 0; | 
|---|
|  | 6567 | L102: | 
|---|
|  | 6568 | i__1 = *l1; | 
|---|
|  | 6569 | for (k = 1; k <= i__1; ++k) { | 
|---|
|  | 6570 | i__2 = *ido; | 
|---|
|  | 6571 | for (i__ = 2; i__ <= i__2; i__ += 2) { | 
|---|
|  | 6572 | ti1 = cc[i__ + ((k << 2) + 1) * cc_dim1] - cc[i__ + ((k << 2) + 3) | 
|---|
|  | 6573 | * cc_dim1]; | 
|---|
|  | 6574 | ti2 = cc[i__ + ((k << 2) + 1) * cc_dim1] + cc[i__ + ((k << 2) + 3) | 
|---|
|  | 6575 | * cc_dim1]; | 
|---|
|  | 6576 | ti3 = cc[i__ + ((k << 2) + 2) * cc_dim1] + cc[i__ + ((k << 2) + 4) | 
|---|
|  | 6577 | * cc_dim1]; | 
|---|
|  | 6578 | tr4 = cc[i__ + ((k << 2) + 2) * cc_dim1] - cc[i__ + ((k << 2) + 4) | 
|---|
|  | 6579 | * cc_dim1]; | 
|---|
|  | 6580 | tr1 = cc[i__ - 1 + ((k << 2) + 1) * cc_dim1] - cc[i__ - 1 + ((k << | 
|---|
|  | 6581 | 2) + 3) * cc_dim1]; | 
|---|
|  | 6582 | tr2 = cc[i__ - 1 + ((k << 2) + 1) * cc_dim1] + cc[i__ - 1 + ((k << | 
|---|
|  | 6583 | 2) + 3) * cc_dim1]; | 
|---|
|  | 6584 | ti4 = cc[i__ - 1 + ((k << 2) + 4) * cc_dim1] - cc[i__ - 1 + ((k << | 
|---|
|  | 6585 | 2) + 2) * cc_dim1]; | 
|---|
|  | 6586 | tr3 = cc[i__ - 1 + ((k << 2) + 2) * cc_dim1] + cc[i__ - 1 + ((k << | 
|---|
|  | 6587 | 2) + 4) * cc_dim1]; | 
|---|
|  | 6588 | ch[i__ - 1 + (k + ch_dim2) * ch_dim1] = tr2 + tr3; | 
|---|
|  | 6589 | cr3 = tr2 - tr3; | 
|---|
|  | 6590 | ch[i__ + (k + ch_dim2) * ch_dim1] = ti2 + ti3; | 
|---|
|  | 6591 | ci3 = ti2 - ti3; | 
|---|
|  | 6592 | cr2 = tr1 + tr4; | 
|---|
|  | 6593 | cr4 = tr1 - tr4; | 
|---|
|  | 6594 | ci2 = ti1 + ti4; | 
|---|
|  | 6595 | ci4 = ti1 - ti4; | 
|---|
|  | 6596 | ch[i__ - 1 + (k + (ch_dim2 << 1)) * ch_dim1] = wa1[i__ - 1] * cr2 | 
|---|
|  | 6597 | + wa1[i__] * ci2; | 
|---|
|  | 6598 | ch[i__ + (k + (ch_dim2 << 1)) * ch_dim1] = wa1[i__ - 1] * ci2 - | 
|---|
|  | 6599 | wa1[i__] * cr2; | 
|---|
|  | 6600 | ch[i__ - 1 + (k + ch_dim2 * 3) * ch_dim1] = wa2[i__ - 1] * cr3 + | 
|---|
|  | 6601 | wa2[i__] * ci3; | 
|---|
|  | 6602 | ch[i__ + (k + ch_dim2 * 3) * ch_dim1] = wa2[i__ - 1] * ci3 - wa2[ | 
|---|
|  | 6603 | i__] * cr3; | 
|---|
|  | 6604 | ch[i__ - 1 + (k + (ch_dim2 << 2)) * ch_dim1] = wa3[i__ - 1] * cr4 | 
|---|
|  | 6605 | + wa3[i__] * ci4; | 
|---|
|  | 6606 | ch[i__ + (k + (ch_dim2 << 2)) * ch_dim1] = wa3[i__ - 1] * ci4 - | 
|---|
|  | 6607 | wa3[i__] * cr4; | 
|---|
|  | 6608 | /* L103: */ | 
|---|
|  | 6609 | } | 
|---|
|  | 6610 | /* L104: */ | 
|---|
|  | 6611 | } | 
|---|
|  | 6612 | return 0; | 
|---|
|  | 6613 | } /* dpassf4_ */ | 
|---|
|  | 6614 |  | 
|---|
|  | 6615 | /*  ------ File dpassf5.f ------ */ | 
|---|
| [756] | 6616 | /* Subroutine */ int dpassf5_(int_4 *ido, int_4 *l1, r_8 *cc, r_8 *ch, | 
|---|
| [717] | 6617 | r_8 *wa1, r_8 *wa2, r_8 *wa3, r_8 *wa4) | 
|---|
| [459] | 6618 | { | 
|---|
|  | 6619 | /* Initialized data */ | 
|---|
|  | 6620 |  | 
|---|
| [717] | 6621 | static r_8 tr11 = .309016994374947f; | 
|---|
|  | 6622 | static r_8 ti11 = -.951056516295154f; | 
|---|
|  | 6623 | static r_8 tr12 = -.809016994374947f; | 
|---|
|  | 6624 | static r_8 ti12 = -.587785252292473f; | 
|---|
| [459] | 6625 |  | 
|---|
|  | 6626 | /* System generated locals */ | 
|---|
| [756] | 6627 | int_4 cc_dim1, cc_offset, ch_dim1, ch_dim2, ch_offset, i__1, i__2; | 
|---|
| [459] | 6628 |  | 
|---|
|  | 6629 | /* Local variables */ | 
|---|
| [756] | 6630 | static int_4 i__, k; | 
|---|
| [717] | 6631 | static r_8 ci2, ci3, ci4, ci5, di3, di4, di5, di2, cr2, cr3, cr5, cr4, | 
|---|
| [459] | 6632 | ti2, ti3, ti4, ti5, dr3, dr4, dr5, dr2, tr2, tr3, tr4, tr5; | 
|---|
|  | 6633 |  | 
|---|
|  | 6634 | /* Parameter adjustments */ | 
|---|
|  | 6635 | ch_dim1 = *ido; | 
|---|
|  | 6636 | ch_dim2 = *l1; | 
|---|
|  | 6637 | ch_offset = ch_dim1 * (ch_dim2 + 1) + 1; | 
|---|
|  | 6638 | ch -= ch_offset; | 
|---|
|  | 6639 | cc_dim1 = *ido; | 
|---|
|  | 6640 | cc_offset = cc_dim1 * 6 + 1; | 
|---|
|  | 6641 | cc -= cc_offset; | 
|---|
|  | 6642 | --wa1; | 
|---|
|  | 6643 | --wa2; | 
|---|
|  | 6644 | --wa3; | 
|---|
|  | 6645 | --wa4; | 
|---|
|  | 6646 |  | 
|---|
|  | 6647 | /* Function Body */ | 
|---|
|  | 6648 | if (*ido != 2) { | 
|---|
|  | 6649 | goto L102; | 
|---|
|  | 6650 | } | 
|---|
|  | 6651 | i__1 = *l1; | 
|---|
|  | 6652 | for (k = 1; k <= i__1; ++k) { | 
|---|
|  | 6653 | ti5 = cc[(k * 5 + 2) * cc_dim1 + 2] - cc[(k * 5 + 5) * cc_dim1 + 2]; | 
|---|
|  | 6654 | ti2 = cc[(k * 5 + 2) * cc_dim1 + 2] + cc[(k * 5 + 5) * cc_dim1 + 2]; | 
|---|
|  | 6655 | ti4 = cc[(k * 5 + 3) * cc_dim1 + 2] - cc[(k * 5 + 4) * cc_dim1 + 2]; | 
|---|
|  | 6656 | ti3 = cc[(k * 5 + 3) * cc_dim1 + 2] + cc[(k * 5 + 4) * cc_dim1 + 2]; | 
|---|
|  | 6657 | tr5 = cc[(k * 5 + 2) * cc_dim1 + 1] - cc[(k * 5 + 5) * cc_dim1 + 1]; | 
|---|
|  | 6658 | tr2 = cc[(k * 5 + 2) * cc_dim1 + 1] + cc[(k * 5 + 5) * cc_dim1 + 1]; | 
|---|
|  | 6659 | tr4 = cc[(k * 5 + 3) * cc_dim1 + 1] - cc[(k * 5 + 4) * cc_dim1 + 1]; | 
|---|
|  | 6660 | tr3 = cc[(k * 5 + 3) * cc_dim1 + 1] + cc[(k * 5 + 4) * cc_dim1 + 1]; | 
|---|
|  | 6661 | ch[(k + ch_dim2) * ch_dim1 + 1] = cc[(k * 5 + 1) * cc_dim1 + 1] + tr2 | 
|---|
|  | 6662 | + tr3; | 
|---|
|  | 6663 | ch[(k + ch_dim2) * ch_dim1 + 2] = cc[(k * 5 + 1) * cc_dim1 + 2] + ti2 | 
|---|
|  | 6664 | + ti3; | 
|---|
|  | 6665 | cr2 = cc[(k * 5 + 1) * cc_dim1 + 1] + tr11 * tr2 + tr12 * tr3; | 
|---|
|  | 6666 | ci2 = cc[(k * 5 + 1) * cc_dim1 + 2] + tr11 * ti2 + tr12 * ti3; | 
|---|
|  | 6667 | cr3 = cc[(k * 5 + 1) * cc_dim1 + 1] + tr12 * tr2 + tr11 * tr3; | 
|---|
|  | 6668 | ci3 = cc[(k * 5 + 1) * cc_dim1 + 2] + tr12 * ti2 + tr11 * ti3; | 
|---|
|  | 6669 | cr5 = ti11 * tr5 + ti12 * tr4; | 
|---|
|  | 6670 | ci5 = ti11 * ti5 + ti12 * ti4; | 
|---|
|  | 6671 | cr4 = ti12 * tr5 - ti11 * tr4; | 
|---|
|  | 6672 | ci4 = ti12 * ti5 - ti11 * ti4; | 
|---|
|  | 6673 | ch[(k + (ch_dim2 << 1)) * ch_dim1 + 1] = cr2 - ci5; | 
|---|
|  | 6674 | ch[(k + ch_dim2 * 5) * ch_dim1 + 1] = cr2 + ci5; | 
|---|
|  | 6675 | ch[(k + (ch_dim2 << 1)) * ch_dim1 + 2] = ci2 + cr5; | 
|---|
|  | 6676 | ch[(k + ch_dim2 * 3) * ch_dim1 + 2] = ci3 + cr4; | 
|---|
|  | 6677 | ch[(k + ch_dim2 * 3) * ch_dim1 + 1] = cr3 - ci4; | 
|---|
|  | 6678 | ch[(k + (ch_dim2 << 2)) * ch_dim1 + 1] = cr3 + ci4; | 
|---|
|  | 6679 | ch[(k + (ch_dim2 << 2)) * ch_dim1 + 2] = ci3 - cr4; | 
|---|
|  | 6680 | ch[(k + ch_dim2 * 5) * ch_dim1 + 2] = ci2 - cr5; | 
|---|
|  | 6681 | /* L101: */ | 
|---|
|  | 6682 | } | 
|---|
|  | 6683 | return 0; | 
|---|
|  | 6684 | L102: | 
|---|
|  | 6685 | i__1 = *l1; | 
|---|
|  | 6686 | for (k = 1; k <= i__1; ++k) { | 
|---|
|  | 6687 | i__2 = *ido; | 
|---|
|  | 6688 | for (i__ = 2; i__ <= i__2; i__ += 2) { | 
|---|
|  | 6689 | ti5 = cc[i__ + (k * 5 + 2) * cc_dim1] - cc[i__ + (k * 5 + 5) * | 
|---|
|  | 6690 | cc_dim1]; | 
|---|
|  | 6691 | ti2 = cc[i__ + (k * 5 + 2) * cc_dim1] + cc[i__ + (k * 5 + 5) * | 
|---|
|  | 6692 | cc_dim1]; | 
|---|
|  | 6693 | ti4 = cc[i__ + (k * 5 + 3) * cc_dim1] - cc[i__ + (k * 5 + 4) * | 
|---|
|  | 6694 | cc_dim1]; | 
|---|
|  | 6695 | ti3 = cc[i__ + (k * 5 + 3) * cc_dim1] + cc[i__ + (k * 5 + 4) * | 
|---|
|  | 6696 | cc_dim1]; | 
|---|
|  | 6697 | tr5 = cc[i__ - 1 + (k * 5 + 2) * cc_dim1] - cc[i__ - 1 + (k * 5 + | 
|---|
|  | 6698 | 5) * cc_dim1]; | 
|---|
|  | 6699 | tr2 = cc[i__ - 1 + (k * 5 + 2) * cc_dim1] + cc[i__ - 1 + (k * 5 + | 
|---|
|  | 6700 | 5) * cc_dim1]; | 
|---|
|  | 6701 | tr4 = cc[i__ - 1 + (k * 5 + 3) * cc_dim1] - cc[i__ - 1 + (k * 5 + | 
|---|
|  | 6702 | 4) * cc_dim1]; | 
|---|
|  | 6703 | tr3 = cc[i__ - 1 + (k * 5 + 3) * cc_dim1] + cc[i__ - 1 + (k * 5 + | 
|---|
|  | 6704 | 4) * cc_dim1]; | 
|---|
|  | 6705 | ch[i__ - 1 + (k + ch_dim2) * ch_dim1] = cc[i__ - 1 + (k * 5 + 1) * | 
|---|
|  | 6706 | cc_dim1] + tr2 + tr3; | 
|---|
|  | 6707 | ch[i__ + (k + ch_dim2) * ch_dim1] = cc[i__ + (k * 5 + 1) * | 
|---|
|  | 6708 | cc_dim1] + ti2 + ti3; | 
|---|
|  | 6709 | cr2 = cc[i__ - 1 + (k * 5 + 1) * cc_dim1] + tr11 * tr2 + tr12 * | 
|---|
|  | 6710 | tr3; | 
|---|
|  | 6711 | ci2 = cc[i__ + (k * 5 + 1) * cc_dim1] + tr11 * ti2 + tr12 * ti3; | 
|---|
|  | 6712 | cr3 = cc[i__ - 1 + (k * 5 + 1) * cc_dim1] + tr12 * tr2 + tr11 * | 
|---|
|  | 6713 | tr3; | 
|---|
|  | 6714 | ci3 = cc[i__ + (k * 5 + 1) * cc_dim1] + tr12 * ti2 + tr11 * ti3; | 
|---|
|  | 6715 | cr5 = ti11 * tr5 + ti12 * tr4; | 
|---|
|  | 6716 | ci5 = ti11 * ti5 + ti12 * ti4; | 
|---|
|  | 6717 | cr4 = ti12 * tr5 - ti11 * tr4; | 
|---|
|  | 6718 | ci4 = ti12 * ti5 - ti11 * ti4; | 
|---|
|  | 6719 | dr3 = cr3 - ci4; | 
|---|
|  | 6720 | dr4 = cr3 + ci4; | 
|---|
|  | 6721 | di3 = ci3 + cr4; | 
|---|
|  | 6722 | di4 = ci3 - cr4; | 
|---|
|  | 6723 | dr5 = cr2 + ci5; | 
|---|
|  | 6724 | dr2 = cr2 - ci5; | 
|---|
|  | 6725 | di5 = ci2 - cr5; | 
|---|
|  | 6726 | di2 = ci2 + cr5; | 
|---|
|  | 6727 | ch[i__ - 1 + (k + (ch_dim2 << 1)) * ch_dim1] = wa1[i__ - 1] * dr2 | 
|---|
|  | 6728 | + wa1[i__] * di2; | 
|---|
|  | 6729 | ch[i__ + (k + (ch_dim2 << 1)) * ch_dim1] = wa1[i__ - 1] * di2 - | 
|---|
|  | 6730 | wa1[i__] * dr2; | 
|---|
|  | 6731 | ch[i__ - 1 + (k + ch_dim2 * 3) * ch_dim1] = wa2[i__ - 1] * dr3 + | 
|---|
|  | 6732 | wa2[i__] * di3; | 
|---|
|  | 6733 | ch[i__ + (k + ch_dim2 * 3) * ch_dim1] = wa2[i__ - 1] * di3 - wa2[ | 
|---|
|  | 6734 | i__] * dr3; | 
|---|
|  | 6735 | ch[i__ - 1 + (k + (ch_dim2 << 2)) * ch_dim1] = wa3[i__ - 1] * dr4 | 
|---|
|  | 6736 | + wa3[i__] * di4; | 
|---|
|  | 6737 | ch[i__ + (k + (ch_dim2 << 2)) * ch_dim1] = wa3[i__ - 1] * di4 - | 
|---|
|  | 6738 | wa3[i__] * dr4; | 
|---|
|  | 6739 | ch[i__ - 1 + (k + ch_dim2 * 5) * ch_dim1] = wa4[i__ - 1] * dr5 + | 
|---|
|  | 6740 | wa4[i__] * di5; | 
|---|
|  | 6741 | ch[i__ + (k + ch_dim2 * 5) * ch_dim1] = wa4[i__ - 1] * di5 - wa4[ | 
|---|
|  | 6742 | i__] * dr5; | 
|---|
|  | 6743 | /* L103: */ | 
|---|
|  | 6744 | } | 
|---|
|  | 6745 | /* L104: */ | 
|---|
|  | 6746 | } | 
|---|
|  | 6747 | return 0; | 
|---|
|  | 6748 | } /* dpassf5_ */ | 
|---|
|  | 6749 |  | 
|---|
|  | 6750 | /*  ------ File dadb2.f ------ */ | 
|---|
| [756] | 6751 | /* Subroutine */ int dadb2_(int_4 *ido, int_4 *l1, r_8 *cc, r_8 *ch, | 
|---|
| [717] | 6752 | r_8 *wa1) | 
|---|
| [459] | 6753 | { | 
|---|
|  | 6754 | /* System generated locals */ | 
|---|
| [756] | 6755 | int_4 cc_dim1, cc_offset, ch_dim1, ch_dim2, ch_offset, i__1, i__2; | 
|---|
| [459] | 6756 |  | 
|---|
|  | 6757 | /* Local variables */ | 
|---|
| [756] | 6758 | static int_4 i__, k, ic; | 
|---|
| [717] | 6759 | static r_8 ti2, tr2; | 
|---|
| [756] | 6760 | static int_4 idp2; | 
|---|
| [459] | 6761 |  | 
|---|
|  | 6762 | /* Parameter adjustments */ | 
|---|
|  | 6763 | ch_dim1 = *ido; | 
|---|
|  | 6764 | ch_dim2 = *l1; | 
|---|
|  | 6765 | ch_offset = ch_dim1 * (ch_dim2 + 1) + 1; | 
|---|
|  | 6766 | ch -= ch_offset; | 
|---|
|  | 6767 | cc_dim1 = *ido; | 
|---|
|  | 6768 | cc_offset = cc_dim1 * 3 + 1; | 
|---|
|  | 6769 | cc -= cc_offset; | 
|---|
|  | 6770 | --wa1; | 
|---|
|  | 6771 |  | 
|---|
|  | 6772 | /* Function Body */ | 
|---|
|  | 6773 | i__1 = *l1; | 
|---|
|  | 6774 | for (k = 1; k <= i__1; ++k) { | 
|---|
|  | 6775 | ch[(k + ch_dim2) * ch_dim1 + 1] = cc[((k << 1) + 1) * cc_dim1 + 1] + | 
|---|
|  | 6776 | cc[*ido + ((k << 1) + 2) * cc_dim1]; | 
|---|
|  | 6777 | ch[(k + (ch_dim2 << 1)) * ch_dim1 + 1] = cc[((k << 1) + 1) * cc_dim1 | 
|---|
|  | 6778 | + 1] - cc[*ido + ((k << 1) + 2) * cc_dim1]; | 
|---|
|  | 6779 | /* L101: */ | 
|---|
|  | 6780 | } | 
|---|
|  | 6781 | if ((i__1 = *ido - 2) < 0) { | 
|---|
|  | 6782 | goto L107; | 
|---|
|  | 6783 | } else if (i__1 == 0) { | 
|---|
|  | 6784 | goto L105; | 
|---|
|  | 6785 | } else { | 
|---|
|  | 6786 | goto L102; | 
|---|
|  | 6787 | } | 
|---|
|  | 6788 | L102: | 
|---|
|  | 6789 | idp2 = *ido + 2; | 
|---|
|  | 6790 | i__1 = *l1; | 
|---|
|  | 6791 | for (k = 1; k <= i__1; ++k) { | 
|---|
|  | 6792 | i__2 = *ido; | 
|---|
|  | 6793 | for (i__ = 3; i__ <= i__2; i__ += 2) { | 
|---|
|  | 6794 | ic = idp2 - i__; | 
|---|
|  | 6795 | ch[i__ - 1 + (k + ch_dim2) * ch_dim1] = cc[i__ - 1 + ((k << 1) + | 
|---|
|  | 6796 | 1) * cc_dim1] + cc[ic - 1 + ((k << 1) + 2) * cc_dim1]; | 
|---|
|  | 6797 | tr2 = cc[i__ - 1 + ((k << 1) + 1) * cc_dim1] - cc[ic - 1 + ((k << | 
|---|
|  | 6798 | 1) + 2) * cc_dim1]; | 
|---|
|  | 6799 | ch[i__ + (k + ch_dim2) * ch_dim1] = cc[i__ + ((k << 1) + 1) * | 
|---|
|  | 6800 | cc_dim1] - cc[ic + ((k << 1) + 2) * cc_dim1]; | 
|---|
|  | 6801 | ti2 = cc[i__ + ((k << 1) + 1) * cc_dim1] + cc[ic + ((k << 1) + 2) | 
|---|
|  | 6802 | * cc_dim1]; | 
|---|
|  | 6803 | ch[i__ - 1 + (k + (ch_dim2 << 1)) * ch_dim1] = wa1[i__ - 2] * tr2 | 
|---|
|  | 6804 | - wa1[i__ - 1] * ti2; | 
|---|
|  | 6805 | ch[i__ + (k + (ch_dim2 << 1)) * ch_dim1] = wa1[i__ - 2] * ti2 + | 
|---|
|  | 6806 | wa1[i__ - 1] * tr2; | 
|---|
|  | 6807 | /* L103: */ | 
|---|
|  | 6808 | } | 
|---|
|  | 6809 | /* L104: */ | 
|---|
|  | 6810 | } | 
|---|
|  | 6811 | if (*ido % 2 == 1) { | 
|---|
|  | 6812 | return 0; | 
|---|
|  | 6813 | } | 
|---|
|  | 6814 | L105: | 
|---|
|  | 6815 | i__1 = *l1; | 
|---|
|  | 6816 | for (k = 1; k <= i__1; ++k) { | 
|---|
|  | 6817 | ch[*ido + (k + ch_dim2) * ch_dim1] = cc[*ido + ((k << 1) + 1) * | 
|---|
|  | 6818 | cc_dim1] + cc[*ido + ((k << 1) + 1) * cc_dim1]; | 
|---|
|  | 6819 | ch[*ido + (k + (ch_dim2 << 1)) * ch_dim1] = -(cc[((k << 1) + 2) * | 
|---|
|  | 6820 | cc_dim1 + 1] + cc[((k << 1) + 2) * cc_dim1 + 1]); | 
|---|
|  | 6821 | /* L106: */ | 
|---|
|  | 6822 | } | 
|---|
|  | 6823 | L107: | 
|---|
|  | 6824 | return 0; | 
|---|
|  | 6825 | } /* dadb2_ */ | 
|---|
|  | 6826 |  | 
|---|
|  | 6827 | /*  ------ File dadb3.f ------ */ | 
|---|
| [756] | 6828 | /* Subroutine */ int dadb3_(int_4 *ido, int_4 *l1, r_8 *cc, r_8 *ch, | 
|---|
| [717] | 6829 | r_8 *wa1, r_8 *wa2) | 
|---|
| [459] | 6830 | { | 
|---|
|  | 6831 | /* Initialized data */ | 
|---|
|  | 6832 |  | 
|---|
| [717] | 6833 | static r_8 taur = -.5f; | 
|---|
|  | 6834 | static r_8 taui = .866025403784439f; | 
|---|
| [459] | 6835 |  | 
|---|
|  | 6836 | /* System generated locals */ | 
|---|
| [756] | 6837 | int_4 cc_dim1, cc_offset, ch_dim1, ch_dim2, ch_offset, i__1, i__2; | 
|---|
| [459] | 6838 |  | 
|---|
|  | 6839 | /* Local variables */ | 
|---|
| [756] | 6840 | static int_4 i__, k, ic; | 
|---|
| [717] | 6841 | static r_8 ci2, ci3, di2, di3, cr2, cr3, dr2, dr3, ti2, tr2; | 
|---|
| [756] | 6842 | static int_4 idp2; | 
|---|
| [459] | 6843 |  | 
|---|
|  | 6844 | /* Parameter adjustments */ | 
|---|
|  | 6845 | ch_dim1 = *ido; | 
|---|
|  | 6846 | ch_dim2 = *l1; | 
|---|
|  | 6847 | ch_offset = ch_dim1 * (ch_dim2 + 1) + 1; | 
|---|
|  | 6848 | ch -= ch_offset; | 
|---|
|  | 6849 | cc_dim1 = *ido; | 
|---|
|  | 6850 | cc_offset = (cc_dim1 << 2) + 1; | 
|---|
|  | 6851 | cc -= cc_offset; | 
|---|
|  | 6852 | --wa1; | 
|---|
|  | 6853 | --wa2; | 
|---|
|  | 6854 |  | 
|---|
|  | 6855 | /* Function Body */ | 
|---|
|  | 6856 | i__1 = *l1; | 
|---|
|  | 6857 | for (k = 1; k <= i__1; ++k) { | 
|---|
|  | 6858 | tr2 = cc[*ido + (k * 3 + 2) * cc_dim1] + cc[*ido + (k * 3 + 2) * | 
|---|
|  | 6859 | cc_dim1]; | 
|---|
|  | 6860 | cr2 = cc[(k * 3 + 1) * cc_dim1 + 1] + taur * tr2; | 
|---|
|  | 6861 | ch[(k + ch_dim2) * ch_dim1 + 1] = cc[(k * 3 + 1) * cc_dim1 + 1] + tr2; | 
|---|
|  | 6862 | ci3 = taui * (cc[(k * 3 + 3) * cc_dim1 + 1] + cc[(k * 3 + 3) * | 
|---|
|  | 6863 | cc_dim1 + 1]); | 
|---|
|  | 6864 | ch[(k + (ch_dim2 << 1)) * ch_dim1 + 1] = cr2 - ci3; | 
|---|
|  | 6865 | ch[(k + ch_dim2 * 3) * ch_dim1 + 1] = cr2 + ci3; | 
|---|
|  | 6866 | /* L101: */ | 
|---|
|  | 6867 | } | 
|---|
|  | 6868 | if (*ido == 1) { | 
|---|
|  | 6869 | return 0; | 
|---|
|  | 6870 | } | 
|---|
|  | 6871 | idp2 = *ido + 2; | 
|---|
|  | 6872 | i__1 = *l1; | 
|---|
|  | 6873 | for (k = 1; k <= i__1; ++k) { | 
|---|
|  | 6874 | i__2 = *ido; | 
|---|
|  | 6875 | for (i__ = 3; i__ <= i__2; i__ += 2) { | 
|---|
|  | 6876 | ic = idp2 - i__; | 
|---|
|  | 6877 | tr2 = cc[i__ - 1 + (k * 3 + 3) * cc_dim1] + cc[ic - 1 + (k * 3 + | 
|---|
|  | 6878 | 2) * cc_dim1]; | 
|---|
|  | 6879 | cr2 = cc[i__ - 1 + (k * 3 + 1) * cc_dim1] + taur * tr2; | 
|---|
|  | 6880 | ch[i__ - 1 + (k + ch_dim2) * ch_dim1] = cc[i__ - 1 + (k * 3 + 1) * | 
|---|
|  | 6881 | cc_dim1] + tr2; | 
|---|
|  | 6882 | ti2 = cc[i__ + (k * 3 + 3) * cc_dim1] - cc[ic + (k * 3 + 2) * | 
|---|
|  | 6883 | cc_dim1]; | 
|---|
|  | 6884 | ci2 = cc[i__ + (k * 3 + 1) * cc_dim1] + taur * ti2; | 
|---|
|  | 6885 | ch[i__ + (k + ch_dim2) * ch_dim1] = cc[i__ + (k * 3 + 1) * | 
|---|
|  | 6886 | cc_dim1] + ti2; | 
|---|
|  | 6887 | cr3 = taui * (cc[i__ - 1 + (k * 3 + 3) * cc_dim1] - cc[ic - 1 + ( | 
|---|
|  | 6888 | k * 3 + 2) * cc_dim1]); | 
|---|
|  | 6889 | ci3 = taui * (cc[i__ + (k * 3 + 3) * cc_dim1] + cc[ic + (k * 3 + | 
|---|
|  | 6890 | 2) * cc_dim1]); | 
|---|
|  | 6891 | dr2 = cr2 - ci3; | 
|---|
|  | 6892 | dr3 = cr2 + ci3; | 
|---|
|  | 6893 | di2 = ci2 + cr3; | 
|---|
|  | 6894 | di3 = ci2 - cr3; | 
|---|
|  | 6895 | ch[i__ - 1 + (k + (ch_dim2 << 1)) * ch_dim1] = wa1[i__ - 2] * dr2 | 
|---|
|  | 6896 | - wa1[i__ - 1] * di2; | 
|---|
|  | 6897 | ch[i__ + (k + (ch_dim2 << 1)) * ch_dim1] = wa1[i__ - 2] * di2 + | 
|---|
|  | 6898 | wa1[i__ - 1] * dr2; | 
|---|
|  | 6899 | ch[i__ - 1 + (k + ch_dim2 * 3) * ch_dim1] = wa2[i__ - 2] * dr3 - | 
|---|
|  | 6900 | wa2[i__ - 1] * di3; | 
|---|
|  | 6901 | ch[i__ + (k + ch_dim2 * 3) * ch_dim1] = wa2[i__ - 2] * di3 + wa2[ | 
|---|
|  | 6902 | i__ - 1] * dr3; | 
|---|
|  | 6903 | /* L102: */ | 
|---|
|  | 6904 | } | 
|---|
|  | 6905 | /* L103: */ | 
|---|
|  | 6906 | } | 
|---|
|  | 6907 | return 0; | 
|---|
|  | 6908 | } /* dadb3_ */ | 
|---|
|  | 6909 |  | 
|---|
|  | 6910 | /*  ------ File dadb4.f ------ */ | 
|---|
| [756] | 6911 | /* Subroutine */ int dadb4_(int_4 *ido, int_4 *l1, r_8 *cc, r_8 *ch, | 
|---|
| [717] | 6912 | r_8 *wa1, r_8 *wa2, r_8 *wa3) | 
|---|
| [459] | 6913 | { | 
|---|
|  | 6914 | /* Initialized data */ | 
|---|
|  | 6915 |  | 
|---|
| [717] | 6916 | static r_8 sqrt2 = 1.414213562373095f; | 
|---|
| [459] | 6917 |  | 
|---|
|  | 6918 | /* System generated locals */ | 
|---|
| [756] | 6919 | int_4 cc_dim1, cc_offset, ch_dim1, ch_dim2, ch_offset, i__1, i__2; | 
|---|
| [459] | 6920 |  | 
|---|
|  | 6921 | /* Local variables */ | 
|---|
| [756] | 6922 | static int_4 i__, k, ic; | 
|---|
| [717] | 6923 | static r_8 ci2, ci3, ci4, cr2, cr3, cr4, ti1, ti2, ti3, ti4, tr1, tr2, | 
|---|
| [459] | 6924 | tr3, tr4; | 
|---|
| [756] | 6925 | static int_4 idp2; | 
|---|
| [459] | 6926 |  | 
|---|
|  | 6927 | /* Parameter adjustments */ | 
|---|
|  | 6928 | ch_dim1 = *ido; | 
|---|
|  | 6929 | ch_dim2 = *l1; | 
|---|
|  | 6930 | ch_offset = ch_dim1 * (ch_dim2 + 1) + 1; | 
|---|
|  | 6931 | ch -= ch_offset; | 
|---|
|  | 6932 | cc_dim1 = *ido; | 
|---|
|  | 6933 | cc_offset = cc_dim1 * 5 + 1; | 
|---|
|  | 6934 | cc -= cc_offset; | 
|---|
|  | 6935 | --wa1; | 
|---|
|  | 6936 | --wa2; | 
|---|
|  | 6937 | --wa3; | 
|---|
|  | 6938 |  | 
|---|
|  | 6939 | /* Function Body */ | 
|---|
|  | 6940 | i__1 = *l1; | 
|---|
|  | 6941 | for (k = 1; k <= i__1; ++k) { | 
|---|
|  | 6942 | tr1 = cc[((k << 2) + 1) * cc_dim1 + 1] - cc[*ido + ((k << 2) + 4) * | 
|---|
|  | 6943 | cc_dim1]; | 
|---|
|  | 6944 | tr2 = cc[((k << 2) + 1) * cc_dim1 + 1] + cc[*ido + ((k << 2) + 4) * | 
|---|
|  | 6945 | cc_dim1]; | 
|---|
|  | 6946 | tr3 = cc[*ido + ((k << 2) + 2) * cc_dim1] + cc[*ido + ((k << 2) + 2) * | 
|---|
|  | 6947 | cc_dim1]; | 
|---|
|  | 6948 | tr4 = cc[((k << 2) + 3) * cc_dim1 + 1] + cc[((k << 2) + 3) * cc_dim1 | 
|---|
|  | 6949 | + 1]; | 
|---|
|  | 6950 | ch[(k + ch_dim2) * ch_dim1 + 1] = tr2 + tr3; | 
|---|
|  | 6951 | ch[(k + (ch_dim2 << 1)) * ch_dim1 + 1] = tr1 - tr4; | 
|---|
|  | 6952 | ch[(k + ch_dim2 * 3) * ch_dim1 + 1] = tr2 - tr3; | 
|---|
|  | 6953 | ch[(k + (ch_dim2 << 2)) * ch_dim1 + 1] = tr1 + tr4; | 
|---|
|  | 6954 | /* L101: */ | 
|---|
|  | 6955 | } | 
|---|
|  | 6956 | if ((i__1 = *ido - 2) < 0) { | 
|---|
|  | 6957 | goto L107; | 
|---|
|  | 6958 | } else if (i__1 == 0) { | 
|---|
|  | 6959 | goto L105; | 
|---|
|  | 6960 | } else { | 
|---|
|  | 6961 | goto L102; | 
|---|
|  | 6962 | } | 
|---|
|  | 6963 | L102: | 
|---|
|  | 6964 | idp2 = *ido + 2; | 
|---|
|  | 6965 | i__1 = *l1; | 
|---|
|  | 6966 | for (k = 1; k <= i__1; ++k) { | 
|---|
|  | 6967 | i__2 = *ido; | 
|---|
|  | 6968 | for (i__ = 3; i__ <= i__2; i__ += 2) { | 
|---|
|  | 6969 | ic = idp2 - i__; | 
|---|
|  | 6970 | ti1 = cc[i__ + ((k << 2) + 1) * cc_dim1] + cc[ic + ((k << 2) + 4) | 
|---|
|  | 6971 | * cc_dim1]; | 
|---|
|  | 6972 | ti2 = cc[i__ + ((k << 2) + 1) * cc_dim1] - cc[ic + ((k << 2) + 4) | 
|---|
|  | 6973 | * cc_dim1]; | 
|---|
|  | 6974 | ti3 = cc[i__ + ((k << 2) + 3) * cc_dim1] - cc[ic + ((k << 2) + 2) | 
|---|
|  | 6975 | * cc_dim1]; | 
|---|
|  | 6976 | tr4 = cc[i__ + ((k << 2) + 3) * cc_dim1] + cc[ic + ((k << 2) + 2) | 
|---|
|  | 6977 | * cc_dim1]; | 
|---|
|  | 6978 | tr1 = cc[i__ - 1 + ((k << 2) + 1) * cc_dim1] - cc[ic - 1 + ((k << | 
|---|
|  | 6979 | 2) + 4) * cc_dim1]; | 
|---|
|  | 6980 | tr2 = cc[i__ - 1 + ((k << 2) + 1) * cc_dim1] + cc[ic - 1 + ((k << | 
|---|
|  | 6981 | 2) + 4) * cc_dim1]; | 
|---|
|  | 6982 | ti4 = cc[i__ - 1 + ((k << 2) + 3) * cc_dim1] - cc[ic - 1 + ((k << | 
|---|
|  | 6983 | 2) + 2) * cc_dim1]; | 
|---|
|  | 6984 | tr3 = cc[i__ - 1 + ((k << 2) + 3) * cc_dim1] + cc[ic - 1 + ((k << | 
|---|
|  | 6985 | 2) + 2) * cc_dim1]; | 
|---|
|  | 6986 | ch[i__ - 1 + (k + ch_dim2) * ch_dim1] = tr2 + tr3; | 
|---|
|  | 6987 | cr3 = tr2 - tr3; | 
|---|
|  | 6988 | ch[i__ + (k + ch_dim2) * ch_dim1] = ti2 + ti3; | 
|---|
|  | 6989 | ci3 = ti2 - ti3; | 
|---|
|  | 6990 | cr2 = tr1 - tr4; | 
|---|
|  | 6991 | cr4 = tr1 + tr4; | 
|---|
|  | 6992 | ci2 = ti1 + ti4; | 
|---|
|  | 6993 | ci4 = ti1 - ti4; | 
|---|
|  | 6994 | ch[i__ - 1 + (k + (ch_dim2 << 1)) * ch_dim1] = wa1[i__ - 2] * cr2 | 
|---|
|  | 6995 | - wa1[i__ - 1] * ci2; | 
|---|
|  | 6996 | ch[i__ + (k + (ch_dim2 << 1)) * ch_dim1] = wa1[i__ - 2] * ci2 + | 
|---|
|  | 6997 | wa1[i__ - 1] * cr2; | 
|---|
|  | 6998 | ch[i__ - 1 + (k + ch_dim2 * 3) * ch_dim1] = wa2[i__ - 2] * cr3 - | 
|---|
|  | 6999 | wa2[i__ - 1] * ci3; | 
|---|
|  | 7000 | ch[i__ + (k + ch_dim2 * 3) * ch_dim1] = wa2[i__ - 2] * ci3 + wa2[ | 
|---|
|  | 7001 | i__ - 1] * cr3; | 
|---|
|  | 7002 | ch[i__ - 1 + (k + (ch_dim2 << 2)) * ch_dim1] = wa3[i__ - 2] * cr4 | 
|---|
|  | 7003 | - wa3[i__ - 1] * ci4; | 
|---|
|  | 7004 | ch[i__ + (k + (ch_dim2 << 2)) * ch_dim1] = wa3[i__ - 2] * ci4 + | 
|---|
|  | 7005 | wa3[i__ - 1] * cr4; | 
|---|
|  | 7006 | /* L103: */ | 
|---|
|  | 7007 | } | 
|---|
|  | 7008 | /* L104: */ | 
|---|
|  | 7009 | } | 
|---|
|  | 7010 | if (*ido % 2 == 1) { | 
|---|
|  | 7011 | return 0; | 
|---|
|  | 7012 | } | 
|---|
|  | 7013 | L105: | 
|---|
|  | 7014 | i__1 = *l1; | 
|---|
|  | 7015 | for (k = 1; k <= i__1; ++k) { | 
|---|
|  | 7016 | ti1 = cc[((k << 2) + 2) * cc_dim1 + 1] + cc[((k << 2) + 4) * cc_dim1 | 
|---|
|  | 7017 | + 1]; | 
|---|
|  | 7018 | ti2 = cc[((k << 2) + 4) * cc_dim1 + 1] - cc[((k << 2) + 2) * cc_dim1 | 
|---|
|  | 7019 | + 1]; | 
|---|
|  | 7020 | tr1 = cc[*ido + ((k << 2) + 1) * cc_dim1] - cc[*ido + ((k << 2) + 3) * | 
|---|
|  | 7021 | cc_dim1]; | 
|---|
|  | 7022 | tr2 = cc[*ido + ((k << 2) + 1) * cc_dim1] + cc[*ido + ((k << 2) + 3) * | 
|---|
|  | 7023 | cc_dim1]; | 
|---|
|  | 7024 | ch[*ido + (k + ch_dim2) * ch_dim1] = tr2 + tr2; | 
|---|
|  | 7025 | ch[*ido + (k + (ch_dim2 << 1)) * ch_dim1] = sqrt2 * (tr1 - ti1); | 
|---|
|  | 7026 | ch[*ido + (k + ch_dim2 * 3) * ch_dim1] = ti2 + ti2; | 
|---|
|  | 7027 | ch[*ido + (k + (ch_dim2 << 2)) * ch_dim1] = -sqrt2 * (tr1 + ti1); | 
|---|
|  | 7028 | /* L106: */ | 
|---|
|  | 7029 | } | 
|---|
|  | 7030 | L107: | 
|---|
|  | 7031 | return 0; | 
|---|
|  | 7032 | } /* dadb4_ */ | 
|---|
|  | 7033 |  | 
|---|
|  | 7034 | /*  ------ File dadb5.f ------ */ | 
|---|
| [756] | 7035 | /* Subroutine */ int dadb5_(int_4 *ido, int_4 *l1, r_8 *cc, r_8 *ch, | 
|---|
| [717] | 7036 | r_8 *wa1, r_8 *wa2, r_8 *wa3, r_8 *wa4) | 
|---|
| [459] | 7037 | { | 
|---|
|  | 7038 | /* Initialized data */ | 
|---|
|  | 7039 |  | 
|---|
| [717] | 7040 | static r_8 tr11 = .309016994374947f; | 
|---|
|  | 7041 | static r_8 ti11 = .951056516295154f; | 
|---|
|  | 7042 | static r_8 tr12 = -.809016994374947f; | 
|---|
|  | 7043 | static r_8 ti12 = .587785252292473f; | 
|---|
| [459] | 7044 |  | 
|---|
|  | 7045 | /* System generated locals */ | 
|---|
| [756] | 7046 | int_4 cc_dim1, cc_offset, ch_dim1, ch_dim2, ch_offset, i__1, i__2; | 
|---|
| [459] | 7047 |  | 
|---|
|  | 7048 | /* Local variables */ | 
|---|
| [756] | 7049 | static int_4 i__, k, ic; | 
|---|
| [717] | 7050 | static r_8 ci2, ci3, ci4, ci5, di3, di4, di5, di2, cr2, cr3, cr5, cr4, | 
|---|
| [459] | 7051 | ti2, ti3, ti4, ti5, dr3, dr4, dr5, dr2, tr2, tr3, tr4, tr5; | 
|---|
| [756] | 7052 | static int_4 idp2; | 
|---|
| [459] | 7053 |  | 
|---|
|  | 7054 | /* Parameter adjustments */ | 
|---|
|  | 7055 | ch_dim1 = *ido; | 
|---|
|  | 7056 | ch_dim2 = *l1; | 
|---|
|  | 7057 | ch_offset = ch_dim1 * (ch_dim2 + 1) + 1; | 
|---|
|  | 7058 | ch -= ch_offset; | 
|---|
|  | 7059 | cc_dim1 = *ido; | 
|---|
|  | 7060 | cc_offset = cc_dim1 * 6 + 1; | 
|---|
|  | 7061 | cc -= cc_offset; | 
|---|
|  | 7062 | --wa1; | 
|---|
|  | 7063 | --wa2; | 
|---|
|  | 7064 | --wa3; | 
|---|
|  | 7065 | --wa4; | 
|---|
|  | 7066 |  | 
|---|
|  | 7067 | /* Function Body */ | 
|---|
|  | 7068 | i__1 = *l1; | 
|---|
|  | 7069 | for (k = 1; k <= i__1; ++k) { | 
|---|
|  | 7070 | ti5 = cc[(k * 5 + 3) * cc_dim1 + 1] + cc[(k * 5 + 3) * cc_dim1 + 1]; | 
|---|
|  | 7071 | ti4 = cc[(k * 5 + 5) * cc_dim1 + 1] + cc[(k * 5 + 5) * cc_dim1 + 1]; | 
|---|
|  | 7072 | tr2 = cc[*ido + (k * 5 + 2) * cc_dim1] + cc[*ido + (k * 5 + 2) * | 
|---|
|  | 7073 | cc_dim1]; | 
|---|
|  | 7074 | tr3 = cc[*ido + (k * 5 + 4) * cc_dim1] + cc[*ido + (k * 5 + 4) * | 
|---|
|  | 7075 | cc_dim1]; | 
|---|
|  | 7076 | ch[(k + ch_dim2) * ch_dim1 + 1] = cc[(k * 5 + 1) * cc_dim1 + 1] + tr2 | 
|---|
|  | 7077 | + tr3; | 
|---|
|  | 7078 | cr2 = cc[(k * 5 + 1) * cc_dim1 + 1] + tr11 * tr2 + tr12 * tr3; | 
|---|
|  | 7079 | cr3 = cc[(k * 5 + 1) * cc_dim1 + 1] + tr12 * tr2 + tr11 * tr3; | 
|---|
|  | 7080 | ci5 = ti11 * ti5 + ti12 * ti4; | 
|---|
|  | 7081 | ci4 = ti12 * ti5 - ti11 * ti4; | 
|---|
|  | 7082 | ch[(k + (ch_dim2 << 1)) * ch_dim1 + 1] = cr2 - ci5; | 
|---|
|  | 7083 | ch[(k + ch_dim2 * 3) * ch_dim1 + 1] = cr3 - ci4; | 
|---|
|  | 7084 | ch[(k + (ch_dim2 << 2)) * ch_dim1 + 1] = cr3 + ci4; | 
|---|
|  | 7085 | ch[(k + ch_dim2 * 5) * ch_dim1 + 1] = cr2 + ci5; | 
|---|
|  | 7086 | /* L101: */ | 
|---|
|  | 7087 | } | 
|---|
|  | 7088 | if (*ido == 1) { | 
|---|
|  | 7089 | return 0; | 
|---|
|  | 7090 | } | 
|---|
|  | 7091 | idp2 = *ido + 2; | 
|---|
|  | 7092 | i__1 = *l1; | 
|---|
|  | 7093 | for (k = 1; k <= i__1; ++k) { | 
|---|
|  | 7094 | i__2 = *ido; | 
|---|
|  | 7095 | for (i__ = 3; i__ <= i__2; i__ += 2) { | 
|---|
|  | 7096 | ic = idp2 - i__; | 
|---|
|  | 7097 | ti5 = cc[i__ + (k * 5 + 3) * cc_dim1] + cc[ic + (k * 5 + 2) * | 
|---|
|  | 7098 | cc_dim1]; | 
|---|
|  | 7099 | ti2 = cc[i__ + (k * 5 + 3) * cc_dim1] - cc[ic + (k * 5 + 2) * | 
|---|
|  | 7100 | cc_dim1]; | 
|---|
|  | 7101 | ti4 = cc[i__ + (k * 5 + 5) * cc_dim1] + cc[ic + (k * 5 + 4) * | 
|---|
|  | 7102 | cc_dim1]; | 
|---|
|  | 7103 | ti3 = cc[i__ + (k * 5 + 5) * cc_dim1] - cc[ic + (k * 5 + 4) * | 
|---|
|  | 7104 | cc_dim1]; | 
|---|
|  | 7105 | tr5 = cc[i__ - 1 + (k * 5 + 3) * cc_dim1] - cc[ic - 1 + (k * 5 + | 
|---|
|  | 7106 | 2) * cc_dim1]; | 
|---|
|  | 7107 | tr2 = cc[i__ - 1 + (k * 5 + 3) * cc_dim1] + cc[ic - 1 + (k * 5 + | 
|---|
|  | 7108 | 2) * cc_dim1]; | 
|---|
|  | 7109 | tr4 = cc[i__ - 1 + (k * 5 + 5) * cc_dim1] - cc[ic - 1 + (k * 5 + | 
|---|
|  | 7110 | 4) * cc_dim1]; | 
|---|
|  | 7111 | tr3 = cc[i__ - 1 + (k * 5 + 5) * cc_dim1] + cc[ic - 1 + (k * 5 + | 
|---|
|  | 7112 | 4) * cc_dim1]; | 
|---|
|  | 7113 | ch[i__ - 1 + (k + ch_dim2) * ch_dim1] = cc[i__ - 1 + (k * 5 + 1) * | 
|---|
|  | 7114 | cc_dim1] + tr2 + tr3; | 
|---|
|  | 7115 | ch[i__ + (k + ch_dim2) * ch_dim1] = cc[i__ + (k * 5 + 1) * | 
|---|
|  | 7116 | cc_dim1] + ti2 + ti3; | 
|---|
|  | 7117 | cr2 = cc[i__ - 1 + (k * 5 + 1) * cc_dim1] + tr11 * tr2 + tr12 * | 
|---|
|  | 7118 | tr3; | 
|---|
|  | 7119 | ci2 = cc[i__ + (k * 5 + 1) * cc_dim1] + tr11 * ti2 + tr12 * ti3; | 
|---|
|  | 7120 | cr3 = cc[i__ - 1 + (k * 5 + 1) * cc_dim1] + tr12 * tr2 + tr11 * | 
|---|
|  | 7121 | tr3; | 
|---|
|  | 7122 | ci3 = cc[i__ + (k * 5 + 1) * cc_dim1] + tr12 * ti2 + tr11 * ti3; | 
|---|
|  | 7123 | cr5 = ti11 * tr5 + ti12 * tr4; | 
|---|
|  | 7124 | ci5 = ti11 * ti5 + ti12 * ti4; | 
|---|
|  | 7125 | cr4 = ti12 * tr5 - ti11 * tr4; | 
|---|
|  | 7126 | ci4 = ti12 * ti5 - ti11 * ti4; | 
|---|
|  | 7127 | dr3 = cr3 - ci4; | 
|---|
|  | 7128 | dr4 = cr3 + ci4; | 
|---|
|  | 7129 | di3 = ci3 + cr4; | 
|---|
|  | 7130 | di4 = ci3 - cr4; | 
|---|
|  | 7131 | dr5 = cr2 + ci5; | 
|---|
|  | 7132 | dr2 = cr2 - ci5; | 
|---|
|  | 7133 | di5 = ci2 - cr5; | 
|---|
|  | 7134 | di2 = ci2 + cr5; | 
|---|
|  | 7135 | ch[i__ - 1 + (k + (ch_dim2 << 1)) * ch_dim1] = wa1[i__ - 2] * dr2 | 
|---|
|  | 7136 | - wa1[i__ - 1] * di2; | 
|---|
|  | 7137 | ch[i__ + (k + (ch_dim2 << 1)) * ch_dim1] = wa1[i__ - 2] * di2 + | 
|---|
|  | 7138 | wa1[i__ - 1] * dr2; | 
|---|
|  | 7139 | ch[i__ - 1 + (k + ch_dim2 * 3) * ch_dim1] = wa2[i__ - 2] * dr3 - | 
|---|
|  | 7140 | wa2[i__ - 1] * di3; | 
|---|
|  | 7141 | ch[i__ + (k + ch_dim2 * 3) * ch_dim1] = wa2[i__ - 2] * di3 + wa2[ | 
|---|
|  | 7142 | i__ - 1] * dr3; | 
|---|
|  | 7143 | ch[i__ - 1 + (k + (ch_dim2 << 2)) * ch_dim1] = wa3[i__ - 2] * dr4 | 
|---|
|  | 7144 | - wa3[i__ - 1] * di4; | 
|---|
|  | 7145 | ch[i__ + (k + (ch_dim2 << 2)) * ch_dim1] = wa3[i__ - 2] * di4 + | 
|---|
|  | 7146 | wa3[i__ - 1] * dr4; | 
|---|
|  | 7147 | ch[i__ - 1 + (k + ch_dim2 * 5) * ch_dim1] = wa4[i__ - 2] * dr5 - | 
|---|
|  | 7148 | wa4[i__ - 1] * di5; | 
|---|
|  | 7149 | ch[i__ + (k + ch_dim2 * 5) * ch_dim1] = wa4[i__ - 2] * di5 + wa4[ | 
|---|
|  | 7150 | i__ - 1] * dr5; | 
|---|
|  | 7151 | /* L102: */ | 
|---|
|  | 7152 | } | 
|---|
|  | 7153 | /* L103: */ | 
|---|
|  | 7154 | } | 
|---|
|  | 7155 | return 0; | 
|---|
|  | 7156 | } /* dadb5_ */ | 
|---|
|  | 7157 |  | 
|---|
|  | 7158 | /*  ------ File dadbg.f ------ */ | 
|---|
| [756] | 7159 | /* Subroutine */ int dadbg_(int_4 *ido, int_4 *ip, int_4 *l1, int_4 * | 
|---|
| [717] | 7160 | idl1, r_8 *cc, r_8 *c1, r_8 *c2, r_8 *ch, r_8 *ch2, r_8 *wa) | 
|---|
| [459] | 7161 | { | 
|---|
|  | 7162 | /* Initialized data */ | 
|---|
|  | 7163 |  | 
|---|
| [717] | 7164 | static r_8 tpi = 6.28318530717959f; | 
|---|
| [459] | 7165 |  | 
|---|
|  | 7166 | /* System generated locals */ | 
|---|
| [756] | 7167 | int_4 ch_dim1, ch_dim2, ch_offset, cc_dim1, cc_dim2, cc_offset, c1_dim1, | 
|---|
| [459] | 7168 | c1_dim2, c1_offset, c2_dim1, c2_offset, ch2_dim1, ch2_offset, | 
|---|
|  | 7169 | i__1, i__2, i__3; | 
|---|
|  | 7170 |  | 
|---|
|  | 7171 | /* Builtin functions */ | 
|---|
| [717] | 7172 | /*    r_8 cos(r_8truc), sin(r_8truc);  remplace par math.h  Reza 29/11/99 */ | 
|---|
| [459] | 7173 |  | 
|---|
|  | 7174 | /* Local variables */ | 
|---|
| [756] | 7175 | static int_4 idij, ipph, i__, j, k, l, j2, ic, jc, lc, ik, is; | 
|---|
| [717] | 7176 | static r_8 dc2, ai1, ai2, ar1, ar2, ds2; | 
|---|
| [756] | 7177 | static int_4 nbd; | 
|---|
| [717] | 7178 | static r_8 dcp, arg, dsp, ar1h, ar2h; | 
|---|
| [756] | 7179 | static int_4 idp2, ipp2; | 
|---|
| [459] | 7180 |  | 
|---|
|  | 7181 | /* Parameter adjustments */ | 
|---|
|  | 7182 | ch_dim1 = *ido; | 
|---|
|  | 7183 | ch_dim2 = *l1; | 
|---|
|  | 7184 | ch_offset = ch_dim1 * (ch_dim2 + 1) + 1; | 
|---|
|  | 7185 | ch -= ch_offset; | 
|---|
|  | 7186 | c1_dim1 = *ido; | 
|---|
|  | 7187 | c1_dim2 = *l1; | 
|---|
|  | 7188 | c1_offset = c1_dim1 * (c1_dim2 + 1) + 1; | 
|---|
|  | 7189 | c1 -= c1_offset; | 
|---|
|  | 7190 | cc_dim1 = *ido; | 
|---|
|  | 7191 | cc_dim2 = *ip; | 
|---|
|  | 7192 | cc_offset = cc_dim1 * (cc_dim2 + 1) + 1; | 
|---|
|  | 7193 | cc -= cc_offset; | 
|---|
|  | 7194 | ch2_dim1 = *idl1; | 
|---|
|  | 7195 | ch2_offset = ch2_dim1 + 1; | 
|---|
|  | 7196 | ch2 -= ch2_offset; | 
|---|
|  | 7197 | c2_dim1 = *idl1; | 
|---|
|  | 7198 | c2_offset = c2_dim1 + 1; | 
|---|
|  | 7199 | c2 -= c2_offset; | 
|---|
|  | 7200 | --wa; | 
|---|
|  | 7201 |  | 
|---|
|  | 7202 | /* Function Body */ | 
|---|
| [717] | 7203 | arg = tpi / (r_8) (*ip); | 
|---|
| [459] | 7204 | dcp = cos(arg); | 
|---|
|  | 7205 | dsp = sin(arg); | 
|---|
|  | 7206 | idp2 = *ido + 2; | 
|---|
|  | 7207 | nbd = (*ido - 1) / 2; | 
|---|
|  | 7208 | ipp2 = *ip + 2; | 
|---|
|  | 7209 | ipph = (*ip + 1) / 2; | 
|---|
|  | 7210 | if (*ido < *l1) { | 
|---|
|  | 7211 | goto L103; | 
|---|
|  | 7212 | } | 
|---|
|  | 7213 | i__1 = *l1; | 
|---|
|  | 7214 | for (k = 1; k <= i__1; ++k) { | 
|---|
|  | 7215 | i__2 = *ido; | 
|---|
|  | 7216 | for (i__ = 1; i__ <= i__2; ++i__) { | 
|---|
|  | 7217 | ch[i__ + (k + ch_dim2) * ch_dim1] = cc[i__ + (k * cc_dim2 + 1) * | 
|---|
|  | 7218 | cc_dim1]; | 
|---|
|  | 7219 | /* L101: */ | 
|---|
|  | 7220 | } | 
|---|
|  | 7221 | /* L102: */ | 
|---|
|  | 7222 | } | 
|---|
|  | 7223 | goto L106; | 
|---|
|  | 7224 | L103: | 
|---|
|  | 7225 | i__1 = *ido; | 
|---|
|  | 7226 | for (i__ = 1; i__ <= i__1; ++i__) { | 
|---|
|  | 7227 | i__2 = *l1; | 
|---|
|  | 7228 | for (k = 1; k <= i__2; ++k) { | 
|---|
|  | 7229 | ch[i__ + (k + ch_dim2) * ch_dim1] = cc[i__ + (k * cc_dim2 + 1) * | 
|---|
|  | 7230 | cc_dim1]; | 
|---|
|  | 7231 | /* L104: */ | 
|---|
|  | 7232 | } | 
|---|
|  | 7233 | /* L105: */ | 
|---|
|  | 7234 | } | 
|---|
|  | 7235 | L106: | 
|---|
|  | 7236 | i__1 = ipph; | 
|---|
|  | 7237 | for (j = 2; j <= i__1; ++j) { | 
|---|
|  | 7238 | jc = ipp2 - j; | 
|---|
|  | 7239 | j2 = j + j; | 
|---|
|  | 7240 | i__2 = *l1; | 
|---|
|  | 7241 | for (k = 1; k <= i__2; ++k) { | 
|---|
|  | 7242 | ch[(k + j * ch_dim2) * ch_dim1 + 1] = cc[*ido + (j2 - 2 + k * | 
|---|
|  | 7243 | cc_dim2) * cc_dim1] + cc[*ido + (j2 - 2 + k * cc_dim2) * | 
|---|
|  | 7244 | cc_dim1]; | 
|---|
|  | 7245 | ch[(k + jc * ch_dim2) * ch_dim1 + 1] = cc[(j2 - 1 + k * cc_dim2) * | 
|---|
|  | 7246 | cc_dim1 + 1] + cc[(j2 - 1 + k * cc_dim2) * cc_dim1 + 1]; | 
|---|
|  | 7247 | /* L107: */ | 
|---|
|  | 7248 | } | 
|---|
|  | 7249 | /* L108: */ | 
|---|
|  | 7250 | } | 
|---|
|  | 7251 | if (*ido == 1) { | 
|---|
|  | 7252 | goto L116; | 
|---|
|  | 7253 | } | 
|---|
|  | 7254 | if (nbd < *l1) { | 
|---|
|  | 7255 | goto L112; | 
|---|
|  | 7256 | } | 
|---|
|  | 7257 | i__1 = ipph; | 
|---|
|  | 7258 | for (j = 2; j <= i__1; ++j) { | 
|---|
|  | 7259 | jc = ipp2 - j; | 
|---|
|  | 7260 | i__2 = *l1; | 
|---|
|  | 7261 | for (k = 1; k <= i__2; ++k) { | 
|---|
|  | 7262 | i__3 = *ido; | 
|---|
|  | 7263 | for (i__ = 3; i__ <= i__3; i__ += 2) { | 
|---|
|  | 7264 | ic = idp2 - i__; | 
|---|
|  | 7265 | ch[i__ - 1 + (k + j * ch_dim2) * ch_dim1] = cc[i__ - 1 + ((j | 
|---|
|  | 7266 | << 1) - 1 + k * cc_dim2) * cc_dim1] + cc[ic - 1 + ((j | 
|---|
|  | 7267 | << 1) - 2 + k * cc_dim2) * cc_dim1]; | 
|---|
|  | 7268 | ch[i__ - 1 + (k + jc * ch_dim2) * ch_dim1] = cc[i__ - 1 + ((j | 
|---|
|  | 7269 | << 1) - 1 + k * cc_dim2) * cc_dim1] - cc[ic - 1 + ((j | 
|---|
|  | 7270 | << 1) - 2 + k * cc_dim2) * cc_dim1]; | 
|---|
|  | 7271 | ch[i__ + (k + j * ch_dim2) * ch_dim1] = cc[i__ + ((j << 1) - | 
|---|
|  | 7272 | 1 + k * cc_dim2) * cc_dim1] - cc[ic + ((j << 1) - 2 + | 
|---|
|  | 7273 | k * cc_dim2) * cc_dim1]; | 
|---|
|  | 7274 | ch[i__ + (k + jc * ch_dim2) * ch_dim1] = cc[i__ + ((j << 1) - | 
|---|
|  | 7275 | 1 + k * cc_dim2) * cc_dim1] + cc[ic + ((j << 1) - 2 + | 
|---|
|  | 7276 | k * cc_dim2) * cc_dim1]; | 
|---|
|  | 7277 | /* L109: */ | 
|---|
|  | 7278 | } | 
|---|
|  | 7279 | /* L110: */ | 
|---|
|  | 7280 | } | 
|---|
|  | 7281 | /* L111: */ | 
|---|
|  | 7282 | } | 
|---|
|  | 7283 | goto L116; | 
|---|
|  | 7284 | L112: | 
|---|
|  | 7285 | i__1 = ipph; | 
|---|
|  | 7286 | for (j = 2; j <= i__1; ++j) { | 
|---|
|  | 7287 | jc = ipp2 - j; | 
|---|
|  | 7288 | i__2 = *ido; | 
|---|
|  | 7289 | for (i__ = 3; i__ <= i__2; i__ += 2) { | 
|---|
|  | 7290 | ic = idp2 - i__; | 
|---|
|  | 7291 | i__3 = *l1; | 
|---|
|  | 7292 | for (k = 1; k <= i__3; ++k) { | 
|---|
|  | 7293 | ch[i__ - 1 + (k + j * ch_dim2) * ch_dim1] = cc[i__ - 1 + ((j | 
|---|
|  | 7294 | << 1) - 1 + k * cc_dim2) * cc_dim1] + cc[ic - 1 + ((j | 
|---|
|  | 7295 | << 1) - 2 + k * cc_dim2) * cc_dim1]; | 
|---|
|  | 7296 | ch[i__ - 1 + (k + jc * ch_dim2) * ch_dim1] = cc[i__ - 1 + ((j | 
|---|
|  | 7297 | << 1) - 1 + k * cc_dim2) * cc_dim1] - cc[ic - 1 + ((j | 
|---|
|  | 7298 | << 1) - 2 + k * cc_dim2) * cc_dim1]; | 
|---|
|  | 7299 | ch[i__ + (k + j * ch_dim2) * ch_dim1] = cc[i__ + ((j << 1) - | 
|---|
|  | 7300 | 1 + k * cc_dim2) * cc_dim1] - cc[ic + ((j << 1) - 2 + | 
|---|
|  | 7301 | k * cc_dim2) * cc_dim1]; | 
|---|
|  | 7302 | ch[i__ + (k + jc * ch_dim2) * ch_dim1] = cc[i__ + ((j << 1) - | 
|---|
|  | 7303 | 1 + k * cc_dim2) * cc_dim1] + cc[ic + ((j << 1) - 2 + | 
|---|
|  | 7304 | k * cc_dim2) * cc_dim1]; | 
|---|
|  | 7305 | /* L113: */ | 
|---|
|  | 7306 | } | 
|---|
|  | 7307 | /* L114: */ | 
|---|
|  | 7308 | } | 
|---|
|  | 7309 | /* L115: */ | 
|---|
|  | 7310 | } | 
|---|
|  | 7311 | L116: | 
|---|
|  | 7312 | ar1 = 1.f; | 
|---|
|  | 7313 | ai1 = 0.f; | 
|---|
|  | 7314 | i__1 = ipph; | 
|---|
|  | 7315 | for (l = 2; l <= i__1; ++l) { | 
|---|
|  | 7316 | lc = ipp2 - l; | 
|---|
|  | 7317 | ar1h = dcp * ar1 - dsp * ai1; | 
|---|
|  | 7318 | ai1 = dcp * ai1 + dsp * ar1; | 
|---|
|  | 7319 | ar1 = ar1h; | 
|---|
|  | 7320 | i__2 = *idl1; | 
|---|
|  | 7321 | for (ik = 1; ik <= i__2; ++ik) { | 
|---|
|  | 7322 | c2[ik + l * c2_dim1] = ch2[ik + ch2_dim1] + ar1 * ch2[ik + ( | 
|---|
|  | 7323 | ch2_dim1 << 1)]; | 
|---|
|  | 7324 | c2[ik + lc * c2_dim1] = ai1 * ch2[ik + *ip * ch2_dim1]; | 
|---|
|  | 7325 | /* L117: */ | 
|---|
|  | 7326 | } | 
|---|
|  | 7327 | dc2 = ar1; | 
|---|
|  | 7328 | ds2 = ai1; | 
|---|
|  | 7329 | ar2 = ar1; | 
|---|
|  | 7330 | ai2 = ai1; | 
|---|
|  | 7331 | i__2 = ipph; | 
|---|
|  | 7332 | for (j = 3; j <= i__2; ++j) { | 
|---|
|  | 7333 | jc = ipp2 - j; | 
|---|
|  | 7334 | ar2h = dc2 * ar2 - ds2 * ai2; | 
|---|
|  | 7335 | ai2 = dc2 * ai2 + ds2 * ar2; | 
|---|
|  | 7336 | ar2 = ar2h; | 
|---|
|  | 7337 | i__3 = *idl1; | 
|---|
|  | 7338 | for (ik = 1; ik <= i__3; ++ik) { | 
|---|
|  | 7339 | c2[ik + l * c2_dim1] += ar2 * ch2[ik + j * ch2_dim1]; | 
|---|
|  | 7340 | c2[ik + lc * c2_dim1] += ai2 * ch2[ik + jc * ch2_dim1]; | 
|---|
|  | 7341 | /* L118: */ | 
|---|
|  | 7342 | } | 
|---|
|  | 7343 | /* L119: */ | 
|---|
|  | 7344 | } | 
|---|
|  | 7345 | /* L120: */ | 
|---|
|  | 7346 | } | 
|---|
|  | 7347 | i__1 = ipph; | 
|---|
|  | 7348 | for (j = 2; j <= i__1; ++j) { | 
|---|
|  | 7349 | i__2 = *idl1; | 
|---|
|  | 7350 | for (ik = 1; ik <= i__2; ++ik) { | 
|---|
|  | 7351 | ch2[ik + ch2_dim1] += ch2[ik + j * ch2_dim1]; | 
|---|
|  | 7352 | /* L121: */ | 
|---|
|  | 7353 | } | 
|---|
|  | 7354 | /* L122: */ | 
|---|
|  | 7355 | } | 
|---|
|  | 7356 | i__1 = ipph; | 
|---|
|  | 7357 | for (j = 2; j <= i__1; ++j) { | 
|---|
|  | 7358 | jc = ipp2 - j; | 
|---|
|  | 7359 | i__2 = *l1; | 
|---|
|  | 7360 | for (k = 1; k <= i__2; ++k) { | 
|---|
|  | 7361 | ch[(k + j * ch_dim2) * ch_dim1 + 1] = c1[(k + j * c1_dim2) * | 
|---|
|  | 7362 | c1_dim1 + 1] - c1[(k + jc * c1_dim2) * c1_dim1 + 1]; | 
|---|
|  | 7363 | ch[(k + jc * ch_dim2) * ch_dim1 + 1] = c1[(k + j * c1_dim2) * | 
|---|
|  | 7364 | c1_dim1 + 1] + c1[(k + jc * c1_dim2) * c1_dim1 + 1]; | 
|---|
|  | 7365 | /* L123: */ | 
|---|
|  | 7366 | } | 
|---|
|  | 7367 | /* L124: */ | 
|---|
|  | 7368 | } | 
|---|
|  | 7369 | if (*ido == 1) { | 
|---|
|  | 7370 | goto L132; | 
|---|
|  | 7371 | } | 
|---|
|  | 7372 | if (nbd < *l1) { | 
|---|
|  | 7373 | goto L128; | 
|---|
|  | 7374 | } | 
|---|
|  | 7375 | i__1 = ipph; | 
|---|
|  | 7376 | for (j = 2; j <= i__1; ++j) { | 
|---|
|  | 7377 | jc = ipp2 - j; | 
|---|
|  | 7378 | i__2 = *l1; | 
|---|
|  | 7379 | for (k = 1; k <= i__2; ++k) { | 
|---|
|  | 7380 | i__3 = *ido; | 
|---|
|  | 7381 | for (i__ = 3; i__ <= i__3; i__ += 2) { | 
|---|
|  | 7382 | ch[i__ - 1 + (k + j * ch_dim2) * ch_dim1] = c1[i__ - 1 + (k + | 
|---|
|  | 7383 | j * c1_dim2) * c1_dim1] - c1[i__ + (k + jc * c1_dim2) | 
|---|
|  | 7384 | * c1_dim1]; | 
|---|
|  | 7385 | ch[i__ - 1 + (k + jc * ch_dim2) * ch_dim1] = c1[i__ - 1 + (k | 
|---|
|  | 7386 | + j * c1_dim2) * c1_dim1] + c1[i__ + (k + jc * | 
|---|
|  | 7387 | c1_dim2) * c1_dim1]; | 
|---|
|  | 7388 | ch[i__ + (k + j * ch_dim2) * ch_dim1] = c1[i__ + (k + j * | 
|---|
|  | 7389 | c1_dim2) * c1_dim1] + c1[i__ - 1 + (k + jc * c1_dim2) | 
|---|
|  | 7390 | * c1_dim1]; | 
|---|
|  | 7391 | ch[i__ + (k + jc * ch_dim2) * ch_dim1] = c1[i__ + (k + j * | 
|---|
|  | 7392 | c1_dim2) * c1_dim1] - c1[i__ - 1 + (k + jc * c1_dim2) | 
|---|
|  | 7393 | * c1_dim1]; | 
|---|
|  | 7394 | /* L125: */ | 
|---|
|  | 7395 | } | 
|---|
|  | 7396 | /* L126: */ | 
|---|
|  | 7397 | } | 
|---|
|  | 7398 | /* L127: */ | 
|---|
|  | 7399 | } | 
|---|
|  | 7400 | goto L132; | 
|---|
|  | 7401 | L128: | 
|---|
|  | 7402 | i__1 = ipph; | 
|---|
|  | 7403 | for (j = 2; j <= i__1; ++j) { | 
|---|
|  | 7404 | jc = ipp2 - j; | 
|---|
|  | 7405 | i__2 = *ido; | 
|---|
|  | 7406 | for (i__ = 3; i__ <= i__2; i__ += 2) { | 
|---|
|  | 7407 | i__3 = *l1; | 
|---|
|  | 7408 | for (k = 1; k <= i__3; ++k) { | 
|---|
|  | 7409 | ch[i__ - 1 + (k + j * ch_dim2) * ch_dim1] = c1[i__ - 1 + (k + | 
|---|
|  | 7410 | j * c1_dim2) * c1_dim1] - c1[i__ + (k + jc * c1_dim2) | 
|---|
|  | 7411 | * c1_dim1]; | 
|---|
|  | 7412 | ch[i__ - 1 + (k + jc * ch_dim2) * ch_dim1] = c1[i__ - 1 + (k | 
|---|
|  | 7413 | + j * c1_dim2) * c1_dim1] + c1[i__ + (k + jc * | 
|---|
|  | 7414 | c1_dim2) * c1_dim1]; | 
|---|
|  | 7415 | ch[i__ + (k + j * ch_dim2) * ch_dim1] = c1[i__ + (k + j * | 
|---|
|  | 7416 | c1_dim2) * c1_dim1] + c1[i__ - 1 + (k + jc * c1_dim2) | 
|---|
|  | 7417 | * c1_dim1]; | 
|---|
|  | 7418 | ch[i__ + (k + jc * ch_dim2) * ch_dim1] = c1[i__ + (k + j * | 
|---|
|  | 7419 | c1_dim2) * c1_dim1] - c1[i__ - 1 + (k + jc * c1_dim2) | 
|---|
|  | 7420 | * c1_dim1]; | 
|---|
|  | 7421 | /* L129: */ | 
|---|
|  | 7422 | } | 
|---|
|  | 7423 | /* L130: */ | 
|---|
|  | 7424 | } | 
|---|
|  | 7425 | /* L131: */ | 
|---|
|  | 7426 | } | 
|---|
|  | 7427 | L132: | 
|---|
|  | 7428 | if (*ido == 1) { | 
|---|
|  | 7429 | return 0; | 
|---|
|  | 7430 | } | 
|---|
|  | 7431 | i__1 = *idl1; | 
|---|
|  | 7432 | for (ik = 1; ik <= i__1; ++ik) { | 
|---|
|  | 7433 | c2[ik + c2_dim1] = ch2[ik + ch2_dim1]; | 
|---|
|  | 7434 | /* L133: */ | 
|---|
|  | 7435 | } | 
|---|
|  | 7436 | i__1 = *ip; | 
|---|
|  | 7437 | for (j = 2; j <= i__1; ++j) { | 
|---|
|  | 7438 | i__2 = *l1; | 
|---|
|  | 7439 | for (k = 1; k <= i__2; ++k) { | 
|---|
|  | 7440 | c1[(k + j * c1_dim2) * c1_dim1 + 1] = ch[(k + j * ch_dim2) * | 
|---|
|  | 7441 | ch_dim1 + 1]; | 
|---|
|  | 7442 | /* L134: */ | 
|---|
|  | 7443 | } | 
|---|
|  | 7444 | /* L135: */ | 
|---|
|  | 7445 | } | 
|---|
|  | 7446 | if (nbd > *l1) { | 
|---|
|  | 7447 | goto L139; | 
|---|
|  | 7448 | } | 
|---|
|  | 7449 | is = -(*ido); | 
|---|
|  | 7450 | i__1 = *ip; | 
|---|
|  | 7451 | for (j = 2; j <= i__1; ++j) { | 
|---|
|  | 7452 | is += *ido; | 
|---|
|  | 7453 | idij = is; | 
|---|
|  | 7454 | i__2 = *ido; | 
|---|
|  | 7455 | for (i__ = 3; i__ <= i__2; i__ += 2) { | 
|---|
|  | 7456 | idij += 2; | 
|---|
|  | 7457 | i__3 = *l1; | 
|---|
|  | 7458 | for (k = 1; k <= i__3; ++k) { | 
|---|
|  | 7459 | c1[i__ - 1 + (k + j * c1_dim2) * c1_dim1] = wa[idij - 1] * ch[ | 
|---|
|  | 7460 | i__ - 1 + (k + j * ch_dim2) * ch_dim1] - wa[idij] * | 
|---|
|  | 7461 | ch[i__ + (k + j * ch_dim2) * ch_dim1]; | 
|---|
|  | 7462 | c1[i__ + (k + j * c1_dim2) * c1_dim1] = wa[idij - 1] * ch[i__ | 
|---|
|  | 7463 | + (k + j * ch_dim2) * ch_dim1] + wa[idij] * ch[i__ - | 
|---|
|  | 7464 | 1 + (k + j * ch_dim2) * ch_dim1]; | 
|---|
|  | 7465 | /* L136: */ | 
|---|
|  | 7466 | } | 
|---|
|  | 7467 | /* L137: */ | 
|---|
|  | 7468 | } | 
|---|
|  | 7469 | /* L138: */ | 
|---|
|  | 7470 | } | 
|---|
|  | 7471 | goto L143; | 
|---|
|  | 7472 | L139: | 
|---|
|  | 7473 | is = -(*ido); | 
|---|
|  | 7474 | i__1 = *ip; | 
|---|
|  | 7475 | for (j = 2; j <= i__1; ++j) { | 
|---|
|  | 7476 | is += *ido; | 
|---|
|  | 7477 | i__2 = *l1; | 
|---|
|  | 7478 | for (k = 1; k <= i__2; ++k) { | 
|---|
|  | 7479 | idij = is; | 
|---|
|  | 7480 | i__3 = *ido; | 
|---|
|  | 7481 | for (i__ = 3; i__ <= i__3; i__ += 2) { | 
|---|
|  | 7482 | idij += 2; | 
|---|
|  | 7483 | c1[i__ - 1 + (k + j * c1_dim2) * c1_dim1] = wa[idij - 1] * ch[ | 
|---|
|  | 7484 | i__ - 1 + (k + j * ch_dim2) * ch_dim1] - wa[idij] * | 
|---|
|  | 7485 | ch[i__ + (k + j * ch_dim2) * ch_dim1]; | 
|---|
|  | 7486 | c1[i__ + (k + j * c1_dim2) * c1_dim1] = wa[idij - 1] * ch[i__ | 
|---|
|  | 7487 | + (k + j * ch_dim2) * ch_dim1] + wa[idij] * ch[i__ - | 
|---|
|  | 7488 | 1 + (k + j * ch_dim2) * ch_dim1]; | 
|---|
|  | 7489 | /* L140: */ | 
|---|
|  | 7490 | } | 
|---|
|  | 7491 | /* L141: */ | 
|---|
|  | 7492 | } | 
|---|
|  | 7493 | /* L142: */ | 
|---|
|  | 7494 | } | 
|---|
|  | 7495 | L143: | 
|---|
|  | 7496 | return 0; | 
|---|
|  | 7497 | } /* dadbg_ */ | 
|---|
|  | 7498 |  | 
|---|
|  | 7499 | /*  ------ File dadf2.f ------ */ | 
|---|
| [756] | 7500 | /* Subroutine */ int dadf2_(int_4 *ido, int_4 *l1, r_8 *cc, r_8 *ch, | 
|---|
| [717] | 7501 | r_8 *wa1) | 
|---|
| [459] | 7502 | { | 
|---|
|  | 7503 | /* System generated locals */ | 
|---|
| [756] | 7504 | int_4 ch_dim1, ch_offset, cc_dim1, cc_dim2, cc_offset, i__1, i__2; | 
|---|
| [459] | 7505 |  | 
|---|
|  | 7506 | /* Local variables */ | 
|---|
| [756] | 7507 | static int_4 i__, k, ic; | 
|---|
| [717] | 7508 | static r_8 ti2, tr2; | 
|---|
| [756] | 7509 | static int_4 idp2; | 
|---|
| [459] | 7510 |  | 
|---|
|  | 7511 | /* Parameter adjustments */ | 
|---|
|  | 7512 | ch_dim1 = *ido; | 
|---|
|  | 7513 | ch_offset = ch_dim1 * 3 + 1; | 
|---|
|  | 7514 | ch -= ch_offset; | 
|---|
|  | 7515 | cc_dim1 = *ido; | 
|---|
|  | 7516 | cc_dim2 = *l1; | 
|---|
|  | 7517 | cc_offset = cc_dim1 * (cc_dim2 + 1) + 1; | 
|---|
|  | 7518 | cc -= cc_offset; | 
|---|
|  | 7519 | --wa1; | 
|---|
|  | 7520 |  | 
|---|
|  | 7521 | /* Function Body */ | 
|---|
|  | 7522 | i__1 = *l1; | 
|---|
|  | 7523 | for (k = 1; k <= i__1; ++k) { | 
|---|
|  | 7524 | ch[((k << 1) + 1) * ch_dim1 + 1] = cc[(k + cc_dim2) * cc_dim1 + 1] + | 
|---|
|  | 7525 | cc[(k + (cc_dim2 << 1)) * cc_dim1 + 1]; | 
|---|
|  | 7526 | ch[*ido + ((k << 1) + 2) * ch_dim1] = cc[(k + cc_dim2) * cc_dim1 + 1] | 
|---|
|  | 7527 | - cc[(k + (cc_dim2 << 1)) * cc_dim1 + 1]; | 
|---|
|  | 7528 | /* L101: */ | 
|---|
|  | 7529 | } | 
|---|
|  | 7530 | if ((i__1 = *ido - 2) < 0) { | 
|---|
|  | 7531 | goto L107; | 
|---|
|  | 7532 | } else if (i__1 == 0) { | 
|---|
|  | 7533 | goto L105; | 
|---|
|  | 7534 | } else { | 
|---|
|  | 7535 | goto L102; | 
|---|
|  | 7536 | } | 
|---|
|  | 7537 | L102: | 
|---|
|  | 7538 | idp2 = *ido + 2; | 
|---|
|  | 7539 | i__1 = *l1; | 
|---|
|  | 7540 | for (k = 1; k <= i__1; ++k) { | 
|---|
|  | 7541 | i__2 = *ido; | 
|---|
|  | 7542 | for (i__ = 3; i__ <= i__2; i__ += 2) { | 
|---|
|  | 7543 | ic = idp2 - i__; | 
|---|
|  | 7544 | tr2 = wa1[i__ - 2] * cc[i__ - 1 + (k + (cc_dim2 << 1)) * cc_dim1] | 
|---|
|  | 7545 | + wa1[i__ - 1] * cc[i__ + (k + (cc_dim2 << 1)) * cc_dim1]; | 
|---|
|  | 7546 | ti2 = wa1[i__ - 2] * cc[i__ + (k + (cc_dim2 << 1)) * cc_dim1] - | 
|---|
|  | 7547 | wa1[i__ - 1] * cc[i__ - 1 + (k + (cc_dim2 << 1)) * | 
|---|
|  | 7548 | cc_dim1]; | 
|---|
|  | 7549 | ch[i__ + ((k << 1) + 1) * ch_dim1] = cc[i__ + (k + cc_dim2) * | 
|---|
|  | 7550 | cc_dim1] + ti2; | 
|---|
|  | 7551 | ch[ic + ((k << 1) + 2) * ch_dim1] = ti2 - cc[i__ + (k + cc_dim2) * | 
|---|
|  | 7552 | cc_dim1]; | 
|---|
|  | 7553 | ch[i__ - 1 + ((k << 1) + 1) * ch_dim1] = cc[i__ - 1 + (k + | 
|---|
|  | 7554 | cc_dim2) * cc_dim1] + tr2; | 
|---|
|  | 7555 | ch[ic - 1 + ((k << 1) + 2) * ch_dim1] = cc[i__ - 1 + (k + cc_dim2) | 
|---|
|  | 7556 | * cc_dim1] - tr2; | 
|---|
|  | 7557 | /* L103: */ | 
|---|
|  | 7558 | } | 
|---|
|  | 7559 | /* L104: */ | 
|---|
|  | 7560 | } | 
|---|
|  | 7561 | if (*ido % 2 == 1) { | 
|---|
|  | 7562 | return 0; | 
|---|
|  | 7563 | } | 
|---|
|  | 7564 | L105: | 
|---|
|  | 7565 | i__1 = *l1; | 
|---|
|  | 7566 | for (k = 1; k <= i__1; ++k) { | 
|---|
|  | 7567 | ch[((k << 1) + 2) * ch_dim1 + 1] = -cc[*ido + (k + (cc_dim2 << 1)) * | 
|---|
|  | 7568 | cc_dim1]; | 
|---|
|  | 7569 | ch[*ido + ((k << 1) + 1) * ch_dim1] = cc[*ido + (k + cc_dim2) * | 
|---|
|  | 7570 | cc_dim1]; | 
|---|
|  | 7571 | /* L106: */ | 
|---|
|  | 7572 | } | 
|---|
|  | 7573 | L107: | 
|---|
|  | 7574 | return 0; | 
|---|
|  | 7575 | } /* dadf2_ */ | 
|---|
|  | 7576 |  | 
|---|
|  | 7577 | /*  ------ File dadf3.f ------ */ | 
|---|
| [756] | 7578 | /* Subroutine */ int dadf3_(int_4 *ido, int_4 *l1, r_8 *cc, r_8 *ch, | 
|---|
| [717] | 7579 | r_8 *wa1, r_8 *wa2) | 
|---|
| [459] | 7580 | { | 
|---|
|  | 7581 | /* Initialized data */ | 
|---|
|  | 7582 |  | 
|---|
| [717] | 7583 | static r_8 taur = -.5f; | 
|---|
|  | 7584 | static r_8 taui = .866025403784439f; | 
|---|
| [459] | 7585 |  | 
|---|
|  | 7586 | /* System generated locals */ | 
|---|
| [756] | 7587 | int_4 ch_dim1, ch_offset, cc_dim1, cc_dim2, cc_offset, i__1, i__2; | 
|---|
| [459] | 7588 |  | 
|---|
|  | 7589 | /* Local variables */ | 
|---|
| [756] | 7590 | static int_4 i__, k, ic; | 
|---|
| [717] | 7591 | static r_8 ci2, di2, di3, cr2, dr2, dr3, ti2, ti3, tr2, tr3; | 
|---|
| [756] | 7592 | static int_4 idp2; | 
|---|
| [459] | 7593 |  | 
|---|
|  | 7594 | /* Parameter adjustments */ | 
|---|
|  | 7595 | ch_dim1 = *ido; | 
|---|
|  | 7596 | ch_offset = (ch_dim1 << 2) + 1; | 
|---|
|  | 7597 | ch -= ch_offset; | 
|---|
|  | 7598 | cc_dim1 = *ido; | 
|---|
|  | 7599 | cc_dim2 = *l1; | 
|---|
|  | 7600 | cc_offset = cc_dim1 * (cc_dim2 + 1) + 1; | 
|---|
|  | 7601 | cc -= cc_offset; | 
|---|
|  | 7602 | --wa1; | 
|---|
|  | 7603 | --wa2; | 
|---|
|  | 7604 |  | 
|---|
|  | 7605 | /* Function Body */ | 
|---|
|  | 7606 | i__1 = *l1; | 
|---|
|  | 7607 | for (k = 1; k <= i__1; ++k) { | 
|---|
|  | 7608 | cr2 = cc[(k + (cc_dim2 << 1)) * cc_dim1 + 1] + cc[(k + cc_dim2 * 3) * | 
|---|
|  | 7609 | cc_dim1 + 1]; | 
|---|
|  | 7610 | ch[(k * 3 + 1) * ch_dim1 + 1] = cc[(k + cc_dim2) * cc_dim1 + 1] + cr2; | 
|---|
|  | 7611 | ch[(k * 3 + 3) * ch_dim1 + 1] = taui * (cc[(k + cc_dim2 * 3) * | 
|---|
|  | 7612 | cc_dim1 + 1] - cc[(k + (cc_dim2 << 1)) * cc_dim1 + 1]); | 
|---|
|  | 7613 | ch[*ido + (k * 3 + 2) * ch_dim1] = cc[(k + cc_dim2) * cc_dim1 + 1] + | 
|---|
|  | 7614 | taur * cr2; | 
|---|
|  | 7615 | /* L101: */ | 
|---|
|  | 7616 | } | 
|---|
|  | 7617 | if (*ido == 1) { | 
|---|
|  | 7618 | return 0; | 
|---|
|  | 7619 | } | 
|---|
|  | 7620 | idp2 = *ido + 2; | 
|---|
|  | 7621 | i__1 = *l1; | 
|---|
|  | 7622 | for (k = 1; k <= i__1; ++k) { | 
|---|
|  | 7623 | i__2 = *ido; | 
|---|
|  | 7624 | for (i__ = 3; i__ <= i__2; i__ += 2) { | 
|---|
|  | 7625 | ic = idp2 - i__; | 
|---|
|  | 7626 | dr2 = wa1[i__ - 2] * cc[i__ - 1 + (k + (cc_dim2 << 1)) * cc_dim1] | 
|---|
|  | 7627 | + wa1[i__ - 1] * cc[i__ + (k + (cc_dim2 << 1)) * cc_dim1]; | 
|---|
|  | 7628 | di2 = wa1[i__ - 2] * cc[i__ + (k + (cc_dim2 << 1)) * cc_dim1] - | 
|---|
|  | 7629 | wa1[i__ - 1] * cc[i__ - 1 + (k + (cc_dim2 << 1)) * | 
|---|
|  | 7630 | cc_dim1]; | 
|---|
|  | 7631 | dr3 = wa2[i__ - 2] * cc[i__ - 1 + (k + cc_dim2 * 3) * cc_dim1] + | 
|---|
|  | 7632 | wa2[i__ - 1] * cc[i__ + (k + cc_dim2 * 3) * cc_dim1]; | 
|---|
|  | 7633 | di3 = wa2[i__ - 2] * cc[i__ + (k + cc_dim2 * 3) * cc_dim1] - wa2[ | 
|---|
|  | 7634 | i__ - 1] * cc[i__ - 1 + (k + cc_dim2 * 3) * cc_dim1]; | 
|---|
|  | 7635 | cr2 = dr2 + dr3; | 
|---|
|  | 7636 | ci2 = di2 + di3; | 
|---|
|  | 7637 | ch[i__ - 1 + (k * 3 + 1) * ch_dim1] = cc[i__ - 1 + (k + cc_dim2) * | 
|---|
|  | 7638 | cc_dim1] + cr2; | 
|---|
|  | 7639 | ch[i__ + (k * 3 + 1) * ch_dim1] = cc[i__ + (k + cc_dim2) * | 
|---|
|  | 7640 | cc_dim1] + ci2; | 
|---|
|  | 7641 | tr2 = cc[i__ - 1 + (k + cc_dim2) * cc_dim1] + taur * cr2; | 
|---|
|  | 7642 | ti2 = cc[i__ + (k + cc_dim2) * cc_dim1] + taur * ci2; | 
|---|
|  | 7643 | tr3 = taui * (di2 - di3); | 
|---|
|  | 7644 | ti3 = taui * (dr3 - dr2); | 
|---|
|  | 7645 | ch[i__ - 1 + (k * 3 + 3) * ch_dim1] = tr2 + tr3; | 
|---|
|  | 7646 | ch[ic - 1 + (k * 3 + 2) * ch_dim1] = tr2 - tr3; | 
|---|
|  | 7647 | ch[i__ + (k * 3 + 3) * ch_dim1] = ti2 + ti3; | 
|---|
|  | 7648 | ch[ic + (k * 3 + 2) * ch_dim1] = ti3 - ti2; | 
|---|
|  | 7649 | /* L102: */ | 
|---|
|  | 7650 | } | 
|---|
|  | 7651 | /* L103: */ | 
|---|
|  | 7652 | } | 
|---|
|  | 7653 | return 0; | 
|---|
|  | 7654 | } /* dadf3_ */ | 
|---|
|  | 7655 |  | 
|---|
|  | 7656 | /*  ------ File dadf4.f ------ */ | 
|---|
| [756] | 7657 | /* Subroutine */ int dadf4_(int_4 *ido, int_4 *l1, r_8 *cc, r_8 *ch, | 
|---|
| [717] | 7658 | r_8 *wa1, r_8 *wa2, r_8 *wa3) | 
|---|
| [459] | 7659 | { | 
|---|
|  | 7660 | /* Initialized data */ | 
|---|
|  | 7661 |  | 
|---|
| [717] | 7662 | static r_8 hsqt2 = .7071067811865475f; | 
|---|
| [459] | 7663 |  | 
|---|
|  | 7664 | /* System generated locals */ | 
|---|
| [756] | 7665 | int_4 cc_dim1, cc_dim2, cc_offset, ch_dim1, ch_offset, i__1, i__2; | 
|---|
| [459] | 7666 |  | 
|---|
|  | 7667 | /* Local variables */ | 
|---|
| [756] | 7668 | static int_4 i__, k, ic; | 
|---|
| [717] | 7669 | static r_8 ci2, ci3, ci4, cr2, cr3, cr4, ti1, ti2, ti3, ti4, tr1, tr2, | 
|---|
| [459] | 7670 | tr3, tr4; | 
|---|
| [756] | 7671 | static int_4 idp2; | 
|---|
| [459] | 7672 |  | 
|---|
|  | 7673 | /* Parameter adjustments */ | 
|---|
|  | 7674 | ch_dim1 = *ido; | 
|---|
|  | 7675 | ch_offset = ch_dim1 * 5 + 1; | 
|---|
|  | 7676 | ch -= ch_offset; | 
|---|
|  | 7677 | cc_dim1 = *ido; | 
|---|
|  | 7678 | cc_dim2 = *l1; | 
|---|
|  | 7679 | cc_offset = cc_dim1 * (cc_dim2 + 1) + 1; | 
|---|
|  | 7680 | cc -= cc_offset; | 
|---|
|  | 7681 | --wa1; | 
|---|
|  | 7682 | --wa2; | 
|---|
|  | 7683 | --wa3; | 
|---|
|  | 7684 |  | 
|---|
|  | 7685 | /* Function Body */ | 
|---|
|  | 7686 | i__1 = *l1; | 
|---|
|  | 7687 | for (k = 1; k <= i__1; ++k) { | 
|---|
|  | 7688 | tr1 = cc[(k + (cc_dim2 << 1)) * cc_dim1 + 1] + cc[(k + (cc_dim2 << 2)) | 
|---|
|  | 7689 | * cc_dim1 + 1]; | 
|---|
|  | 7690 | tr2 = cc[(k + cc_dim2) * cc_dim1 + 1] + cc[(k + cc_dim2 * 3) * | 
|---|
|  | 7691 | cc_dim1 + 1]; | 
|---|
|  | 7692 | ch[((k << 2) + 1) * ch_dim1 + 1] = tr1 + tr2; | 
|---|
|  | 7693 | ch[*ido + ((k << 2) + 4) * ch_dim1] = tr2 - tr1; | 
|---|
|  | 7694 | ch[*ido + ((k << 2) + 2) * ch_dim1] = cc[(k + cc_dim2) * cc_dim1 + 1] | 
|---|
|  | 7695 | - cc[(k + cc_dim2 * 3) * cc_dim1 + 1]; | 
|---|
|  | 7696 | ch[((k << 2) + 3) * ch_dim1 + 1] = cc[(k + (cc_dim2 << 2)) * cc_dim1 | 
|---|
|  | 7697 | + 1] - cc[(k + (cc_dim2 << 1)) * cc_dim1 + 1]; | 
|---|
|  | 7698 | /* L101: */ | 
|---|
|  | 7699 | } | 
|---|
|  | 7700 | if ((i__1 = *ido - 2) < 0) { | 
|---|
|  | 7701 | goto L107; | 
|---|
|  | 7702 | } else if (i__1 == 0) { | 
|---|
|  | 7703 | goto L105; | 
|---|
|  | 7704 | } else { | 
|---|
|  | 7705 | goto L102; | 
|---|
|  | 7706 | } | 
|---|
|  | 7707 | L102: | 
|---|
|  | 7708 | idp2 = *ido + 2; | 
|---|
|  | 7709 | i__1 = *l1; | 
|---|
|  | 7710 | for (k = 1; k <= i__1; ++k) { | 
|---|
|  | 7711 | i__2 = *ido; | 
|---|
|  | 7712 | for (i__ = 3; i__ <= i__2; i__ += 2) { | 
|---|
|  | 7713 | ic = idp2 - i__; | 
|---|
|  | 7714 | cr2 = wa1[i__ - 2] * cc[i__ - 1 + (k + (cc_dim2 << 1)) * cc_dim1] | 
|---|
|  | 7715 | + wa1[i__ - 1] * cc[i__ + (k + (cc_dim2 << 1)) * cc_dim1]; | 
|---|
|  | 7716 | ci2 = wa1[i__ - 2] * cc[i__ + (k + (cc_dim2 << 1)) * cc_dim1] - | 
|---|
|  | 7717 | wa1[i__ - 1] * cc[i__ - 1 + (k + (cc_dim2 << 1)) * | 
|---|
|  | 7718 | cc_dim1]; | 
|---|
|  | 7719 | cr3 = wa2[i__ - 2] * cc[i__ - 1 + (k + cc_dim2 * 3) * cc_dim1] + | 
|---|
|  | 7720 | wa2[i__ - 1] * cc[i__ + (k + cc_dim2 * 3) * cc_dim1]; | 
|---|
|  | 7721 | ci3 = wa2[i__ - 2] * cc[i__ + (k + cc_dim2 * 3) * cc_dim1] - wa2[ | 
|---|
|  | 7722 | i__ - 1] * cc[i__ - 1 + (k + cc_dim2 * 3) * cc_dim1]; | 
|---|
|  | 7723 | cr4 = wa3[i__ - 2] * cc[i__ - 1 + (k + (cc_dim2 << 2)) * cc_dim1] | 
|---|
|  | 7724 | + wa3[i__ - 1] * cc[i__ + (k + (cc_dim2 << 2)) * cc_dim1]; | 
|---|
|  | 7725 | ci4 = wa3[i__ - 2] * cc[i__ + (k + (cc_dim2 << 2)) * cc_dim1] - | 
|---|
|  | 7726 | wa3[i__ - 1] * cc[i__ - 1 + (k + (cc_dim2 << 2)) * | 
|---|
|  | 7727 | cc_dim1]; | 
|---|
|  | 7728 | tr1 = cr2 + cr4; | 
|---|
|  | 7729 | tr4 = cr4 - cr2; | 
|---|
|  | 7730 | ti1 = ci2 + ci4; | 
|---|
|  | 7731 | ti4 = ci2 - ci4; | 
|---|
|  | 7732 | ti2 = cc[i__ + (k + cc_dim2) * cc_dim1] + ci3; | 
|---|
|  | 7733 | ti3 = cc[i__ + (k + cc_dim2) * cc_dim1] - ci3; | 
|---|
|  | 7734 | tr2 = cc[i__ - 1 + (k + cc_dim2) * cc_dim1] + cr3; | 
|---|
|  | 7735 | tr3 = cc[i__ - 1 + (k + cc_dim2) * cc_dim1] - cr3; | 
|---|
|  | 7736 | ch[i__ - 1 + ((k << 2) + 1) * ch_dim1] = tr1 + tr2; | 
|---|
|  | 7737 | ch[ic - 1 + ((k << 2) + 4) * ch_dim1] = tr2 - tr1; | 
|---|
|  | 7738 | ch[i__ + ((k << 2) + 1) * ch_dim1] = ti1 + ti2; | 
|---|
|  | 7739 | ch[ic + ((k << 2) + 4) * ch_dim1] = ti1 - ti2; | 
|---|
|  | 7740 | ch[i__ - 1 + ((k << 2) + 3) * ch_dim1] = ti4 + tr3; | 
|---|
|  | 7741 | ch[ic - 1 + ((k << 2) + 2) * ch_dim1] = tr3 - ti4; | 
|---|
|  | 7742 | ch[i__ + ((k << 2) + 3) * ch_dim1] = tr4 + ti3; | 
|---|
|  | 7743 | ch[ic + ((k << 2) + 2) * ch_dim1] = tr4 - ti3; | 
|---|
|  | 7744 | /* L103: */ | 
|---|
|  | 7745 | } | 
|---|
|  | 7746 | /* L104: */ | 
|---|
|  | 7747 | } | 
|---|
|  | 7748 | if (*ido % 2 == 1) { | 
|---|
|  | 7749 | return 0; | 
|---|
|  | 7750 | } | 
|---|
|  | 7751 | L105: | 
|---|
|  | 7752 | i__1 = *l1; | 
|---|
|  | 7753 | for (k = 1; k <= i__1; ++k) { | 
|---|
|  | 7754 | ti1 = -hsqt2 * (cc[*ido + (k + (cc_dim2 << 1)) * cc_dim1] + cc[*ido + | 
|---|
|  | 7755 | (k + (cc_dim2 << 2)) * cc_dim1]); | 
|---|
|  | 7756 | tr1 = hsqt2 * (cc[*ido + (k + (cc_dim2 << 1)) * cc_dim1] - cc[*ido + ( | 
|---|
|  | 7757 | k + (cc_dim2 << 2)) * cc_dim1]); | 
|---|
|  | 7758 | ch[*ido + ((k << 2) + 1) * ch_dim1] = tr1 + cc[*ido + (k + cc_dim2) * | 
|---|
|  | 7759 | cc_dim1]; | 
|---|
|  | 7760 | ch[*ido + ((k << 2) + 3) * ch_dim1] = cc[*ido + (k + cc_dim2) * | 
|---|
|  | 7761 | cc_dim1] - tr1; | 
|---|
|  | 7762 | ch[((k << 2) + 2) * ch_dim1 + 1] = ti1 - cc[*ido + (k + cc_dim2 * 3) * | 
|---|
|  | 7763 | cc_dim1]; | 
|---|
|  | 7764 | ch[((k << 2) + 4) * ch_dim1 + 1] = ti1 + cc[*ido + (k + cc_dim2 * 3) * | 
|---|
|  | 7765 | cc_dim1]; | 
|---|
|  | 7766 | /* L106: */ | 
|---|
|  | 7767 | } | 
|---|
|  | 7768 | L107: | 
|---|
|  | 7769 | return 0; | 
|---|
|  | 7770 | } /* dadf4_ */ | 
|---|
|  | 7771 |  | 
|---|
|  | 7772 | /*  ------ File dadf5.f ------ */ | 
|---|
| [756] | 7773 | /* Subroutine */ int dadf5_(int_4 *ido, int_4 *l1, r_8 *cc, r_8 *ch, | 
|---|
| [717] | 7774 | r_8 *wa1, r_8 *wa2, r_8 *wa3, r_8 *wa4) | 
|---|
| [459] | 7775 | { | 
|---|
|  | 7776 | /* Initialized data */ | 
|---|
|  | 7777 |  | 
|---|
| [717] | 7778 | static r_8 tr11 = .309016994374947f; | 
|---|
|  | 7779 | static r_8 ti11 = .951056516295154f; | 
|---|
|  | 7780 | static r_8 tr12 = -.809016994374947f; | 
|---|
|  | 7781 | static r_8 ti12 = .587785252292473f; | 
|---|
| [459] | 7782 |  | 
|---|
|  | 7783 | /* System generated locals */ | 
|---|
| [756] | 7784 | int_4 cc_dim1, cc_dim2, cc_offset, ch_dim1, ch_offset, i__1, i__2; | 
|---|
| [459] | 7785 |  | 
|---|
|  | 7786 | /* Local variables */ | 
|---|
| [756] | 7787 | static int_4 i__, k, ic; | 
|---|
| [717] | 7788 | static r_8 ci2, di2, ci4, ci5, di3, di4, di5, ci3, cr2, cr3, dr2, dr3, | 
|---|
| [459] | 7789 | dr4, dr5, cr5, cr4, ti2, ti3, ti5, ti4, tr2, tr3, tr4, tr5; | 
|---|
| [756] | 7790 | static int_4 idp2; | 
|---|
| [459] | 7791 |  | 
|---|
|  | 7792 | /* Parameter adjustments */ | 
|---|
|  | 7793 | ch_dim1 = *ido; | 
|---|
|  | 7794 | ch_offset = ch_dim1 * 6 + 1; | 
|---|
|  | 7795 | ch -= ch_offset; | 
|---|
|  | 7796 | cc_dim1 = *ido; | 
|---|
|  | 7797 | cc_dim2 = *l1; | 
|---|
|  | 7798 | cc_offset = cc_dim1 * (cc_dim2 + 1) + 1; | 
|---|
|  | 7799 | cc -= cc_offset; | 
|---|
|  | 7800 | --wa1; | 
|---|
|  | 7801 | --wa2; | 
|---|
|  | 7802 | --wa3; | 
|---|
|  | 7803 | --wa4; | 
|---|
|  | 7804 |  | 
|---|
|  | 7805 | /* Function Body */ | 
|---|
|  | 7806 | i__1 = *l1; | 
|---|
|  | 7807 | for (k = 1; k <= i__1; ++k) { | 
|---|
|  | 7808 | cr2 = cc[(k + cc_dim2 * 5) * cc_dim1 + 1] + cc[(k + (cc_dim2 << 1)) * | 
|---|
|  | 7809 | cc_dim1 + 1]; | 
|---|
|  | 7810 | ci5 = cc[(k + cc_dim2 * 5) * cc_dim1 + 1] - cc[(k + (cc_dim2 << 1)) * | 
|---|
|  | 7811 | cc_dim1 + 1]; | 
|---|
|  | 7812 | cr3 = cc[(k + (cc_dim2 << 2)) * cc_dim1 + 1] + cc[(k + cc_dim2 * 3) * | 
|---|
|  | 7813 | cc_dim1 + 1]; | 
|---|
|  | 7814 | ci4 = cc[(k + (cc_dim2 << 2)) * cc_dim1 + 1] - cc[(k + cc_dim2 * 3) * | 
|---|
|  | 7815 | cc_dim1 + 1]; | 
|---|
|  | 7816 | ch[(k * 5 + 1) * ch_dim1 + 1] = cc[(k + cc_dim2) * cc_dim1 + 1] + cr2 | 
|---|
|  | 7817 | + cr3; | 
|---|
|  | 7818 | ch[*ido + (k * 5 + 2) * ch_dim1] = cc[(k + cc_dim2) * cc_dim1 + 1] + | 
|---|
|  | 7819 | tr11 * cr2 + tr12 * cr3; | 
|---|
|  | 7820 | ch[(k * 5 + 3) * ch_dim1 + 1] = ti11 * ci5 + ti12 * ci4; | 
|---|
|  | 7821 | ch[*ido + (k * 5 + 4) * ch_dim1] = cc[(k + cc_dim2) * cc_dim1 + 1] + | 
|---|
|  | 7822 | tr12 * cr2 + tr11 * cr3; | 
|---|
|  | 7823 | ch[(k * 5 + 5) * ch_dim1 + 1] = ti12 * ci5 - ti11 * ci4; | 
|---|
|  | 7824 | /* L101: */ | 
|---|
|  | 7825 | } | 
|---|
|  | 7826 | if (*ido == 1) { | 
|---|
|  | 7827 | return 0; | 
|---|
|  | 7828 | } | 
|---|
|  | 7829 | idp2 = *ido + 2; | 
|---|
|  | 7830 | i__1 = *l1; | 
|---|
|  | 7831 | for (k = 1; k <= i__1; ++k) { | 
|---|
|  | 7832 | i__2 = *ido; | 
|---|
|  | 7833 | for (i__ = 3; i__ <= i__2; i__ += 2) { | 
|---|
|  | 7834 | ic = idp2 - i__; | 
|---|
|  | 7835 | dr2 = wa1[i__ - 2] * cc[i__ - 1 + (k + (cc_dim2 << 1)) * cc_dim1] | 
|---|
|  | 7836 | + wa1[i__ - 1] * cc[i__ + (k + (cc_dim2 << 1)) * cc_dim1]; | 
|---|
|  | 7837 | di2 = wa1[i__ - 2] * cc[i__ + (k + (cc_dim2 << 1)) * cc_dim1] - | 
|---|
|  | 7838 | wa1[i__ - 1] * cc[i__ - 1 + (k + (cc_dim2 << 1)) * | 
|---|
|  | 7839 | cc_dim1]; | 
|---|
|  | 7840 | dr3 = wa2[i__ - 2] * cc[i__ - 1 + (k + cc_dim2 * 3) * cc_dim1] + | 
|---|
|  | 7841 | wa2[i__ - 1] * cc[i__ + (k + cc_dim2 * 3) * cc_dim1]; | 
|---|
|  | 7842 | di3 = wa2[i__ - 2] * cc[i__ + (k + cc_dim2 * 3) * cc_dim1] - wa2[ | 
|---|
|  | 7843 | i__ - 1] * cc[i__ - 1 + (k + cc_dim2 * 3) * cc_dim1]; | 
|---|
|  | 7844 | dr4 = wa3[i__ - 2] * cc[i__ - 1 + (k + (cc_dim2 << 2)) * cc_dim1] | 
|---|
|  | 7845 | + wa3[i__ - 1] * cc[i__ + (k + (cc_dim2 << 2)) * cc_dim1]; | 
|---|
|  | 7846 | di4 = wa3[i__ - 2] * cc[i__ + (k + (cc_dim2 << 2)) * cc_dim1] - | 
|---|
|  | 7847 | wa3[i__ - 1] * cc[i__ - 1 + (k + (cc_dim2 << 2)) * | 
|---|
|  | 7848 | cc_dim1]; | 
|---|
|  | 7849 | dr5 = wa4[i__ - 2] * cc[i__ - 1 + (k + cc_dim2 * 5) * cc_dim1] + | 
|---|
|  | 7850 | wa4[i__ - 1] * cc[i__ + (k + cc_dim2 * 5) * cc_dim1]; | 
|---|
|  | 7851 | di5 = wa4[i__ - 2] * cc[i__ + (k + cc_dim2 * 5) * cc_dim1] - wa4[ | 
|---|
|  | 7852 | i__ - 1] * cc[i__ - 1 + (k + cc_dim2 * 5) * cc_dim1]; | 
|---|
|  | 7853 | cr2 = dr2 + dr5; | 
|---|
|  | 7854 | ci5 = dr5 - dr2; | 
|---|
|  | 7855 | cr5 = di2 - di5; | 
|---|
|  | 7856 | ci2 = di2 + di5; | 
|---|
|  | 7857 | cr3 = dr3 + dr4; | 
|---|
|  | 7858 | ci4 = dr4 - dr3; | 
|---|
|  | 7859 | cr4 = di3 - di4; | 
|---|
|  | 7860 | ci3 = di3 + di4; | 
|---|
|  | 7861 | ch[i__ - 1 + (k * 5 + 1) * ch_dim1] = cc[i__ - 1 + (k + cc_dim2) * | 
|---|
|  | 7862 | cc_dim1] + cr2 + cr3; | 
|---|
|  | 7863 | ch[i__ + (k * 5 + 1) * ch_dim1] = cc[i__ + (k + cc_dim2) * | 
|---|
|  | 7864 | cc_dim1] + ci2 + ci3; | 
|---|
|  | 7865 | tr2 = cc[i__ - 1 + (k + cc_dim2) * cc_dim1] + tr11 * cr2 + tr12 * | 
|---|
|  | 7866 | cr3; | 
|---|
|  | 7867 | ti2 = cc[i__ + (k + cc_dim2) * cc_dim1] + tr11 * ci2 + tr12 * ci3; | 
|---|
|  | 7868 | tr3 = cc[i__ - 1 + (k + cc_dim2) * cc_dim1] + tr12 * cr2 + tr11 * | 
|---|
|  | 7869 | cr3; | 
|---|
|  | 7870 | ti3 = cc[i__ + (k + cc_dim2) * cc_dim1] + tr12 * ci2 + tr11 * ci3; | 
|---|
|  | 7871 | tr5 = ti11 * cr5 + ti12 * cr4; | 
|---|
|  | 7872 | ti5 = ti11 * ci5 + ti12 * ci4; | 
|---|
|  | 7873 | tr4 = ti12 * cr5 - ti11 * cr4; | 
|---|
|  | 7874 | ti4 = ti12 * ci5 - ti11 * ci4; | 
|---|
|  | 7875 | ch[i__ - 1 + (k * 5 + 3) * ch_dim1] = tr2 + tr5; | 
|---|
|  | 7876 | ch[ic - 1 + (k * 5 + 2) * ch_dim1] = tr2 - tr5; | 
|---|
|  | 7877 | ch[i__ + (k * 5 + 3) * ch_dim1] = ti2 + ti5; | 
|---|
|  | 7878 | ch[ic + (k * 5 + 2) * ch_dim1] = ti5 - ti2; | 
|---|
|  | 7879 | ch[i__ - 1 + (k * 5 + 5) * ch_dim1] = tr3 + tr4; | 
|---|
|  | 7880 | ch[ic - 1 + (k * 5 + 4) * ch_dim1] = tr3 - tr4; | 
|---|
|  | 7881 | ch[i__ + (k * 5 + 5) * ch_dim1] = ti3 + ti4; | 
|---|
|  | 7882 | ch[ic + (k * 5 + 4) * ch_dim1] = ti4 - ti3; | 
|---|
|  | 7883 | /* L102: */ | 
|---|
|  | 7884 | } | 
|---|
|  | 7885 | /* L103: */ | 
|---|
|  | 7886 | } | 
|---|
|  | 7887 | return 0; | 
|---|
|  | 7888 | } /* dadf5_ */ | 
|---|
|  | 7889 |  | 
|---|
|  | 7890 | /*  ------ File dadfg.f ------ */ | 
|---|
| [756] | 7891 | /* Subroutine */ int dadfg_(int_4 *ido, int_4 *ip, int_4 *l1, int_4 * | 
|---|
| [717] | 7892 | idl1, r_8 *cc, r_8 *c1, r_8 *c2, r_8 *ch, r_8 *ch2, r_8 *wa) | 
|---|
| [459] | 7893 | { | 
|---|
|  | 7894 | /* Initialized data */ | 
|---|
|  | 7895 |  | 
|---|
| [717] | 7896 | static r_8 tpi = 6.28318530717959f; | 
|---|
| [459] | 7897 |  | 
|---|
|  | 7898 | /* System generated locals */ | 
|---|
| [756] | 7899 | int_4 ch_dim1, ch_dim2, ch_offset, cc_dim1, cc_dim2, cc_offset, c1_dim1, | 
|---|
| [459] | 7900 | c1_dim2, c1_offset, c2_dim1, c2_offset, ch2_dim1, ch2_offset, | 
|---|
|  | 7901 | i__1, i__2, i__3; | 
|---|
|  | 7902 |  | 
|---|
|  | 7903 | /* Builtin functions */ | 
|---|
| [717] | 7904 | /*    r_8 cos(r_8truc), sin(r_8truc);   */ | 
|---|
| [459] | 7905 |  | 
|---|
|  | 7906 | /* Local variables */ | 
|---|
| [756] | 7907 | static int_4 idij, ipph, i__, j, k, l, j2, ic, jc, lc, ik, is; | 
|---|
| [717] | 7908 | static r_8 dc2, ai1, ai2, ar1, ar2, ds2; | 
|---|
| [756] | 7909 | static int_4 nbd; | 
|---|
| [717] | 7910 | static r_8 dcp, arg, dsp, ar1h, ar2h; | 
|---|
| [756] | 7911 | static int_4 idp2, ipp2; | 
|---|
| [459] | 7912 |  | 
|---|
|  | 7913 | /* Parameter adjustments */ | 
|---|
|  | 7914 | ch_dim1 = *ido; | 
|---|
|  | 7915 | ch_dim2 = *l1; | 
|---|
|  | 7916 | ch_offset = ch_dim1 * (ch_dim2 + 1) + 1; | 
|---|
|  | 7917 | ch -= ch_offset; | 
|---|
|  | 7918 | c1_dim1 = *ido; | 
|---|
|  | 7919 | c1_dim2 = *l1; | 
|---|
|  | 7920 | c1_offset = c1_dim1 * (c1_dim2 + 1) + 1; | 
|---|
|  | 7921 | c1 -= c1_offset; | 
|---|
|  | 7922 | cc_dim1 = *ido; | 
|---|
|  | 7923 | cc_dim2 = *ip; | 
|---|
|  | 7924 | cc_offset = cc_dim1 * (cc_dim2 + 1) + 1; | 
|---|
|  | 7925 | cc -= cc_offset; | 
|---|
|  | 7926 | ch2_dim1 = *idl1; | 
|---|
|  | 7927 | ch2_offset = ch2_dim1 + 1; | 
|---|
|  | 7928 | ch2 -= ch2_offset; | 
|---|
|  | 7929 | c2_dim1 = *idl1; | 
|---|
|  | 7930 | c2_offset = c2_dim1 + 1; | 
|---|
|  | 7931 | c2 -= c2_offset; | 
|---|
|  | 7932 | --wa; | 
|---|
|  | 7933 |  | 
|---|
|  | 7934 | /* Function Body */ | 
|---|
| [717] | 7935 | arg = tpi / (r_8) (*ip); | 
|---|
| [459] | 7936 | dcp = cos(arg); | 
|---|
|  | 7937 | dsp = sin(arg); | 
|---|
|  | 7938 | ipph = (*ip + 1) / 2; | 
|---|
|  | 7939 | ipp2 = *ip + 2; | 
|---|
|  | 7940 | idp2 = *ido + 2; | 
|---|
|  | 7941 | nbd = (*ido - 1) / 2; | 
|---|
|  | 7942 | if (*ido == 1) { | 
|---|
|  | 7943 | goto L119; | 
|---|
|  | 7944 | } | 
|---|
|  | 7945 | i__1 = *idl1; | 
|---|
|  | 7946 | for (ik = 1; ik <= i__1; ++ik) { | 
|---|
|  | 7947 | ch2[ik + ch2_dim1] = c2[ik + c2_dim1]; | 
|---|
|  | 7948 | /* L101: */ | 
|---|
|  | 7949 | } | 
|---|
|  | 7950 | i__1 = *ip; | 
|---|
|  | 7951 | for (j = 2; j <= i__1; ++j) { | 
|---|
|  | 7952 | i__2 = *l1; | 
|---|
|  | 7953 | for (k = 1; k <= i__2; ++k) { | 
|---|
|  | 7954 | ch[(k + j * ch_dim2) * ch_dim1 + 1] = c1[(k + j * c1_dim2) * | 
|---|
|  | 7955 | c1_dim1 + 1]; | 
|---|
|  | 7956 | /* L102: */ | 
|---|
|  | 7957 | } | 
|---|
|  | 7958 | /* L103: */ | 
|---|
|  | 7959 | } | 
|---|
|  | 7960 | if (nbd > *l1) { | 
|---|
|  | 7961 | goto L107; | 
|---|
|  | 7962 | } | 
|---|
|  | 7963 | is = -(*ido); | 
|---|
|  | 7964 | i__1 = *ip; | 
|---|
|  | 7965 | for (j = 2; j <= i__1; ++j) { | 
|---|
|  | 7966 | is += *ido; | 
|---|
|  | 7967 | idij = is; | 
|---|
|  | 7968 | i__2 = *ido; | 
|---|
|  | 7969 | for (i__ = 3; i__ <= i__2; i__ += 2) { | 
|---|
|  | 7970 | idij += 2; | 
|---|
|  | 7971 | i__3 = *l1; | 
|---|
|  | 7972 | for (k = 1; k <= i__3; ++k) { | 
|---|
|  | 7973 | ch[i__ - 1 + (k + j * ch_dim2) * ch_dim1] = wa[idij - 1] * c1[ | 
|---|
|  | 7974 | i__ - 1 + (k + j * c1_dim2) * c1_dim1] + wa[idij] * | 
|---|
|  | 7975 | c1[i__ + (k + j * c1_dim2) * c1_dim1]; | 
|---|
|  | 7976 | ch[i__ + (k + j * ch_dim2) * ch_dim1] = wa[idij - 1] * c1[i__ | 
|---|
|  | 7977 | + (k + j * c1_dim2) * c1_dim1] - wa[idij] * c1[i__ - | 
|---|
|  | 7978 | 1 + (k + j * c1_dim2) * c1_dim1]; | 
|---|
|  | 7979 | /* L104: */ | 
|---|
|  | 7980 | } | 
|---|
|  | 7981 | /* L105: */ | 
|---|
|  | 7982 | } | 
|---|
|  | 7983 | /* L106: */ | 
|---|
|  | 7984 | } | 
|---|
|  | 7985 | goto L111; | 
|---|
|  | 7986 | L107: | 
|---|
|  | 7987 | is = -(*ido); | 
|---|
|  | 7988 | i__1 = *ip; | 
|---|
|  | 7989 | for (j = 2; j <= i__1; ++j) { | 
|---|
|  | 7990 | is += *ido; | 
|---|
|  | 7991 | i__2 = *l1; | 
|---|
|  | 7992 | for (k = 1; k <= i__2; ++k) { | 
|---|
|  | 7993 | idij = is; | 
|---|
|  | 7994 | i__3 = *ido; | 
|---|
|  | 7995 | for (i__ = 3; i__ <= i__3; i__ += 2) { | 
|---|
|  | 7996 | idij += 2; | 
|---|
|  | 7997 | ch[i__ - 1 + (k + j * ch_dim2) * ch_dim1] = wa[idij - 1] * c1[ | 
|---|
|  | 7998 | i__ - 1 + (k + j * c1_dim2) * c1_dim1] + wa[idij] * | 
|---|
|  | 7999 | c1[i__ + (k + j * c1_dim2) * c1_dim1]; | 
|---|
|  | 8000 | ch[i__ + (k + j * ch_dim2) * ch_dim1] = wa[idij - 1] * c1[i__ | 
|---|
|  | 8001 | + (k + j * c1_dim2) * c1_dim1] - wa[idij] * c1[i__ - | 
|---|
|  | 8002 | 1 + (k + j * c1_dim2) * c1_dim1]; | 
|---|
|  | 8003 | /* L108: */ | 
|---|
|  | 8004 | } | 
|---|
|  | 8005 | /* L109: */ | 
|---|
|  | 8006 | } | 
|---|
|  | 8007 | /* L110: */ | 
|---|
|  | 8008 | } | 
|---|
|  | 8009 | L111: | 
|---|
|  | 8010 | if (nbd < *l1) { | 
|---|
|  | 8011 | goto L115; | 
|---|
|  | 8012 | } | 
|---|
|  | 8013 | i__1 = ipph; | 
|---|
|  | 8014 | for (j = 2; j <= i__1; ++j) { | 
|---|
|  | 8015 | jc = ipp2 - j; | 
|---|
|  | 8016 | i__2 = *l1; | 
|---|
|  | 8017 | for (k = 1; k <= i__2; ++k) { | 
|---|
|  | 8018 | i__3 = *ido; | 
|---|
|  | 8019 | for (i__ = 3; i__ <= i__3; i__ += 2) { | 
|---|
|  | 8020 | c1[i__ - 1 + (k + j * c1_dim2) * c1_dim1] = ch[i__ - 1 + (k + | 
|---|
|  | 8021 | j * ch_dim2) * ch_dim1] + ch[i__ - 1 + (k + jc * | 
|---|
|  | 8022 | ch_dim2) * ch_dim1]; | 
|---|
|  | 8023 | c1[i__ - 1 + (k + jc * c1_dim2) * c1_dim1] = ch[i__ + (k + j * | 
|---|
|  | 8024 | ch_dim2) * ch_dim1] - ch[i__ + (k + jc * ch_dim2) * | 
|---|
|  | 8025 | ch_dim1]; | 
|---|
|  | 8026 | c1[i__ + (k + j * c1_dim2) * c1_dim1] = ch[i__ + (k + j * | 
|---|
|  | 8027 | ch_dim2) * ch_dim1] + ch[i__ + (k + jc * ch_dim2) * | 
|---|
|  | 8028 | ch_dim1]; | 
|---|
|  | 8029 | c1[i__ + (k + jc * c1_dim2) * c1_dim1] = ch[i__ - 1 + (k + jc | 
|---|
|  | 8030 | * ch_dim2) * ch_dim1] - ch[i__ - 1 + (k + j * ch_dim2) | 
|---|
|  | 8031 | * ch_dim1]; | 
|---|
|  | 8032 | /* L112: */ | 
|---|
|  | 8033 | } | 
|---|
|  | 8034 | /* L113: */ | 
|---|
|  | 8035 | } | 
|---|
|  | 8036 | /* L114: */ | 
|---|
|  | 8037 | } | 
|---|
|  | 8038 | goto L121; | 
|---|
|  | 8039 | L115: | 
|---|
|  | 8040 | i__1 = ipph; | 
|---|
|  | 8041 | for (j = 2; j <= i__1; ++j) { | 
|---|
|  | 8042 | jc = ipp2 - j; | 
|---|
|  | 8043 | i__2 = *ido; | 
|---|
|  | 8044 | for (i__ = 3; i__ <= i__2; i__ += 2) { | 
|---|
|  | 8045 | i__3 = *l1; | 
|---|
|  | 8046 | for (k = 1; k <= i__3; ++k) { | 
|---|
|  | 8047 | c1[i__ - 1 + (k + j * c1_dim2) * c1_dim1] = ch[i__ - 1 + (k + | 
|---|
|  | 8048 | j * ch_dim2) * ch_dim1] + ch[i__ - 1 + (k + jc * | 
|---|
|  | 8049 | ch_dim2) * ch_dim1]; | 
|---|
|  | 8050 | c1[i__ - 1 + (k + jc * c1_dim2) * c1_dim1] = ch[i__ + (k + j * | 
|---|
|  | 8051 | ch_dim2) * ch_dim1] - ch[i__ + (k + jc * ch_dim2) * | 
|---|
|  | 8052 | ch_dim1]; | 
|---|
|  | 8053 | c1[i__ + (k + j * c1_dim2) * c1_dim1] = ch[i__ + (k + j * | 
|---|
|  | 8054 | ch_dim2) * ch_dim1] + ch[i__ + (k + jc * ch_dim2) * | 
|---|
|  | 8055 | ch_dim1]; | 
|---|
|  | 8056 | c1[i__ + (k + jc * c1_dim2) * c1_dim1] = ch[i__ - 1 + (k + jc | 
|---|
|  | 8057 | * ch_dim2) * ch_dim1] - ch[i__ - 1 + (k + j * ch_dim2) | 
|---|
|  | 8058 | * ch_dim1]; | 
|---|
|  | 8059 | /* L116: */ | 
|---|
|  | 8060 | } | 
|---|
|  | 8061 | /* L117: */ | 
|---|
|  | 8062 | } | 
|---|
|  | 8063 | /* L118: */ | 
|---|
|  | 8064 | } | 
|---|
|  | 8065 | goto L121; | 
|---|
|  | 8066 | L119: | 
|---|
|  | 8067 | i__1 = *idl1; | 
|---|
|  | 8068 | for (ik = 1; ik <= i__1; ++ik) { | 
|---|
|  | 8069 | c2[ik + c2_dim1] = ch2[ik + ch2_dim1]; | 
|---|
|  | 8070 | /* L120: */ | 
|---|
|  | 8071 | } | 
|---|
|  | 8072 | L121: | 
|---|
|  | 8073 | i__1 = ipph; | 
|---|
|  | 8074 | for (j = 2; j <= i__1; ++j) { | 
|---|
|  | 8075 | jc = ipp2 - j; | 
|---|
|  | 8076 | i__2 = *l1; | 
|---|
|  | 8077 | for (k = 1; k <= i__2; ++k) { | 
|---|
|  | 8078 | c1[(k + j * c1_dim2) * c1_dim1 + 1] = ch[(k + j * ch_dim2) * | 
|---|
|  | 8079 | ch_dim1 + 1] + ch[(k + jc * ch_dim2) * ch_dim1 + 1]; | 
|---|
|  | 8080 | c1[(k + jc * c1_dim2) * c1_dim1 + 1] = ch[(k + jc * ch_dim2) * | 
|---|
|  | 8081 | ch_dim1 + 1] - ch[(k + j * ch_dim2) * ch_dim1 + 1]; | 
|---|
|  | 8082 | /* L122: */ | 
|---|
|  | 8083 | } | 
|---|
|  | 8084 | /* L123: */ | 
|---|
|  | 8085 | } | 
|---|
|  | 8086 |  | 
|---|
|  | 8087 | ar1 = 1.f; | 
|---|
|  | 8088 | ai1 = 0.f; | 
|---|
|  | 8089 | i__1 = ipph; | 
|---|
|  | 8090 | for (l = 2; l <= i__1; ++l) { | 
|---|
|  | 8091 | lc = ipp2 - l; | 
|---|
|  | 8092 | ar1h = dcp * ar1 - dsp * ai1; | 
|---|
|  | 8093 | ai1 = dcp * ai1 + dsp * ar1; | 
|---|
|  | 8094 | ar1 = ar1h; | 
|---|
|  | 8095 | i__2 = *idl1; | 
|---|
|  | 8096 | for (ik = 1; ik <= i__2; ++ik) { | 
|---|
|  | 8097 | ch2[ik + l * ch2_dim1] = c2[ik + c2_dim1] + ar1 * c2[ik + ( | 
|---|
|  | 8098 | c2_dim1 << 1)]; | 
|---|
|  | 8099 | ch2[ik + lc * ch2_dim1] = ai1 * c2[ik + *ip * c2_dim1]; | 
|---|
|  | 8100 | /* L124: */ | 
|---|
|  | 8101 | } | 
|---|
|  | 8102 | dc2 = ar1; | 
|---|
|  | 8103 | ds2 = ai1; | 
|---|
|  | 8104 | ar2 = ar1; | 
|---|
|  | 8105 | ai2 = ai1; | 
|---|
|  | 8106 | i__2 = ipph; | 
|---|
|  | 8107 | for (j = 3; j <= i__2; ++j) { | 
|---|
|  | 8108 | jc = ipp2 - j; | 
|---|
|  | 8109 | ar2h = dc2 * ar2 - ds2 * ai2; | 
|---|
|  | 8110 | ai2 = dc2 * ai2 + ds2 * ar2; | 
|---|
|  | 8111 | ar2 = ar2h; | 
|---|
|  | 8112 | i__3 = *idl1; | 
|---|
|  | 8113 | for (ik = 1; ik <= i__3; ++ik) { | 
|---|
|  | 8114 | ch2[ik + l * ch2_dim1] += ar2 * c2[ik + j * c2_dim1]; | 
|---|
|  | 8115 | ch2[ik + lc * ch2_dim1] += ai2 * c2[ik + jc * c2_dim1]; | 
|---|
|  | 8116 | /* L125: */ | 
|---|
|  | 8117 | } | 
|---|
|  | 8118 | /* L126: */ | 
|---|
|  | 8119 | } | 
|---|
|  | 8120 | /* L127: */ | 
|---|
|  | 8121 | } | 
|---|
|  | 8122 | i__1 = ipph; | 
|---|
|  | 8123 | for (j = 2; j <= i__1; ++j) { | 
|---|
|  | 8124 | i__2 = *idl1; | 
|---|
|  | 8125 | for (ik = 1; ik <= i__2; ++ik) { | 
|---|
|  | 8126 | ch2[ik + ch2_dim1] += c2[ik + j * c2_dim1]; | 
|---|
|  | 8127 | /* L128: */ | 
|---|
|  | 8128 | } | 
|---|
|  | 8129 | /* L129: */ | 
|---|
|  | 8130 | } | 
|---|
|  | 8131 |  | 
|---|
|  | 8132 | if (*ido < *l1) { | 
|---|
|  | 8133 | goto L132; | 
|---|
|  | 8134 | } | 
|---|
|  | 8135 | i__1 = *l1; | 
|---|
|  | 8136 | for (k = 1; k <= i__1; ++k) { | 
|---|
|  | 8137 | i__2 = *ido; | 
|---|
|  | 8138 | for (i__ = 1; i__ <= i__2; ++i__) { | 
|---|
|  | 8139 | cc[i__ + (k * cc_dim2 + 1) * cc_dim1] = ch[i__ + (k + ch_dim2) * | 
|---|
|  | 8140 | ch_dim1]; | 
|---|
|  | 8141 | /* L130: */ | 
|---|
|  | 8142 | } | 
|---|
|  | 8143 | /* L131: */ | 
|---|
|  | 8144 | } | 
|---|
|  | 8145 | goto L135; | 
|---|
|  | 8146 | L132: | 
|---|
|  | 8147 | i__1 = *ido; | 
|---|
|  | 8148 | for (i__ = 1; i__ <= i__1; ++i__) { | 
|---|
|  | 8149 | i__2 = *l1; | 
|---|
|  | 8150 | for (k = 1; k <= i__2; ++k) { | 
|---|
|  | 8151 | cc[i__ + (k * cc_dim2 + 1) * cc_dim1] = ch[i__ + (k + ch_dim2) * | 
|---|
|  | 8152 | ch_dim1]; | 
|---|
|  | 8153 | /* L133: */ | 
|---|
|  | 8154 | } | 
|---|
|  | 8155 | /* L134: */ | 
|---|
|  | 8156 | } | 
|---|
|  | 8157 | L135: | 
|---|
|  | 8158 | i__1 = ipph; | 
|---|
|  | 8159 | for (j = 2; j <= i__1; ++j) { | 
|---|
|  | 8160 | jc = ipp2 - j; | 
|---|
|  | 8161 | j2 = j + j; | 
|---|
|  | 8162 | i__2 = *l1; | 
|---|
|  | 8163 | for (k = 1; k <= i__2; ++k) { | 
|---|
|  | 8164 | cc[*ido + (j2 - 2 + k * cc_dim2) * cc_dim1] = ch[(k + j * ch_dim2) | 
|---|
|  | 8165 | * ch_dim1 + 1]; | 
|---|
|  | 8166 | cc[(j2 - 1 + k * cc_dim2) * cc_dim1 + 1] = ch[(k + jc * ch_dim2) * | 
|---|
|  | 8167 | ch_dim1 + 1]; | 
|---|
|  | 8168 | /* L136: */ | 
|---|
|  | 8169 | } | 
|---|
|  | 8170 | /* L137: */ | 
|---|
|  | 8171 | } | 
|---|
|  | 8172 | if (*ido == 1) { | 
|---|
|  | 8173 | return 0; | 
|---|
|  | 8174 | } | 
|---|
|  | 8175 | if (nbd < *l1) { | 
|---|
|  | 8176 | goto L141; | 
|---|
|  | 8177 | } | 
|---|
|  | 8178 | i__1 = ipph; | 
|---|
|  | 8179 | for (j = 2; j <= i__1; ++j) { | 
|---|
|  | 8180 | jc = ipp2 - j; | 
|---|
|  | 8181 | j2 = j + j; | 
|---|
|  | 8182 | i__2 = *l1; | 
|---|
|  | 8183 | for (k = 1; k <= i__2; ++k) { | 
|---|
|  | 8184 | i__3 = *ido; | 
|---|
|  | 8185 | for (i__ = 3; i__ <= i__3; i__ += 2) { | 
|---|
|  | 8186 | ic = idp2 - i__; | 
|---|
|  | 8187 | cc[i__ - 1 + (j2 - 1 + k * cc_dim2) * cc_dim1] = ch[i__ - 1 + | 
|---|
|  | 8188 | (k + j * ch_dim2) * ch_dim1] + ch[i__ - 1 + (k + jc * | 
|---|
|  | 8189 | ch_dim2) * ch_dim1]; | 
|---|
|  | 8190 | cc[ic - 1 + (j2 - 2 + k * cc_dim2) * cc_dim1] = ch[i__ - 1 + ( | 
|---|
|  | 8191 | k + j * ch_dim2) * ch_dim1] - ch[i__ - 1 + (k + jc * | 
|---|
|  | 8192 | ch_dim2) * ch_dim1]; | 
|---|
|  | 8193 | cc[i__ + (j2 - 1 + k * cc_dim2) * cc_dim1] = ch[i__ + (k + j * | 
|---|
|  | 8194 | ch_dim2) * ch_dim1] + ch[i__ + (k + jc * ch_dim2) * | 
|---|
|  | 8195 | ch_dim1]; | 
|---|
|  | 8196 | cc[ic + (j2 - 2 + k * cc_dim2) * cc_dim1] = ch[i__ + (k + jc * | 
|---|
|  | 8197 | ch_dim2) * ch_dim1] - ch[i__ + (k + j * ch_dim2) * | 
|---|
|  | 8198 | ch_dim1]; | 
|---|
|  | 8199 | /* L138: */ | 
|---|
|  | 8200 | } | 
|---|
|  | 8201 | /* L139: */ | 
|---|
|  | 8202 | } | 
|---|
|  | 8203 | /* L140: */ | 
|---|
|  | 8204 | } | 
|---|
|  | 8205 | return 0; | 
|---|
|  | 8206 | L141: | 
|---|
|  | 8207 | i__1 = ipph; | 
|---|
|  | 8208 | for (j = 2; j <= i__1; ++j) { | 
|---|
|  | 8209 | jc = ipp2 - j; | 
|---|
|  | 8210 | j2 = j + j; | 
|---|
|  | 8211 | i__2 = *ido; | 
|---|
|  | 8212 | for (i__ = 3; i__ <= i__2; i__ += 2) { | 
|---|
|  | 8213 | ic = idp2 - i__; | 
|---|
|  | 8214 | i__3 = *l1; | 
|---|
|  | 8215 | for (k = 1; k <= i__3; ++k) { | 
|---|
|  | 8216 | cc[i__ - 1 + (j2 - 1 + k * cc_dim2) * cc_dim1] = ch[i__ - 1 + | 
|---|
|  | 8217 | (k + j * ch_dim2) * ch_dim1] + ch[i__ - 1 + (k + jc * | 
|---|
|  | 8218 | ch_dim2) * ch_dim1]; | 
|---|
|  | 8219 | cc[ic - 1 + (j2 - 2 + k * cc_dim2) * cc_dim1] = ch[i__ - 1 + ( | 
|---|
|  | 8220 | k + j * ch_dim2) * ch_dim1] - ch[i__ - 1 + (k + jc * | 
|---|
|  | 8221 | ch_dim2) * ch_dim1]; | 
|---|
|  | 8222 | cc[i__ + (j2 - 1 + k * cc_dim2) * cc_dim1] = ch[i__ + (k + j * | 
|---|
|  | 8223 | ch_dim2) * ch_dim1] + ch[i__ + (k + jc * ch_dim2) * | 
|---|
|  | 8224 | ch_dim1]; | 
|---|
|  | 8225 | cc[ic + (j2 - 2 + k * cc_dim2) * cc_dim1] = ch[i__ + (k + jc * | 
|---|
|  | 8226 | ch_dim2) * ch_dim1] - ch[i__ + (k + j * ch_dim2) * | 
|---|
|  | 8227 | ch_dim1]; | 
|---|
|  | 8228 | /* L142: */ | 
|---|
|  | 8229 | } | 
|---|
|  | 8230 | /* L143: */ | 
|---|
|  | 8231 | } | 
|---|
|  | 8232 | /* L144: */ | 
|---|
|  | 8233 | } | 
|---|
|  | 8234 | return 0; | 
|---|
|  | 8235 | } /* dadfg_ */ | 
|---|
|  | 8236 |  | 
|---|
|  | 8237 | /*  ------ File dfftb.f ------ */ | 
|---|
| [756] | 8238 | /* Subroutine */ int dfftb_(int_4 *n, r_8 *r__, r_8 *wsave) | 
|---|
| [459] | 8239 | { | 
|---|
| [756] | 8240 | extern /* Subroutine */ int dfftb1_(int_4 *, r_8 *, r_8 *, r_8 *, | 
|---|
| [717] | 8241 | int_8 *); | 
|---|
| [459] | 8242 |  | 
|---|
|  | 8243 | /* Parameter adjustments */ | 
|---|
|  | 8244 | --wsave; | 
|---|
|  | 8245 | --r__; | 
|---|
|  | 8246 |  | 
|---|
|  | 8247 | /* Function Body */ | 
|---|
|  | 8248 | if (*n == 1) { | 
|---|
|  | 8249 | return 0; | 
|---|
|  | 8250 | } | 
|---|
| [717] | 8251 | dfftb1_(n, &r__[1], &wsave[1], &wsave[*n + 1], (int_8 *)&wsave[(*n << 1) + 1]); /* (int *) rajoute Reza 29/11/99 */ | 
|---|
| [459] | 8252 | return 0; | 
|---|
|  | 8253 | } /* dfftb_ */ | 
|---|
|  | 8254 |  | 
|---|
|  | 8255 | /*  ------ File dfftb1.f ------ */ | 
|---|
| [756] | 8256 | /* Subroutine */ int dfftb1_(int_4 *n, r_8 *c__, r_8 *ch, r_8 *wa, | 
|---|
| [717] | 8257 | int_8 *ifac) | 
|---|
| [459] | 8258 | { | 
|---|
|  | 8259 | /* System generated locals */ | 
|---|
| [756] | 8260 | int_4 i__1; | 
|---|
| [459] | 8261 |  | 
|---|
|  | 8262 | /* Local variables */ | 
|---|
| [756] | 8263 | extern /* Subroutine */ int dadb2_(int_4 *, int_4 *, r_8 *, r_8 *, | 
|---|
|  | 8264 | r_8 *), dadb3_(int_4 *, int_4 *, r_8 *, r_8 *, r_8 *, | 
|---|
|  | 8265 | r_8 *), dadb4_(int_4 *, int_4 *, r_8 *, r_8 *, r_8 *, | 
|---|
|  | 8266 | r_8 *, r_8 *), dadb5_(int_4 *, int_4 *, r_8 *, r_8 *, | 
|---|
| [717] | 8267 | r_8 *, r_8 *, r_8 *, r_8 *); | 
|---|
| [756] | 8268 | static int_4 i__; | 
|---|
|  | 8269 | extern /* Subroutine */ int dadbg_(int_4 *, int_4 *, int_4 *, | 
|---|
|  | 8270 | int_4 *, r_8 *, r_8 *, r_8 *, r_8 *, r_8 *, r_8 *); | 
|---|
|  | 8271 | static int_4 k1, l1, l2, na, nf, ip, iw, ix2, ix3, ix4, ido, idl1; | 
|---|
| [459] | 8272 |  | 
|---|
|  | 8273 | /* Parameter adjustments */ | 
|---|
|  | 8274 | --ifac; | 
|---|
|  | 8275 | --wa; | 
|---|
|  | 8276 | --ch; | 
|---|
|  | 8277 | --c__; | 
|---|
|  | 8278 |  | 
|---|
|  | 8279 | /* Function Body */ | 
|---|
|  | 8280 | nf = ifac[2]; | 
|---|
|  | 8281 | na = 0; | 
|---|
|  | 8282 | l1 = 1; | 
|---|
|  | 8283 | iw = 1; | 
|---|
|  | 8284 | i__1 = nf; | 
|---|
|  | 8285 | for (k1 = 1; k1 <= i__1; ++k1) { | 
|---|
|  | 8286 | ip = ifac[k1 + 2]; | 
|---|
|  | 8287 | l2 = ip * l1; | 
|---|
|  | 8288 | ido = *n / l2; | 
|---|
|  | 8289 | idl1 = ido * l1; | 
|---|
|  | 8290 | if (ip != 4) { | 
|---|
|  | 8291 | goto L103; | 
|---|
|  | 8292 | } | 
|---|
|  | 8293 | ix2 = iw + ido; | 
|---|
|  | 8294 | ix3 = ix2 + ido; | 
|---|
|  | 8295 | if (na != 0) { | 
|---|
|  | 8296 | goto L101; | 
|---|
|  | 8297 | } | 
|---|
|  | 8298 | dadb4_(&ido, &l1, &c__[1], &ch[1], &wa[iw], &wa[ix2], &wa[ix3]); | 
|---|
|  | 8299 | goto L102; | 
|---|
|  | 8300 | L101: | 
|---|
|  | 8301 | dadb4_(&ido, &l1, &ch[1], &c__[1], &wa[iw], &wa[ix2], &wa[ix3]); | 
|---|
|  | 8302 | L102: | 
|---|
|  | 8303 | na = 1 - na; | 
|---|
|  | 8304 | goto L115; | 
|---|
|  | 8305 | L103: | 
|---|
|  | 8306 | if (ip != 2) { | 
|---|
|  | 8307 | goto L106; | 
|---|
|  | 8308 | } | 
|---|
|  | 8309 | if (na != 0) { | 
|---|
|  | 8310 | goto L104; | 
|---|
|  | 8311 | } | 
|---|
|  | 8312 | dadb2_(&ido, &l1, &c__[1], &ch[1], &wa[iw]); | 
|---|
|  | 8313 | goto L105; | 
|---|
|  | 8314 | L104: | 
|---|
|  | 8315 | dadb2_(&ido, &l1, &ch[1], &c__[1], &wa[iw]); | 
|---|
|  | 8316 | L105: | 
|---|
|  | 8317 | na = 1 - na; | 
|---|
|  | 8318 | goto L115; | 
|---|
|  | 8319 | L106: | 
|---|
|  | 8320 | if (ip != 3) { | 
|---|
|  | 8321 | goto L109; | 
|---|
|  | 8322 | } | 
|---|
|  | 8323 | ix2 = iw + ido; | 
|---|
|  | 8324 | if (na != 0) { | 
|---|
|  | 8325 | goto L107; | 
|---|
|  | 8326 | } | 
|---|
|  | 8327 | dadb3_(&ido, &l1, &c__[1], &ch[1], &wa[iw], &wa[ix2]); | 
|---|
|  | 8328 | goto L108; | 
|---|
|  | 8329 | L107: | 
|---|
|  | 8330 | dadb3_(&ido, &l1, &ch[1], &c__[1], &wa[iw], &wa[ix2]); | 
|---|
|  | 8331 | L108: | 
|---|
|  | 8332 | na = 1 - na; | 
|---|
|  | 8333 | goto L115; | 
|---|
|  | 8334 | L109: | 
|---|
|  | 8335 | if (ip != 5) { | 
|---|
|  | 8336 | goto L112; | 
|---|
|  | 8337 | } | 
|---|
|  | 8338 | ix2 = iw + ido; | 
|---|
|  | 8339 | ix3 = ix2 + ido; | 
|---|
|  | 8340 | ix4 = ix3 + ido; | 
|---|
|  | 8341 | if (na != 0) { | 
|---|
|  | 8342 | goto L110; | 
|---|
|  | 8343 | } | 
|---|
|  | 8344 | dadb5_(&ido, &l1, &c__[1], &ch[1], &wa[iw], &wa[ix2], &wa[ix3], &wa[ | 
|---|
|  | 8345 | ix4]); | 
|---|
|  | 8346 | goto L111; | 
|---|
|  | 8347 | L110: | 
|---|
|  | 8348 | dadb5_(&ido, &l1, &ch[1], &c__[1], &wa[iw], &wa[ix2], &wa[ix3], &wa[ | 
|---|
|  | 8349 | ix4]); | 
|---|
|  | 8350 | L111: | 
|---|
|  | 8351 | na = 1 - na; | 
|---|
|  | 8352 | goto L115; | 
|---|
|  | 8353 | L112: | 
|---|
|  | 8354 | if (na != 0) { | 
|---|
|  | 8355 | goto L113; | 
|---|
|  | 8356 | } | 
|---|
|  | 8357 | dadbg_(&ido, &ip, &l1, &idl1, &c__[1], &c__[1], &c__[1], &ch[1], &ch[ | 
|---|
|  | 8358 | 1], &wa[iw]); | 
|---|
|  | 8359 | goto L114; | 
|---|
|  | 8360 | L113: | 
|---|
|  | 8361 | dadbg_(&ido, &ip, &l1, &idl1, &ch[1], &ch[1], &ch[1], &c__[1], &c__[1] | 
|---|
|  | 8362 | , &wa[iw]); | 
|---|
|  | 8363 | L114: | 
|---|
|  | 8364 | if (ido == 1) { | 
|---|
|  | 8365 | na = 1 - na; | 
|---|
|  | 8366 | } | 
|---|
|  | 8367 | L115: | 
|---|
|  | 8368 | l1 = l2; | 
|---|
|  | 8369 | iw += (ip - 1) * ido; | 
|---|
|  | 8370 | /* L116: */ | 
|---|
|  | 8371 | } | 
|---|
|  | 8372 | if (na == 0) { | 
|---|
|  | 8373 | return 0; | 
|---|
|  | 8374 | } | 
|---|
|  | 8375 | i__1 = *n; | 
|---|
|  | 8376 | for (i__ = 1; i__ <= i__1; ++i__) { | 
|---|
|  | 8377 | c__[i__] = ch[i__]; | 
|---|
|  | 8378 | /* L117: */ | 
|---|
|  | 8379 | } | 
|---|
|  | 8380 | return 0; | 
|---|
|  | 8381 | } /* dfftb1_ */ | 
|---|
|  | 8382 |  | 
|---|
|  | 8383 | /*  ------ File dfftf.f ------ */ | 
|---|
| [756] | 8384 | /* Subroutine */ int dfftf_(int_4 *n, r_8 *r__, r_8 *wsave) | 
|---|
| [459] | 8385 | { | 
|---|
| [756] | 8386 | extern /* Subroutine */ int dfftf1_(int_4 *, r_8 *, r_8 *, r_8 *, | 
|---|
| [717] | 8387 | int_8 *); | 
|---|
| [459] | 8388 |  | 
|---|
|  | 8389 | /* Parameter adjustments */ | 
|---|
|  | 8390 | --wsave; | 
|---|
|  | 8391 | --r__; | 
|---|
|  | 8392 |  | 
|---|
|  | 8393 | /* Function Body */ | 
|---|
|  | 8394 | if (*n == 1) { | 
|---|
|  | 8395 | return 0; | 
|---|
|  | 8396 | } | 
|---|
| [717] | 8397 | dfftf1_(n, &r__[1], &wsave[1], &wsave[*n + 1], (int_8 *)&wsave[(*n << 1) + 1]);/* (int *) rajoute Reza 29/11/99 */ | 
|---|
| [459] | 8398 | return 0; | 
|---|
|  | 8399 | } /* dfftf_ */ | 
|---|
|  | 8400 |  | 
|---|
|  | 8401 | /*  ------ File dfftf1.f ------ */ | 
|---|
| [756] | 8402 | /* Subroutine */ int dfftf1_(int_4 *n, r_8 *c__, r_8 *ch, r_8 *wa, | 
|---|
| [717] | 8403 | int_8 *ifac) | 
|---|
| [459] | 8404 | { | 
|---|
|  | 8405 | /* System generated locals */ | 
|---|
| [756] | 8406 | int_4 i__1; | 
|---|
| [459] | 8407 |  | 
|---|
|  | 8408 | /* Local variables */ | 
|---|
| [756] | 8409 | extern /* Subroutine */ int dadf2_(int_4 *, int_4 *, r_8 *, r_8 *, | 
|---|
|  | 8410 | r_8 *), dadf3_(int_4 *, int_4 *, r_8 *, r_8 *, r_8 *, | 
|---|
|  | 8411 | r_8 *), dadf4_(int_4 *, int_4 *, r_8 *, r_8 *, r_8 *, | 
|---|
|  | 8412 | r_8 *, r_8 *), dadf5_(int_4 *, int_4 *, r_8 *, r_8 *, | 
|---|
| [717] | 8413 | r_8 *, r_8 *, r_8 *, r_8 *); | 
|---|
| [756] | 8414 | static int_4 i__; | 
|---|
|  | 8415 | extern /* Subroutine */ int dadfg_(int_4 *, int_4 *, int_4 *, | 
|---|
|  | 8416 | int_4 *, r_8 *, r_8 *, r_8 *, r_8 *, r_8 *, r_8 *); | 
|---|
|  | 8417 | static int_4 k1, l1, l2, na, kh, nf, ip, iw, ix2, ix3, ix4, ido, idl1; | 
|---|
| [459] | 8418 |  | 
|---|
|  | 8419 | /* Parameter adjustments */ | 
|---|
|  | 8420 | --ifac; | 
|---|
|  | 8421 | --wa; | 
|---|
|  | 8422 | --ch; | 
|---|
|  | 8423 | --c__; | 
|---|
|  | 8424 |  | 
|---|
|  | 8425 | /* Function Body */ | 
|---|
|  | 8426 | nf = ifac[2]; | 
|---|
|  | 8427 | na = 1; | 
|---|
|  | 8428 | l2 = *n; | 
|---|
|  | 8429 | iw = *n; | 
|---|
|  | 8430 | i__1 = nf; | 
|---|
|  | 8431 | for (k1 = 1; k1 <= i__1; ++k1) { | 
|---|
|  | 8432 | kh = nf - k1; | 
|---|
|  | 8433 | ip = ifac[kh + 3]; | 
|---|
|  | 8434 | l1 = l2 / ip; | 
|---|
|  | 8435 | ido = *n / l2; | 
|---|
|  | 8436 | idl1 = ido * l1; | 
|---|
|  | 8437 | iw -= (ip - 1) * ido; | 
|---|
|  | 8438 | na = 1 - na; | 
|---|
|  | 8439 | if (ip != 4) { | 
|---|
|  | 8440 | goto L102; | 
|---|
|  | 8441 | } | 
|---|
|  | 8442 | ix2 = iw + ido; | 
|---|
|  | 8443 | ix3 = ix2 + ido; | 
|---|
|  | 8444 | if (na != 0) { | 
|---|
|  | 8445 | goto L101; | 
|---|
|  | 8446 | } | 
|---|
|  | 8447 | dadf4_(&ido, &l1, &c__[1], &ch[1], &wa[iw], &wa[ix2], &wa[ix3]); | 
|---|
|  | 8448 | goto L110; | 
|---|
|  | 8449 | L101: | 
|---|
|  | 8450 | dadf4_(&ido, &l1, &ch[1], &c__[1], &wa[iw], &wa[ix2], &wa[ix3]); | 
|---|
|  | 8451 | goto L110; | 
|---|
|  | 8452 | L102: | 
|---|
|  | 8453 | if (ip != 2) { | 
|---|
|  | 8454 | goto L104; | 
|---|
|  | 8455 | } | 
|---|
|  | 8456 | if (na != 0) { | 
|---|
|  | 8457 | goto L103; | 
|---|
|  | 8458 | } | 
|---|
|  | 8459 | dadf2_(&ido, &l1, &c__[1], &ch[1], &wa[iw]); | 
|---|
|  | 8460 | goto L110; | 
|---|
|  | 8461 | L103: | 
|---|
|  | 8462 | dadf2_(&ido, &l1, &ch[1], &c__[1], &wa[iw]); | 
|---|
|  | 8463 | goto L110; | 
|---|
|  | 8464 | L104: | 
|---|
|  | 8465 | if (ip != 3) { | 
|---|
|  | 8466 | goto L106; | 
|---|
|  | 8467 | } | 
|---|
|  | 8468 | ix2 = iw + ido; | 
|---|
|  | 8469 | if (na != 0) { | 
|---|
|  | 8470 | goto L105; | 
|---|
|  | 8471 | } | 
|---|
|  | 8472 | dadf3_(&ido, &l1, &c__[1], &ch[1], &wa[iw], &wa[ix2]); | 
|---|
|  | 8473 | goto L110; | 
|---|
|  | 8474 | L105: | 
|---|
|  | 8475 | dadf3_(&ido, &l1, &ch[1], &c__[1], &wa[iw], &wa[ix2]); | 
|---|
|  | 8476 | goto L110; | 
|---|
|  | 8477 | L106: | 
|---|
|  | 8478 | if (ip != 5) { | 
|---|
|  | 8479 | goto L108; | 
|---|
|  | 8480 | } | 
|---|
|  | 8481 | ix2 = iw + ido; | 
|---|
|  | 8482 | ix3 = ix2 + ido; | 
|---|
|  | 8483 | ix4 = ix3 + ido; | 
|---|
|  | 8484 | if (na != 0) { | 
|---|
|  | 8485 | goto L107; | 
|---|
|  | 8486 | } | 
|---|
|  | 8487 | dadf5_(&ido, &l1, &c__[1], &ch[1], &wa[iw], &wa[ix2], &wa[ix3], &wa[ | 
|---|
|  | 8488 | ix4]); | 
|---|
|  | 8489 | goto L110; | 
|---|
|  | 8490 | L107: | 
|---|
|  | 8491 | dadf5_(&ido, &l1, &ch[1], &c__[1], &wa[iw], &wa[ix2], &wa[ix3], &wa[ | 
|---|
|  | 8492 | ix4]); | 
|---|
|  | 8493 | goto L110; | 
|---|
|  | 8494 | L108: | 
|---|
|  | 8495 | if (ido == 1) { | 
|---|
|  | 8496 | na = 1 - na; | 
|---|
|  | 8497 | } | 
|---|
|  | 8498 | if (na != 0) { | 
|---|
|  | 8499 | goto L109; | 
|---|
|  | 8500 | } | 
|---|
|  | 8501 | dadfg_(&ido, &ip, &l1, &idl1, &c__[1], &c__[1], &c__[1], &ch[1], &ch[ | 
|---|
|  | 8502 | 1], &wa[iw]); | 
|---|
|  | 8503 | na = 1; | 
|---|
|  | 8504 | goto L110; | 
|---|
|  | 8505 | L109: | 
|---|
|  | 8506 | dadfg_(&ido, &ip, &l1, &idl1, &ch[1], &ch[1], &ch[1], &c__[1], &c__[1] | 
|---|
|  | 8507 | , &wa[iw]); | 
|---|
|  | 8508 | na = 0; | 
|---|
|  | 8509 | L110: | 
|---|
|  | 8510 | l2 = l1; | 
|---|
|  | 8511 | /* L111: */ | 
|---|
|  | 8512 | } | 
|---|
|  | 8513 | if (na == 1) { | 
|---|
|  | 8514 | return 0; | 
|---|
|  | 8515 | } | 
|---|
|  | 8516 | i__1 = *n; | 
|---|
|  | 8517 | for (i__ = 1; i__ <= i__1; ++i__) { | 
|---|
|  | 8518 | c__[i__] = ch[i__]; | 
|---|
|  | 8519 | /* L112: */ | 
|---|
|  | 8520 | } | 
|---|
|  | 8521 | return 0; | 
|---|
|  | 8522 | } /* dfftf1_ */ | 
|---|
|  | 8523 |  | 
|---|
|  | 8524 | /*  ------ File dffti.f ------ */ | 
|---|
| [756] | 8525 | /* Subroutine */ int dffti_(int_4 *n, r_8 *wsave) | 
|---|
| [459] | 8526 | { | 
|---|
| [756] | 8527 | extern /* Subroutine */ int dffti1_(int_4 *, r_8 *, int_8 *); | 
|---|
| [459] | 8528 |  | 
|---|
|  | 8529 | /* Parameter adjustments */ | 
|---|
|  | 8530 | --wsave; | 
|---|
|  | 8531 |  | 
|---|
|  | 8532 | /* Function Body */ | 
|---|
|  | 8533 | if (*n == 1) { | 
|---|
|  | 8534 | return 0; | 
|---|
|  | 8535 | } | 
|---|
| [717] | 8536 | dffti1_(n, &wsave[*n + 1], (int_8 *)&wsave[(*n << 1) + 1]); /* (int *) rajoute Reza 29/11/99 */ | 
|---|
| [459] | 8537 | return 0; | 
|---|
|  | 8538 | } /* dffti_ */ | 
|---|
|  | 8539 |  | 
|---|
|  | 8540 | /*  ------ File dffti1.f ------ */ | 
|---|
| [756] | 8541 | /* Subroutine */ int dffti1_(int_4 *n, r_8 *wa, int_8 *ifac) | 
|---|
| [459] | 8542 | { | 
|---|
|  | 8543 | /* Initialized data */ | 
|---|
|  | 8544 |  | 
|---|
| [756] | 8545 | static int_4 ntryh[4] = { 4,2,3,5 }; | 
|---|
| [459] | 8546 |  | 
|---|
|  | 8547 | /* System generated locals */ | 
|---|
| [756] | 8548 | int_4 i__1, i__2, i__3; | 
|---|
| [459] | 8549 |  | 
|---|
|  | 8550 | /* Builtin functions */ | 
|---|
| [717] | 8551 | /*    r_8 cos(r_8truc), sin(r_8truc); remplace par math.h  Reza 29/11/99 */ | 
|---|
| [459] | 8552 |  | 
|---|
|  | 8553 | /* Local variables */ | 
|---|
| [717] | 8554 | static r_8 argh; | 
|---|
| [756] | 8555 | static int_4 ntry, i__, j; | 
|---|
| [717] | 8556 | static r_8 argld; | 
|---|
| [756] | 8557 | static int_4 k1, l1, l2, ib; | 
|---|
| [717] | 8558 | static r_8 fi; | 
|---|
| [756] | 8559 | static int_4 ld, ii, nf, ip, nl, is, nq, nr; | 
|---|
| [717] | 8560 | static r_8 arg; | 
|---|
| [756] | 8561 | static int_4 ido, ipm; | 
|---|
| [717] | 8562 | static r_8 tpi; | 
|---|
| [756] | 8563 | static int_4 nfm1; | 
|---|
| [459] | 8564 |  | 
|---|
|  | 8565 | /* Parameter adjustments */ | 
|---|
|  | 8566 | --ifac; | 
|---|
|  | 8567 | --wa; | 
|---|
|  | 8568 |  | 
|---|
|  | 8569 | /* Function Body */ | 
|---|
|  | 8570 | nl = *n; | 
|---|
|  | 8571 | nf = 0; | 
|---|
|  | 8572 | j = 0; | 
|---|
|  | 8573 | L101: | 
|---|
|  | 8574 | ++j; | 
|---|
|  | 8575 | if (j - 4 <= 0) { | 
|---|
|  | 8576 | goto L102; | 
|---|
|  | 8577 | } else { | 
|---|
|  | 8578 | goto L103; | 
|---|
|  | 8579 | } | 
|---|
|  | 8580 | L102: | 
|---|
|  | 8581 | ntry = ntryh[j - 1]; | 
|---|
|  | 8582 | goto L104; | 
|---|
|  | 8583 | L103: | 
|---|
|  | 8584 | ntry += 2; | 
|---|
|  | 8585 | L104: | 
|---|
|  | 8586 | nq = nl / ntry; | 
|---|
|  | 8587 | nr = nl - ntry * nq; | 
|---|
|  | 8588 | if (nr != 0) { | 
|---|
|  | 8589 | goto L101; | 
|---|
|  | 8590 | } else { | 
|---|
|  | 8591 | goto L105; | 
|---|
|  | 8592 | } | 
|---|
|  | 8593 | L105: | 
|---|
|  | 8594 | ++nf; | 
|---|
|  | 8595 | ifac[nf + 2] = ntry; | 
|---|
|  | 8596 | nl = nq; | 
|---|
|  | 8597 | if (ntry != 2) { | 
|---|
|  | 8598 | goto L107; | 
|---|
|  | 8599 | } | 
|---|
|  | 8600 | if (nf == 1) { | 
|---|
|  | 8601 | goto L107; | 
|---|
|  | 8602 | } | 
|---|
|  | 8603 | i__1 = nf; | 
|---|
|  | 8604 | for (i__ = 2; i__ <= i__1; ++i__) { | 
|---|
|  | 8605 | ib = nf - i__ + 2; | 
|---|
|  | 8606 | ifac[ib + 2] = ifac[ib + 1]; | 
|---|
|  | 8607 | /* L106: */ | 
|---|
|  | 8608 | } | 
|---|
|  | 8609 | ifac[3] = 2; | 
|---|
|  | 8610 | L107: | 
|---|
|  | 8611 | if (nl != 1) { | 
|---|
|  | 8612 | goto L104; | 
|---|
|  | 8613 | } | 
|---|
|  | 8614 | ifac[1] = *n; | 
|---|
|  | 8615 | ifac[2] = nf; | 
|---|
|  | 8616 | tpi = 6.28318530717959f; | 
|---|
| [717] | 8617 | argh = tpi / (r_8) (*n); | 
|---|
| [459] | 8618 | is = 0; | 
|---|
|  | 8619 | nfm1 = nf - 1; | 
|---|
|  | 8620 | l1 = 1; | 
|---|
|  | 8621 | if (nfm1 == 0) { | 
|---|
|  | 8622 | return 0; | 
|---|
|  | 8623 | } | 
|---|
|  | 8624 | i__1 = nfm1; | 
|---|
|  | 8625 | for (k1 = 1; k1 <= i__1; ++k1) { | 
|---|
|  | 8626 | ip = ifac[k1 + 2]; | 
|---|
|  | 8627 | ld = 0; | 
|---|
|  | 8628 | l2 = l1 * ip; | 
|---|
|  | 8629 | ido = *n / l2; | 
|---|
|  | 8630 | ipm = ip - 1; | 
|---|
|  | 8631 | i__2 = ipm; | 
|---|
|  | 8632 | for (j = 1; j <= i__2; ++j) { | 
|---|
|  | 8633 | ld += l1; | 
|---|
|  | 8634 | i__ = is; | 
|---|
| [717] | 8635 | argld = (r_8) ld * argh; | 
|---|
| [459] | 8636 | fi = 0.f; | 
|---|
|  | 8637 | i__3 = ido; | 
|---|
|  | 8638 | for (ii = 3; ii <= i__3; ii += 2) { | 
|---|
|  | 8639 | i__ += 2; | 
|---|
|  | 8640 | fi += 1.f; | 
|---|
|  | 8641 | arg = fi * argld; | 
|---|
|  | 8642 | wa[i__ - 1] = cos(arg); | 
|---|
|  | 8643 | wa[i__] = sin(arg); | 
|---|
|  | 8644 | /* L108: */ | 
|---|
|  | 8645 | } | 
|---|
|  | 8646 | is += ido; | 
|---|
|  | 8647 | /* L109: */ | 
|---|
|  | 8648 | } | 
|---|
|  | 8649 | l1 = l2; | 
|---|
|  | 8650 | /* L110: */ | 
|---|
|  | 8651 | } | 
|---|
|  | 8652 | return 0; | 
|---|
|  | 8653 | } /* dffti1_ */ | 
|---|
|  | 8654 |  | 
|---|
|  | 8655 | /*  ------ File dsinqb.f ------ */ | 
|---|
| [756] | 8656 | /* Subroutine */ int dsinqb_(int_4 *n, r_8 *x, r_8 *wsave) | 
|---|
| [459] | 8657 | { | 
|---|
|  | 8658 | /* System generated locals */ | 
|---|
| [756] | 8659 | int_4 i__1; | 
|---|
| [459] | 8660 |  | 
|---|
|  | 8661 | /* Local variables */ | 
|---|
| [756] | 8662 | static int_4 k; | 
|---|
|  | 8663 | extern /* Subroutine */ int dcosqb_(int_4 *, r_8 *, r_8 *); | 
|---|
| [717] | 8664 | static r_8 xhold; | 
|---|
| [756] | 8665 | static int_4 kc, ns2; | 
|---|
| [459] | 8666 |  | 
|---|
|  | 8667 | /* Parameter adjustments */ | 
|---|
|  | 8668 | --wsave; | 
|---|
|  | 8669 | --x; | 
|---|
|  | 8670 |  | 
|---|
|  | 8671 | /* Function Body */ | 
|---|
|  | 8672 | if (*n > 1) { | 
|---|
|  | 8673 | goto L101; | 
|---|
|  | 8674 | } | 
|---|
|  | 8675 | x[1] *= 4.f; | 
|---|
|  | 8676 | return 0; | 
|---|
|  | 8677 | L101: | 
|---|
|  | 8678 | ns2 = *n / 2; | 
|---|
|  | 8679 | i__1 = *n; | 
|---|
|  | 8680 | for (k = 2; k <= i__1; k += 2) { | 
|---|
|  | 8681 | x[k] = -x[k]; | 
|---|
|  | 8682 | /* L102: */ | 
|---|
|  | 8683 | } | 
|---|
|  | 8684 | dcosqb_(n, &x[1], &wsave[1]); | 
|---|
|  | 8685 | i__1 = ns2; | 
|---|
|  | 8686 | for (k = 1; k <= i__1; ++k) { | 
|---|
|  | 8687 | kc = *n - k; | 
|---|
|  | 8688 | xhold = x[k]; | 
|---|
|  | 8689 | x[k] = x[kc + 1]; | 
|---|
|  | 8690 | x[kc + 1] = xhold; | 
|---|
|  | 8691 | /* L103: */ | 
|---|
|  | 8692 | } | 
|---|
|  | 8693 | return 0; | 
|---|
|  | 8694 | } /* dsinqb_ */ | 
|---|
|  | 8695 |  | 
|---|
|  | 8696 | /*  ------ File dsinqf.f ------ */ | 
|---|
| [756] | 8697 | /* Subroutine */ int dsinqf_(int_4 *n, r_8 *x, r_8 *wsave) | 
|---|
| [459] | 8698 | { | 
|---|
|  | 8699 | /* System generated locals */ | 
|---|
| [756] | 8700 | int_4 i__1; | 
|---|
| [459] | 8701 |  | 
|---|
|  | 8702 | /* Local variables */ | 
|---|
| [756] | 8703 | static int_4 k; | 
|---|
|  | 8704 | extern /* Subroutine */ int dcosqf_(int_4 *, r_8 *, r_8 *); | 
|---|
| [717] | 8705 | static r_8 xhold; | 
|---|
| [756] | 8706 | static int_4 kc, ns2; | 
|---|
| [459] | 8707 |  | 
|---|
|  | 8708 | /* Parameter adjustments */ | 
|---|
|  | 8709 | --wsave; | 
|---|
|  | 8710 | --x; | 
|---|
|  | 8711 |  | 
|---|
|  | 8712 | /* Function Body */ | 
|---|
|  | 8713 | if (*n == 1) { | 
|---|
|  | 8714 | return 0; | 
|---|
|  | 8715 | } | 
|---|
|  | 8716 | ns2 = *n / 2; | 
|---|
|  | 8717 | i__1 = ns2; | 
|---|
|  | 8718 | for (k = 1; k <= i__1; ++k) { | 
|---|
|  | 8719 | kc = *n - k; | 
|---|
|  | 8720 | xhold = x[k]; | 
|---|
|  | 8721 | x[k] = x[kc + 1]; | 
|---|
|  | 8722 | x[kc + 1] = xhold; | 
|---|
|  | 8723 | /* L101: */ | 
|---|
|  | 8724 | } | 
|---|
|  | 8725 | dcosqf_(n, &x[1], &wsave[1]); | 
|---|
|  | 8726 | i__1 = *n; | 
|---|
|  | 8727 | for (k = 2; k <= i__1; k += 2) { | 
|---|
|  | 8728 | x[k] = -x[k]; | 
|---|
|  | 8729 | /* L102: */ | 
|---|
|  | 8730 | } | 
|---|
|  | 8731 | return 0; | 
|---|
|  | 8732 | } /* dsinqf_ */ | 
|---|
|  | 8733 |  | 
|---|
|  | 8734 | /*  ------ File dsinqi.f ------ */ | 
|---|
| [756] | 8735 | /* Subroutine */ int dsinqi_(int_4 *n, r_8 *wsave) | 
|---|
| [459] | 8736 | { | 
|---|
| [756] | 8737 | extern /* Subroutine */ int dcosqi_(int_4 *, r_8 *); | 
|---|
| [459] | 8738 |  | 
|---|
|  | 8739 | /* Parameter adjustments */ | 
|---|
|  | 8740 | --wsave; | 
|---|
|  | 8741 |  | 
|---|
|  | 8742 | /* Function Body */ | 
|---|
|  | 8743 | dcosqi_(n, &wsave[1]); | 
|---|
|  | 8744 | return 0; | 
|---|
|  | 8745 | } /* dsinqi_ */ | 
|---|
|  | 8746 |  | 
|---|
|  | 8747 | /*  ------ File dsint.f ------ */ | 
|---|
| [756] | 8748 | /* Subroutine */ int dsint_(int_4 *n, r_8 *x, r_8 *wsave) | 
|---|
| [459] | 8749 | { | 
|---|
| [756] | 8750 | extern /* Subroutine */ int dsint1_(int_4 *, r_8 *, r_8 *, r_8 *, | 
|---|
| [717] | 8751 | r_8 *, int_8 *); | 
|---|
| [756] | 8752 | static int_4 np1, iw1, iw2, iw3; | 
|---|
| [459] | 8753 |  | 
|---|
|  | 8754 | /* Parameter adjustments */ | 
|---|
|  | 8755 | --wsave; | 
|---|
|  | 8756 | --x; | 
|---|
|  | 8757 |  | 
|---|
|  | 8758 | /* Function Body */ | 
|---|
|  | 8759 | np1 = *n + 1; | 
|---|
|  | 8760 | iw1 = *n / 2 + 1; | 
|---|
|  | 8761 | iw2 = iw1 + np1; | 
|---|
|  | 8762 | iw3 = iw2 + np1; | 
|---|
| [717] | 8763 | dsint1_(n, &x[1], &wsave[1], &wsave[iw1], &wsave[iw2], (int_8 *) &wsave[iw3]); /* (int *) rajoute Reza 29/11/99 */ | 
|---|
| [459] | 8764 | return 0; | 
|---|
|  | 8765 | } /* dsint_ */ | 
|---|
|  | 8766 |  | 
|---|
|  | 8767 | /*  ------ File dsint1.f ------ */ | 
|---|
| [756] | 8768 | /* Subroutine */ int dsint1_(int_4 *n, r_8 *war, r_8 *was, r_8 *xh, r_8 * | 
|---|
| [717] | 8769 | x, int_8 *ifac) | 
|---|
| [459] | 8770 | { | 
|---|
|  | 8771 | /* Initialized data */ | 
|---|
|  | 8772 |  | 
|---|
| [717] | 8773 | static r_8 sqrt3 = 1.73205080756888f; | 
|---|
| [459] | 8774 |  | 
|---|
|  | 8775 | /* System generated locals */ | 
|---|
| [756] | 8776 | int_4 i__1; | 
|---|
| [459] | 8777 |  | 
|---|
|  | 8778 | /* Local variables */ | 
|---|
| [756] | 8779 | static int_4 modn, i__, k; | 
|---|
| [717] | 8780 | static r_8 xhold, t1, t2; | 
|---|
| [756] | 8781 | extern /* Subroutine */ int dfftf1_(int_4 *, r_8 *, r_8 *, r_8 *, | 
|---|
| [717] | 8782 | int_8 *); | 
|---|
| [756] | 8783 | static int_4 kc, np1, ns2; | 
|---|
| [459] | 8784 |  | 
|---|
|  | 8785 | /* Parameter adjustments */ | 
|---|
|  | 8786 | --ifac; | 
|---|
|  | 8787 | --x; | 
|---|
|  | 8788 | --xh; | 
|---|
|  | 8789 | --was; | 
|---|
|  | 8790 | --war; | 
|---|
|  | 8791 |  | 
|---|
|  | 8792 | /* Function Body */ | 
|---|
|  | 8793 | i__1 = *n; | 
|---|
|  | 8794 | for (i__ = 1; i__ <= i__1; ++i__) { | 
|---|
|  | 8795 | xh[i__] = war[i__]; | 
|---|
|  | 8796 | war[i__] = x[i__]; | 
|---|
|  | 8797 | /* L100: */ | 
|---|
|  | 8798 | } | 
|---|
|  | 8799 | if ((i__1 = *n - 2) < 0) { | 
|---|
|  | 8800 | goto L101; | 
|---|
|  | 8801 | } else if (i__1 == 0) { | 
|---|
|  | 8802 | goto L102; | 
|---|
|  | 8803 | } else { | 
|---|
|  | 8804 | goto L103; | 
|---|
|  | 8805 | } | 
|---|
|  | 8806 | L101: | 
|---|
|  | 8807 | xh[1] += xh[1]; | 
|---|
|  | 8808 | goto L106; | 
|---|
|  | 8809 | L102: | 
|---|
|  | 8810 | xhold = sqrt3 * (xh[1] + xh[2]); | 
|---|
|  | 8811 | xh[2] = sqrt3 * (xh[1] - xh[2]); | 
|---|
|  | 8812 | xh[1] = xhold; | 
|---|
|  | 8813 | goto L106; | 
|---|
|  | 8814 | L103: | 
|---|
|  | 8815 | np1 = *n + 1; | 
|---|
|  | 8816 | ns2 = *n / 2; | 
|---|
|  | 8817 | x[1] = 0.f; | 
|---|
|  | 8818 | i__1 = ns2; | 
|---|
|  | 8819 | for (k = 1; k <= i__1; ++k) { | 
|---|
|  | 8820 | kc = np1 - k; | 
|---|
|  | 8821 | t1 = xh[k] - xh[kc]; | 
|---|
|  | 8822 | t2 = was[k] * (xh[k] + xh[kc]); | 
|---|
|  | 8823 | x[k + 1] = t1 + t2; | 
|---|
|  | 8824 | x[kc + 1] = t2 - t1; | 
|---|
|  | 8825 | /* L104: */ | 
|---|
|  | 8826 | } | 
|---|
|  | 8827 | modn = *n % 2; | 
|---|
|  | 8828 | if (modn != 0) { | 
|---|
|  | 8829 | x[ns2 + 2] = xh[ns2 + 1] * 4.f; | 
|---|
|  | 8830 | } | 
|---|
|  | 8831 | dfftf1_(&np1, &x[1], &xh[1], &war[1], &ifac[1]); | 
|---|
|  | 8832 | xh[1] = x[1] * .5f; | 
|---|
|  | 8833 | i__1 = *n; | 
|---|
|  | 8834 | for (i__ = 3; i__ <= i__1; i__ += 2) { | 
|---|
|  | 8835 | xh[i__ - 1] = -x[i__]; | 
|---|
|  | 8836 | xh[i__] = xh[i__ - 2] + x[i__ - 1]; | 
|---|
|  | 8837 | /* L105: */ | 
|---|
|  | 8838 | } | 
|---|
|  | 8839 | if (modn != 0) { | 
|---|
|  | 8840 | goto L106; | 
|---|
|  | 8841 | } | 
|---|
|  | 8842 | xh[*n] = -x[*n + 1]; | 
|---|
|  | 8843 | L106: | 
|---|
|  | 8844 | i__1 = *n; | 
|---|
|  | 8845 | for (i__ = 1; i__ <= i__1; ++i__) { | 
|---|
|  | 8846 | x[i__] = war[i__]; | 
|---|
|  | 8847 | war[i__] = xh[i__]; | 
|---|
|  | 8848 | /* L107: */ | 
|---|
|  | 8849 | } | 
|---|
|  | 8850 | return 0; | 
|---|
|  | 8851 | } /* dsint1_ */ | 
|---|
|  | 8852 |  | 
|---|
|  | 8853 | /*  ------ File dsinti.f ------ */ | 
|---|
| [756] | 8854 | /* Subroutine */ int dsinti_(int_4 *n, r_8 *wsave) | 
|---|
| [459] | 8855 | { | 
|---|
|  | 8856 | /* Initialized data */ | 
|---|
|  | 8857 |  | 
|---|
| [717] | 8858 | static r_8 pi = 3.14159265358979f; | 
|---|
| [459] | 8859 |  | 
|---|
|  | 8860 | /* System generated locals */ | 
|---|
| [756] | 8861 | int_4 i__1; | 
|---|
| [459] | 8862 |  | 
|---|
|  | 8863 | /* Builtin functions */ | 
|---|
| [717] | 8864 | /*    r_8 sin(r_8truc);  remplace par math.h  Reza 29/11/99 */ | 
|---|
| [459] | 8865 |  | 
|---|
|  | 8866 | /* Local variables */ | 
|---|
| [756] | 8867 | static int_4 k; | 
|---|
|  | 8868 | extern /* Subroutine */ int dffti_(int_4 *, r_8 *); | 
|---|
| [717] | 8869 | static r_8 dt; | 
|---|
| [756] | 8870 | static int_4 np1, ns2; | 
|---|
| [459] | 8871 |  | 
|---|
|  | 8872 | /* Parameter adjustments */ | 
|---|
|  | 8873 | --wsave; | 
|---|
|  | 8874 |  | 
|---|
|  | 8875 | /* Function Body */ | 
|---|
|  | 8876 | if (*n <= 1) { | 
|---|
|  | 8877 | return 0; | 
|---|
|  | 8878 | } | 
|---|
|  | 8879 | ns2 = *n / 2; | 
|---|
|  | 8880 | np1 = *n + 1; | 
|---|
| [717] | 8881 | dt = pi / (r_8) np1; | 
|---|
| [459] | 8882 | i__1 = ns2; | 
|---|
|  | 8883 | for (k = 1; k <= i__1; ++k) { | 
|---|
|  | 8884 | wsave[k] = sin(k * dt) * 2.f; | 
|---|
|  | 8885 | /* L101: */ | 
|---|
|  | 8886 | } | 
|---|
|  | 8887 | dffti_(&np1, &wsave[ns2 + 1]); | 
|---|
|  | 8888 | return 0; | 
|---|
|  | 8889 | } /* dsinti_ */ | 
|---|
|  | 8890 |  | 
|---|