Class qprop_class
In: MeasureClass/OLDS/qprop_class.F90
MeasureClass/BK/qprop_class.F90
lattice_class error_class field_gauge_class field_fermion_class quark_clover_class quark_wilson_class hmc_std_quark_wilson_class quark_dw_ovlp_class wavefunction_class file_tools_class comlib qprop_class dot/f_74.png

Methods

delete   delete   get   get   get_parameter_str   new   new   quark_prop   quark_prop  

Included Modules

lattice_class error_class field_gauge_class field_fermion_class quark_clover_class quark_wilson_class hmc_std_quark_wilson_class quark_dw_ovlp_class wavefunction_class file_tools_class comlib

Public Instance methods

Subroutine :
this :type(quark_prop), intent(inout)

[Source]

subroutine delete_qprop(this)
  implicit none
  type(quark_prop), intent(inout) :: this
  return
end subroutine
Subroutine :
this :type(quark_prop), intent(inout)

[Source]

subroutine delete_qprop(this)
  implicit none
  type(quark_prop), intent(inout) :: this
  return
end subroutine
Subroutine :
this :type(quark_prop), intent(inout)
u :type(vfield_gluon_wg), intent(in)

[Source]

subroutine get_qprop(this,u)
  use comlib
  implicit none
  type(quark_prop),      intent(inout) :: this
  type(vfield_gluon_wg), intent(in) :: u
  type(field_quark_wg), allocatable ::  y
  type(field_quark_wg), allocatable :: dy
  integer :: ix,iy,iz,it,is,ic,js,jc,ixyz
  integer :: ieo,ieoxyz,ith
  integer :: iout,iiter
  integer :: itry
  real(DP) :: tol, rtmp0, rtmp1

  allocate(y,dy)
  call new(y)
  call new(dy)

  if (.not.associated(this%wf)) then
    call error_stop("please assign wavefunction pointer for qprop.")
  endif

  do js=1,SPIN
  do jc=1,COL

    !
    ! set local source
    !
    if (0==nodeid) then
      select case(this%wf%type)
      case(TYPE_WF_LOCAL)
        write(*,'("%M Set source TYPE= LOCAL")')
      case(TYPE_WF_JACOBI)
        write(*,'("%M Set source TYPE= JACOBI, Nsmr=",I3," Ksrm=",E24.15)')this%wf%Nsmr,this%wf%Ksmr
      end select
      write(*,'("%M (col,spin)=(",I3,",",I3,") at ")',advance='no') jc,js
      write(*,'("(it,iz,iy,ix)=(",I3,",",I3,",",I3,",",I3,")")') this%wf%itt0,this%wf%itz0,this%wf%ity0,this%wf%itx0
    endif

    call set_source(this%wf,jc,js,y,u)

    iout  = this%iout
    tol   = this%tol
    iiter = this%iiter
    if (0==nodeid) write(iout,'("# iout=",I3," tol=",E24.15," maxiter=",I6)')iout,tol,iiter
#ifdef _DEBUG
    if (0==nodeid) write(   *,'("# iout=",I3," tol=",E24.15," maxiter=",I6)')iout,tol,iiter
#endif

    select type(parameter => this%parameter)
    type is (quark_truncd_dw_overlap)
      call assign_inv_mult_ov(parameter,iout,tol,iiter,dy,y,u)
#ifdef _CLOVER
    type is (quark_clover)
#else
    type is (quark_wilson) 
#endif
      call assign_inv_mult_wd(parameter,iout,tol,iiter,dy,y,u)
    end select

!$OMP PARALLEL DO PRIVATE(ix,iy,iz,ixyz,it,ieo,ith,is,ic)
    do ix=1,NX
    do iy=1,NY
    do iz=1,NZ
      ixyz = iz + (iy-1)*NZ + (ix-1)*NZ*NY
    do it=1,NT
      ieo = mod(ipeo+it+iz+iy+ix,2)
      ith = it/2
      do is=1,SPIN
      do ic=1,COL
        this%qprop(ic,jc,is,js,ixyz,it) = dy%eo(ieo)%s(ith,iz,iy,ix)%y(ic,is)
      enddo
      enddo
    enddo
    enddo
    enddo
    enddo

    rtmp0 = abs2(dy)
    rtmp1 = abs2(y)
    if (0 == nodeid) then
      write(iout,'("%M Dy^2=",E24.15," y^2=",E24.15)')rtmp0,rtmp1
#ifdef _DEBUG
      write(   *,'("%M Dy^2=",E24.15," y^2=",E24.15)')rtmp0,rtmp1
#endif
    endif

#ifdef _PERFMON_
    call error_stop("stop for performace monitoring.")
#endif

  enddo
  enddo

!call comlib_finalize()
!stop
  deallocate(y,dy)

  return
end subroutine
Subroutine :
this :type(quark_prop), intent(inout)
u :type(vfield_gluon_wg), intent(in)

[Source]

