c     ==================================================
c     =    Hoseholder逆変換ルーチン                    =
c     =    PHouseInvTrs                                =
c     ==================================================
c     ver. 1.00   1997 7/30
c
c   All Rights Reserved, Copyright (C) 1998, T.Katagiri
c/*-
c * Copyright (c) 1998 Information Promotion Agency of Japan and T.Katagiri
c * All rights reserved.
c *
c * Redistribution and non-commercial use in source and binary forms,
c * with or without modification, are permitted provided that the following
c * conditions are met:
c *
c * 1. Redistributions of source code must retain the above copyright
c *    notice, this list of conditions and the following disclaimer.
c *
c * 2. Redistributions in binary form must reproduce the above copyright
c *    notice, this list of conditions and the following disclaimer in the
c *    documentation and/or other materials provided with the distribution.
c *
c * 3. All advertising materials mentioning features or use of this
c *    software must display the following acknowledgement:
c *
c *    This product includes software developed by Information Promotion
c *    Agency of Japan and T.Katagiri
c *
c * 4. The name "Information Promotion Agency" or "T.Katagiri" should not be
c *    used to endorse or promote products derived from this software
c *    without specific prior written permission.
c *
c * 5. Any use of the source code or the binary in a commercial product,
c *    whether may it be the origial representation or in some modified form,
c *    is not permitted without specific prior written permission.
c *
c * THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND
c * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
c * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
c * ARE DISCLAIMED.  IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE
c * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
c * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
c * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
c * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
c * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
c * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
c * SUCH DAMAGE.
c */

      subroutine PHouseInvTrs(W, U, ALP, buf, buf2, n, nstart, nend, ny, 
     +                  p, ncelx, ncidx, cid)
      include "mppf.h"       
      common  /MPI2d/MPP_COMM_X, MPP_COMM_Y, ISTATUS

c     === 引数宣言
      real*8,   dimension (1:n, 1:n/p+1) :: W 
      real*8,   dimension (1:ny, 1:n) :: U
      real*8,   dimension (1:n) :: ALP
      real*8,   dimension (1:n) :: buf, buf2
      integer   n, nstart, nend, ny, p
      integer   ncelx, ncidx, cid

c     === その他の変数
      integer   i, j, k, ii, jj, kk
      real*8    norm
      integer   ierr
      integer   pivotx, sendPE
      integer   local_i


      ierr = cid      
        
c     === Householder逆変換
      do j=n-2, 1, -1
c       === Householderベクトルの収集
        pivotx = mod(j-1, ncelx)   

        do ii=0, ncelx-1
          sendPE = mod(pivotx+ii, ncelx)
          if (ncidx .eq. sendPE) then

            call MPP_BCAST(U(1,j), ny, MPP_DOUBLE_PRECISION, sendPE, 
     +                 MPP_COMM_X, ierr )
            
            kk = 1  
            do jj=j+ii, n, ncelx
              buf(jj) = U(kk,j)
              kk = kk + 1
            enddo 

          else
            call MPP_BCAST(buf2, ny, MPP_DOUBLE_PRECISION, sendPE, 
     +                 MPP_COMM_X, ierr )

            kk = 1  
            do jj=j+ii, n, ncelx
              buf(jj) = buf2(kk)
              kk = kk + 1
            enddo          
          endif  

        enddo  

      
c       === 各固有ベクトル逆変換
        do i=nstart, nend
          local_i = i - nstart + 1
          norm = 0.0d0
          do k=j, n
            norm = norm + buf(k) * W(k, local_i)
          enddo
          norm = ALP(j) * norm
          do k=j, n
            W(k, local_i) = W(k, local_i) - norm * buf(k)
          enddo 
        enddo

      enddo


      return
      end
c     ==================================================
c     =    Hoseholder逆変換ルーチン                    =
c     ==================================================