c--------------------------------------------------------------------
c
c     routine name      - hypermatrix_solve2x2_test
c
c--------------------------------------------------------------------
c
c     computer:         - machine independent
c
c     latest revision:  - May 2010
c
c     purpose:          - tests the hypermatrix with 2x2 submatrices
c                         f.e. and b.s. routines
c
c---------------------------------------------------------------------
c
      subroutine hypermatrix_solve2x2_test
c
      use parallelism
      use supernodes_system_mod
c
      implicit none
c
c.....arguments
      integer :: Init(51)
      integer, dimension(:),allocatable :: subdomains
      type(supernodes_system) :: system
c
      integer :: nr_subdomains, isub, i
c
      integer :: istat
c
      integer :: iprint
c
      iprint=0
c-------------------------------------------------------------------
c
c
      write(*,*)'construct a super-system of linear equations'
      call pause
c
        Init(1)=-2
        Init(2)=2
        Init(3)=2

        Init(4)=2
        Init(5)=2
        Init(6)=2

        Init(7)=2
        Init(8)=2
        Init(9)=2

        Init(10)=2
        Init(11)=2
        Init(12)=2

        Init(13)=2
        Init(14)=2
        Init(15)=2

        call hm_init(Init,system%A,istat)
        system%nr_rows=2
        system%nr_columns=2
c
        Init(1)=-2
        Init(2)=2
        Init(3)=1
        Init(4)=2
        Init(5)=2
        Init(6)=1
        Init(7)=2
        Init(8)=2
        Init(9)=1
c
        call hm_init(Init,system%b,istat)
        call hm_init(Init,SOLUTION_INSTANCE%x,istat)
        SOLUTION_INSTANCE%nr_components=2
c
        system%A%H(1,1)%D(1,1)=1.d0
        system%A%H(1,1)%D(1,2)=1.d0
        system%A%H(1,1)%D(2,1)=2.d0
        system%A%H(1,1)%D(2,2)=1.d0
        system%A%H(1,2)%D(1,1)=0.d0
        system%A%H(1,2)%D(1,2)=3.d0
        system%A%H(1,2)%D(2,1)=-1.d0
        system%A%H(1,2)%D(2,2)=1.d0
        system%A%H(2,1)%D(1,1)=3.d0
        system%A%H(2,1)%D(1,2)=-1.d0
        system%A%H(2,1)%D(2,1)=-1.d0
        system%A%H(2,1)%D(2,2)=2.d0
        system%A%H(2,2)%D(1,1)=-1.d0
        system%A%H(2,2)%D(1,2)=2.d0
        system%A%H(2,2)%D(2,1)=3.d0
        system%A%H(2,2)%D(2,2)=-1.d0
c
        system%b%H(1,1)%D(1,1)=4.d0
        system%b%H(1,1)%D(2,1)=1.d0
        system%b%H(2,1)%D(1,1)=-3.d0
        system%b%H(2,1)%D(2,1)=4.d0
c
        write(*,*)"A"
        call hm_print(system%A)
        call pause
        write(*,*)"b"
        call hm_print(system%b)
        call pause
c
      write(*,*)'prepare supernodes'
      call pause
c
      call allocate_row_supernodes(system,2)
      call allocate_column_supernodes(system,2)
      call allocate_solution_supernodes(SOLUTION_INSTANCE,2)
c
      do i=1,2
        call allocate_supernode_subdomains(system%row_supernodes(i),1)
        system%row_supernodes(i)%subdomains(1)=0
        system%row_supernodes(i)%matrix_id=i
        system%row_supernodes(i)%global_id=i
        call allocate_supernode_subdomains(system%column_supernodes(i),1)
        system%column_supernodes(i)%subdomains(1)=0
        system%column_supernodes(i)%matrix_id=i
        system%column_supernodes(i)%global_id=i
        call allocate_supernode_subdomains(SOLUTION_INSTANCE%supernodes(i),1)
        SOLUTION_INSTANCE%supernodes(i)%subdomains(1)=0
        SOLUTION_INSTANCE%supernodes(i)%matrix_id=i
        SOLUTION_INSTANCE%supernodes(i)%global_id=i
      enddo
c
      write(*,*)'forward elimination'
      call pause
c
      system%ncount=2
c
      call partial_forward_elimination(system)
c
      write(*,*)'A'
      call hm_print(system%A)
      call pause
c
      write(*,*)'b'
      call hm_print(system%b)
      call pause
c
      write(*,*)'**************************************************'
      write(*,*)'update rhs'
      call pause
c
        system%b%H(1,1)%D(1,1)=4.d0
        system%b%H(1,1)%D(2,1)=1.d0
        system%b%H(2,1)%D(1,1)=-3.d0
        system%b%H(2,1)%D(2,1)=4.d0
c
        write(*,*)"A"
        call hm_print(system%A)
        call pause
        write(*,*)"b"
        call hm_print(system%b)
        call pause
c
      write(*,*)'full forward substitution with new rhs'
      call pause
c
      call full_forward_substitution_with_new_rhs(system)
c
      write(*,*)'full backward substitution (with already updated rhs)'
      call pause
c
      call full_backward_substitution(system)
c
      write(*,*)'solution'
      call hm_print(SOLUTION_INSTANCE%x)

      write(*,*)'cleaning'
c
      call delete_tree
      call deallocate_solution(SOLUTION_INSTANCE)
c
      end subroutine hypermatrix_solve2x2_test