!===============================================================================
!
!  deflation.F90
!
!-------------------------------------------------------------------------------
!
! Copyright (C) 2010 Yoshifumi Nakamura
!
! This file is part of BQCD -- Berlin Quantum ChromoDynamics program
!
! BQCD is free software: you can redistribute it and/or modify
! it under the terms of the GNU General Public License as published by
! the Free Software Foundation, either version 3 of the License, or
! (at your option) any later version.
!
! BQCD is distributed in the hope that it will be useful,
! but WITHOUT ANY WARRANTY; without even the implied warranty of
! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
! GNU General Public License for more details.
!
! You should have received a copy of the GNU General Public License
! along with BQCD.  If not, see <http://www.gnu.org/licenses/>.
!
!-------------------------------------------------------------------------------
# include "defs.h"

!-------------------------------------------------------------------------------
module deflation
  integer, parameter :: m = 20
  integer, save :: deflationlevel = -999
                               !!!= 0 probably OK
                               !!!= 1 may have bugs
  type :: littledirac
     complex(8) :: b(m,m)
  end type littledirac

  type(littledirac), save :: aop
  type(littledirac), pointer, save :: bop1(:)
  type(littledirac), pointer, save :: bop2(:,:,:,:)
  complex(8), dimension(:,:,:,:,:,:), pointer, save :: subs
end module deflation
!-------------------------------------------------------------------------------
subroutine init_deflation()
  use deflation
  use module_dd

  if (deflationlevel < 0) return

  if(.not. associated(bop1))  allocate(bop1(0:ld%lat%num_ip-1))
  if(.not. associated(bop2))  allocate(bop2(gd%lat%volh,EVEN:ODD,4,FWD:BWD))
  if(.not. associated(subs))  allocate(subs(4,3,ld%lat%volh,0:ld%lat%num_ip-1,0:1,m))

end
!-------------------------------------------------------------------------------
subroutine build_deflation(mid)
  use deflation
  use module_dd
  use module_xbound_sc2_dd
  implicit none
!
! level=0, create A
! level=1, create B, Ns x Nb 
!
  integer, intent(in) :: mid
  real(8),   external :: vecnorm2
  complex(8),external :: veccdotc
  complex(8), dimension(24*ld%lat%volh,m):: source
  complex(8), dimension(4,3,ld%lat%volh,0:ld%lat%num_ip-1,0:1):: source1_global
  complex(8) :: solution(m,m), btmp(m,m)
  integer :: i, ip, ip2, mu, fb, ns1, ns2, ibound
  real(8)   :: r_11
  complex(8):: r_12

!write(0,*)"build_deflation start"

  if (deflationlevel < 0) return

  if (deflationlevel==0) then
     call gram_schmidt(subs, 24*ld%lat%volh*ld%lat%num_ip, m, .true.)
     do ns1=1,m
     do ns2=1,m
        call unprec_d(source1_global, subs(1,1,1,0,0,ns1), mid, 0)
        aop%b(ns2,ns1)=veccdotc(subs(1,1,1,0,0,ns2),source1_global,24*ld%lat%volh*ld%lat%num_ip)
        call global_sum_vec(2,aop%b(ns2,ns1))
     enddo
     enddo
     !!!!write(0,*)"level0 deflation",aop%b
     return
  endif


  ! gram-schmidt
  do ip=0,ld%lat%num_ip-1
     do ns1=1,m
        call proj_source(source(1,ns1), ip,ns1)
     enddo
     do ns1=1,m
        r_11=vecnorm2(source(1,ns1), 24*ld%lat%volh)
        r_11=ONE/sqrt(r_11)
        source(:,ns1)=source(:,ns1)*r_11
        do ns2=ns1+1,m
           r_12 = veccdotc(source(1,ns1), source(1,ns2), 24*ld%lat%volh)
           source(:,ns2) = source(:,ns2) -r_12 * source(:,ns1)
        enddo
     enddo
     do ns1=1,m
        call put_source(source(1,ns1), ip,ns1)
     enddo
  enddo

  do ip=0,ld%lat%num_ip-1
     !
     !  b=(s2, D s1)
     !
     do ns1=1,m
     do ns2=1,m
        call proj_source(source(1,1), ip,ns1)
        call proj_source(source(1,2), ip,ns2)
        call unprec_mmul_d(source(1,3), source(1,1), mid, ip, 0)
        bop1(ip)%b(ns2,ns1)=veccdotc(source(1,2),source(1,3), 24*ld%lat%volh)

