OpenLibm/slatec/hwscsp.f

*DECK HWSCSP
      SUBROUTINE HWSCSP (INTL, TS, TF, M, MBDCND, BDTS, BDTF, RS, RF, N,
     +   NBDCND, BDRS, BDRF, ELMBDA, F, IDIMF, PERTRB, IERROR, W)
C***BEGIN PROLOGUE  HWSCSP
C***PURPOSE  Solve a finite difference approximation to the modified
C            Helmholtz equation in spherical coordinates assuming
C            axisymmetry  (no dependence on longitude).
C***LIBRARY   SLATEC (FISHPACK)
C***CATEGORY  I2B1A1A
C***TYPE      SINGLE PRECISION (HWSCSP-S)
C***KEYWORDS  ELLIPTIC, FISHPACK, HELMHOLTZ, PDE, SPHERICAL
C***AUTHOR  Adams, J., (NCAR)
C           Swarztrauber, P. N., (NCAR)
C           Sweet, R., (NCAR)
C***DESCRIPTION
C
C     Subroutine HWSCSP solves a finite difference approximation to the
C       modified Helmholtz equation in spherical coordinates assuming
C       axisymmetry  (no dependence on longitude)
C
C          (1/R**2)(d/dR)((R**2)(d/dR)U)
C
C             + (1/(R**2)SIN(THETA))(d/dTHETA)(SIN(THETA)(d/dTHETA)U)
C
C             + (LAMBDA/(RSIN(THETA))**2)U = F(THETA,R).
C
C     This two dimensional modified Helmholtz equation results from
C     the Fourier transform of the three dimensional Poisson equation
C
C     * * * * * * * * * *     On Input     * * * * * * * * * *
C
C     INTL
C       = 0  On initial entry to HWSCSP or if any of the arguments
C            RS, RF, N, NBDCND are changed from a previous call.
C       = 1  If RS, RF, N, NBDCND are all unchanged from previous call
C            to HWSCSP.
C
C       NOTE   A call with INTL=0 takes approximately 1.5 times as
C              much time as a call with INTL = 1.  Once a call with
C              INTL = 0 has been made then subsequent solutions
C              corresponding to different F, BDTS, BDTF, BDRS, BDRF can
C              be obtained faster with INTL = 1 since initialization is
C              not repeated.
C
C     TS,TF
C       The range of THETA (colatitude), i.e., TS .LE. THETA .LE. TF.
C       TS must be less than TF.  TS and TF are in radians.  A TS of
C       zero corresponds to the north pole and a TF of PI corresponds
C       to the south pole.
C
C     * * * * * * * * * * * * * * IMPORTANT * * * * * * * * * * * * * *
C
C     If TF is equal to PI then it must be computed using the statement
C     TF = PIMACH(DUM). This insures that TF in the users program is
C     equal to PI in this program which permits several tests of the
C     input parameters that otherwise would not be possible.
C
C     M
C       The number of panels into which the interval (TS,TF) is
C       subdivided.  Hence, there will be M+1 grid points in the
C       THETA-direction given by THETA(K) = (I-1)DTHETA+TS for
C       I = 1,2,...,M+1, where DTHETA = (TF-TS)/M is the panel width.
C
C     MBDCND
C       Indicates the type of boundary condition at THETA = TS and
C       THETA = TF.
C
C       = 1  If the solution is specified at THETA = TS and THETA = TF.
C       = 2  If the solution is specified at THETA = TS and the
C            derivative of the solution with respect to THETA is
C            specified at THETA = TF (see note 2 below).
C       = 3  If the derivative of the solution with respect to THETA is
C            specified at THETA = TS and THETA = TF (see notes 1,2
C            below).
C       = 4  If the derivative of the solution with respect to THETA is
C            specified at THETA = TS (see note 1 below) and the
C            solution is specified at THETA = TF.
C       = 5  If the solution is unspecified at THETA = TS = 0 and the
C            solution is specified at THETA = TF.
C       = 6  If the solution is unspecified at THETA = TS = 0 and the
C            derivative of the solution with respect to THETA is
C            specified at THETA = TF (see note 2 below).
C       = 7  If the solution is specified at THETA = TS and the
C            solution is unspecified at THETA = TF = PI.
C       = 8  If the derivative of the solution with respect to THETA is
C            specified at THETA = TS (see note 1 below) and the solution
C            is unspecified at THETA = TF = PI.
C       = 9  If the solution is unspecified at THETA = TS = 0 and
C            THETA = TF = PI.
C
C       NOTES:  1.  If TS = 0, do not use MBDCND = 3,4, or 8, but
C                   instead use MBDCND = 5,6, or 9  .
C               2.  If TF = PI, do not use MBDCND = 2,3, or 6, but
C                   instead use MBDCND = 7,8, or 9  .
C
C     BDTS
C       A one-dimensional array of length N+1 that specifies the values
C       of the derivative of the solution with respect to THETA at
C       THETA = TS.  When MBDCND = 3,4, or 8,
C
C            BDTS(J) = (d/dTHETA)U(TS,R(J)), J = 1,2,...,N+1  .
C
C       When MBDCND has any other value, BDTS is a dummy variable.
C
C     BDTF
C       A one-dimensional array of length N+1 that specifies the values
C       of the derivative of the solution with respect to THETA at
C       THETA = TF.  When MBDCND = 2,3, or 6,
C
C            BDTF(J) = (d/dTHETA)U(TF,R(J)), J = 1,2,...,N+1  .
C
C       When MBDCND has any other value, BDTF is a dummy variable.
C
C     RS,RF
C       The range of R, i.e., RS .LE. R .LT. RF.  RS must be less than
C       RF.  RS must be non-negative.
C
C       N
C       The number of panels into which the interval (RS,RF) is
C       subdivided.  Hence, there will be N+1 grid points in the
C       R-direction given by R(J) = (J-1)DR+RS for J = 1,2,...,N+1,
C       where DR = (RF-RS)/N is the panel width.
C       N must be greater than 2
C
C     NBDCND
C       Indicates the type of boundary condition at R = RS and R = RF.
C
C       = 1  If the solution is specified at R = RS and R = RF.
C       = 2  If the solution is specified at R = RS and the derivative
C            of the solution with respect to R is specified at R = RF.
C       = 3  If the derivative of the solution with respect to R is
C            specified at R = RS and R = RF.
C       = 4  If the derivative of the solution with respect to R is
C            specified at RS and the solution is specified at R = RF.
C       = 5  If the solution is unspecified at R = RS = 0 (see note
C            below) and the solution is specified at R = RF.
C       = 6  If the solution is unspecified at R = RS = 0 (see note
C            below) and the derivative of the solution with respect to
C            R is specified at R = RF.
C
C       NOTE:  NBDCND = 5 or 6 cannot be used with
C              MBDCND = 1,2,4,5, or 7 (the former indicates that the
C                       solution is unspecified at R = 0, the latter
C                       indicates that the solution is specified).
C                       Use instead
C              NBDCND = 1 or 2  .
C
C     BDRS
C       A one-dimensional array of length M+1 that specifies the values
C       of the derivative of the solution with respect to R at R = RS.
C       When NBDCND = 3 or 4,
C
C            BDRS(I) = (d/dR)U(THETA(I),RS), I = 1,2,...,M+1  .
C
C       When NBDCND has any other value, BDRS is a dummy variable.
C
C     BDRF
C       A one-dimensional array of length M+1 that specifies the values
C       of the derivative of the solution with respect to R at R = RF.
C       When NBDCND = 2,3, or 6,
C
C            BDRF(I) = (d/dR)U(THETA(I),RF), I = 1,2,...,M+1  .
C
C       When NBDCND has any other value, BDRF is a dummy variable.
C
C     ELMBDA
C       The constant LAMBDA in the Helmholtz equation.  If
C       LAMBDA .GT. 0, a solution may not exist.  However, HWSCSP will
C       attempt to find a solution.  If NBDCND = 5 or 6 or
C       MBDCND = 5,6,7,8, or 9, ELMBDA must be zero.
C
C     F
C       A two-dimensional array that specifies the value of the right
C       side of the Helmholtz equation and boundary values (if any).
C       for I = 2,3,...,M and J = 2,3,...,N
C
C            F(I,J) = F(THETA(I),R(J)).
C
C       On the boundaries F is defined by
C
C            MBDCND   F(1,J)            F(M+1,J)
C            ------   ----------        ----------
C
C              1      U(TS,R(J))        U(TF,R(J))
C              2      U(TS,R(J))        F(TF,R(J))
C              3      F(TS,R(J))        F(TF,R(J))
C              4      F(TS,R(J))        U(TF,R(J))
C              5      F(0,R(J))         U(TF,R(J))   J = 1,2,...,N+1
C              6      F(0,R(J))         F(TF,R(J))
C              7      U(TS,R(J))        F(PI,R(J))
C              8      F(TS,R(J))        F(PI,R(J))
C              9      F(0,R(J))         F(PI,R(J))
C
C            NBDCND   F(I,1)            F(I,N+1)
C            ------   --------------    --------------
C
C              1      U(THETA(I),RS)    U(THETA(I),RF)
C              2      U(THETA(I),RS)    F(THETA(I),RF)
C              3      F(THETA(I),RS)    F(THETA(I),RF)
C              4      F(THETA(I),RS)    U(THETA(I),RF)   I = 1,2,...,M+1
C              5      F(TS,0)           U(THETA(I),RF)
C              6      F(TS,0)           F(THETA(I),RF)
C
C       F must be dimensioned at least (M+1)*(N+1).
C
C       NOTE
C
C       If the table calls for both the solution U and the right side F
C       at a corner then the solution must be specified.
C
C     IDIMF
C       The row (or first) dimension of the array F as it appears in the
C       program calling HWSCSP.  This parameter is used to specify the
C       variable dimension of F.  IDIMF must be at least M+1  .
C
C     W
C       A one-dimensional array that must be provided by the user for
C       work space. Its length can be computed from the formula below
C       which depends on the value of NBDCND.
C
C       If NBDCND=2,4 or 6 define NUNK=N
C       If NBDCND=1 or 5   define NUNK=N-1
C       If NBDCND=3        define NUNK=N+1
C
C       Now set K=INT(log2(NUNK))+1 and L=2**(K+1) then W must be
C       dimensioned at least (K-2)*L+K+5*(M+N)+MAX(2*N,6*M)+23
C
C       **IMPORTANT** For purposes of checking, the required length
C                     of W is computed by HWSCSP and stored in W(1)
C                     in floating point format.
C
C
C     * * * * * * * * * *     On Output     * * * * * * * * * *
C
C     F
C       Contains the solution U(I,J) of the finite difference
C       approximation for the grid point (THETA(I),R(J)),
C       I = 1,2,...,M+1,   J = 1,2,...,N+1  .
C
C     PERTRB
C       If a combination of periodic or derivative boundary conditions
C       is specified for a Poisson equation (LAMBDA = 0), a solution may
C       not exist.  PERTRB is a constant, calculated and subtracted from
C       F, which ensures that a solution exists.  HWSCSP then computes
C       this solution, which is a least squares solution to the original
C       approximation. This solution is not unique and is unnormalized.
C       The value of PERTRB should be small compared to the right side
C       F. Otherwise , a solution is obtained to an essentially
C       different problem. This comparison should always be made to
C       insure that a meaningful solution has been obtained.
C
C     IERROR
C       An error flag that indicates invalid input parameters.  Except
C       for numbers 0 and 10, a solution is not attempted.
C
C       = 1  TS.LT.0. or TF.GT.PI
C       = 2  TS.GE.TF
C       = 3  M.LT.5
C       = 4  MBDCND.LT.1 or MBDCND.GT.9
C       = 5  RS.LT.0
C       = 6  RS.GE.RF
C       = 7  N.LT.5
C       = 8  NBDCND.LT.1 or NBDCND.GT.6
C       = 9  ELMBDA.GT.0
C       = 10 IDIMF.LT.M+1
C       = 11 ELMBDA.NE.0 and MBDCND.GE.5
C       = 12 ELMBDA.NE.0 and NBDCND equals 5 or 6
C       = 13 MBDCND equals 5,6 or 9 and TS.NE.0
C       = 14 MBDCND.GE.7 and TF.NE.PI
C       = 15 TS.EQ.0 and MBDCND equals 3,4 or 8
C       = 16 TF.EQ.PI and MBDCND equals 2,3 or 6
C       = 17 NBDCND.GE.5 and RS.NE.0
C       = 18 NBDCND.GE.5 and MBDCND equals 1,2,4,5 or 7
C
C       Since this is the only means of indicating a possibly incorrect
C       call to HWSCSP, the user should test IERROR after a call.
C
C     W
C       Contains intermediate values that must not be destroyed if
C       HWSCSP will be called again with INTL = 1.  W(1) contains the
C       number of locations which W must have.
C
C *Long Description:
C
C     * * * * * * *   Program Specifications    * * * * * * * * * * * *
C
C     Dimension of   BDTS(N+1),BDTF(N+1),BDRS(M+1),BDRF(M+1),
C     Arguments      F(IDIMF,N+1),W(see argument list)
C
C     Latest         June 1979
C     Revision
C
C     Subprograms    HWSCSP,HWSCS1,BLKTRI,BLKTR1,PROD,PRODP,CPROD,CPRODP
C     Required       ,COMBP,PPADD,PSGF,BSRH,PPSGF,PPSPF,TEVLS,INDXA,
C                    ,INDXB,INDXC,R1MACH
C
C     Special
C     Conditions
C
C     Common         CBLKT
C     Blocks
C
C     I/O            NONE
C
C     Precision      Single
C
C     Specialist     Paul N Swarztrauber
C
C     Language       FORTRAN
C
C     History        Version 1 September 1973
C                    Version 2 April     1976
C                    Version 3 June      1979
C
C     Algorithm      The routine defines the finite difference
C                    equations, incorporates boundary data, and adjusts
C                    the right side of singular systems and then calls
C                    BLKTRI to solve the system.
C
C     Space
C     Required
C
C     Portability    American National Standards Institute FORTRAN.
C                    The machine accuracy is set using function R1MACH.
C
C     Required       NONE
C     Resident
C     Routines
C
C     Reference      Swarztrauber,P. and R. Sweet, 'Efficient FORTRAN
C                    Subprograms for The Solution Of Elliptic Equations'
C                    NCAR TN/IA-109, July, 1975, 138 pp.
C
C     * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
C
C***REFERENCES  P. N. Swarztrauber and R. Sweet, Efficient Fortran
C                 subprograms for the solution of elliptic equations,
C                 NCAR TN/IA-109, July 1975, 138 pp.
C***ROUTINES CALLED  HWSCS1, PIMACH
C***REVISION HISTORY  (YYMMDD)
C   801001  DATE WRITTEN
C   890531  Changed all specific intrinsics to generic.  (WRB)
C   890531  REVISION DATE from Version 3.2
C   891214  Prologue converted to Version 4.0 format.  (BAB)
C   920501  Reformatted the REFERENCES section.  (WRB)
C***END PROLOGUE  HWSCSP
C
      DIMENSION       F(IDIMF,*) ,BDTS(*)    ,BDTF(*)    ,BDRS(*)    ,
     1                BDRF(*)    ,W(*)
