Class wavefunction_class
In: MeasureClass/OLDS/wavefunction_class.F90
MeasureClass/BK/wavefunction_class.F90
comlib lattice_class field_gauge_class field_fermion_class error_class wavefunction_class dot/f_72.png

Methods

Included Modules

comlib lattice_class field_gauge_class field_fermion_class error_class

Public Instance methods

TYPE_WF_JACOBI
Constant :
TYPE_WF_JACOBI = 1 :integer, parameter
TYPE_WF_JACOBI
Constant :
TYPE_WF_JACOBI = 1 :integer, parameter
TYPE_WF_LOCAL
Constant :
TYPE_WF_LOCAL = 0 :integer, parameter
TYPE_WF_LOCAL
Constant :
TYPE_WF_LOCAL = 0 :integer, parameter
Subroutine :
this :type(wavefunc), intent(inout)

[Source]

subroutine delete_wf(this)
  implicit none
  type(wavefunc), intent(inout) :: this
  call new(this)
  return
end subroutine
Subroutine :
this :type(wavefunc), intent(inout)

[Source]

subroutine delete_wf(this)
  implicit none
  type(wavefunc), intent(inout) :: this
  call new(this)
  return
end subroutine
Subroutine :
this :type(wavefunc), intent(inout)

[Source]

subroutine new_wf(this)
  implicit none
  type(wavefunc), intent(inout) :: this
  this%type = TYPE_WF_LOCAL
  this%itx0 = 1
  this%ity0 = 1
  this%itz0 = 1
  this%itt0 = 1
  this%Nsmr = 1
  this%Ksmr = 0.1_DP
  return
end subroutine
Subroutine :
this :type(wavefunc), intent(inout)

[Source]

subroutine new_wf(this)
  implicit none
  type(wavefunc), intent(inout) :: this
  this%type = TYPE_WF_LOCAL
  this%itx0 = 1
  this%ity0 = 1
  this%itz0 = 1
  this%itt0 = 1
  this%Nsmr = 1
  this%Ksmr = 0.1_DP
  return
end subroutine
Subroutine :
this :type(wavefunc), intent(in)

[Source]

subroutine print_wf(this)
  use error_class
  implicit none
  type(wavefunc), intent(in) :: this
  if (0==nodeid) then
    select case(this%type)
    case(TYPE_WF_LOCAL)
      write(*,'(" wave function type: LOCAL")')
    case(TYPE_WF_JACOBI)
      write(*,'(" wave function type: JACOBI")')
    end select
    write(*,'(" wave function centor location: (x,y,z,t)=(",I3,",",I3,",",I3,",",I3,")")') this%itx0,this%ity0,this%itz0,this%itt0
  endif
  return
end subroutine
Subroutine :
this :type(wavefunc), intent(inout)
iout :integer, intent(in)

[Source]

subroutine read_wf(this,iout)
  use error_class
  implicit none
  type(wavefunc), intent(inout) :: this
  integer, intent(in) :: iout
  integer :: flg
  flg = 0
  if (0==nodeid) then
    read(iout,*) this%type
    read(iout,*) this%itx0,this%ity0,this%itz0,this%itt0
  endif

#ifndef _singlePU
  call comlib_bcast(this%type,0)
  call comlib_bcast(this%itx0,0)
  call comlib_bcast(this%ity0,0)
  call comlib_bcast(this%itz0,0)
  call comlib_bcast(this%itt0,0)
#endif

  select case(this%type)
  case (TYPE_WF_LOCAL)
    continue
  case (TYPE_WF_JACOBI)
    if (0==nodeid) then
      read(iout,*)this%Nsmr,this%Ksmr
    endif
#ifndef _singlePU
    call comlib_bcast(this%Nsmr,0)
    call comlib_bcast(this%Ksmr,0)
#endif
  case default
    call error_stop("Error in wavefunction type parameter.")
  end select

  if (this%itx0 <= 0 .or. this%itx0 > NTX) then
    call error_stop("Error in wavefunction itx0 parameter.")
  endif
  if (this%ity0 <= 0 .or. this%ity0 > NTY) then
    call error_stop("Error in wavefunction ity0 parameter.")
  endif
  if (this%itz0 <= 0 .or. this%itz0 > NTZ) then
    call error_stop("Error in wavefunction itz0 parameter.")
  endif
  if (this%itt0 <= 0 .or. this%itt0 > NTT) then
    call error_stop("Error in wavefunction itt0 parameter.")
  endif

  select case(this%type)
  case (TYPE_WF_LOCAL)
    continue
  case (TYPE_WF_JACOBI)
    if (this%Nsmr < 0) then
      call error_stop("Error in wavefunction Nsmr parameter.")
    endif
    if (this%Ksmr < 0) then
      call error_stop("Error in wavefunction Ksmr parameter.")
    endif
  end select

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

[Source]

subroutine read_wf(this,iout)
  use error_class
  implicit none
  type(wavefunc), intent(inout) :: this
  integer, intent(in) :: iout
  integer :: flg
  flg = 0
  if (0==nodeid) then
    read(iout,*) this%type
    read(iout,*) this%itx0,this%ity0,this%itz0,this%itt0
  endif

#ifndef _singlePU
  call comlib_bcast(this%type,0)
  call comlib_bcast(this%itx0,0)
  call comlib_bcast(this%ity0,0)
  call comlib_bcast(this%itz0,0)
  call comlib_bcast(this%itt0,0)
#endif

  select case(this%type)
  case (TYPE_WF_LOCAL)
    continue
  case (TYPE_WF_JACOBI)
    if (0==nodeid) then
      read(iout,*)this%Nsmr,this%Ksmr
    endif