!write(0,*)"ipDip",ip,ns2,ns1,bop1(ip)%b(ns2,ns1)
!flush(0)

     enddo
     enddo
  enddo
!write(0,*)"build_deflation1"
!flush(0)

  do ip=0,ld%lat%num_ip-1
     do mu=1,4
     do fb=0,1
     !
     ! bop for ip -> ip2
     !

     ibound = xbsc2(ip)%i_bound(mu, fb)
     ip2    = xbsc2(ip)%b(ibound)%dm_source

!write(0,*)"build_deflation1.1 ",ibound,ip2
!flush(0)

     do ns1=1,m
     do ns2=1,m
     call proj_source_global(source1_global, ip2, ns1, mu, 1-fb)
     call proj_source(       source(1,2),   ip, ns2)
     call unprec_mmul_bb_ip(source(1,3),source1_global,mid, ip)
     btmp(ns2, ns1)=veccdotc(source(1,2),source(1,3), 24*ld%lat%volh)

!write(0,*)"ip2Dip",ip2,ip,ns2,ns1,btmp(ns2, ns1)
!flush(0)

     enddo
     enddo
!write(0,*)"build_deflation2"
!flush(0)
     do i=1,m
        call bcgs(bop1(ip)%b(1,1), solution(1,i), btmp(1,i), m)
     enddo
!write(0,*)"build_deflation3"

!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
     !!! need to change for parallel
     bop2(i_dm(ip),eo_dm(ip),mu,fb)%b=solution
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
     enddo
     enddo
  enddo
end

!-------------------------------------------------------------------------------
subroutine test_deflation()
  use deflation
  use module_dd
  use module_function_decl
  use module_action
  implicit none
  integer :: i
  COMPLEX, dimension(4,3,ld%lat%volh,0:ld%lat%num_ip-1,0:1)::tmp1, tmp2
  SECONDS :: time0, sekunden, time
  real(8),save :: kappac
  integer :: id
  time0=sekunden()

  if(.not. ddable) return
  if (deflationlevel < 0) return


write(0,*)"test_deflation start"
  call init_deflation()

  kappac=0.1805 !364_8
  id=1

  call swap_real(action%mtilde(id)%kappa,kappac)
  write(0,*)"now kappa",action%mtilde(id)%kappa
  do i=1,m
     call random_deflationfield(subs(1,1,1,0,0,i))
     call inv_dirac_def(subs(1,1,1,0,0,i),10)
  enddo
  call swap_real(action%mtilde(id)%kappa,kappac)
  write(0,*)"now kappa",action%mtilde(id)%kappa

  time=sekunden()-time0
  write(0,*)"before build_deflation",time

  time0=sekunden()
  call build_deflation(1)
  time=sekunden()-time0
  write(0,*)"after build_deflation",time


!!  time0=sekunden()
!!  call random_deflationfield(tmp1)
!!  call random_deflationfield(tmp2)
!!  time=sekunden()-time0
!!  write(0,*)"2 rand",time

!!  time0=sekunden()
!!  call projectl(tmp1,tmp2)
!!  call projectr(tmp1,tmp2)
!!  time=sekunden()-time0
!!  write(0,*)"2 projection",time

!stop

end

!-------------------------------------------------------------------------------
subroutine random_deflationfield(out)
  use module_dd
  implicit none
  COMPLEX, dimension(4,3,ld%lat%volh,0:ld%lat%num_ip-1) :: tmp1,tmp2
  COMPLEX, dimension(4,3,ld%lat%volh,0:ld%lat%num_ip-1,0:1), intent(out) :: out

  call make_source(tmp1, tmp2, RANDOM_SOURCE)
  call sc2ddsc(out,tmp1,tmp2)
end
!-------------------------------------------------------------------------------
subroutine proj_source(out, ip, is)
  use deflation
  use module_dd
  implicit none
  complex(8), dimension(4,3,ld%lat%volh,0:1), intent(out) :: out
  integer, intent(in) :: ip, is

  out(:,:,:,0)=subs(:,:,:,ip,0,is)
  out(:,:,:,1)=subs(:,:,:,ip,1,is)

