xref: /phasta/phSolver/AMG/ramg_cheby.f (revision 595995161822a203c8467e0e4a253d7bd7d6df32)

!***********************************************************
!      ramg_cheby_apply: u = Cheby(v,(lhs,r))
!      v : approx. solution before
!      u : approx. solution (after)
!      r : residual vector, r=Ax-b
!***********************************************************


      subroutine ramg_cheby_apply(u,v,r,level,colm,rowp,lhsK,lhsP,
     &                          ilwork,BC,iBC,iper,fwdbck)
      use ramg_data
      include "common.h"
      include "mpif.h"
      include "auxmpi.h"

      integer,intent(in),dimension(nlwork)            :: ilwork
      integer,intent(in),dimension(nshg)              :: iBC,iper
      real(kind=8),intent(in),dimension(nshg,ndofBC)  :: BC
      integer,intent(in),dimension(nshg+1)       :: colm
      integer,intent(in),dimension(nnz_tot)      :: rowp

      real(kind=8),intent(in),dimension(9,nnz_tot)    :: lhsK
      real(kind=8),intent(in),dimension(4,nnz_tot)    :: lhsP


      real(kind=8),intent(in),dimension(amg_nshg(level)) :: v,r
      real(kind=8),intent(inout),dimension(amg_nshg(level)) :: u
      integer,intent(in) :: fwdbck

      ! Local
      real(kind=8),dimension(amg_nshg(level)) :: pAux
      real(kind=8),dimension(amg_nshg(level)) :: epdk,epx

      real(kind=8),dimension(amg_nshg(level)) :: cy1,cz1

      real(kind=8) :: cf,beta,alpha,delta,theta,s1,rhok,invtheta
      real(kind=8) :: rhokp1,dtemp1,dtemp2,twoodelta
      real(kind=8) :: chebyniu,chebyomega,chebyck1,chebyck2,chebygamma
      integer :: i,j,k

      beta = 1.1*mlsCf(level,1) ! 1.1 * Ev_max
      alpha = mlsCf(level,1)*ramg_chebyratio

      IF (.FALSE.) THEN
      ! mine ( matrix computing )
      chebyniu = 1.0+2.0*(1.0-beta)/(beta-alpha)
      chebygamma = 2.0/(2.0-alpha-beta)
      chebyomega = chebyniu/(2.0*chebyniu*chebyniu-1.0)
      chebyomega = chebyomega*2.0*(2.0-beta-alpha)/(beta-alpha)
      if (fwdbck.eq.2) then ! initial guess x0 = 0
          cy1 = r
      else
          call ramg_calcAv_g(level,pAux,v,colm,rowp,lhsK,lhsP,
     &         ilwork,BC,iBC,iper,1)
          cy1 = v-1.1*3.0/beta*(pAux-r)
      endif

      call ramg_calcAv_g(level,pAux,cy1,colm,rowp,lhsK,lhsP,
     &                   ilwork,BC,iBC,iper,1)
      cz1 = r-pAux

      if (fwdbck.eq.2) then
          u = chebyomega*(cy1+chebygamma*cz1)
      else
          u = chebyomega*(cy1-v+chebygamma*cz1)+v
      endif

      ELSE
      ! trilinos
      delta = (beta-alpha)/2.0
      twoodelta = 4.0/(beta-alpha)
      theta = (beta+alpha)/2.0
      invtheta = 2.0/(beta+alpha)
      s1 = 2.0*theta/delta
      rhok = delta/theta

      !write(*,*)delta,twoodelta,2.0/delta
      if (fwdbck.eq.2) then ! pre-smoothing, initial guess v=0
          epdk = r*invtheta!/theta
          epx  = epdk
      else
          call ramg_calcAv_g(level,pAux,v,colm,rowp,lhsK,lhsP,
     &         ilwork,BC,iBC,iper,1)
          epdk = r-pAux
          epdk = epdk*invtheta!/theta
          epx = v+epdk
      endif

      do k=1,mlsDeg-1
          call ramg_calcAv_g(level,pAux,epx,colm,rowp,lhsK,lhsP,
     &         ilwork,BC,iBC,iper,1)
          rhokp1 = 1.0/(s1-rhok)
          dtemp1 = rhokp1*rhok
          dtemp2 = rhokp1*twoodelta
          rhok = rhokp1
          epdk = dtemp1*epdk+dtemp2*(r-pAux)
          epx = epx + epdk
      enddo
      u = epx

      ENDIF

      end subroutine ! ramg_cheby_apply


      subroutine ramg_cheby_setup(colm,rowp,lhsK,lhsP,
     &                          ilwork,BC,iBC,iper)
      use ramg_data
      include "common.h"
      include "mpif.h"
      include "auxmpi.h"

      integer,intent(in),dimension(nshg+1)            :: colm
      integer,intent(in),dimension(nnz_tot)           :: rowp
      real(kind=8),intent(in),dimension(9,nnz_tot)    :: lhsK
      real(kind=8),intent(in),dimension(4,nnz_tot)    :: lhsP
      integer,intent(in),dimension(nlwork)            :: ilwork
      integer,intent(in),dimension(nshg)              :: iBC,iper
      real(kind=8),intent(in),dimension(nshg,ndofBC)  :: BC

      integer :: i,j,k,lvl,ideg

      if (ramg_setup_flag .ne. 0 ) return

      if (myrank.eq.master) then
         write(*,*)'Start Chebyshev setup'
      endif
      do lvl=1,ramg_levelx
      call ramg_mls_eigen(mlsCf(lvl,1),lvl,1,colm,rowp,lhsK,lhsP,
     &                    ilwork,BC,iBC,iper)
!      call ramg_mls_min_eigen(mlsCf(lvl,2),lvl,1,colm,rowp,lhsK,lhsP,
!     &                    ilwork,BC,iBC,iper)
!      mlsCf(lvl,2) = mlsCf(lvl,1)
      if (myrank.eq.master) then
          write(*,7000)lvl,mlsCf(lvl,1)
7000      format('Level: ',I2,T15,'Ev_max: ',E10.4)
      endif
      enddo
      if (myrank.eq.master) then
          write(*,*)'End Chebyshev setup'
      endif

      end subroutine !ramg_cheby_setup