relibc_openlibm/slatec/exbvp.f

*DECK EXBVP
      SUBROUTINE EXBVP (Y, NROWY, XPTS, A, NROWA, ALPHA, B, NROWB, BETA,
     +   IFLAG, WORK, IWORK)
C***BEGIN PROLOGUE  EXBVP
C***SUBSIDIARY
C***PURPOSE  Subsidiary to BVSUP
C***LIBRARY   SLATEC
C***TYPE      SINGLE PRECISION (EXBVP-S, DEXBVP-D)
C***AUTHOR  Watts, H. A., (SNLA)
C***DESCRIPTION
C
C  This subroutine is used to execute the basic technique for solving
C  the two-point boundary value problem
C
C***SEE ALSO  BVSUP
C***ROUTINES CALLED  BVPOR, XERMSG
C***COMMON BLOCKS    ML15TO, ML17BW, ML18JR, ML5MCO, ML8SZ
C***REVISION HISTORY  (YYMMDD)
C   750601  DATE WRITTEN
C   890921  Realigned order of variables in certain COMMON blocks.
C           (WRB)
C   891214  Prologue converted to Version 4.0 format.  (BAB)
C   900328  Added TYPE section.  (WRB)
C   900510  Convert XERRWV calls to XERMSG calls.  (RWC)
C   910722  Updated AUTHOR section.  (ALS)
C***END PROLOGUE  EXBVP
C
      DIMENSION Y(NROWY,*),A(NROWA,*),ALPHA(*),B(NROWB,*),BETA(*),
     1         WORK(*),IWORK(*),XPTS(*)
      CHARACTER*8 XERN1, XERN2
C
C     ****************************************************************
C
      COMMON /ML8SZ/ C,XSAV,IGOFX,INHOMO,IVP,NCOMP,NFC
      COMMON /ML18JR/ AE,RE,TOL,NXPTS,NIC,NOPG,MXNON,NDISK,NTAPE,NEQ,
     1                INDPVT,INTEG,NPS,NTP,NEQIVP,NUMORT,NFCC,
     2                ICOCO
      COMMON /ML15TO/ PX,PWCND,TND,X,XBEG,XEND,XOT,XOP,INFO(15),ISTKOP,
     1                KNSWOT,KOP,LOTJP,MNSWOT,NSWOT
      COMMON /ML17BW/ KKKZPW,NEEDW,NEEDIW,K1,K2,K3,K4,K5,K6,K7,K8,K9,
     1                K10,K11,L1,L2,KKKINT,LLLINT
C
      COMMON /ML5MCO/ URO,SRU,EPS,SQOVFL,TWOU,FOURU,LPAR
C
C***FIRST EXECUTABLE STATEMENT  EXBVP
      KOTC = 1
      IEXP = 0
      IF (IWORK(7) .EQ. -1) IEXP = IWORK(8)
C
C     COMPUTE ORTHONORMALIZATION TOLERANCES.
C
   10 TOL = 10.0**((-LPAR-IEXP)*2)
C
      IWORK(8) = IEXP
      MXNON = IWORK(2)
C
C **********************************************************************
C **********************************************************************
C
      CALL BVPOR(Y,NROWY,NCOMP,XPTS,NXPTS,A,NROWA,ALPHA,NIC,B,
     1           NROWB,BETA,NFC,IFLAG,WORK(1),MXNON,WORK(K1),NTP,
     2           IWORK(18),WORK(K2),IWORK(16),WORK(K3),WORK(K4),
     3           WORK(K5),WORK(K6),WORK(K7),WORK(K8),WORK(K9),
     4           WORK(K10),IWORK(L1),NFCC)
C
C **********************************************************************
C **********************************************************************
C     IF MGSBV RETURNS WITH MESSAGE OF DEPENDENT VECTORS, WE REDUCE
C     ORTHONORMALIZATION TOLERANCE AND TRY AGAIN. THIS IS DONE
C     A MAXIMUM OF 2 TIMES.
C
      IF (IFLAG .NE. 30) GO TO 20
      IF (KOTC .EQ. 3  .OR.  NOPG .EQ. 1) GO TO 30
      KOTC = KOTC + 1
      IEXP = IEXP - 2
      GO TO 10
C
C **********************************************************************
C     IF BVPOR RETURNS MESSAGE THAT THE MAXIMUM NUMBER OF
C     ORTHONORMALIZATIONS HAS BEEN ATTAINED AND WE CANNOT CONTINUE, THEN
C     WE ESTIMATE THE NEW STORAGE REQUIREMENTS IN ORDER TO SOLVE PROBLEM
C
   20 IF (IFLAG .NE. 13) GO TO 30
      XL = ABS(XEND-XBEG)
      ZQUIT = ABS(X-XBEG)
      INC = 1.5 * XL/ZQUIT * (MXNON+1)
      IF (NDISK .NE. 1) THEN
         NSAFW = INC*KKKZPW + NEEDW
         NSAFIW = INC*NFCC + NEEDIW
      ELSE
         NSAFW = NEEDW + INC
         NSAFIW = NEEDIW
      ENDIF
C
      WRITE (XERN1, '(I8)') NSAFW
      WRITE (XERN2, '(I8)') NSAFIW
      CALL XERMSG ('SLATEC', 'EXBVP',
     *   'IN BVSUP, PREDICTED STORAGE ALLOCATION FOR WORK ARRAY IS ' //
     *   XERN1 // ', PREDICTED STORAGE ALLOCATION FOR IWORK ARRAY IS '
     *   // XERN2, 1, 0)
C
   30 IWORK(1) = MXNON
      RETURN
      END