1*----------------------------------------------------------------------- 2 SUBROUTINE PASSF (NAC,IDO,IP,L1,IDL1,CC,C1,C2,CH,CH2,WA) 3 DIMENSION CH(IDO,L1,IP) ,CC(IDO,IP,L1) , 4 1 C1(IDO,L1,IP) ,WA(*) ,C2(IDL1,IP), 5 2 CH2(IDL1,IP) 6 IDOT = IDO/2 7 NT = IP*IDL1 8 IPP2 = IP+2 9 IPPH = (IP+1)/2 10 IDP = IP*IDO 11C 12 IF (IDO .LT. L1) GO TO 106 13 DO 103 J=2,IPPH 14 JC = IPP2-J 15 DO 102 K=1,L1 16 DO 101 I=1,IDO 17 CH(I,K,J) = CC(I,J,K)+CC(I,JC,K) 18 CH(I,K,JC) = CC(I,J,K)-CC(I,JC,K) 19 101 CONTINUE 20 102 CONTINUE 21 103 CONTINUE 22 DO 105 K=1,L1 23 DO 104 I=1,IDO 24 CH(I,K,1) = CC(I,1,K) 25 104 CONTINUE 26 105 CONTINUE 27 GO TO 112 28 106 DO 109 J=2,IPPH 29 JC = IPP2-J 30 DO 108 I=1,IDO 31 DO 107 K=1,L1 32 CH(I,K,J) = CC(I,J,K)+CC(I,JC,K) 33 CH(I,K,JC) = CC(I,J,K)-CC(I,JC,K) 34 107 CONTINUE 35 108 CONTINUE 36 109 CONTINUE 37 DO 111 I=1,IDO 38 DO 110 K=1,L1 39 CH(I,K,1) = CC(I,1,K) 40 110 CONTINUE 41 111 CONTINUE 42 112 IDL = 2-IDO 43 INC = 0 44 DO 116 L=2,IPPH 45 LC = IPP2-L 46 IDL = IDL+IDO 47 DO 113 IK=1,IDL1 48 C2(IK,L) = CH2(IK,1)+WA(IDL-1)*CH2(IK,2) 49 C2(IK,LC) = -WA(IDL)*CH2(IK,IP) 50 113 CONTINUE 51 IDLJ = IDL 52 INC = INC+IDO 53 DO 115 J=3,IPPH 54 JC = IPP2-J 55 IDLJ = IDLJ+INC 56 IF (IDLJ .GT. IDP) IDLJ = IDLJ-IDP 57 WAR = WA(IDLJ-1) 58 WAI = WA(IDLJ) 59 DO 114 IK=1,IDL1 60 C2(IK,L) = C2(IK,L)+WAR*CH2(IK,J) 61 C2(IK,LC) = C2(IK,LC)-WAI*CH2(IK,JC) 62 114 CONTINUE 63 115 CONTINUE 64 116 CONTINUE 65 DO 118 J=2,IPPH 66 DO 117 IK=1,IDL1 67 CH2(IK,1) = CH2(IK,1)+CH2(IK,J) 68 117 CONTINUE 69 118 CONTINUE 70 DO 120 J=2,IPPH 71 JC = IPP2-J 72 DO 119 IK=2,IDL1,2 73 CH2(IK-1,J) = C2(IK-1,J)-C2(IK,JC) 74 CH2(IK-1,JC) = C2(IK-1,J)+C2(IK,JC) 75 CH2(IK,J) = C2(IK,J)+C2(IK-1,JC) 76 CH2(IK,JC) = C2(IK,J)-C2(IK-1,JC) 77 119 CONTINUE 78 120 CONTINUE 79 NAC = 1 80 IF (IDO .EQ. 2) RETURN 81 NAC = 0 82 DO 121 IK=1,IDL1 83 C2(IK,1) = CH2(IK,1) 84 121 CONTINUE 85 DO 123 J=2,IP 86 DO 122 K=1,L1 87 C1(1,K,J) = CH(1,K,J) 88 C1(2,K,J) = CH(2,K,J) 89 122 CONTINUE 90 123 CONTINUE 91 IF (IDOT .GT. L1) GO TO 127 92 IDIJ = 0 93 DO 126 J=2,IP 94 IDIJ = IDIJ+2 95 DO 125 I=4,IDO,2 96 IDIJ = IDIJ+2 97 DO 124 K=1,L1 98 C1(I-1,K,J) = WA(IDIJ-1)*CH(I-1,K,J)+WA(IDIJ)*CH(I,K,J) 99 C1(I,K,J) = WA(IDIJ-1)*CH(I,K,J)-WA(IDIJ)*CH(I-1,K,J) 100 124 CONTINUE 101 125 CONTINUE 102 126 CONTINUE 103 RETURN 104 127 IDJ = 2-IDO 105 DO 130 J=2,IP 106 IDJ = IDJ+IDO 107 DO 129 K=1,L1 108 IDIJ = IDJ 109 DO 128 I=4,IDO,2 110 IDIJ = IDIJ+2 111 C1(I-1,K,J) = WA(IDIJ-1)*CH(I-1,K,J)+WA(IDIJ)*CH(I,K,J) 112 C1(I,K,J) = WA(IDIJ-1)*CH(I,K,J)-WA(IDIJ)*CH(I-1,K,J) 113 128 CONTINUE 114 129 CONTINUE 115 130 CONTINUE 116 RETURN 117 END 118