!---------------------------------------------------------------------
!     Copyright (C) GFD Dennou Club, 2004. All rights reserved.
!---------------------------------------------------------------------
                                                                 !=begin
!= Module SSL2_Linear
!
!   * Developer: SUGIYAMA Ko-ichiro 
!   * Version: $Id: ssl2_linear.f90,v 1.2.2.1 2005/11/14 01:55:12 kitamo Exp $ 
!   * Tag Name: $Name: arare3m-20051114 $
!   * Change History: 
!
!== Overview 
!
!SSL2 線形計算のためのパッケージ型モジュール
!
!== Error Handling
!
!== Known Bugs
!
!== Note
!
!== Future Plans
!
!エラー処理に gt4f90io を使う
!
                                                                 !=end

module ssl2_linear
  implicit none
  
  private
                                                                 !=begin
  !=== Public Interface
  public ssl2_lax_init       !初期化
  public ssl2_lax            !実行列の連立 1 次方程式(倍精度)
  public ssl2_lsx_init       !初期化
  public ssl2_lsx            !正値対称行列の連立 1 次方程式(倍精度)
  public ssl2_lsix_init      !初期化
  public ssl2_lsix           !実対称行列の連立 1 次方程式(倍精度)
  public ssl2_ltx_init       !初期化
  public ssl2_ltx            !実 3 項行列の連立 1 次方程式(倍精度)
                                                                 !=end
  real(8), allocatable      :: VW(:)  
  real(8)                   :: EPSZ = 0.0d0 ! 標準値
  integer, allocatable      :: IP(:)
  integer, allocatable      :: IVW(:)
  integer                   :: ISW = 1
  integer                   :: K = 10       !値はダミー
  integer                   :: N = 10       !値はダミー

  save K, N, ISW, IP, EPSZ, VW, IVW

