      SUBROUTINE DETGBS (IY,IOBUF,KCOUNT)
C
C     DETGFBS IS A SPECIAL VERSION OF THE DETFBS ROUTINE AND IS USED BY
C     THE REAL DETERMINANT METHOD FOR UNSYMMETRIC DECOMPOSITION.  
C     IT IS SUITABLE FOR BOTH SINGLE AND DOUBLE PRECISION OPERATION.
C
C
C     DEFINITION OF PARAMETERS
C     ------------------------
C
C     FILEU  = MATRIX CONTROL BLOCK FOR THE UPPER TRIANGLE
C     FILEV  = SAME AS FILEU
C     FILEVT = MATRIX CONTROL BLOCK FOR THE TRANSPOSE OF THE UPPER
C              TRIANGLE
C     X, DX  = THE SOLUTION VECTOR
C     Y, DY  = REGION USED FOR UNPACKING
C     IY     = POINTER TO Y (DY) RELATIVE TO X (DX)
C     IOBUF  = THE INPUT BUFFER
C     NROW   = MATRIX SIZE
C     KCOUNT = EIGENVALUE COUNTER
C
      INTEGER          FILEU(7),PARM(4) ,IOBUF(7),OPTION , FC
     1,                SCR3    ,SCR4    ,SCR6    ,EOL  
      REAL             X(1)    ,Y(1)
      DOUBLE PRECISION DX(1)   ,DY(1)   ,DXMIN   ,DSDIAG ,DA(2)
      COMMON /ZZZZZZ/  CORE(1)
      COMMON /DETMX /  DUM3(36),IPDETA
      COMMON /NAMES /  RD      ,RDREW   ,WRT     ,WRTREW  ,REW
      COMMON /REGEAN/  DUM1(23),SCR3    ,SCR4    ,DUM2(11),SCR6
      COMMON /REIGKR/  OPTION
      COMMON /UNPAKX/  ITYPEX  , IUNPAK ,JUNPAK  ,INCR
      COMMON /ZNTPKX/  A(4)    , II     ,EOL
      COMMON /DCOMPX/  FA(7)   , FL(7)  ,FC(7)
      EQUIVALENCE      (CORE(1),X(1),DX(1),Y(1),DY(1))    
     1,                (XMIN,DXMIN) ,   (SDIAG,DSDIAG)
     2,                (A(1),DA(1) )
      DATA    PARM(3), PARM(4) / 4HDETG, 4HFBS  /
C
      FILEU(1) = FC(1)
      CALL RDTRL ( FILEU )
      ITYPEX = FILEU(5)
      NROW   = FILEU(2)
      IOFF   = FILEU(7)-1
      IPREC  = 1
      IF ( ITYPEX .EQ. 2 ) IPREC = 2
      INDEX  = -1
      INCR   = 1
      NFILE  = FILEU(1)
      INDEX  = 1
      LCORE  = IPDETA - IY*ITYPEX - 1
      IF (LCORE .LT. 0) CALL MESAGE (-8,0,PARM(3))
      NFILE  = FILEU(1)
      PARM(2) = NFILE
      CALL GOPEN (NFILE,IOBUF,RDREW)
      XMIN = 1.0E20
      IF (ITYPEX .NE. 1) DXMIN = 1.0D20
      DO 80 I = 1,NROW
      IUNPAK = I
      JUNPAK = I
      IND    = NROW - I + 1 
      IF (ITYPEX .NE. 1) GO TO 70
      CALL UNPACK (*400,NFILE,X(IND))
      IF (XMIN .GT. ABS(X(IND))) XMIN = ABS(X(IND))
      GO TO 80
   70 CALL UNPACK (*400,NFILE,DX(IND))
      IF (DXMIN .GT. DABS(DX(IND))) DXMIN = DABS(DX(IND))
   80 CONTINUE
      IF (ITYPEX.EQ.1 .AND. XMIN .NE.0.0  ) GO TO 120
      IF (ITYPEX.NE.1 .AND. DXMIN.NE.0.0D0) GO TO 120
      XMIN = 1.0E20
      IF (ITYPEX .NE. 1) DXMIN = 1.0D20
      DO 100 I = 1,NROW
      IF (ITYPEX .NE. 1) GO TO 90
      IF (X(I) .EQ. 0.0) GO TO 100
      IF (XMIN .GT. ABS(X(I))) XMIN = ABS(X(I))
      GO TO 100
   90 IF (DX(I) .EQ. 0.0D0) GO TO 100
      IF (DXMIN .GT. DABS(DX(I))) DXMIN = DABS(DX(I))
  100 CONTINUE
      IF (ITYPEX .NE. 1) GO TO 110
      IF (XMIN .GT. 1.0E-8) XMIN = 1.0E-8
      GO TO 120
  110 IF (DXMIN .GT. 1.0D-8) DXMIN = 1.0D-8
