C
      SUBROUTINE ZLF1M (A,N,NA,B,EPS,IOPT,IP,WK,IER)
C
C-----------------------------------------------------------------------
C
C   ALL RIGHTS RESERVED,COPYRIGHT(C)1980,1982,HITACHI,LTD.S-1511-1
C   LICENSED MATERIAL OF HITACHI,LTD.
C
C   NAME                - $ZLF1M : DOUBLE PRECISION
C
C   USAGE               - CALL $ZLF1M(A,N,NA,B,EPS,IOPT,IP,WK,IER)
C
C   FUNCTION           - BY GAUSS'S METHOD (LU-DECOMPOSITION), WE SOLVE
C                          THE SYSTEM OF LINEAR EQUATIONS IN N UNKNOWNS
C                          WITH A COMPLEX COEFFICIENT MATRIX.
C
C   ARGUMENTS  A(NA,N)  - INPUT. MATRIX FORMED BY LEFT-SIDE COEFFI-
C                           CIENTS OF THE EQUATION.
C                         OUTPUT. LU-FACTORIZED RESULTS ARE GIVEN.
C              N        - INPUT. NUMBER OF UNKNOWNS (0<N<=NA).
C              NA       - INPUT. NUMBER OF ROWS OF THE MATRIX A IN THE
C                           DIMENSION STATEMENT OF A MAIN PROGRAM.
C              B(N)     - INPUT. RIGHT-SIDE VECTOR OF THE EQUATION.
C                         OUTPUT. SOLUTIONS OF THE EQUATION.
C              EPS      - INPUT. TOLERANCE FOR THE SINGULARITY
C                           (EPS>=0.0).
C                           WHEN EPS<0.0 IS GIVEN, STANDARD VALUE IS
C                           ASSUMED.
C              IOPT     - INPUT.
C                           IOPT=1,LU-DECOMPOSITION AND SOLUTION OF THE
C                                  EQUATION.
C                           IOPT=2,LU-DECOMPOSITION ONLY.
C                           IOPT=3,SOLUTION OF THE EQUATION ONLY.
C              IP(N)    - OUTPUT. THE ROW NUMBER WHICH WAS SELECTED (AS
C                           A PIVOT ROW) IN THE K-TH FACTORIZATION
C                           PROCESS IS GIVEN IN IP(K) (K=1,...,N).
C              WK(N)    - WORK AREA.
C              IER      - ERROR INDICATOR.
C                           IER=   0,NO ERROR WAS DETECTED.
C                           IER=2000,N<=0, N>NA,IOPT<1 OR IOPT>3.
C                           IER=3000+L,THE MATRIX IS NEARLY SINGULAR.
C
C   REQD. SUBPROGRAM    - $SUERM, $SURTM
C
C   STATUS              - S-1511-1 05-02
C
C   HISTORY             - DATE.    1979.12
C                                  1980. 7
C                                  1980.11
C                                  1982. 4
C                                  1982. 9
C                                  1986. 6
C
C-----------------------------------------------------------------------
C
      IMPLICIT REAL*8 (A-H,O-Z)
C      GENERIC
      COMPLEX*16 A, B, PIVOT, CW
      DIMENSION A(NA,N), B(N), IP(N), WK(N)
C      DIMENSION NAME$(2)
      DATA ZERO, ONE, UEPS / 0.D0, 1.D0, Z3410000000000000  /
C      DATA NAME$, SIXTN /4H$ZLF, 4H1M  , 16.0D0 /
      DATA SIXTN / 16.0D0 /
C
C      REAL(CW)=DREAL(CW)
C      ZABS(CW) = ABS(REAL(CW)) + ABS(IMAG(CW))
C
C**************  PARAMETER CHECK                 ***************
C
      IF(N.LE.0 .OR. N.GT.NA) GO TO 180
      IF(IOPT.LE.0 .OR. IOPT.GT.3) GO TO 180
C
      IF(IOPT .EQ. 3) GO TO 110