contains

                                                                 !=begin
  !== Procedure Interface 
  !
  !=== Initialize module 
  !
  !SSL II の LAX ルーチンの初期化
  !
  subroutine ssl2_lax_init(M)

    !=== Input
    integer, intent(in) :: M  !配列の大きさ
                                                                 !=end
    if (allocated(IP)) deallocate(IP, VW)
    allocate(IP(M), VW(M))
    N = M
    K = M
  end subroutine ssl2_lax_init
  
                                                                 !=begin
  !== Procedure Interface 
  !
  !=== Execute Subroutine for the module
  !
  !実行列の連立 1 次方程式(倍精度)
  !
  subroutine ssl2_lax(A, B, sw)

    !=== In/Out
    real(8), intent(inout)         :: A(:,:)     !係数行列
    real(8), intent(inout)         :: B(:)       !定数/解行列

    !=== Output
    logical, intent(out), optional :: sw         !非正則を表すスイッチ
                                                                 !=end
    integer                        :: ICON
    integer                        :: IS

    IS = 0; VW = 0.0d0; IP = 0; ICON = 0
    if (present(sw)) sw = .false.

    !配列の大きさチェック
    if (N /= size(B,1) .OR. N /= size(A,1) .OR. N /= size(A,2)) then  
       write(*,*) "ssl2_lax; matrix size is wrong"
       stop
    end if

    !解行列の計算. SSL II を使用. 
    call DLAX(A, K, N, B, EPSZ, ISW, IS, VW, IP, ICON)
  
    !解のコンディションをチェック. 
    if (ICON == 30000) then
       write(*,*) 'ssl2_lax: ICON is 30000' 
       stop
    elseif (ICON == 20000) then
       write(*,*) 'ssl2_lax: ICON is 20000' 
       write(*,*) "ssl2_lax: matrix is singular!"
       if (present(sw)) then           
          sw = .true.
       else
          stop
       end if
    end if
  end subroutine ssl2_lax

    
                                                                 !=begin
  !== Procedure Interface 
  !
  !=== Initialize module
  !
  !SSL II の LSX ルーチンの初期化
  !
  subroutine ssl2_lsx_init(M)
    !=== Input
    integer, intent(in) :: M   !配列の大きさ
                                                                 !=end
    N = M
  end subroutine ssl2_lsx_init
  

                                                                 !=begin
  !== Procedure Interface 
  !
  !=== Execute Subroutine for the module
  !
  !正値対称行列の連立 1 次方程式(倍精度)
  !
  subroutine ssl2_lsx(A, B, sw)
    real(8), intent(inout)         :: A(:)   !係数行列
    real(8), intent(inout)         :: B(:)   !定数/解行列
    logical, intent(out), optional :: sw     !非正則を表すスイッチ
                                                                 !=end
    integer                        :: ICON

    ICON = 0
    if (present(sw)) sw = .false.

    !配列の大きさチェック
    if (N /= size(B,1) .OR. N*(N+1)/2 /= size(A,1)) then 
       write(*,*) "ssl2_lsx; matrix size is wrong"
    end if

    !解行列の計算. SSL II を使用. 
    call DLSX(A, N, B, EPSZ, ISW, ICON)
  
    !解のコンディションをチェック. 
    if (ICON == 30000) then
       write(*,*) 'ssl2_lsx: ICON is 30000' 
       stop
    elseif (ICON == 20000) then
       write(*,*) 'ssl2_lsx: ICON is 20000' 
       write(*,*) "ssl2_lsx: matrix is singular!"
       if (present(sw)) then           
          sw = .true.
       else
          stop
       end if
    end if
  end subroutine ssl2_lsx
      
    
                                                                 !=begin
  !== Procedure Interface 
  !
  !=== Initialize module
  !
  !SSL II の LSIX ルーチンの初期化
  !
  subroutine ssl2_lsix_init(M)

    !=== Input
    integer, intent(in) :: M    !配列の大きさ
                                                                 !=end
    if (allocated(IP)) deallocate(IP, VW, IVW)
    allocate(IP(M), VW(2*M), IVW(M))
    N = M
    K = M
  end subroutine ssl2_lsix_init


                                                                 !=begin
  !== Procedure Interface 
  !
  !=== Execute Subroutine for the module
  !
  !実対称行列の連立 1 次方程式(倍精度)
  !
  subroutine ssl2_lsix(A, B, sw)

    !=== In/Out
    real(8), intent(inout)         :: A(:)   !係数行列
    real(8), intent(inout)         :: B(:)   !定数/解行列
    !=== Output
    logical, intent(out), optional :: sw     !非正則を表すスイッチ
                                                                 !=end
    integer                        :: ICON
    
    ICON = 0; VW = 0.0d0; IP = 0; IVW = 0
    if (present(sw)) sw = .false.

    !配列の大きさチェック
    if (N /= size(B,1) .OR. N*(N+1)/2 /= size(A,1)) then 
       write(*,*) "ssl2_lsx; matrix size is wrong"
    end if

    !解行列の計算. SSL II を使用. 
    call DLSIX(A, N, B, EPSZ, ISW, VW, IP, IVW, ICON)
  
    !解のコンディションをチェック. 
    if (ICON == 30000) then
       write(*,*) 'ssl2_lsix: ICON is 30000' 
       stop
    elseif (ICON == 20000) then
       write(*,*) 'ssl2_lsix: ICON is 20000' 
       write(*,*) "ssl2_lsix: matrix is singular!"
       if (present(sw)) then           
          sw = .true.
       else
          stop
       end if
    end if
    
  end subroutine ssl2_lsix
  

                                                                 !=begin
  !== Procedure Interface 
  !
  !=== Initialize module
  !
  !SSL II の LTX ルーチンの初期化
  !
  subroutine ssl2_ltx_init(M)

    !=== Input
    integer, intent(in) :: M  !配列の大きさ
                                                                 !=end
    if (allocated(IP)) deallocate(IP, VW)
    allocate(IP(M), VW(M))
    N = M
  end subroutine ssl2_ltx_init
  
  
                                                                 !=begin
  !== Procedure Interface 
  !
  !=== Execute Subroutine for the module
  !
  !実 3 項行列の連立 1 次方程式(倍精度)
  !
  subroutine ssl2_ltx(A, B, C, D)
    !=== Dependency
    use dc_message, only: MessageNotify
                                                                 !=end
    !=== 暗黙の型宣言禁止
    implicit none
                                                                 !=begin
    !=== Input
    real(8), intent(in)            :: A(N)      !係数行列
    real(8), intent(in)            :: B(N-1)    !係数行列
    real(8), intent(in)            :: C(N-1)    !係数行列

    !=== In/Out
    real(8), intent(inout)         :: D(N)      !定数/解行列
                                                                 !=end
    !=== Work
    integer                        :: ICON
    integer                        :: IS
    
    ICON = 0; VW = 0.0d0; IP = 0
    
    !=== 解行列の計算. SSL II を使用. 
    call DLTX(C, A, B, N, D, EPSZ, ISW, IS, IP, VW, ICON)
    
    !=== 解のコンディションをチェック. 
    if (ICON == 30000) then
       call MessageNotify("Error", "ssl2_linear", &
&                        "ICON is 30000. matrix is singular!!")
       stop
    elseif (ICON == 20000) then
       call MessageNotify("Error", "ssl2_linear", &
&                        "ICON is 20000. matrix is singular!!")
       stop
    end if
    
  end subroutine ssl2_ltx
  
    
end module ssl2_linear