*DECK DVECS
      SUBROUTINE DVECS (NCOMP, LNFC, YHP, WORK, IWORK, INHOMO, IFLAG)
C***BEGIN PROLOGUE  DVECS
C***SUBSIDIARY
C***PURPOSE  Subsidiary to DBVSUP
C***LIBRARY   SLATEC
C***TYPE      DOUBLE PRECISION (SVECS-S, DVECS-D)
C***AUTHOR  Watts, H. A., (SNLA)
C***DESCRIPTION
C
C  This subroutine is used for the special structure of COMPLEX*16
C  valued problems. DMGSBV is called upon to obtain LNFC vectors from an
C  original set of 2*LNFC independent vectors so that the resulting
C  LNFC vectors together with their imaginary product or mate vectors
C  form an independent set.
C
C***SEE ALSO  DBVSUP
C***ROUTINES CALLED  DMGSBV
C***COMMON BLOCKS    DML18J
C***REVISION HISTORY  (YYMMDD)
C   750601  DATE WRITTEN
C   890831  Modified array declarations.  (WRB)
C   890921  Realigned order of variables in certain COMMON blocks.
C           (WRB)
C   891009  Removed unreferenced statement label.  (WRB)
C   891214  Prologue converted to Version 4.0 format.  (BAB)
C   900328  Added TYPE section.  (WRB)
C   910722  Updated AUTHOR section.  (ALS)
C***END PROLOGUE  DVECS
C
      INTEGER ICOCO, IDP, IFLAG, INDPVT, INHOMO, INTEG, IWORK(*), K,
     1     KP, LNFC, LNFCC, MXNON, NCOMP, NDISK, NEQ, NEQIVP, NIC, NIV,
     2     NOPG, NPS, NTAPE, NTP, NUMORT, NXPTS
      DOUBLE PRECISION AE, DUM, RE, TOL, WORK(*), YHP(NCOMP,*)
      COMMON /DML18J/ AE,RE,TOL,NXPTS,NIC,NOPG,MXNON,NDISK,NTAPE,NEQ,
     1                INDPVT,INTEG,NPS,NTP,NEQIVP,NUMORT,LNFCC,
     2                ICOCO
C***FIRST EXECUTABLE STATEMENT  DVECS
         IF (LNFC .NE. 1) GO TO 20
            DO 10 K = 1, NCOMP
               YHP(K,LNFC+1) = YHP(K,LNFCC+1)
   10       CONTINUE
            IFLAG = 1
         GO TO 60
   20    CONTINUE
            NIV = LNFC
            LNFC = 2*LNFC
            LNFCC = 2*LNFCC
            KP = LNFC + 2 + LNFCC
            IDP = INDPVT
            INDPVT = 0
            CALL DMGSBV(NCOMP,LNFC,YHP,NCOMP,NIV,IFLAG,WORK(1),WORK(KP),
     1                  IWORK(1),INHOMO,YHP(1,LNFC+1),WORK(LNFC+2),DUM)
            LNFC = LNFC/2
            LNFCC = LNFCC/2
            INDPVT = IDP
            IF (IFLAG .NE. 0 .OR. NIV .NE. LNFC) GO TO 40
               DO 30 K = 1, NCOMP
                  YHP(K,LNFC+1) = YHP(K,LNFCC+1)
   30          CONTINUE
               IFLAG = 1
            GO TO 50
   40       CONTINUE
               IFLAG = 99
   50       CONTINUE
   60    CONTINUE
      CONTINUE
      RETURN
      END
*DECK DVNRMS
      DOUBLE PRECISION FUNCTION DVNRMS (N, V, W)
C***BEGIN PROLOGUE  DVNRMS
C***SUBSIDIARY
C***PURPOSE  Subsidiary to DDEBDF
C***LIBRARY   SLATEC
C***TYPE      DOUBLE PRECISION (VNWRMS-S, DVNRMS-D)
C***AUTHOR  (UNKNOWN)
C***DESCRIPTION
C
C   DVNRMS computes a weighted root-mean-square vector norm for the
C   integrator package DDEBDF.
C
C***SEE ALSO  DDEBDF
C***ROUTINES CALLED  (NONE)
C***REVISION HISTORY  (YYMMDD)
C   820301  DATE WRITTEN
C   890531  Changed all specific intrinsics to generic.  (WRB)
C   890831  Modified array declarations.  (WRB)
C   890911  Removed unnecessary intrinsics.  (WRB)
C   891214  Prologue converted to Version 4.0 format.  (BAB)
C   900328  Added TYPE section.  (WRB)
C***END PROLOGUE  DVNRMS
      INTEGER I, N
      DOUBLE PRECISION SUM, V, W
      DIMENSION V(*),W(*)
C***FIRST EXECUTABLE STATEMENT  DVNRMS
      SUM = 0.0D0
      DO 10 I = 1, N
         SUM = SUM + (V(I)/W(I))**2
   10 CONTINUE
      DVNRMS = SQRT(SUM/N)
      RETURN
C     ----------------------- END OF FUNCTION DVNRMS
C     ------------------------
      END
*DECK DVOUT
      SUBROUTINE DVOUT (N, DX, IFMT, IDIGIT)