subroutine get_qprop(this,u)
  use comlib
  implicit none
  type(quark_prop),      intent(inout) :: this
  type(vfield_gluon_wg), intent(in) :: u
  type(field_quark_wg), allocatable ::  y
  type(field_quark_wg), allocatable :: dy
  integer :: ix,iy,iz,it,is,ic,js,jc,ixyz
  integer :: ieo,ieoxyz,ith
  integer :: iout,iiter
  integer :: itry
  real(DP) :: tol, rtmp0, rtmp1

  allocate(y,dy)
  call new(y)
  call new(dy)

  if (.not.associated(this%wf)) then
    call error_stop("please assign wavefunction pointer for qprop.")
  endif

  do js=1,SPIN
  do jc=1,COL

    !
    ! set local source
    !
    if (0==nodeid) then
      select case(this%wf%type)
      case(TYPE_WF_LOCAL)
        write(*,'("%M Set source TYPE= LOCAL")')
      case(TYPE_WF_JACOBI)
        write(*,'("%M Set source TYPE= JACOBI, Nsmr=",I3," Ksrm=",E24.15)')this%wf%Nsmr,this%wf%Ksmr
      end select
      write(*,'("%M (col,spin)=(",I3,",",I3,") at ")',advance='no') jc,js
      write(*,'("(it,iz,iy,ix)=(",I3,",",I3,",",I3,",",I3,")")') this%wf%itt0,this%wf%itz0,this%wf%ity0,this%wf%itx0
    endif

    call set_source(this%wf,jc,js,y,u)

    iout  = this%iout
    tol   = this%tol
    iiter = this%iiter
    if (0==nodeid) write(iout,'("# iout=",I3," tol=",E24.15," maxiter=",I6)')iout,tol,iiter
#ifdef _DEBUG
    if (0==nodeid) write(   *,'("# iout=",I3," tol=",E24.15," maxiter=",I6)')iout,tol,iiter
#endif

    select type(parameter => this%parameter)
    type is (quark_truncd_dw_overlap)
      call assign_inv_mult_ov(parameter,iout,tol,iiter,dy,y,u)
#ifdef _CLOVER
    type is (quark_clover)
#else
    type is (quark_wilson) 
#endif
      call assign_inv_mult_wd(parameter,iout,tol,iiter,dy,y,u)
    end select

!$OMP PARALLEL DO PRIVATE(ix,iy,iz,ixyz,it,ieo,ith,is,ic)
    do ix=1,NX
    do iy=1,NY
    do iz=1,NZ
      ixyz = iz + (iy-1)*NZ + (ix-1)*NZ*NY
    do it=1,NT
      ieo = mod(ipeo+it+iz+iy+ix,2)
      ith = it/2
      do is=1,SPIN
      do ic=1,COL
        this%qprop(ic,jc,is,js,ixyz,it) = dy%eo(ieo)%s(ith,iz,iy,ix)%y(ic,is)
      enddo
      enddo
    enddo
    enddo
    enddo
    enddo

    rtmp0 = abs2(dy)
    rtmp1 = abs2(y)
    if (0 == nodeid) then
      write(iout,'("%M Dy^2=",E24.15," y^2=",E24.15)')rtmp0,rtmp1
#ifdef _DEBUG
      write(   *,'("%M Dy^2=",E24.15," y^2=",E24.15)')rtmp0,rtmp1
#endif
    endif

#ifdef _PERFMON_
    call error_stop("stop for performace monitoring.")
#endif

  enddo
  enddo

!call comlib_finalize()
!stop
  deallocate(y,dy)

  return
end subroutine
Function :
str :character(len=CHARLEN)
this :type(quark_prop), intent(in)

[Source]

function get_parameter_str_qprop(this) result(str)
  implicit none
  type(quark_prop), intent(in) :: this
  character(len=CHARLEN) :: str

  select type(parameter => this%parameter)
  type is (quark_truncd_dw_overlap)
#ifdef _CLOVER
  type is (quark_clover)
#else
  type is (quark_wilson) 
#endif
    write(str,'("kappa=",F14.6)')get_kappa(parameter)
  end select
  
  return
end function
Subroutine :
this :type(quark_prop), intent(inout)
iout :integer, optional, intent(in)

[Source]

subroutine new_qprop(this,iout)
  use file_tools_class
  implicit none
  type(quark_prop), intent(inout) :: this
  integer, optional, intent(in) :: iout

  if (present(iout)) then
    this%iout = iout
  else
    this%iout = search_free_file_unit()
  endif
  this%tol   = 1.0e-14_DP
  this%iiter = 10000

  return
end subroutine
Subroutine :
this :type(quark_prop), intent(inout)
iout :integer, optional, intent(in)

[Source]

subroutine new_qprop(this,iout)
  use file_tools_class
  implicit none
  type(quark_prop), intent(inout) :: this
  integer, optional, intent(in) :: iout

  if (present(iout)) then
    this%iout = iout
  else
    this%iout = search_free_file_unit()
  endif
  this%tol   = 1.0e-14_DP
  this%iiter = 10000

  return
end subroutine
quark_prop
Derived Type :
qprop(COL,COL,SPIN,SPIN,NX*NY*NZ,NT) :complex(DP)
:
type(quark_truncd_dw_overlap) :parameter
parameter => NULL() :class(quark_wilson), pointer
wf => NULL() :type(wavefunc), pointer
iout :integer
iiter :integer
tol :real(DP)
quark_prop
Derived Type :
qprop(COL,COL,SPIN,SPIN,NX*NY*NZ,NT) :complex(DP)
:
type(quark_truncd_dw_overlap) :parameter
parameter => NULL() :class(quark_wilson), pointer
wf => NULL() :type(wavefunc), pointer
iout :integer
iiter :integer
tol :real(DP)