end
!-------------------------------------------------------------------------------
subroutine proj_source_global(out, ip, is, mu, fb)
  use deflation
  use module_dd
  implicit none
  complex(8), dimension(4,3,ld%lat%volh,0:ld%lat%num_ip-1,0:1), intent(out) :: out
  integer, intent(in) :: ip, is, mu, fb
  integer :: i,j,eo

  out=ZERO
  out(:,:,:,ip,0)=subs(:,:,:,ip,0,is)
  out(:,:,:,ip,1)=subs(:,:,:,ip,1,is)

  ! put zero at place where (mu,1-fb) bomes out of domain
  do eo=0,1
  do i=1, ldnn(ip)%count_eo(eo,mu,1-fb)
     j=ldnn(ip)%volh_eo(i,eo,mu,1-fb)
     out(:,:,j,ip,eo)=ZERO
  enddo
  enddo
end
!-------------------------------------------------------------------------------
subroutine put_source(in, ip, is)
  use deflation
  use module_dd
  implicit none
  complex(8), dimension(4,3,ld%lat%volh,0:1), intent(in) :: in
  integer, intent(in) :: ip, is

  subs(:,:,:,ip,0,is)=in(:,:,:,0)
  subs(:,:,:,ip,1,is)=in(:,:,:,1)

end
!-------------------------------------------------------------------------------
subroutine inv_b(out_e, out_o, in_e, in_o)
  use deflation
  use module_dd
  implicit none
  complex(8), dimension(m, gd%lat%volh), intent(out) :: out_e, out_o
  complex(8), dimension(m, gd%lat%volh), intent(in) :: in_e, in_o

  call b(EVEN, ODD, out_e, in_o)
  out_e = in_e - out_e
  out_o=out_e                 ! use out_o as tmp
  call bt_inv(out_e, out_o)
  call b(ODD, EVEN, out_o, out_e)
  out_o = in_o - out_o
end
!-------------------------------------------------------------------------------
subroutine bt(out, in)
  use deflation
  use module_dd
  implicit none
  complex(8), dimension(m, gd%lat%volh), intent(out) :: out
  complex(8), dimension(m, gd%lat%volh), intent(in) :: in
  complex(8), dimension(m, gd%lat%volh) :: tmp

  call b(ODD, EVEN, tmp, in)
  call b(EVEN, ODD, out, tmp)
  out = in - out
end

!-------------------------------------------------------------------------------
subroutine b(e, o, out, in)  !!! this is done on e of (e, o)
  use deflation
  use module_dd
  use module_xbound_sc2_dd
  implicit none
  complex(8), dimension(m, gd%lat%volh), intent(out) :: out
  complex(8), dimension(m, gd%lat%volh), intent(in) :: in
  integer, intent(in) :: e, o
  integer :: i, j, mu, fb, ip, ibound, neighbor_ip, idm

  out=ZERO
  do fb=0,1
  do mu=1,4
  do i=1,gd%lat%volh
     ip=my_dm(i,e)
     ibound = xbsc2(ip)%i_bound(mu, fb)
     neighbor_ip = xbsc2(ip)%b(ibound)%dm_source
     j = i_dm(neighbor_ip)

!!!! need  if (my_pe() == xbsc2(ip)%b(ibound)%pe_source) then

     call matvecmult_add(bop2(i,e,mu,fb)%b(1,1), out(1,i), in(1,j) ,m)

!write(0,*)"b",out
!stop

  enddo
  enddo
  enddo

end

!-------------------------------------------------------------------------------
subroutine bt_inv(x, b)
  use deflation
  use module_dd
  implicit none
  complex(8), dimension(m*gd%lat%volh), intent(out):: x
  complex(8), dimension(m*gd%lat%volh), intent(in) :: b
  integer :: i
  real(8) :: bb, rtr, rtrold
  complex(8), dimension(m*gd%lat%volh) :: r, r0, p, ap, s, as
  complex(8) :: ak, bk, pap, ss1, ss2, omega
  real(8),    external :: vecnorm2
  complex(8), external :: veccdotc
  integer :: veclen

  veclen=m*gd%lat%volh
!write(0,*)matrix
!write(0,*)x
!write(0,*)b