C***FIRST EXECUTABLE STATEMENT  HWSCSP
      PI = PIMACH(DUM)
      IERROR = 0
      IF (TS.LT.0. .OR. TF.GT.PI) IERROR = 1
      IF (TS .GE. TF) IERROR = 2
      IF (M .LT. 5) IERROR = 3
      IF (MBDCND.LT.1 .OR. MBDCND.GT.9) IERROR = 4
      IF (RS .LT. 0.) IERROR = 5
      IF (RS .GE. RF) IERROR = 6
      IF (N .LT. 5) IERROR = 7
      IF (NBDCND.LT.1 .OR. NBDCND.GT.6) IERROR = 8
      IF (ELMBDA .GT. 0.) IERROR = 9
      IF (IDIMF .LT. M+1) IERROR = 10
      IF (ELMBDA.NE.0. .AND. MBDCND.GE.5) IERROR = 11
      IF (ELMBDA.NE.0. .AND. (NBDCND.EQ.5 .OR. NBDCND.EQ.6)) IERROR = 12
      IF ((MBDCND.EQ.5 .OR. MBDCND.EQ.6 .OR. MBDCND.EQ.9) .AND.
     1    TS.NE.0.) IERROR = 13
      IF (MBDCND.GE.7 .AND. TF.NE.PI) IERROR = 14
      IF (TS.EQ.0. .AND.
     1    (MBDCND.EQ.4 .OR. MBDCND.EQ.8 .OR. MBDCND.EQ.3)) IERROR = 15
      IF (TF.EQ.PI .AND.
     1    (MBDCND.EQ.2 .OR. MBDCND.EQ.3 .OR. MBDCND.EQ.6)) IERROR = 16
      IF (NBDCND.GE.5 .AND. RS.NE.0.) IERROR = 17
      IF (NBDCND.GE.5 .AND. (MBDCND.EQ.1 .OR. MBDCND.EQ.2 .OR.
     1                                    MBDCND.EQ.5 .OR. MBDCND.EQ.7))
     2    IERROR = 18
      IF (IERROR.NE.0 .AND. IERROR.NE.9) RETURN
      NCK = N
      GO TO (101,103,102,103,101,103),NBDCND
  101 NCK = NCK-1
      GO TO 103
  102 NCK = NCK+1
  103 L = 2
      K = 1
  104 L = L+L
      K = K+1
      IF (NCK-L) 105,105,104
  105 L = L+L
      NP1 = N+1
      MP1 = M+1
      I1 = (K-2)*L+K+MAX(2*N,6*M)+13
      I2 = I1+NP1
      I3 = I2+NP1
      I4 = I3+NP1
      I5 = I4+NP1
      I6 = I5+NP1
      I7 = I6+MP1
      I8 = I7+MP1
      I9 = I8+MP1
      I10 = I9+MP1
      W(1) = I10+M
      CALL HWSCS1 (INTL,TS,TF,M,MBDCND,BDTS,BDTF,RS,RF,N,NBDCND,BDRS,
     1             BDRF,ELMBDA,F,IDIMF,PERTRB,W(2),W(I1),W(I2),W(I3),
     2             W(I4),W(I5),W(I6),W(I7),W(I8),W(I9),W(I10))
      RETURN
      END