| fe4da5cc |
1 | * |
| 2 | * $Id$ |
| 3 | * |
| 4 | * $Log$ |
| 5 | * Revision 1.1.1.1 1996/04/01 15:02:18 mclareni |
| 6 | * Mathlib gen |
| 7 | * |
| 8 | * |
| 9 | #include "gen/pilot.h" |
| 10 | SUBROUTINE ESOLVE(M1,N,AD,BD,CD,DELTAY,IBCX,ALFAS,BETAS,ALFAN, |
| 11 | +BETAN,POT,IKIND) |
| 12 | COMMON/FW1/W1(774)/FW2/W2(100) |
| 13 | DIMENSION POT(M1,N) |
| 14 | DATA PI/3.141592653589793/ |
| 15 | M=M1-1 |
| 16 | COEFY=2.*DELTAY |
| 17 | IF(BETAS.EQ.0.) GOTO 50 |
| 18 | IBCYS=2 |
| 19 | COEF1S=COEFY/BETAS |
| 20 | COEF2S=ALFAS*COEF1S |
| 21 | GOTO 53 |
| 22 | 50 IBCYS=1 |
| 23 | DIV=1./ALFAS |
| 24 | DO 51 I=1,M1 |
| 25 | 51 W1(2*M1+I)=DIV*W1(2*M1+I) |
| 26 | 53 IF(BETAN.EQ.0.) GOTO 54 |
| 27 | IBCYN=2 |
| 28 | COEF1N=COEFY/BETAN |
| 29 | COEF2N=ALFAN*COEF1N |
| 30 | GOTO 56 |
| 31 | 54 IBCYN=1 |
| 32 | DIV=1./ALFAN |
| 33 | DO 55 I=1,M1 |
| 34 | 55 W1(3*M1+I)=DIV*W1(3*M1+I) |
| 35 | 56 CONTINUE |
| 36 | XM=M |
| 37 | NA=N-1 |
| 38 | NAA=N-2 |
| 39 | JUMP=1 |
| 40 | PIOVM=PI/XM |
| 41 | IF(IBCX.EQ.1) PIOVM=2.*PIOVM |
| 42 | IF(IBCX.EQ.4) PIOVM=.5*PIOVM |
| 43 | DUM1=.5*BD |
| 44 | XNORTH=AD+DUM1 |
| 45 | XSOUTH=AD-DUM1 |
| 46 | CENT=2.*(1.+AD)-CD |
| 47 | GOTO(100,200,300),IKIND |
| 48 | C |
| 49 | C THIS PART OF THE SUBROUTINE IS USED |
| 50 | C WHEN IKIND=1 THAT IS IN THE ELLIPTIC CASE |
| 51 | C AND SOLVES THE THREE-POINT RECURRENCE |
| 52 | C FORMULA THROUGH GAUSS ELIMINATION |
| 53 | C |
| 54 | 100 GOTO(110,120,130,135),IBCX |
| 55 | 110 IMIN=1 |
| 56 | IMAX=M/2+1 |
| 57 | GOTO 140 |
| 58 | 120 IMIN=1 |
| 59 | IMAX=M1 |
| 60 | GOTO 140 |
| 61 | 130 IMIN=2 |
| 62 | IMAX=M |
| 63 | GOTO 140 |
| 64 | 135 IMIN=2 |
| 65 | IMAX=M1 |
| 66 | JUMP=2 |
| 67 | 140 AA=1. |
| 68 | IOUT=0 |
| 69 | ISUB=0 |
| 70 | 141 DO 1 I=IMIN,IMAX,JUMP |
| 71 | XI=I-1-ISUB |
| 72 | H=2.*COS(PIOVM*XI) |
| 73 | FCENT=CENT-AA*H |
| 74 | DEN=1./FCENT |
| 75 | GOTO(111,112),IBCYS |
| 76 | 111 W2(2)=DEN*XNORTH |
| 77 | W2(N+2)=DEN*(XSOUTH*W1(2*M1+I)-POT(I,2)) |
| 78 | JMIN=3 |
| 79 | JMAX=NAA |
| 80 | GOTO 113 |
| 81 | 112 DEN=1./(FCENT-XSOUTH*COEF2S) |
| 82 | W2(1)=DEN*(XSOUTH+XNORTH) |
| 83 | W2(N+1)=-DEN*(POT(I,1)+XSOUTH*COEF1S*W1(2*M1+I)) |
| 84 | JMIN=2 |
| 85 | JMAX=NA |
| 86 | 113 DO 2 J=JMIN,NA |
| 87 | DEN=1./(FCENT-XSOUTH*W2(J-1)) |
| 88 | W2(J)=DEN*XNORTH |
| 89 | 2 W2(N+J)=DEN*(XSOUTH*W2(NA+J)-POT(I,J)) |
| 90 | GOTO(121,122),IBCYN |
| 91 | 121 POT(I,N)=W1(3*M1+I) |
| 92 | GOTO 123 |
| 93 | 122 IF(IBCX.EQ.4) GOTO 126 |
| 94 | IF(IBCYS.EQ.2.AND.IBCX.NE.3) GOTO 124 |
| 95 | GOTO 126 |
| 96 | 124 IF(I.EQ.1) GOTO 125 |
| 97 | 126 DEN=1./(FCENT-W2(NA)*(XSOUTH+XNORTH)+XNORTH*COEF2N) |
| 98 | POT(I,N)=DEN*(-POT(I,N)+XNORTH*COEF1N*W1(3*M1+I) |
| 99 | ++W2(N+NA)*(XSOUTH+XNORTH)) |
| 100 | GOTO 123 |
| 101 | 125 POT(1,N)=0. |
| 102 | 123 POT(I,1)=W1(2*M1+I) |
| 103 | DO 3 J=1,JMAX |
| 104 | K=N-J |
| 105 | 3 POT(I,K)=W2(K)*POT(I,K+1)+W2(N+K) |
| 106 | 1 CONTINUE |
| 107 | IOUT=IOUT+1 |
| 108 | IF(IOUT.EQ.2) RETURN |
| 109 | IF(IBCX.NE.1) GOTO 143 |
| 110 | IMIN=IMAX+1 |
| 111 | IMAX=M |
| 112 | AA=-1. |
| 113 | GOTO 141 |
| 114 | 143 IF(IBCX.NE.4) RETURN |
| 115 | ISUB=ISUB+1 |
| 116 | IMIN=3 |
| 117 | AA=-1. |
| 118 | GOTO 141 |
| 119 | C |
| 120 | C |
| 121 | C THIS PART OF THE SUBROUTINE IS USED |
| 122 | C WHEN IKIND=2 THAT IS IN THE PARABOLIC CASE |
| 123 | C AND SOLVES THE TWO-POINT RECURRENCE |
| 124 | C FORMULA STEP BY STEP |
| 125 | C |
| 126 | C |
| 127 | 200 GOTO(210,220,230,235),IBCX |
| 128 | 210 IMIN=1 |
| 129 | IMAX=M/2+1 |
| 130 | GOTO 240 |
| 131 | 220 IMIN=1 |
| 132 | IMAX=M1 |
| 133 | GOTO 240 |
| 134 | 230 IMIN=2 |
| 135 | IMAX=M |
| 136 | GOTO 240 |
| 137 | 235 IMIN=2 |
| 138 | IMAX=M1 |
| 139 | JUMP=2 |
| 140 | 240 AA=1. |
| 141 | IOUT=0 |
| 142 | ISUB=0 |
| 143 | DUM2=2.*BD |
| 144 | DUMUP=-2.+DUM2+CD |
| 145 | DUMLO=-2.-DUM2+CD |
| 146 | 241 DO 11 I=IMIN,IMAX,JUMP |
| 147 | XI=I-1-ISUB |
| 148 | H=2.*COS(PIOVM*XI) |
| 149 | XNORTH=DUMUP+AA*H |
| 150 | XSOUTH=DUMLO+AA*H |
| 151 | DEN2=1./XNORTH |
| 152 | DO 12 J=2,N |
| 153 | 12 W2(J)=POT(I,J-1)+POT(I,J) |
| 154 | GOTO(201,202),IBCYS |
| 155 | 201 POT(I,1)=W1(2*M1+I) |
| 156 | GOTO 203 |
| 157 | 202 IF(IBCX.EQ.3.OR.IBCX.EQ.4) GOTO 226 |
| 158 | C*UL 224 IF(I.EQ.1) GOTO 225 |
| 159 | IF(I.EQ.1) GOTO 225 |
| 160 | 226 DEN1=1./(XNORTH+XSOUTH*(1.+.5*COEF2S)) |
| 161 | POT(I,1)=DEN1*(POT(I,1)+.5*XSOUTH*COEF1S*W1(2*M1+I)) |
| 162 | GOTO 203 |
| 163 | 225 POT(1,1)=0. |
| 164 | 203 DO 13 J=2,N |
| 165 | 13 POT(I,J)=DEN2*(W2(J)-XSOUTH*POT(I,J-1)) |
| 166 | 11 CONTINUE |
| 167 | IOUT=IOUT+1 |
| 168 | IF(IOUT.EQ.2) GOTO 242 |
| 169 | IF(IBCX.NE.1) GOTO 243 |
| 170 | IMIN=IMAX+1 |
| 171 | IMAX=M |
| 172 | AA=-1. |
| 173 | GOTO 241 |
| 174 | 243 IF(IBCX.NE.4) GOTO 242 |
| 175 | ISUB=ISUB+1 |
| 176 | IMIN=3 |
| 177 | AA=-1. |
| 178 | GOTO 241 |
| 179 | 242 RETURN |
| 180 | C |
| 181 | C |
| 182 | C THIS PART OF THE SUBROUTINE IS USED |
| 183 | C WHEN IKIND=3 THAT IS IN THE HYPERBOLIC CASE |
| 184 | C AND SOLVES THE THREE-POINT RECURRENCE |
| 185 | C FORMULA STEP BY STEP |
| 186 | C |
| 187 | C |
| 188 | 300 GOTO(310,320,330,335),IBCX |
| 189 | 310 IMIN=1 |
| 190 | IMAX=M/2+1 |
| 191 | GOTO 340 |
| 192 | 320 IMIN=1 |
| 193 | IMAX=M1 |
| 194 | GOTO 340 |
| 195 | 330 IMIN=2 |
| 196 | IMAX=M |
| 197 | GOTO 340 |
| 198 | 335 IMIN=2 |
| 199 | IMAX=M1 |
| 200 | JUMP=2 |
| 201 | 340 AA=1. |
| 202 | IOUT=0 |
| 203 | ISUB=0 |
| 204 | DEN1=1./(XSOUTH+XNORTH) |
| 205 | DEN2=1./XNORTH |
| 206 | 341 DO 7 I=IMIN,IMAX,JUMP |
| 207 | XI=I-1-ISUB |
| 208 | H=2.*COS(PIOVM*XI) |
| 209 | FCENT=CENT-AA*H |
| 210 | DO 8 J=1,N |
| 211 | 8 W2(J)=POT(I,J) |
| 212 | POT(I,1)=W1(2*M1+I) |
| 213 | POT(I,2)=DEN1*(W2(1)+XSOUTH*COEFY*W1(3*M1+I)+FCENT*W1(2*M1+I)) |
| 214 | DO 9 J=3,N |
| 215 | 9 POT(I,J)=DEN2*(W2(J-1)-XSOUTH*POT(I,J-2)+FCENT*POT(I,J-1)) |
| 216 | 7 CONTINUE |
| 217 | IOUT=IOUT+1 |
| 218 | IF(IOUT.EQ.2) GOTO 342 |
| 219 | IF(IBCX.NE.1) GOTO 343 |
| 220 | IMIN=IMAX+1 |
| 221 | IMAX=M |
| 222 | AA=-1. |
| 223 | GOTO 341 |
| 224 | 343 IF(IBCX.NE.4) GOTO 342 |
| 225 | ISUB=ISUB+1 |
| 226 | IMIN=3 |
| 227 | AA=-1. |
| 228 | GOTO 341 |
| 229 | 342 CONTINUE |
| 230 | RETURN |
| 231 | END |
git://git.uio.no / u / mrichter / AliRoot.git / blame