*
* $Id: f406zr.F,v 1.1.1.1 1996/02/15 17:48:42 mclareni Exp $
*
* $Log: f406zr.F,v $
* Revision 1.1.1.1  1996/02/15 17:48:42  mclareni
* Kernlib
*
*
#include "kernnumt/pilot.h"
      SUBROUTINE F406ZR(N,M,IDIM,ABAND,B,IFAIL)
      REAL ABAND,B,ZERO,ONE
      DIMENSION ABAND(IDIM,2),B(N)
      DATA ZERO/0./,ONE/1./
C
C  SINGULAR MATRIX TEST FOR BANDED EQUATION SOLVER RBEQN (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  (REAL) TWO-DIMENSIONAL ARRAY WITH AT LEAST 2*M+1 COLUMNS.
C     B      (REAL) ONE-DIMENSIONAL ARRAY WITH AT LEAST N ELEMENTS.
C     IFAIL  (INTEGER) IS SET BY RBEQN TO -1 IF MATRIX IS SINGULAR.
C
C  CALLS ... SUBROUTINE RBEQN (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 RMRAN(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 RBEQN(N,M,ABAND,IDIM,IFAIL,1,B)
      RETURN
      END