C
C     BUILD LOAD VECTOR FOR BACKWARD PASS
C
  120 SDIAG = 1.0
      IF (ITYPEX .NE. 1) DSDIAG = 1.0D0
      DO 160 I = 1,NROW
      ANUM = (-1)**(I*KCOUNT)
      AI   = I
      ADEN = 1.0 + (1.0 - AI/NROW)*KCOUNT
      AVALUE = ANUM/ADEN
      IF (ITYPEX .NE.    1) GO TO 140
  130 X(I) = XMIN*AVALUE/SDIAG
      GO TO 160
  140 DX(I) = DXMIN*AVALUE/DSDIAG
  160 CONTINUE
C
C     BEGIN BACKWARD PASS
C
      CALL REWIND ( FILEU )
      CALL SKPREC ( FILEU, 1 )
      J = NROW
  390 CALL INTPK (*650,FILEU(1),0,IPREC,0)
      IF (EOL) 650,410,650
  410 CALL ZNTPKI
      I = NROW - II + 1
      IF (I .NE. J) GO TO 510
C
C     DIVIDE BY THE DIAGONAL
C
      IN1 = I
      K   = 0
  420 GO TO (430,440), IPREC
  430 CONTINUE
      IF ( A(1) .GE. 0.0 .AND. ABS( A(1)) .LT. XMIN ) A(1) =  XMIN 
      IF ( A(1) .LT. 0.0 .AND. ABS( A(1)) .LT. XMIN ) A(1) = -XMIN 
      X(IN1) = X(IN1)/A(1)      
      GO TO 470
  440 CONTINUE
      IF ( DA(1) .GE. 0.0D0 .AND. DABS(DA(1)).LT. DXMIN) DA(1) =  DXMIN   
      IF ( DA(1) .LT. 0.0D0 .AND. DABS(DA(1)).LT. DXMIN) DA(1) = -DXMIN   
      DX(IN1) = DX(IN1)/DA(1) 
  470 GO TO 490
C
C     SUBTRACT OFF REMAINING TERMS
C
  480 IF (I .GT. J) GO TO 410
  490 IF (EOL) 590,500,590
  500 CALL ZNTPKI
      I   = NROW - II + 1
  510 IN1 = I
      IN2 = J
      IF (I .LT. J) GO TO 530
      K   = IN1
      IN1 = IN2 - IOFF
      IN2 = K
  530 GO TO (540,550), IPREC
  540 X(IN1) = X(IN1) - A(1)*X(IN2)
      GO TO 580
  550 DX(IN1) = DX(IN1) - DX(IN2)*DA(1)
  580 IN1 = IN1 + NROW
      IN2 = IN2 + NROW
      GO TO 480
  590 J = J - 1
      IF (J .GT. 0) GO TO 390
C END OF BACKWARD SUBSTITUTION, NEGATE TERMS AND RETURN
      GO TO (600,620), IPREC
  600 DO 610 K = 1, NROW
      X(K)  = -X(K)
  610 CONTINUE 
      GO TO 700
  620 DO 630 K = 1, NROW
      DX(K) = -DX(K)
  630 CONTINUE
  700 CONTINUE
      CALL CLOSE ( FILEU, REW )
      RETURN
C
C     ATTEMPT TO OPERATE ON SINGULAR MATRIX
C
  400 PARM(1) = -5
      CALL MESAGE (PARM(1),PARM(2),PARM(3))
  650 CALL MESAGE ( -5    ,PARM(2),PARM(3))
      RETURN
      END