C***BEGIN PROLOGUE  DVOUT
C***SUBSIDIARY
C***PURPOSE  Subsidiary to DSPLP
C***LIBRARY   SLATEC
C***TYPE      DOUBLE PRECISION (SVOUT-S, DVOUT-D)
C***AUTHOR  Hanson, R. J., (SNLA)
C           Wisniewski, J. A., (SNLA)
C***DESCRIPTION
C
C     DOUBLE PRECISION VECTOR OUTPUT ROUTINE.
C
C  INPUT..
C
C  N,DX(*) PRINT THE DOUBLE PRECISION ARRAY DX(I),I=1,...,N, ON
C          OUTPUT UNIT LOUT. THE HEADING IN THE FORTRAN FORMAT
C          STATEMENT IFMT(*), DESCRIBED BELOW, IS PRINTED AS A FIRST
C          STEP. THE COMPONENTS DX(I) ARE INDEXED, ON OUTPUT,
C          IN A PLEASANT FORMAT.
C  IFMT(*) A FORTRAN FORMAT STATEMENT. THIS IS PRINTED ON OUTPUT
C          UNIT LOUT WITH THE VARIABLE FORMAT FORTRAN STATEMENT
C                WRITE(LOUT,IFMT)
C  IDIGIT  PRINT AT LEAST ABS(IDIGIT) DECIMAL DIGITS PER NUMBER.
C          THE SUBPROGRAM WILL CHOOSE THAT INTEGER 4,6,10 OR 14
C          WHICH WILL PRINT AT LEAST ABS(IDIGIT) NUMBER OF
C          PLACES.  IF IDIGIT.LT.0, 72 PRINTING COLUMNS ARE UTILIZED
C          TO WRITE EACH LINE OF OUTPUT OF THE ARRAY DX(*). (THIS
C          CAN BE USED ON MOST TIME-SHARING TERMINALS). IF
C          IDIGIT.GE.0, 133 PRINTING COLUMNS ARE UTILIZED. (THIS CAN
C          BE USED ON MOST LINE PRINTERS).
C
C  EXAMPLE..
C
C  PRINT AN ARRAY CALLED (COSTS OF PURCHASES) OF LENGTH 100 SHOWING
C  6 DECIMAL DIGITS PER NUMBER. THE USER IS RUNNING ON A TIME-SHARING
C  SYSTEM WITH A 72 COLUMN OUTPUT DEVICE.
C
C     DOUBLE PRECISION COSTS(100)
C     N = 100
C     IDIGIT = -6
C     CALL DVOUT(N,COSTS,'(''1COSTS OF PURCHASES'')',IDIGIT)
C
C***SEE ALSO  DSPLP
C***ROUTINES CALLED  I1MACH
C***REVISION HISTORY  (YYMMDD)
C   811215  DATE WRITTEN
C   890531  Changed all specific intrinsics to generic.  (WRB)
C   891107  Added comma after 1P edit descriptor in FORMAT
C           statements.  (WRB)
C   891214  Prologue converted to Version 4.0 format.  (BAB)
C   900328  Added TYPE section.  (WRB)
C   910403  Updated AUTHOR section.  (WRB)
C***END PROLOGUE  DVOUT
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
      DOUBLE PRECISION DX(*)
      CHARACTER IFMT*(*)
C***FIRST EXECUTABLE STATEMENT  DVOUT
      LOUT=I1MACH(2)
      WRITE(LOUT,IFMT)
      IF(N.LE.0) RETURN
      NDIGIT = IDIGIT
      IF(IDIGIT.EQ.0) NDIGIT = 6
      IF(IDIGIT.GE.0) GO TO 80
C
      NDIGIT = -IDIGIT
      IF(NDIGIT.GT.6) GO TO 20
C
      DO 10 K1=1,N,4
      K2 = MIN(N,K1+3)
      WRITE(LOUT,1000) K1,K2,(DX(I),I = K1, K2)
   10 CONTINUE
      RETURN
C
   20 CONTINUE
      IF(NDIGIT.GT.14) GO TO 40
C
      DO 30 K1=1,N,2
      K2 = MIN(N,K1+1)
      WRITE(LOUT,1001) K1,K2,(DX(I),I = K1, K2)
   30 CONTINUE
      RETURN
C
   40 CONTINUE
      IF(NDIGIT.GT.20) GO TO 60
C
      DO 50 K1=1,N,2
      K2=MIN(N,K1+1)
      WRITE(LOUT,1002) K1,K2,(DX(I),I = K1, K2)
   50 CONTINUE
      RETURN
C
   60 CONTINUE
      DO 70 K1=1,N
      K2 = K1
      WRITE(LOUT,1003) K1,K2,(DX(I),I = K1, K2)
   70 CONTINUE
      RETURN
C
   80 CONTINUE
      IF(NDIGIT.GT.6) GO TO 100
C
      DO 90 K1=1,N,8
      K2 = MIN(N,K1+7)
      WRITE(LOUT,1000) K1,K2,(DX(I),I = K1, K2)
   90 CONTINUE
      RETURN
C
  100 CONTINUE
      IF(NDIGIT.GT.14) GO TO 120
C
      DO 110 K1=1,N,5
      K2 = MIN(N,K1+4)
      WRITE(LOUT,1001) K1,K2,(DX(I),I = K1, K2)
  110 CONTINUE
      RETURN
C
  120 CONTINUE
      IF(NDIGIT.GT.20) GO TO 140
C
      DO 130 K1=1,N,4
      K2 = MIN(N,K1+3)
      WRITE(LOUT,1002) K1,K2,(DX(I),I = K1, K2)
  130 CONTINUE
      RETURN
C
  140 CONTINUE
      DO 150 K1=1,N,3
      K2 = MIN(N,K1+2)
      WRITE(LOUT,1003) K1,K2,(DX(I),I = K1, K2)
  150 CONTINUE
      RETURN
 1000 FORMAT(1X,I4,' - ',I4,1X,1P,8D14.5)
 1001 FORMAT(1X,I4,' - ',I4,1X,1P,5D22.13)
 1002 FORMAT(1X,I4,' - ',I4,1X,1P,4D28.19)
 1003 FORMAT(1X,I4,' - ',I4,1X,1P,3D36.27)
      END