#ifndef _singlePU
    call comlib_bcast(this%Nsmr,0)
    call comlib_bcast(this%Ksmr,0)
#endif
  case default
    call error_stop("Error in wavefunction type parameter.")
  end select

  if (this%itx0 <= 0 .or. this%itx0 > NTX) then
    call error_stop("Error in wavefunction itx0 parameter.")
  endif
  if (this%ity0 <= 0 .or. this%ity0 > NTY) then
    call error_stop("Error in wavefunction ity0 parameter.")
  endif
  if (this%itz0 <= 0 .or. this%itz0 > NTZ) then
    call error_stop("Error in wavefunction itz0 parameter.")
  endif
  if (this%itt0 <= 0 .or. this%itt0 > NTT) then
    call error_stop("Error in wavefunction itt0 parameter.")
  endif

  select case(this%type)
  case (TYPE_WF_LOCAL)
    continue
  case (TYPE_WF_JACOBI)
    if (this%Nsmr < 0) then
      call error_stop("Error in wavefunction Nsmr parameter.")
    endif
    if (this%Ksmr < 0) then
      call error_stop("Error in wavefunction Ksmr parameter.")
    endif
  end select

  return
end subroutine
Subroutine :
this :type(wavefunc), intent(in)
jc :integer, intent(in)
js :integer, intent(in)
y :type(field_quark_wg), intent(inout)
u :type(vfield_gluon_wg), intent(in)

[Source]

subroutine set_source_wf(this,jc,js,y,u)
  use error_class
  implicit none
  type(wavefunc), intent(in) :: this
  integer, intent(in) :: jc,js
  type(field_quark_wg),  intent(inout) :: y
  type(vfield_gluon_wg), intent(in)    :: u
  character(CHARLEN) :: str
  integer :: ix,iy,iz,it,is,ic
  integer :: ieo,ieoxyz,ith
  integer :: ix0,iy0,iz0
  integer :: ipx0,ipy0,ipz0

  !
  ! source center corrdinate in a node
  !
  ix0 = mod(this%itx0-1,NX)+1
  iy0 = mod(this%ity0-1,NY)+1
  iz0 = mod(this%itz0-1,NZ)+1

  !
  ! source center node corrdinate
  !
  ipx0 = (this%itx0-1)/NX
  ipy0 = (this%ity0-1)/NY
  ipz0 = (this%itz0-1)/NZ

  call new(y)
  call clear(y)

  !
  ! set local source
  !
  if ( (ipsite(1) == ipx0) .and. (ipsite(2) == ipy0) .and. (ipsite(3) == ipz0) ) then
    ix = ix0
    iy = iy0
    iz = iz0
    it = this%itt0
    ieo = mod(ipeo+it+iz+iy+ix,2)
    ith = it/2
    y%eo(ieo)%s(ith,iz,iy,ix)%y(jc,js) = Z1
  endif

  select case(this%type)
  case (TYPE_WF_LOCAL)
    continue
  case (TYPE_WF_JACOBI)
    call jacobi_smear(this,y,u)
  case default
    write(str,'("error in type wavefunc:",I4)')this%type
    call error_stop(TRIM(str))
  end select

  return
end subroutine
Subroutine :
this :type(wavefunc), intent(in)
jc :integer, intent(in)
js :integer, intent(in)
y :type(field_quark_wg), intent(inout)
u :type(vfield_gluon_wg), intent(in)

[Source]

subroutine set_source_wf(this,jc,js,y,u)
  use error_class
  implicit none
  type(wavefunc), intent(in) :: this
  integer, intent(in) :: jc,js
  type(field_quark_wg),  intent(inout) :: y
  type(vfield_gluon_wg), intent(in)    :: u
  character(CHARLEN) :: str
  integer :: ix,iy,iz,it,is,ic
  integer :: ieo,ieoxyz,ith
  integer :: ix0,iy0,iz0
  integer :: ipx0,ipy0,ipz0

  !
  ! source center corrdinate in a node
  !
  ix0 = mod(this%itx0-1,NX)+1
  iy0 = mod(this%ity0-1,NY)+1
  iz0 = mod(this%itz0-1,NZ)+1

  !
  ! source center node corrdinate
  !
  ipx0 = (this%itx0-1)/NX
  ipy0 = (this%ity0-1)/NY
  ipz0 = (this%itz0-1)/NZ

  call new(y)
  call clear(y)

  !
  ! set local source
  !
  if ( (ipsite(1) == ipx0) .and. (ipsite(2) == ipy0) .and. (ipsite(3) == ipz0) ) then
    ix = ix0
    iy = iy0
    iz = iz0
    it = this%itt0
    ieo = mod(ipeo+it+iz+iy+ix,2)
    ith = it/2
    y%eo(ieo)%s(ith,iz,iy,ix)%y(jc,js) = Z1
  endif

  select case(this%type)
  case (TYPE_WF_LOCAL)
    continue
  case (TYPE_WF_JACOBI)
    call jacobi_smear(this,y,u)
  case default
    write(str,'("error in type wavefunc:",I4)')this%type
    call error_stop(TRIM(str))
  end select

  return
end subroutine
wavefunc
Derived Type :
type = TYPE_WF_LOCAL :integer
itx0 = 1 :integer
ity0 = 1 :integer
itz0 = 1 :integer
itt0 = 1 :integer
Nsmr = 1 :integer
Ksmr = 0.1_DP :real(DP)
wavefunc
Derived Type :
type = TYPE_WF_LOCAL :integer
itx0 = 1 :integer
ity0 = 1 :integer
itz0 = 1 :integer
itt0 = 1 :integer
Nsmr = 1 :integer
Ksmr = 0.1_DP :real(DP)