| 1 | !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC |
|---|
| 2 | ! |
|---|
| 3 | ! FFTPACK 5.0 |
|---|
| 4 | ! Copyright (C) 1995-2004, Scientific Computing Division, |
|---|
| 5 | ! University Corporation for Atmospheric Research |
|---|
| 6 | ! Licensed under the GNU General Public License (GPL) |
|---|
| 7 | ! |
|---|
| 8 | ! Authors: Paul N. Swarztrauber and Richard A. Valent |
|---|
| 9 | ! |
|---|
| 10 | ! $Id: c1fgkb.f,v 1.2 2004/06/15 21:08:32 rodney Exp $ |
|---|
| 11 | ! |
|---|
| 12 | !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC |
|---|
| 13 | |
|---|
| 14 | SUBROUTINE C1FGKB (IDO,IP,L1,LID,NA,CC,CC1,IN1, & |
|---|
| 15 | & CH,CH1,IN2,WA) |
|---|
| 16 | REAL CH(IN2,L1,IDO,IP) ,CC(IN1,L1,IP,IDO), & |
|---|
| 17 | & CC1(IN1,LID,IP) ,CH1(IN2,LID,IP) , & |
|---|
| 18 | & WA(IDO,IP-1,2) |
|---|
| 19 | ! |
|---|
| 20 | ! FFTPACK 5.0 auxiliary routine |
|---|
| 21 | ! |
|---|
| 22 | IPP2 = IP+2 |
|---|
| 23 | IPPH = (IP+1)/2 |
|---|
| 24 | DO 110 KI=1,LID |
|---|
| 25 | CH1(1,KI,1) = CC1(1,KI,1) |
|---|
| 26 | CH1(2,KI,1) = CC1(2,KI,1) |
|---|
| 27 | 110 END DO |
|---|
| 28 | DO 111 J=2,IPPH |
|---|
| 29 | JC = IPP2-J |
|---|
| 30 | DO 112 KI=1,LID |
|---|
| 31 | CH1(1,KI,J) = CC1(1,KI,J)+CC1(1,KI,JC) |
|---|
| 32 | CH1(1,KI,JC) = CC1(1,KI,J)-CC1(1,KI,JC) |
|---|
| 33 | CH1(2,KI,J) = CC1(2,KI,J)+CC1(2,KI,JC) |
|---|
| 34 | CH1(2,KI,JC) = CC1(2,KI,J)-CC1(2,KI,JC) |
|---|
| 35 | 112 CONTINUE |
|---|
| 36 | 111 END DO |
|---|
| 37 | DO 118 J=2,IPPH |
|---|
| 38 | DO 117 KI=1,LID |
|---|
| 39 | CC1(1,KI,1) = CC1(1,KI,1)+CH1(1,KI,J) |
|---|
| 40 | CC1(2,KI,1) = CC1(2,KI,1)+CH1(2,KI,J) |
|---|
| 41 | 117 CONTINUE |
|---|
| 42 | 118 END DO |
|---|
| 43 | DO 116 L=2,IPPH |
|---|
| 44 | LC = IPP2-L |
|---|
| 45 | DO 113 KI=1,LID |
|---|
| 46 | CC1(1,KI,L) = CH1(1,KI,1)+WA(1,L-1,1)*CH1(1,KI,2) |
|---|
| 47 | CC1(1,KI,LC) = WA(1,L-1,2)*CH1(1,KI,IP) |
|---|
| 48 | CC1(2,KI,L) = CH1(2,KI,1)+WA(1,L-1,1)*CH1(2,KI,2) |
|---|
| 49 | CC1(2,KI,LC) = WA(1,L-1,2)*CH1(2,KI,IP) |
|---|
| 50 | 113 CONTINUE |
|---|
| 51 | DO 115 J=3,IPPH |
|---|
| 52 | JC = IPP2-J |
|---|
| 53 | IDLJ = MOD((L-1)*(J-1),IP) |
|---|
| 54 | WAR = WA(1,IDLJ,1) |
|---|
| 55 | WAI = WA(1,IDLJ,2) |
|---|
| 56 | DO 114 KI=1,LID |
|---|
| 57 | CC1(1,KI,L) = CC1(1,KI,L)+WAR*CH1(1,KI,J) |
|---|
| 58 | CC1(1,KI,LC) = CC1(1,KI,LC)+WAI*CH1(1,KI,JC) |
|---|
| 59 | CC1(2,KI,L) = CC1(2,KI,L)+WAR*CH1(2,KI,J) |
|---|
| 60 | CC1(2,KI,LC) = CC1(2,KI,LC)+WAI*CH1(2,KI,JC) |
|---|
| 61 | 114 CONTINUE |
|---|
| 62 | 115 CONTINUE |
|---|
| 63 | 116 END DO |
|---|
| 64 | IF(IDO.GT.1 .OR. NA.EQ.1) GO TO 136 |
|---|
| 65 | DO 120 J=2,IPPH |
|---|
| 66 | JC = IPP2-J |
|---|
| 67 | DO 119 KI=1,LID |
|---|
| 68 | CHOLD1 = CC1(1,KI,J)-CC1(2,KI,JC) |
|---|
| 69 | CHOLD2 = CC1(1,KI,J)+CC1(2,KI,JC) |
|---|
| 70 | CC1(1,KI,J) = CHOLD1 |
|---|
| 71 | CC1(2,KI,JC) = CC1(2,KI,J)-CC1(1,KI,JC) |
|---|
| 72 | CC1(2,KI,J) = CC1(2,KI,J)+CC1(1,KI,JC) |
|---|
| 73 | CC1(1,KI,JC) = CHOLD2 |
|---|
| 74 | 119 CONTINUE |
|---|
| 75 | 120 END DO |
|---|
| 76 | RETURN |
|---|
| 77 | 136 DO 137 KI=1,LID |
|---|
| 78 | CH1(1,KI,1) = CC1(1,KI,1) |
|---|
| 79 | CH1(2,KI,1) = CC1(2,KI,1) |
|---|
| 80 | 137 END DO |
|---|
| 81 | DO 135 J=2,IPPH |
|---|
| 82 | JC = IPP2-J |
|---|
| 83 | DO 134 KI=1,LID |
|---|
| 84 | CH1(1,KI,J) = CC1(1,KI,J)-CC1(2,KI,JC) |
|---|
| 85 | CH1(1,KI,JC) = CC1(1,KI,J)+CC1(2,KI,JC) |
|---|
| 86 | CH1(2,KI,JC) = CC1(2,KI,J)-CC1(1,KI,JC) |
|---|
| 87 | CH1(2,KI,J) = CC1(2,KI,J)+CC1(1,KI,JC) |
|---|
| 88 | 134 CONTINUE |
|---|
| 89 | 135 END DO |
|---|
| 90 | IF (IDO .EQ. 1) RETURN |
|---|
| 91 | DO 131 I=1,IDO |
|---|
| 92 | DO 130 K=1,L1 |
|---|
| 93 | CC(1,K,1,I) = CH(1,K,I,1) |
|---|
| 94 | CC(2,K,1,I) = CH(2,K,I,1) |
|---|
| 95 | 130 CONTINUE |
|---|
| 96 | 131 END DO |
|---|
| 97 | DO 123 J=2,IP |
|---|
| 98 | DO 122 K=1,L1 |
|---|
| 99 | CC(1,K,J,1) = CH(1,K,1,J) |
|---|
| 100 | CC(2,K,J,1) = CH(2,K,1,J) |
|---|
| 101 | 122 CONTINUE |
|---|
| 102 | 123 END DO |
|---|
| 103 | DO 126 J=2,IP |
|---|
| 104 | DO 125 I=2,IDO |
|---|
| 105 | DO 124 K=1,L1 |
|---|
| 106 | CC(1,K,J,I) = WA(I,J-1,1)*CH(1,K,I,J) & |
|---|
| 107 | & -WA(I,J-1,2)*CH(2,K,I,J) |
|---|
| 108 | CC(2,K,J,I) = WA(I,J-1,1)*CH(2,K,I,J) & |
|---|
| 109 | & +WA(I,J-1,2)*CH(1,K,I,J) |
|---|
| 110 | 124 CONTINUE |
|---|
| 111 | 125 CONTINUE |
|---|
| 112 | 126 END DO |
|---|
| 113 | RETURN |
|---|
| 114 | END |
|---|