!write(0,*) b
!stop

  x=b
  bb = vecnorm2(b, veclen); call global_sum_vec(1,bb)
  call bt(r, x)

  r=b-r; r0=r; p=r
  rtrold = vecnorm2(r, veclen); call global_sum_vec(1,rtrold)

  if ( sqrt(rtrold/bb) < 1d-32 ) goto 9999

  do i = 1, veclen**3
     call bt(ap, p)
     pap = veccdotc(ap,r0,veclen); call global_sum_vec(2,pap)

     ak = rtrold / pap
     s = r - ak * ap

     call bt(as, s)
     ss1=veccdotc(s,as,veclen); call global_sum_vec(2,ss1)
     ss2=veccdotc(as,as,veclen); call global_sum_vec(2,ss2)
     omega = ss1/ss2

     x = x + ak * p + omega * s
     r = s          - omega * as

     ss1=veccdotc(r,r,veclen); call global_sum_vec(2,ss1)
     ss2=veccdotc(r,r0,veclen); call global_sum_vec(2,ss2)

     rtr =  ss1
!     write(0,*)"bt_inv",rtr,bb,sqrt(rtr/bb)

     if ( sqrt(rtr/bb) < 1d-32 ) goto 9999

     bk = ss2 / rtrold * ak / omega
     rtrold = ss2
     p = r + bk * (p - omega * ap)
  enddo

  write(0, *) "bt_inv(): no convergence; rtr = ", rtr
  call die("aborted due to bt_inv no convergence")

9999 continue

!  call bt(r,x)
!  r=r-b
!write(0,*)r
!write(0,*)"bt_inv",i,rtr,bb,sqrt(rtr/bb)
!stop

end

!-------------------------------------------------------------------------------
subroutine projectl(out, in)
  use deflation
  use module_dd
  implicit none
  !
  !         ordering 4,3,ld%lat%volh,0:ld%lat%num_ip-1,0:1
  !
  complex(8), dimension(4,3,ld%lat%volh,0:ld%lat%num_ip-1,0:1),intent(in):: in
  complex(8), dimension(4,3,ld%lat%volh,0:ld%lat%num_ip-1,0:1),intent(out):: out
  complex(8), dimension(4,3,ld%lat%volh,0:ld%lat%num_ip-1,0:1):: tmp
  complex(8), dimension(m,gd%lat%volh):: x_e, x_o
  complex(8), dimension(m,gd%lat%volh):: b_e, b_o
  complex(8):: rc_e, rc_o, bglobal(m), xglobal(m)
  integer :: im, ip
  complex(8),external::veccdotc

  if (deflationlevel < 0) then

     out=in

  elseif(deflationlevel == 0) then

     do im=1,m
        bglobal(im) = veccdotc(subs(1,1,1,0,0,im),in,24*ld%lat%volh*ld%lat%num_ip)
        call global_sum_vec(2,bglobal(im))
     enddo
     call bcgs(aop%b(1,1), xglobal, bglobal, m)
     tmp=ZERO
     do im=1,m
        tmp(:,:,:,:,:)=tmp(:,:,:,:,:)+subs(:,:,:,:,:,im) * xglobal(im)
     enddo
     call unprec_d(out, tmp, 1, 0)
     out=in-out

  else

     do im=1,m
     do ip=0,ld%lat%num_ip-1
        rc_e=veccdotc(subs(1,1,1,ip,0,im), &
                        in(1,1,1,ip,0), 12*ld%lat%volh)
        rc_o=veccdotc(subs(1,1,1,ip,1,im), &
                        in(1,1,1,ip,1), 12*ld%lat%volh)
        if (eo_dm(ip) == 0) then
           b_e(im,i_dm(ip))=rc_e+rc_o
        else
           b_o(im,i_dm(ip))=rc_e+rc_o
        endif
     enddo
     enddo
     call inv_b(x_e, x_o, b_e, b_o)
     tmp=ZERO
     do im=1,m
     do ip=0,ld%lat%num_ip-1
        if (eo_dm(ip) == 0) then
           tmp(:,:,:,ip,0)=tmp(:,:,:,ip,0)+subs(:,:,:,ip,0,im) * x_e(im,i_dm(ip))
           tmp(:,:,:,ip,1)=tmp(:,:,:,ip,1)+subs(:,:,:,ip,1,im) * x_e(im,i_dm(ip))
        else
           tmp(:,:,:,ip,0)=tmp(:,:,:,ip,0)+subs(:,:,:,ip,0,im) * x_o(im,i_dm(ip))
           tmp(:,:,:,ip,1)=tmp(:,:,:,ip,1)+subs(:,:,:,ip,1,im) * x_o(im,i_dm(ip))
        endif
     enddo
     enddo
                             !mid, not dagger
     call unprec_d(out, tmp, 1, 0)
     out=in-out

  endif

