Class | wavefunction_class |
In: |
MeasureClass/OLDS/wavefunction_class.F90
MeasureClass/BK/wavefunction_class.F90 |
Subroutine : | |
this : | type(wavefunc), intent(in) |
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) |
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) |
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) |
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) |
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
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) |
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) |