C
C**************  INITIAL VALUE SET              ***************
C
      IER = 0
        KR = 0
      DO 5 I=1,N
    5    WK(I) = ZERO
      DO 10 J=1,N
         DO 10 I=1,N
            IF(CDABS(A(I,J)) .GT. WK(I)) WK(I) = CDABS(A(I,J))
   10    CONTINUE
      DO 15 I=1,N
         IF(WK(I) .NE. ZERO) WK(I) = ONE/WK(I)
   15 CONTINUE
      SEPS=EPS
      IF(EPS .LT. ZERO) SEPS = SIXTN*FLOAT(N)*UEPS
C
C**************  FORWARD REDUCTION                     ***************
C
        DO 100 K=1,N
              KQ = K-KR+1
              KQM1 = KQ-1
              KPIVOT = KQM1
              AMAX = CDABS(A(KQM1,K))*WK(KQM1)
              IF(KQM1 .EQ. N) GO TO 30
C
                DO 20 I=KQ,N
                      AW = CDABS(A(I,K))*WK(I)
                      IF(AW .LE. AMAX) GO TO 20
                        KPIVOT = I
                        AMAX = AW
   20           CONTINUE
   30         IF(AMAX .GT. SEPS) GO TO 40
                KR = KR+1
                IP(K) = 0
                GO TO 100
C
   40         IP(K) = KPIVOT
                IF(KPIVOT .EQ. KQM1) GO TO 50
                  CW = A(KPIVOT,K)
                  A(KPIVOT,K) = A(KQM1,K)
                  A(KQM1,K) = CW
                  AW = WK(KPIVOT)
                  WK(KPIVOT) = WK(KQM1)
                  WK(KQM1) = AW
   50           A(KQM1,K) = ONE/A(KQM1,K)
                IF(KQM1 .EQ. N) GO TO 100
                PIVOT = A(KQM1,K)
                DO 60 I=KQ,N
   60                 A(I,K) = A(I,K)*PIVOT
                IF(K .EQ. N) GO TO 100
                  DO 90 J=KQ,N
                        IF(KPIVOT .EQ. KQM1) GO TO 70
                          CW = A(KPIVOT,J)
                          A(KPIVOT,J) = A(KQM1,J)
                          A(KQM1,J) = CW
   70                   CW = -A(KQM1,J)
                        KP1 = K+1
                        DO 80 I=KP1,N
   80                         A(I,J) = A(I,J)+CW*A(I,K)
   90             CONTINUE
  100   CONTINUE
        IF(KR .NE. 0) IER = 3000+KR
        IF(IOPT .EQ. 1) GO TO 110
        IF(IER .NE. 0) GO TO 190
        GO TO 9999
C
C**************  CONSTANT TERM TRANSFORMATION          ***************
C
  110 CONTINUE
        KR = 0
        DO 150 K=1,N
              KPIVOT = IP(K)
              IF(KPIVOT .GT. 0) GO TO 120
                KR = KR+1
                GO TO 150
C
  120         KQ = K-KR
              IF(KQ .EQ. N) GO TO 150
                IF(KPIVOT .EQ. KQ) GO TO 130
                  CW = B(KPIVOT)
                  B(KPIVOT) = B(KQ)
                  B(KQ) = CW
  130           CW = -B(KQ)
                KQP1 = KQ+1
                DO 140 I=KQP1,N
  140               B(I) = B(I)+CW*A(I,K)
  150   CONTINUE
        IF(IER .NE. 0) GO TO 190
        IF(N .EQ. 1) GO TO 175
C
C**************  BACKWARD SUBSTITUTION                 ***************
C
        NM1 = N-1
        DO 170 K=1,NM1
              NK = N-K+1
              NKM1 = NK-1
              B(NK) = B(NK)*A(NK,NK)
              CW = -B(NK)
              DO 160 I=1,NKM1
  160               B(I) = B(I)+CW*A(I,NK)
  170   CONTINUE
  175   B(1) = B(1)*A(1,1)
        GO TO 9999
C
C**************  ERROR CODE SET                        ***************
C
  180 JER = 2000
      GO TO 200
C
  190 JER = IER
  200 CONTINUE
C      CALL $SUERM(NAME$,JER,IER)
C
C
 9999 CONTINUE
C      CALL $SURTM(NAME$,IER)
      RETURN
      END
