*
* $Id: f406zd.F,v 1.1.1.1 1996/02/15 17:48:42 mclareni Exp $
*
* $Log: f406zd.F,v $
* Revision 1.1.1.1  1996/02/15 17:48:42  mclareni
* Kernlib
*
*
#include "kernnumt/pilot.h"
      SUBROUTINE F406ZD(N,M,IDIM,ABAND,B,IFAIL)
      DOUBLE PRECISION ABAND,B,ZERO,ONE
      DIMENSION ABAND(IDIM,2),B(N)
      DATA ZERO/0.D0/,ONE/1.D0/
C
C  SINGULAR MATRIX TEST FOR BANDED EQUATION SOLVER DBEQN (F406).
C
C     N      ORDER OF COEFFICIENT MATRIX.
C     M      BAND-WIDTH PARAMETER.
C     IDIM   FIRST DIMENSION PARAMETER OF ARRAYS ABAND AND B.
C     ABAND  (DOUBLE PRECISION) TWO-DIMENSIONAL ARRAY WITH AT LEAST
C            2*M+1 COLUMNS.
C     B      (DOUBLE PRECISION) ONE-DIMENSIONAL ARRAY WITH AT LEAST
C            N ELEMENTS.
C     IFAIL  (INTEGER) IS SET BY DBEQN TO -1 IF MATRIX IS SINGULAR.
C
C  CALLS ... SUBROUTINE DBEQN (F406).
C        ... CERN PACKAGES F002 AND F003.
C
C  START.  SET ARRAY ABAND TO A PACKED BAND MATRIX WITH ZERO LAST
C  COLUMN.
      MBAND=2*M+1
      MWIDTH=MIN0(MBAND,N)
      CALL DMRAN(N,MWIDTH,-ONE,ONE,ABAND,ABAND(1,2),ABAND(2,1))
      IMIN=N-M
      DO 1 I=IMIN,N
         L=N+M-I+1
         IF(I.LE.M) ABAND(I,N)=ZERO
         IF(I.GT.M) ABAND(I,L)=ZERO
         B(I)=ONE
    1 CONTINUE
      CALL DBEQN(N,M,ABAND,IDIM,IFAIL,1,B)
      RETURN
      END