MINICERN/mathlib/gen/d/esolve.F

   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