Class noisy_wavefunc_class
In: SingletMesons_Simple_v1.5/noisy_wavefunc_class.F90
random_class comlib lattice_class wavefunc_class error_class noisy_wavefunc_class dot/f_29.png

Methods

Included Modules

random_class comlib lattice_class wavefunc_class error_class

Public Instance methods

Subroutine :
rand :type(rand_gfsr_obj), intent(inout)

check correlation of wf1 and wf2

[Source]

subroutine check_corr(rand)
!
! check correlation of wf1 and wf2
!
  implicit none
  type(rand_gfsr_obj), intent(inout) :: rand
  type(src_wavefunc_obj), allocatable :: wf(:)
  integer :: ic,is,jc,js,kc,ks
  integer :: it(2),iz(2),iy(2),ix(2)
  integer :: iput(2),ipuz(2),ipuy(2),ipux(2)
  integer :: itx(2),ity(2),itz(2),itt(2)
  integer :: isp(2),ippu(2)
  integer :: ii,ipu
  integer :: xx1,yy1,zz1,tt1
  integer :: xx2,yy2,zz2,tt2
  real(DP) :: rx,ry,rz,rt,rdist
  complex(DP) :: corr(COL,SPIN,COL,SPIN)
  complex(DP) :: ctmp(COL,SPIN,2)
  integer :: nns,ins
  nns=10*12

  node_site(:,:)=0
  node_site(1,nodeid)=ipsite(1)
  node_site(2,nodeid)=ipsite(2)
  node_site(3,nodeid)=ipsite(3)
!  node_site(4,nodeid)=ipsite(4)
  node_site(4,nodeid)=0
#ifndef _singlePU
  do ipu=0,NPU-1
    call comlib_bcast(node_site(:,ipu),ipu)
  enddo
#endif

  do tt1=1,NTT
  do zz1=1,NTZ
  do yy1=1,NTY
  do xx1=1,NTX
!  do tt2=1,NTT
!  do zz2=1,NTZ
!  do yy2=1,NTY
!  do xx2=1,NTX
    xx2=16
    yy2=9
    zz2=5
    tt2=5
    itx(1) = xx1
    ity(1) = yy1
    itz(1) = zz1
    itt(1) = tt1
    itx(2) = xx2
    ity(2) = yy2
    itz(2) = zz2
    itt(2) = tt2

    rx=MIN(IABS(itx(1)-itx(2)),IABS(itx(1)-itx(2)+NTX),IABS(itx(1)-itx(2)-NTX))
    ry=MIN(IABS(ity(1)-ity(2)),IABS(ity(1)-ity(2)+NTY),IABS(ity(1)-ity(2)-NTY))
    rz=MIN(IABS(itz(1)-itz(2)),IABS(itz(1)-itz(2)+NTZ),IABS(itz(1)-itz(2)-NTZ))
    rt=MIN(IABS(itt(1)-itt(2)),IABS(itt(1)-itt(2)+NTT),IABS(itt(1)-itt(2)-NTT))
    rdist = sqrt(real(rx**2+ry**2+rz**2+rt**2,kind=KIND(rdist)))

  do ii=1,2
    it(ii) = mod(itt(ii)-1,NT)+1
    iz(ii) = mod(itz(ii)-1,NZ)+1
    iy(ii) = mod(ity(ii)-1,NY)+1
    ix(ii) = mod(itx(ii)-1,NX)+1
    iput(ii) = (itt(ii)-1)/NT
    ipuz(ii) = (itz(ii)-1)/NZ
    ipuy(ii) = (ity(ii)-1)/NY
    ipux(ii) = (itx(ii)-1)/NX
    isp(ii) = ispace(ix(ii),iy(ii),iz(ii))
    do ipu=0,NPU-1
      if ( (node_site(1,ipu) == ipux(ii)) .and. (node_site(2,ipu) == ipuy(ii)) .and. (node_site(3,ipu) == ipuz(ii)) .and. (node_site(4,ipu) == iput(ii)) ) then
        ippu(ii) = ipu
      endif
    enddo
  enddo

  allocate(wf(nns))
  do ins=1,nns
    call new(wf(ins))
  enddo
  do ins=1,nns
    call set_noisy_wavefunc(wf(ins),rand)
  enddo

  corr = Z0
  do ins=1,nns
    do ii=1,2
      do is=1,SPIN
        do ic=1,COL
        if (nodeid==ippu(ii)) then
          ctmp(ic,is,ii) = wf(ins)%wavefunc(ic,is,isp(ii),it(ii))
        else
          ctmp(ic,is,ii) = Z0
        endif
#ifndef _singlePU
        call comlib_bcast(ctmp(ic,is,ii),ippu(ii))
#endif
      enddo
      enddo
    enddo
    corr(ic,is,jc,js) = corr(ic,is,jc,js) + ctmp(ic,is,1)*conjg(ctmp(jc,js,2))
  enddo
  deallocate(wf)

  corr = corr/nns
  if (nodeid==0) then
  write(*,'("%",8I4)')xx1,yy1,zz1,tt1, xx2,yy2,zz2,tt2
    do js=1,SPIN
    do is=1,SPIN
    do jc=1,COL
    do ic=1,COL
      if (abs(corr(ic,is,jc,js)) > 0.5_DP) write(*,'("@",8I4,4I3,2ES12.4)')xx1,yy1,zz1,tt1, xx2,yy2,zz2,tt2, ic,is,jc,js, corr
    enddo
    enddo
    enddo
    enddo
  endif

!  enddo
!  enddo
!  enddo
!  enddo
  enddo
  enddo
  enddo
  enddo

  return
end subroutine
Subroutine :
this :type(src_wavefunc_obj), intent(inout)
rand :type(rand_gfsr_obj), intent(inout)

set spin-color diluted complex Z2 noise on wavefunction

[Source]

subroutine set_noisy_wavefunc(this,rand)
!
! set spin-color diluted complex Z2 noise on wavefunction
!
  use error_class
  implicit none
  type(src_wavefunc_obj), intent(inout) :: this
  type(rand_gfsr_obj),    intent(inout) :: rand
  integer :: iz,iy,ix,it,ic,is,isp
  complex(DP) :: ctmp
  real(DP) :: vec(2),cr,ci

  if (allocated(this%wavefunc)) deallocate(this%wavefunc)
  allocate(this%wavefunc(COL,SPIN,NSPACE,NT))
  this%wavefunc(:,:,:,:) = Z0
  this%param%type = USER_WAV

  !
  ! set spin-color diluted Z2 noise vector
  !
  do it=1,NT
  do ix=1,NX
  do iy=1,NY
  do iz=1,NZ
    isp=ispace(ix,iy,iz)
    call get_rand3(rand,vec)
    if (vec(1) < 0.5_DP) then
      cr=+1.0_DP
    else
      cr=-1.0_DP
    endif
    if (vec(2) < 0.5_DP) then
      ci=+1.0_DP
    else
      ci=-1.0_DP
    endif
    ctmp=cmplx(cr,ci,kind=KIND(ctmp))/SQRT(2.0_DP)
    do is=1,SPIN
    do ic=1,COL
      this%wavefunc(ic,is,isp,it)=ctmp
    enddo
    enddo
  enddo
  enddo
  enddo
  enddo

  return
end subroutine