end

!-------------------------------------------------------------------------------
subroutine projectr(out, in)
  use deflation
  use module_dd
  implicit none
  !
  !         ordering 4,3,ld%lat%volh,0:ld%lat%num_ip-1,0:1
  !
  complex(8), dimension(4,3,ld%lat%volh,0:ld%lat%num_ip-1,0:1),intent(in):: in
  complex(8), dimension(4,3,ld%lat%volh,0:ld%lat%num_ip-1,0:1),intent(out):: out
  complex(8), dimension(4,3,ld%lat%volh,0:ld%lat%num_ip-1,0:1):: tmp
  complex(8), dimension(m,gd%lat%volh):: x_e, x_o
  complex(8), dimension(m,gd%lat%volh):: b_e, b_o
  complex(8):: rc_e, rc_o, bglobal(m), xglobal(m)
  integer :: im, ip
  complex(8),external :: veccdotc

  if (deflationlevel < 0) then

     out=in

  elseif(deflationlevel == 0 ) then

                         !mid, not dagger
     call unprec_d(out, in, 1, 0)
     do im=1,m
        bglobal(im) = veccdotc(subs(1,1,1,0,0,im),out,24*ld%lat%volh*ld%lat%num_ip)
        call global_sum_vec(2,bglobal(im))
     enddo
     call bcgs(aop%b(1,1), xglobal, bglobal, m)
     tmp=ZERO
     do im=1,m
        tmp(:,:,:,:,:)=tmp(:,:,:,:,:)+subs(:,:,:,:,:,im) * xglobal(im)
     enddo
     out=in-tmp

  else

     call unprec_d(out, in, 1, 0)
     do im=1,m
     do ip=0,ld%lat%num_ip-1
        rc_e=veccdotc(subs(1,1,1,ip,0,im), &
                       out(1,1,1,ip,0), 12*ld%lat%volh)
        rc_o=veccdotc(subs(1,1,1,ip,1,im), &
                       out(1,1,1,ip,1), 12*ld%lat%volh)
        if (eo_dm(ip) == 0) then
           b_e(im,i_dm(ip))=rc_e+rc_o
        else
           b_o(im,i_dm(ip))=rc_e+rc_o
        endif
     enddo
     enddo
     call inv_b(x_e, x_o, b_e, b_o)
     tmp=ZERO
     do im=1,m
     do ip=0,ld%lat%num_ip-1
        if (eo_dm(ip) == 0) then
           tmp(:,:,:,ip,0)=tmp(:,:,:,ip,0)+subs(:,:,:,ip,0,im) * x_e(im,i_dm(ip))
           tmp(:,:,:,ip,1)=tmp(:,:,:,ip,1)+subs(:,:,:,ip,1,im) * x_e(im,i_dm(ip))
        else
           tmp(:,:,:,ip,0)=tmp(:,:,:,ip,0)+subs(:,:,:,ip,0,im) * x_o(im,i_dm(ip))
           tmp(:,:,:,ip,1)=tmp(:,:,:,ip,1)+subs(:,:,:,ip,1,im) * x_o(im,i_dm(ip))
        endif
     enddo
     enddo
     out=in-tmp

  endif

end

!-------------------------------------------------------------------------------
subroutine project(out, in)
  use deflation
  use module_dd
  implicit none
  !
  !         ordering 4,3,ld%lat%volh,0:ld%lat%num_ip-1,0:1
  !
  complex(8), dimension(4,3,ld%lat%volh,0:ld%lat%num_ip-1,0:1),intent(in):: in
  complex(8), dimension(4,3,ld%lat%volh,0:ld%lat%num_ip-1,0:1),intent(out):: out
  complex(8), dimension(4,3,ld%lat%volh,0:ld%lat%num_ip-1,0:1):: tmp
  complex(8), dimension(m,gd%lat%volh):: x_e, x_o
  complex(8), dimension(m,gd%lat%volh):: b_e, b_o
  complex(8):: rc_e, rc_o, bglobal(m), xglobal(m)
  integer :: im, ip
  complex(8),external::veccdotc

  if (deflationlevel < 0) then

     out=ZERO

  elseif(deflationlevel == 0) then

     do im=1,m
        bglobal(im) = veccdotc(subs(1,1,1,0,0,im),in,24*ld%lat%volh*ld%lat%num_ip)
        call global_sum_vec(2,bglobal(im))
     enddo
     call bcgs(aop%b(1,1), xglobal, bglobal, m)
     out=ZERO
     do im=1,m
        out(:,:,:,:,:)=out(:,:,:,:,:)+subs(:,:,:,:,:,im) * xglobal(im)
     enddo

  else

     do im=1,m
     do ip=0,ld%lat%num_ip-1
        rc_e=veccdotc(subs(1,1,1,ip,0,im), &
                        in(1,1,1,ip,0), 12*ld%lat%volh)
        rc_o=veccdotc(subs(1,1,1,ip,1,im), &
                        in(1,1,1,ip,1), 12*ld%lat%volh)
        if (eo_dm(ip) == 0) then
           b_e(im,i_dm(ip))=rc_e+rc_o
        else
           b_o(im,i_dm(ip))=rc_e+rc_o
        endif
     enddo
     enddo
     call inv_b(x_e, x_o, b_e, b_o)
     out=ZERO
     do im=1,m
     do ip=0,ld%lat%num_ip-1
        if (eo_dm(ip) == 0) then
           out(:,:,:,ip,0)=out(:,:,:,ip,0)+subs(:,:,:,ip,0,im) * x_e(im,i_dm(ip))
           out(:,:,:,ip,1)=out(:,:,:,ip,1)+subs(:,:,:,ip,1,im) * x_e(im,i_dm(ip))
        else
           out(:,:,:,ip,0)=out(:,:,:,ip,0)+subs(:,:,:,ip,0,im) * x_o(im,i_dm(ip))
           out(:,:,:,ip,1)=out(:,:,:,ip,1)+subs(:,:,:,ip,1,im) * x_o(im,i_dm(ip))
        endif
     enddo
     enddo

  endif

end

!-------------------------------------------------------------------------------
subroutine inv_dirac_def(inout,step)
  use module_dd
  implicit none
  !
  !         ordering 4,3,ld%lat%volh,0:ld%lat%num_ip-1,0:1
  !
  integer :: step
  complex(8), dimension(12*ld%lat%volh*ld%lat%num_ip*2),intent(inout):: inout
  complex(8), dimension(12*ld%lat%volh*ld%lat%num_ip*2):: b
  complex(8), dimension(12*ld%lat%volh*ld%lat%num_ip*2,step+1):: v
  integer :: veclen,i,j, niter
  real(8) :: inv,beta,tmp, bb
  REAL, external :: ddsc_norm2_eo
  COMPLEX,external :: ddsc_cdotc_eo
  complex(8) :: h(step+1,step), y(step), g(step+1)


  veclen=12*ld%lat%volh*ld%lat%num_ip*2

  b=inout
  bb=ddsc_norm2_eo(b, 2)
  call global_sum_vec(1, bb)

do niter = 1, 40

  call unprec_d(v(1,1), inout,1,0)   !!! mid dag
!!call unprec_mmul_dd(v(1,1), inout,1)
  v(:,1) = b(:) - v(:,1)

  beta = ddsc_norm2_eo(v(:,1), 2)
  call global_sum_vec(1, beta)

  write(0,*)sqrt(beta/bb)
  if (sqrt(beta/bb)< 1d-6 ) return

  beta=sqrt(beta)
  inv=ONE/beta
  v(:,1) = v(:,1)*inv


  h=ZERO;  g=ZERO;  g(1)=beta
  do j = 1, step
     call unprec_d(v(1,j+1), v(1,j),1,0)   !!! mid dag
!!call unprec_mmul_dd(v(1,j+1), v(1,j),1)
     do i = 1, j
          h(i,j) = ddsc_cdotc_eo(v(1,i), v(1,j+1),2) ; call global_sum_vec(2, h(i,j))
          v(:,j+1) = v(:,j+1) - h(i,j) * v(:,i)
     enddo
     tmp = ddsc_norm2_eo(v(1,j+1), 2) ; call global_sum_vec(1, tmp)
     h(j+1,j)=sqrt(tmp)
     inv=ONE/sqrt(tmp)
     v(:,j+1)=v(:,j+1)*inv
  enddo

  call min_gmhy(y,h,g,step)

  do j = 1, step
     inout(:) = inout(:) + v(:,j) * y(j)
  enddo

enddo

end

!===============================================================================
