Subroutine : | |
param1 : | type(qprop_params), intent(inout) |
param2 : | type(qprop_params), intent(in) |
assignment parameters
param1 := param2
subroutine assign_qprop_params(param1,param2) ! ! assignment parameters ! ! param1 := param2 ! type(qprop_params), intent(inout) :: param1 type(qprop_params), intent(in) :: param2 call assign(param1%mass,param2%mass) param1%solver_log => param2%solver_log param1%fname = param2%fname param1%path = param2%path param1%smear_sous = param2%smear_sous param1%smear_sink = param2%smear_sink return end subroutine
Subroutine : | |
param1 : | type(qprop_params), intent(inout) |
param2 : | type(qprop_params), intent(in) |
assignment parameters
param1 := param2
subroutine assign_qprop_params(param1,param2) ! ! assignment parameters ! ! param1 := param2 ! type(qprop_params), intent(inout) :: param1 type(qprop_params), intent(in) :: param2 call assign(param1%mass,param2%mass) param1%solver_log => param2%solver_log param1%fname = param2%fname param1%path = param2%path param1%smear_sous = param2%smear_sous param1%smear_sink = param2%smear_sink return end subroutine
Subroutine : | |
qp1 : | type(quark_prop), intent(inout) |
qp2 : | type(quark_prop), intent(in) |
assign(=duplicate) quark propagator (incuding parameters and data)
q1 := q2
subroutine assign_qprop(qp1,qp2) ! ! assign(=duplicate) quark propagator (incuding parameters and data) ! ! q1 := q2 ! implicit none type(quark_prop), intent(inout) :: qp1 type(quark_prop), intent(in) :: qp2 if (allocated(qp1%prop)) deallocate(qp1%prop) allocate(qp1%prop(COL,COL,SPIN,SPIN,NX*NY*NZ,NTT)) qp1%prop = qp2%prop qp1%psum = qp2%psum qp1%parameter => qp2%parameter qp1%wavefunc_sous => qp2%wavefunc_sous qp1%wavefunc_sink => qp2%wavefunc_sink return end subroutine
Subroutine : | |
qp1 : | type(quark_prop), intent(inout) |
qp2 : | type(quark_prop), intent(in) |
assign(=duplicate) quark propagator (incuding parameters and data)
q1 := q2
subroutine assign_qprop(qp1,qp2) ! ! assign(=duplicate) quark propagator (incuding parameters and data) ! ! q1 := q2 ! implicit none type(quark_prop), intent(inout) :: qp1 type(quark_prop), intent(in) :: qp2 if (allocated(qp1%prop)) deallocate(qp1%prop) allocate(qp1%prop(COL,COL,SPIN,SPIN,NX*NY*NZ,NTT)) qp1%prop = qp2%prop qp1%psum = qp2%psum qp1%parameter => qp2%parameter qp1%wavefunc_sous => qp2%wavefunc_sous qp1%wavefunc_sink => qp2%wavefunc_sink return end subroutine
Subroutine : | |
uq : | type(quark_prop), intent(inout) |
q : | type(quark_prop), intent(in) |
u : | type(vfield_gluon_wg), intent(in) |
mu : | integer, intent(in) |
assign a quark propagtor shifted and multiplied by gauge link
uq(n) := u_mu(n) q(n+mu) uq : quark prop * link q : quark prop u : gauge link mu : direction
subroutine assign_mult_u_q(uq,q,u,mu) ! ! assign a quark propagtor shifted and multiplied by gauge link ! ! uq(n) := u_mu(n) q(n+mu) ! ! uq : quark prop * link ! q : quark prop ! u : gauge link ! mu : direction ! implicit none integer, intent(in) :: mu type(vfield_gluon_wg), intent(in) :: u type(quark_prop), intent(in) :: q type(quark_prop), intent(inout) :: uq type(field_quark_wg), allocatable :: y,uy integer :: ic,is call assign(uq,q) allocate(y,uy) call new(y) call new(uy) do is=1,SPIN do ic=1,COL call conv_prop_to_y(uq, y,ic,is) call assign_mult_u_y(uy,y,u,mu) call conv_y_to_prop(uy,uq,ic,is) enddo enddo deallocate(y,uy) return end subroutine
Subroutine : | |
uq : | type(quark_prop), intent(inout) |
q : | type(quark_prop), intent(in) |
u : | type(vfield_gluon_wg), intent(in) |
mu : | integer, intent(in) |
assign a quark propagtor shifted and multiplied by gauge link
uq(n) := u_mu(n) q(n+mu) uq : quark prop * link q : quark prop u : gauge link mu : direction
subroutine assign_mult_u_q(uq,q,u,mu) ! ! assign a quark propagtor shifted and multiplied by gauge link ! ! uq(n) := u_mu(n) q(n+mu) ! ! uq : quark prop * link ! q : quark prop ! u : gauge link ! mu : direction ! implicit none integer, intent(in) :: mu type(vfield_gluon_wg), intent(in) :: u type(quark_prop), intent(in) :: q type(quark_prop), intent(inout) :: uq type(field_quark_wg), allocatable :: y,uy integer :: ic,is call assign(uq,q) allocate(y,uy) call new(y) call new(uy) do is=1,SPIN do ic=1,COL call conv_prop_to_y(uq, y,ic,is) call assign_mult_u_y(uy,y,u,mu) call conv_y_to_prop(uy,uq,ic,is) enddo enddo deallocate(y,uy) return end subroutine
Subroutine : | |
uy : | type(field_quark_wg), intent(inout) |
y : | type(field_quark_wg), intent(inout) |
u : | type(vfield_gluon_wg), intent(in) |
mu : | integer, intent(in) |
assign a fermion field shifted and multiplied by gauge link
uy(n) := u_mu(n) y(n+mu) uy : quark field * link y : quark field u : gauge link mu : direction
subroutine assign_mult_u_y(uy,y,u,mu) ! ! assign a fermion field shifted and multiplied by gauge link ! ! uy(n) := u_mu(n) y(n+mu) ! ! uy : quark field * link ! y : quark field ! u : gauge link ! mu : direction ! implicit none type(field_quark_wg), intent(inout) :: uy, y type(vfield_gluon_wg), intent(in) :: u integer, intent(in) :: mu call assign_mult_u_eo(uy%eo(0),y%eo(1),u%eo(0),mu) call assign_mult_u_eo(uy%eo(1),y%eo(0),u%eo(1),mu) return end subroutine
Subroutine : | |
uy : | type(field_quark_wg), intent(inout) |
y : | type(field_quark_wg), intent(inout) |
u : | type(vfield_gluon_wg), intent(in) |
mu : | integer, intent(in) |
assign a fermion field shifted and multiplied by gauge link
uy(n) := u_mu(n) y(n+mu) uy : quark field * link y : quark field u : gauge link mu : direction
subroutine assign_mult_u_y(uy,y,u,mu) ! ! assign a fermion field shifted and multiplied by gauge link ! ! uy(n) := u_mu(n) y(n+mu) ! ! uy : quark field * link ! y : quark field ! u : gauge link ! mu : direction ! implicit none type(field_quark_wg), intent(inout) :: uy, y type(vfield_gluon_wg), intent(in) :: u integer, intent(in) :: mu call assign_mult_u_eo(uy%eo(0),y%eo(1),u%eo(0),mu) call assign_mult_u_eo(uy%eo(1),y%eo(0),u%eo(1),mu) return end subroutine
Subroutine : | |||
this : | type(quark_prop),
intent(inout)
|
clear quark propagator data
subroutine clear_qprop(this) ! ! clear quark propagator data ! implicit none type(quark_prop), intent(inout) :: this !$OMP PARALLEL WORKSHARE this%prop(:,:,:,:,:,:) = Z0 !$OMP END PARALLEL WORKSHARE return end subroutine
Subroutine : | |||
this : | type(quark_prop),
intent(inout)
|
clear quark propagator data
subroutine clear_qprop(this) ! ! clear quark propagator data ! implicit none type(quark_prop), intent(inout) :: this !$OMP PARALLEL WORKSHARE this%prop(:,:,:,:,:,:) = Z0 !$OMP END PARALLEL WORKSHARE return end subroutine
Subroutine : | |
this : | type(quark_prop_obj), intent(inout) |
subroutine clear_prop(this) implicit none type(quark_prop_obj), intent(inout) :: this complex(8), parameter :: z0=(0.0d0,0.0d0) this%q(:,:,:,:,:,:)=z0 return end subroutine
Subroutine : | |
this : | type(quark_prop_obj), intent(inout) |
subroutine clear_prop(this) implicit none type(quark_prop_obj), intent(inout) :: this complex(8), parameter :: z0=(0.0d0,0.0d0) this%q(:,:,:,:,:,:)=z0 return end subroutine
Subroutine : | |
this : | type(qprop_params), intent(inout) |
delete quark parameter parameters
subroutine delete_qprop_params(this) ! ! delete quark parameter parameters ! implicit none type(qprop_params), intent(inout) :: this this%solver_log => NULL() call delete(this%mass) return end subroutine
Subroutine : | |
this : | type(qprop_params), intent(inout) |
delete quark parameter parameters
subroutine delete_qprop_params(this) ! ! delete quark parameter parameters ! implicit none type(qprop_params), intent(inout) :: this this%solver_log => NULL() call delete(this%mass) return end subroutine
Subroutine : | |
this : | type(quark_prop), intent(inout) |
set default values for a quark propagator
subroutine delete_qprop(this) ! ! set default values for a quark propagator ! implicit none type(quark_prop), intent(inout) :: this if (allocated(this%prop)) deallocate(this%prop) this%parameter => NULL() this%wavefunc_sous => NULL() this%wavefunc_sink => NULL() return end subroutine
Subroutine : | |
this : | type(quark_prop), intent(inout) |
set default values for a quark propagator
subroutine delete_qprop(this) ! ! set default values for a quark propagator ! implicit none type(quark_prop), intent(inout) :: this if (allocated(this%prop)) deallocate(this%prop) this%parameter => NULL() this%wavefunc_sous => NULL() this%wavefunc_sink => NULL() return end subroutine
Subroutine : | |
this : | type(quark_prop_obj), intent(inout) |
set default values for a quark propagator
subroutine delete_prop(this) ! set default values for a quark propagator implicit none type(quark_prop_obj), intent(inout) :: this call delete(this%parameter) return end subroutine
Subroutine : | |
this : | type(quark_prop_obj), intent(inout) |
set default values for a quark propagator
subroutine delete_prop(this) ! set default values for a quark propagator implicit none type(quark_prop_obj), intent(inout) :: this call delete(this%parameter) return end subroutine
Subroutine : | |
this : | type(quark_prop_parameter_obj), intent(inout) |
subroutine delete_prop_parameter(this) implicit none type(quark_prop_parameter_obj), intent(inout) :: this nullify(this%ir_solver%solver_log) return end subroutine
Subroutine : | |
this : | type(quark_prop_parameter_obj), intent(inout) |
subroutine delete_prop_parameter(this) implicit none type(quark_prop_parameter_obj), intent(inout) :: this nullify(this%ir_solver%solver_log) return end subroutine
Subroutine : | |
this : | type(quark_prop), intent(inout) |
u : | type(vfield_gluon_wg), intent(in) |
compute quark propagator
subroutine get_qprop(this,u) ! ! compute quark propagator ! use error_class implicit none type(quark_prop), intent(inout) :: this type(vfield_gluon_wg), intent(in) :: u type(timer) :: solver_time #ifdef _USE_BLOCK_SOLVER type(field_quark_wg), allocatable :: y(:),Dy(:) integer :: ic,is,ics real(DP), allocatable :: rtmp0(:),rtmp1(:) #else type(field_quark_wg), allocatable :: y,Dy integer :: ic,is real(DP) :: rtmp0,rtmp1 #endif character(len=CHARLEN) :: str integer :: maxiter,mode,iter integer :: iout real(DP) :: tol,etime real(DP) :: copy_y_time0,copy_y_time1,copy_y_etime #ifdef _CLOVER type(tfield_gluon_wg), allocatable :: wl34,wl98 real(DP) :: dummy #endif call new(this%parameter%etime) call tic(this%parameter%etime) #ifdef _CLOVER !======================= ! compute clover term !======================= allocate(wl34,wl98) call make_two_links(u,wl34,wl98) call make_clover_leaf(u,wl34,wl98) deallocate(wl34,wl98) call make_inverse_clover_term(this%parameter%mass,0,dummy) call delete_clover_leaf() #endif if (.not.allocated(this%prop)) then call error_stop("get_qprop: Error, source is not setted/allocated.") endif #ifdef _USE_BLOCK_SOLVER !=============================== ! Blocked solver !=============================== call new(solver_time) call tic(solver_time) copy_y_time0 = get_elapse(copy_fq_time) write(str,'("# BLOCK_SOLVER FOR COL=1,2,3 SPIN=1,2,3,4")') call print(this%parameter%solver_log,TRIM(str)) iout = get_file_unit(this%parameter%solver_log) allocate(y(CLSP),Dy(CLSP)) allocate(rtmp0(CLSP),rtmp1(CLSP)) do ics=1,CLSP call new( y(ics)) call new(dy(ics)) enddo !------------------------ ! Dy = D \ y !------------------------ tol = this%parameter%tol do is=1,SPIN do ic=1,COL ics = ic + (is-1)*COL call conv_prop_to_y(this, y(ics),ic,is) rtmp0(ics) = abs2(y(ics)) enddo enddo call assign_inv_blk_mult_wd(this%parameter%mass,iout,tol,iter,Dy,y,u) do is=1,SPIN do ic=1,COL ics = ic + (is-1)*COL rtmp1(ics) = abs2(Dy(ics)) call conv_y_to_prop(Dy(ics),this,ic,is) enddo enddo copy_y_time1 = get_elapse(copy_fq_time) copy_y_etime = copy_y_time1-copy_y_time0 call toc(solver_time) etime = get_elapse(solver_time) if (nodeid==0) then write(*,'(" block solver done ETime:",E24.16," COPY_Y_ETime:",E24.16)')etime,copy_y_etime do is=1,SPIN do ic=1,COL ics = ic + (is-1)*COL write(*,'(" (col,spin)=",2I3," |y|^2:",E24.16," |Dy|^2:",E24.16)')ic,is,rtmp0(ics),rtmp1(ics) enddo enddo endif deallocate(rtmp0,rtmp1) #else !=============================== ! Non-Blocked solver !=============================== allocate(y,Dy) do is=1,SPIN do ic=1,COL call new(solver_time) call tic(solver_time) copy_y_time0 = get_elapse(copy_fq_time) write(str,'("# SOLVER FOR COL=",I2," SPIN=",I2)')ic,is call print(this%parameter%solver_log,TRIM(str)) iout = get_file_unit(this%parameter%solver_log) call new(y) call new(Dy) !------------------------ ! Dy = D \ y !------------------------ tol = this%parameter%tol call conv_prop_to_y(this, y,ic,is) rtmp0 = abs2(y) call assign_inv_mult_wd(this%parameter%mass,iout,tol,iter,Dy,y,u) rtmp1 = abs2(Dy) call conv_y_to_prop(Dy,this,ic,is) copy_y_time1 = get_elapse(copy_fq_time) copy_y_etime = copy_y_time1-copy_y_time0 call toc(solver_time) etime = get_elapse(solver_time) if (nodeid==0) then write(*,'(" solver done ",2I3," ETime:",E24.16," COPY_Y_ETime:",E24.16," |y|^2:",E24.16," |Dy|^2:",E24.16)') ic,is,etime,copy_y_etime,rtmp0,rtmp1 endif enddo enddo #endif deallocate(y,Dy) #ifdef _CLOVER call delete_inverse_clover_term(this%parameter%mass) #endif call toc(this%parameter%etime) return end subroutine
Subroutine : | |
this : | type(quark_prop), intent(inout) |
u : | type(vfield_gluon_wg), intent(in) |
compute quark propagator
subroutine get_qprop(this,u) ! ! compute quark propagator ! use error_class implicit none type(quark_prop), intent(inout) :: this type(vfield_gluon_wg), intent(in) :: u type(timer) :: solver_time #ifdef _USE_BLOCK_SOLVER type(field_quark_wg), allocatable :: y(:),Dy(:) integer :: ic,is,ics real(DP), allocatable :: rtmp0(:),rtmp1(:) #else type(field_quark_wg), allocatable :: y,Dy integer :: ic,is real(DP) :: rtmp0,rtmp1 #endif character(len=CHARLEN) :: str integer :: maxiter,mode,iter integer :: iout real(DP) :: tol,etime real(DP) :: copy_y_time0,copy_y_time1,copy_y_etime #ifdef _CLOVER type(tfield_gluon_wg), allocatable :: wl34,wl98 real(DP) :: dummy #endif call new(this%parameter%etime) call tic(this%parameter%etime) #ifdef _CLOVER !======================= ! compute clover term !======================= allocate(wl34,wl98) call make_two_links(u,wl34,wl98) call make_clover_leaf(u,wl34,wl98) deallocate(wl34,wl98) call make_inverse_clover_term(this%parameter%mass,0,dummy) call delete_clover_leaf() #endif if (.not.allocated(this%prop)) then call error_stop("get_qprop: Error, source is not setted/allocated.") endif #ifdef _USE_BLOCK_SOLVER !=============================== ! Blocked solver !=============================== call new(solver_time) call tic(solver_time) copy_y_time0 = get_elapse(copy_fq_time) write(str,'("# BLOCK_SOLVER FOR COL=1,2,3 SPIN=1,2,3,4")') call print(this%parameter%solver_log,TRIM(str)) iout = get_file_unit(this%parameter%solver_log) allocate(y(CLSP),Dy(CLSP)) allocate(rtmp0(CLSP),rtmp1(CLSP)) do ics=1,CLSP call new( y(ics)) call new(dy(ics)) enddo !------------------------ ! Dy = D \ y !------------------------ tol = this%parameter%tol do is=1,SPIN do ic=1,COL ics = ic + (is-1)*COL call conv_prop_to_y(this, y(ics),ic,is) rtmp0(ics) = abs2(y(ics)) enddo enddo call assign_inv_blk_mult_wd(this%parameter%mass,iout,tol,iter,Dy,y,u) do is=1,SPIN do ic=1,COL ics = ic + (is-1)*COL rtmp1(ics) = abs2(Dy(ics)) call conv_y_to_prop(Dy(ics),this,ic,is) enddo enddo copy_y_time1 = get_elapse(copy_fq_time) copy_y_etime = copy_y_time1-copy_y_time0 call toc(solver_time) etime = get_elapse(solver_time) if (nodeid==0) then write(*,'(" block solver done ETime:",E24.16," COPY_Y_ETime:",E24.16)')etime,copy_y_etime do is=1,SPIN do ic=1,COL ics = ic + (is-1)*COL write(*,'(" (col,spin)=",2I3," |y|^2:",E24.16," |Dy|^2:",E24.16)')ic,is,rtmp0(ics),rtmp1(ics) enddo enddo endif deallocate(rtmp0,rtmp1) #else !=============================== ! Non-Blocked solver !=============================== allocate(y,Dy) do is=1,SPIN do ic=1,COL call new(solver_time) call tic(solver_time) copy_y_time0 = get_elapse(copy_fq_time) write(str,'("# SOLVER FOR COL=",I2," SPIN=",I2)')ic,is call print(this%parameter%solver_log,TRIM(str)) iout = get_file_unit(this%parameter%solver_log) call new(y) call new(Dy) !------------------------ ! Dy = D \ y !------------------------ tol = this%parameter%tol call conv_prop_to_y(this, y,ic,is) rtmp0 = abs2(y) call assign_inv_mult_wd(this%parameter%mass,iout,tol,iter,Dy,y,u) rtmp1 = abs2(Dy) call conv_y_to_prop(Dy,this,ic,is) copy_y_time1 = get_elapse(copy_fq_time) copy_y_etime = copy_y_time1-copy_y_time0 call toc(solver_time) etime = get_elapse(solver_time) if (nodeid==0) then write(*,'(" solver done ",2I3," ETime:",E24.16," COPY_Y_ETime:",E24.16," |y|^2:",E24.16," |Dy|^2:",E24.16)') ic,is,etime,copy_y_etime,rtmp0,rtmp1 endif enddo enddo #endif deallocate(y,Dy) #ifdef _CLOVER call delete_inverse_clover_term(this%parameter%mass) #endif call toc(this%parameter%etime) return end subroutine
Subroutine : | |
this : | type(quark_prop_obj), intent(inout) |
u : | type(gvfield_dd_wg_obj), intent(in) |
subroutine get_quark_prop(this,u) implicit none type(quark_prop_obj), intent(inout) :: this type(gvfield_dd_wg_obj), intent(in) :: u type(timer_obj) :: timer type(wqfield_dd_wg_obj), pointer :: y,Dy integer :: maxiter,mode,iter integer :: ic,is real(8) :: tol #ifdef _CLOVER real(8) :: dummy type(ctfield_dd_obj), pointer :: ucl type(cchlfield_dd_obj), pointer :: fclinv #endif call tic(this%parameter%etime) #ifdef _CLOVER !******************************* !* calc clover term !******************************* allocate(ucl,fclinv) call make_clover_term(ucl,u) call make_inverse_clover_term(this%parameter%quark_mass,fclinv,ucl,dummy,0) deallocate(ucl) #endif call clear_prop(this) call set_source(this) allocate(y,Dy) call new(this%parameter%ir_solver%single_solver) do is=1,SPIN do ic=1,COL call new(timer) call tic(timer) call new(y) call new(Dy) !******************* !* y = F^-1 src !******************* #ifdef _CLOVER call conv_prop_to_y(this,ic,is,Dy) call mult_clover_term(Dy,y,fclinv) #else call conv_prop_to_y(this,ic,is,y) #endif !********************** !* Dy = \tilde{D}^-1 y !********************** tol = this%parameter%solver_param%tol maxiter= this%parameter%solver_param%maxiter if ( tol <= 0.0d0) then mode = 1 ! stop by maxiter else mode = 0 ! stop by tol endif call set_inverse_parameters(tolerance=tol,max_iteration=maxiter,inverse_mode=mode) #ifdef _CLOVER call inverse_mult_wilson_dirac(ir_solver=this%parameter%ir_solver,kappa=this%parameter%quark_mass%kappa, y=y,Dy=Dy,u=u,fclinv=fclinv) #else call inverse_mult_wilson_dirac(ir_solver=this%parameter%ir_solver,kappa=this%parameter%quark_mass%kappa, y=y,Dy=Dy,u=u) #endif call get_inverse_results(iteration=iter) call inc(this%parameter%solver_param,iter) call conv_y_to_prop(Dy,this,ic,is) call tac(timer) call average(timer) if (nodeid==0) write(*,'(" solver done ",2I3," ETime:",E24.16)')ic,is,timer%elapse enddo enddo call delete(this%parameter%ir_solver%single_solver) deallocate(y,Dy) call tac(this%parameter%etime) return end subroutine
Subroutine : | |
this : | type(quark_prop_obj), intent(inout) |
u : | type(gvfield_dd_wg_obj), intent(in) |
subroutine get_quark_prop(this,u) implicit none type(quark_prop_obj), intent(inout) :: this type(gvfield_dd_wg_obj), intent(in) :: u type(timer_obj) :: timer type(wqfield_dd_wg_obj), pointer :: y,Dy integer :: maxiter,mode,iter integer :: ic,is real(8) :: tol #ifdef _CLOVER real(8) :: dummy type(ctfield_dd_obj), pointer :: ucl type(cchlfield_dd_obj), pointer :: fclinv #endif call tic(this%parameter%etime) #ifdef _CLOVER !******************************* !* calc clover term !******************************* allocate(ucl,fclinv) call make_clover_term(ucl,u) call make_inverse_clover_term(this%parameter%quark_mass,fclinv,ucl,dummy,0) deallocate(ucl) #endif call clear_prop(this) call set_source(this) allocate(y,Dy) call new(this%parameter%ir_solver%single_solver) do is=1,SPIN do ic=1,COL call new(timer) call tic(timer) call new(y) call new(Dy) !******************* !* y = F^-1 src !******************* #ifdef _CLOVER call conv_prop_to_y(this,ic,is,Dy) call mult_clover_term(Dy,y,fclinv) #else call conv_prop_to_y(this,ic,is,y) #endif !********************** !* Dy = \tilde{D}^-1 y !********************** tol = this%parameter%solver_param%tol maxiter= this%parameter%solver_param%maxiter if ( tol <= 0.0d0) then mode = 1 ! stop by maxiter else mode = 0 ! stop by tol endif call set_inverse_parameters(tolerance=tol,max_iteration=maxiter,inverse_mode=mode) #ifdef _CLOVER call inverse_mult_wilson_dirac(ir_solver=this%parameter%ir_solver,kappa=this%parameter%quark_mass%kappa, y=y,Dy=Dy,u=u,fclinv=fclinv) #else call inverse_mult_wilson_dirac(ir_solver=this%parameter%ir_solver,kappa=this%parameter%quark_mass%kappa, y=y,Dy=Dy,u=u) #endif call get_inverse_results(iteration=iter) call inc(this%parameter%solver_param,iter) call conv_y_to_prop(Dy,this,ic,is) call tac(timer) call average(timer) if (nodeid==0) write(*,'(" solver done ",2I3," ETime:",E24.16)')ic,is,timer%elapse enddo enddo call delete(this%parameter%ir_solver%single_solver) deallocate(y,Dy) call tac(this%parameter%etime) return end subroutine
Subroutine : | |
this : | type(qprop_params), intent(inout) |
set default values for a quark propagator parameter
subroutine new_qprop_params(this) ! ! set default values for a quark propagator parameter ! implicit none type(qprop_params), intent(inout) :: this this%solver_log => NULL() this%tol = 10*EPSILON(1.0_DP) call new(this%etime) return end subroutine
Subroutine : | |
this : | type(qprop_params), intent(inout) |
set default values for a quark propagator parameter
subroutine new_qprop_params(this) ! ! set default values for a quark propagator parameter ! implicit none type(qprop_params), intent(inout) :: this this%solver_log => NULL() this%tol = 10*EPSILON(1.0_DP) call new(this%etime) return end subroutine
Subroutine : | |
this : | type(quark_prop), intent(inout) |
set default values for a quark propagator
subroutine new_qprop(this) ! ! set default values for a quark propagator ! implicit none type(quark_prop), intent(inout) :: this if (allocated(this%prop)) deallocate(this%prop) this%parameter => NULL() this%wavefunc_sous => NULL() this%wavefunc_sink => NULL() return end subroutine
Subroutine : | |
this : | type(quark_prop), intent(inout) |
set default values for a quark propagator
subroutine new_qprop(this) ! ! set default values for a quark propagator ! implicit none type(quark_prop), intent(inout) :: this if (allocated(this%prop)) deallocate(this%prop) this%parameter => NULL() this%wavefunc_sous => NULL() this%wavefunc_sink => NULL() return end subroutine
Subroutine : | |
this : | type(quark_prop_obj), intent(inout) |
set default values for a quark propagator
subroutine new_prop(this) ! set default values for a quark propagator implicit none type(quark_prop_obj), intent(inout) :: this call new(this%parameter) return end subroutine
Subroutine : | |
this : | type(quark_prop_obj), intent(inout) |
set default values for a quark propagator
subroutine new_prop(this) ! set default values for a quark propagator implicit none type(quark_prop_obj), intent(inout) :: this call new(this%parameter) return end subroutine
Subroutine : | |
this : | type(quark_prop_parameter_obj), intent(inout) |
set default values for a quark propagator parameter
subroutine new_prop_parameter(this) ! set default values for a quark propagator parameter implicit none type(quark_prop_parameter_obj), intent(inout) :: this this%quark_mass%kappa = 0.1d0 this%quark_mass%csw = 0.0d0 this%solver_param%tol = 1.d-15 this%solver_param%maxiter = 1000 this%ir_solver%omega = 1.1d0 this%ir_solver%nmr = 2 this%ir_solver%nsap = 5 this%ir_solver%nchro = 0 this%ir_solver%solver_log => this%solver_log call new(this%ir_solver%single_solver) call new(this%etime) call new(this%wavefunc_sous) call new(this%wavefunc_sink) return end subroutine
Subroutine : | |
this : | type(quark_prop_parameter_obj), intent(inout) |
set default values for a quark propagator parameter
subroutine new_prop_parameter(this) ! set default values for a quark propagator parameter implicit none type(quark_prop_parameter_obj), intent(inout) :: this this%quark_mass%kappa = 0.1d0 this%quark_mass%csw = 0.0d0 this%solver_param%tol = 1.d-15 this%solver_param%maxiter = 1000 this%ir_solver%omega = 1.1d0 this%ir_solver%nmr = 2 this%ir_solver%nsap = 5 this%ir_solver%nchro = 0 this%ir_solver%solver_log => this%solver_log call new(this%ir_solver%single_solver) call new(this%etime) call new(this%wavefunc_sous) call new(this%wavefunc_sink) return end subroutine
Subroutine : | |
this : | type(qprop_params), intent(inout) |
print parameters for a quark propagator
subroutine print_qprop_params(this) ! ! print parameters for a quark propagator ! implicit none type(qprop_params), intent(inout) :: this if (nodeid==0) then write(*,'("==== Mass Params ====")') call print(this%mass) endif if (nodeid==0) then write(*,'("==== Solver Params ====")') write(*,'(3X," Solver tol :",E24.16)')this%tol write(*,'("==== Smearing type ====")') write(*,'(3X," Source :",I3)')this%smear_sous write(*,'(3X," Sink :",I3)')this%smear_sink endif return end subroutine
Subroutine : | |
this : | type(qprop_params), intent(inout) |
print parameters for a quark propagator
subroutine print_qprop_params(this) ! ! print parameters for a quark propagator ! implicit none type(qprop_params), intent(inout) :: this if (nodeid==0) then write(*,'("==== Mass Params ====")') call print(this%mass) endif if (nodeid==0) then write(*,'("==== Solver Params ====")') write(*,'(3X," Solver tol :",E24.16)')this%tol write(*,'("==== Smearing type ====")') write(*,'(3X," Source :",I3)')this%smear_sous write(*,'(3X," Sink :",I3)')this%smear_sink endif return end subroutine
Subroutine : | |
this : | type(quark_prop), intent(inout) |
print parameters for a quark propagator
subroutine print_qprop(this) ! ! print parameters for a quark propagator ! implicit none type(quark_prop), intent(inout) :: this call print(this%parameter) if (nodeid==0) then write(*,'("==== Source Wavefunction type ====")') endif call print(this%wavefunc_sous) if (0 < this%parameter%smear_sink) then if (nodeid==0) then write(*,'("==== Sink Wavefunction type ====")') endif call print(this%wavefunc_sink) endif if (nodeid==0) then write(*,'(80("="))') endif return end subroutine
Subroutine : | |
this : | type(quark_prop), intent(inout) |
print parameters for a quark propagator
subroutine print_qprop(this) ! ! print parameters for a quark propagator ! implicit none type(quark_prop), intent(inout) :: this call print(this%parameter) if (nodeid==0) then write(*,'("==== Source Wavefunction type ====")') endif call print(this%wavefunc_sous) if (0 < this%parameter%smear_sink) then if (nodeid==0) then write(*,'("==== Sink Wavefunction type ====")') endif call print(this%wavefunc_sink) endif if (nodeid==0) then write(*,'(80("="))') endif return end subroutine
Subroutine : | |
this : | type(quark_prop_parameter_obj), intent(inout) |
read parameters for a quark propagator parameter
subroutine print_prop_parameter(this) ! read parameters for a quark propagator parameter implicit none type(quark_prop_parameter_obj), intent(inout) :: this if (nodeid==0) then write(*,'("==== Mass Params ====")') write(*,'(3X," Kappa :",F24.16)')this%quark_mass%kappa #ifdef _CLOVER write(*,'(3X," Csw :",F24.16)')this%quark_mass%csw #endif write(*,'("==== Solver Params ====")') write(*,'(3X," Solver tol :",E24.16)')this%solver_param%tol write(*,'(3X," Solver max iter :",I10)') this%solver_param%maxiter write(*,'("==== Solver Params II ====")') write(*,'(" outer-BiCGStab + inner-BiCGStab/GCRODR + SAP(NSAP) + domain-SSOR(NMR)")') write(*,'(3X," OR-param :",E16.8)')this%ir_solver%omega write(*,'(3X," NMR :",I4)')this%ir_solver%nmr write(*,'(3X," NSAP :",I4)')this%ir_solver%nsap write(*,'("==== Smearing type ====")') write(*,'(3X," Source :",I3)')this%smear_sous write(*,'(3X," Sink :",I3)')this%smear_sink endif if (nodeid==0) then write(*,'("==== Source Wavefunction type ====")') endif call print(this%wavefunc_sous) if (nodeid==0) then write(*,'("==== Sink Wavefunction type ====")') endif call print(this%wavefunc_sink) if (nodeid==0) then write(*,'(80("="))') endif return end subroutine
Subroutine : | |
this : | type(quark_prop_parameter_obj), intent(inout) |
read parameters for a quark propagator parameter
subroutine print_prop_parameter(this) ! read parameters for a quark propagator parameter implicit none type(quark_prop_parameter_obj), intent(inout) :: this if (nodeid==0) then write(*,'("==== Mass Params ====")') write(*,'(3X," Kappa :",F24.16)')this%quark_mass%kappa #ifdef _CLOVER write(*,'(3X," Csw :",F24.16)')this%quark_mass%csw #endif write(*,'("==== Solver Params ====")') write(*,'(3X," Solver tol :",E24.16)')this%solver_param%tol write(*,'(3X," Solver max iter :",I10)') this%solver_param%maxiter write(*,'("==== Solver Params II ====")') write(*,'(" outer-BiCGStab + inner-BiCGStab/GCRODR + SAP(NSAP) + domain-SSOR(NMR)")') write(*,'(3X," OR-param :",E16.8)')this%ir_solver%omega write(*,'(3X," NMR :",I4)')this%ir_solver%nmr write(*,'(3X," NSAP :",I4)')this%ir_solver%nsap write(*,'("==== Smearing type ====")') write(*,'(3X," Source :",I3)')this%smear_sous write(*,'(3X," Sink :",I3)')this%smear_sink endif if (nodeid==0) then write(*,'("==== Source Wavefunction type ====")') endif call print(this%wavefunc_sous) if (nodeid==0) then write(*,'("==== Sink Wavefunction type ====")') endif call print(this%wavefunc_sink) if (nodeid==0) then write(*,'(80("="))') endif return end subroutine
Subroutine : | |
this : | type(quark_prop), intent(inout) |
print out quark propagator statistics
subroutine print_stat_qprop(this) ! ! print out quark propagator statistics ! implicit none type(quark_prop), intent(inout) :: this integer :: itt real(DP) :: etime call psum(this) etime = get_elapse(this%parameter%etime) if (nodeid==0) then write(*,'("==== Solver Statistics ====")') write(*,'(3X," Time :",F12.4)')etime endif if (nodeid==0) then write(*,'("==== Quark Prop |S(itt)|^2 ====")') do itt=1,NTT write(*,'(I3,E24.16)')itt,this%psum(itt) enddo write(*,'("")') endif return end subroutine
Subroutine : | |
this : | type(quark_prop), intent(inout) |
print out quark propagator statistics
subroutine print_stat_qprop(this) ! ! print out quark propagator statistics ! implicit none type(quark_prop), intent(inout) :: this integer :: itt real(DP) :: etime call psum(this) etime = get_elapse(this%parameter%etime) if (nodeid==0) then write(*,'("==== Solver Statistics ====")') write(*,'(3X," Time :",F12.4)')etime endif if (nodeid==0) then write(*,'("==== Quark Prop |S(itt)|^2 ====")') do itt=1,NTT write(*,'(I3,E24.16)')itt,this%psum(itt) enddo write(*,'("")') endif return end subroutine
Subroutine : | |
this : | type(quark_prop_obj), intent(inout) |
subroutine print_stat_prop(this) implicit none type(quark_prop_obj), intent(inout) :: this integer :: itt call psum(this) call average(this%parameter%solver_param) call average(this%parameter%etime) if (nodeid==0) then write(*,'("==== Solver Statistics ====")') write(*,'(3X," Solver iteration :",F12.4)')this%parameter%solver_param%solver_counter%ave write(*,'(3X," Time :",F12.4)')this%parameter%etime%elapse endif if (nodeid==0) then write(*,'("==== Quark Prop |S(itt)|^2 ====")') do itt=1,NTT write(*,'(I3,E24.16)')itt,this%psum(itt) enddo write(*,'("")') endif return end subroutine
Subroutine : | |
this : | type(quark_prop_obj), intent(inout) |
subroutine print_stat_prop(this) implicit none type(quark_prop_obj), intent(inout) :: this integer :: itt call psum(this) call average(this%parameter%solver_param) call average(this%parameter%etime) if (nodeid==0) then write(*,'("==== Solver Statistics ====")') write(*,'(3X," Solver iteration :",F12.4)')this%parameter%solver_param%solver_counter%ave write(*,'(3X," Time :",F12.4)')this%parameter%etime%elapse endif if (nodeid==0) then write(*,'("==== Quark Prop |S(itt)|^2 ====")') do itt=1,NTT write(*,'(I3,E24.16)')itt,this%psum(itt) enddo write(*,'("")') endif return end subroutine
Derived Type : | |||
mass : | type(quark_clover) | ||
mass : | type(quark_wilson) | ||
mass : | type(quark_clover) | ||
mass : | type(quark_wilson) | ||
etime : | type(timer) | ||
solver_log => NULL() : | type(logfile), pointer | ||
fname : | character(len=CHARLEN) | ||
path : | character(len=CHARLEN) | ||
smear_sous : | integer
| ||
smear_sink : | integer
| ||
tol : | real(DP) |
quark propagator parameter for physics measurement
ifdef _CLOVER
Derived Type : | |||
mass : | type(quark_clover) | ||
mass : | type(quark_wilson) | ||
mass : | type(quark_clover) | ||
mass : | type(quark_wilson) | ||
etime : | type(timer) | ||
solver_log => NULL() : | type(logfile), pointer | ||
fname : | character(len=CHARLEN) | ||
path : | character(len=CHARLEN) | ||
smear_sous : | integer
| ||
smear_sink : | integer
| ||
tol : | real(DP) |
quark propagator parameter for physics measurement
ifdef _CLOVER
Derived Type : | |||
prop(:,:,:,:,:,:) : | complex(DP), allocatable
| ||
psum(NTT) : | real(DP)
| ||
parameter => NULL() : | type(qprop_params), pointer | ||
wavefunc_sous => NULL() : | type(src_wavefunc_obj), pointer | ||
wavefunc_sink => NULL() : | type(snk_wavefunc_obj), pointer |
quark propagator for physics measurement
Derived Type : | |||
prop(:,:,:,:,:,:) : | complex(DP), allocatable
| ||
psum(NTT) : | real(DP)
| ||
parameter => NULL() : | type(qprop_params), pointer | ||
wavefunc_sous => NULL() : | type(src_wavefunc_obj), pointer | ||
wavefunc_sink => NULL() : | type(snk_wavefunc_obj), pointer |
quark propagator for physics measurement
Derived Type : | |||
q(COL,COL,SPIN,SPIN,NZ*NY*NX,NT) : | complex(8)
| ||
psum(NTT) : | real(8)
| ||
parameter : | type(quark_prop_parameter_obj) |
quark propagator for physics measurement
Derived Type : | |||
q(COL,COL,SPIN,SPIN,NZ*NY*NX,NT) : | complex(8)
| ||
psum(NTT) : | real(8)
| ||
parameter : | type(quark_prop_parameter_obj) |
quark propagator for physics measurement
Derived Type : | |||
quark_mass : | type(wilson_quark_parameter_obj) | ||
solver_param : | type(solver_parameter_obj) | ||
ir_solver : | type(ir_solver_parameter_obj) | ||
fname : | character(len=CHARLEN) | ||
path : | character(len=CHARLEN) | ||
wavefunc_sous : | type(wavefunc_param_obj) | ||
wavefunc_sink : | type(wavefunc_param_obj) | ||
etime : | type(timer_obj) | ||
solver_log => null() : | type(logging_obj), pointer | ||
smear_sous : | integer
| ||
smear_sink : | integer
| ||
idummy1 : | integer | ||
idummy2 : | integer |
quark propagator parameter for physics measurement
Derived Type : | |||
quark_mass : | type(wilson_quark_parameter_obj) | ||
solver_param : | type(solver_parameter_obj) | ||
ir_solver : | type(ir_solver_parameter_obj) | ||
fname : | character(len=CHARLEN) | ||
path : | character(len=CHARLEN) | ||
wavefunc_sous : | type(wavefunc_param_obj) | ||
wavefunc_sink : | type(wavefunc_param_obj) | ||
etime : | type(timer_obj) | ||
solver_log => null() : | type(logging_obj), pointer | ||
smear_sous : | integer
| ||
smear_sink : | integer
| ||
idummy1 : | integer | ||
idummy2 : | integer |
quark propagator parameter for physics measurement
Subroutine : | |
iout : | integer, intent(in) |
this : | type(quark_prop_obj), intent(inout) |
read parameters for a quark propagator
subroutine read_prop(iout,this) ! read parameters for a quark propagator implicit none integer, intent(in) :: iout type(quark_prop_obj), intent(inout) :: this call read(iout,this%parameter) return end subroutine
Subroutine : | |
iout : | integer, intent(in) |
this : | type(quark_prop_obj), intent(inout) |
read parameters for a quark propagator
subroutine read_prop(iout,this) ! read parameters for a quark propagator implicit none integer, intent(in) :: iout type(quark_prop_obj), intent(inout) :: this call read(iout,this%parameter) return end subroutine
Subroutine : | |
iout : | integer, intent(in) |
this : | type(quark_prop_parameter_obj), intent(inout) |
read parameters for a quark propagator parameter
subroutine read_prop_parameter(iout,this) ! read parameters for a quark propagator parameter implicit none integer, intent(in) :: iout type(quark_prop_parameter_obj), intent(inout) :: this if (nodeid==0) then !****************************** !* read wilson quark mass parameters !****************************** #ifdef _CLOVER read(iout,*)this%quark_mass%kappa, this%quark_mass%csw #else read(iout,*)this%quark_mass%kappa this%quark_mass%csw=0.0d0 #endif !****************************** !* output quark propagetor !* file parameters !****************************** ! read(iout,'(A)')this%path ! save path ! read(iout,'(A)')this%fname ! file name !****************************** !* read Solver parameters !****************************** read(iout,*)this%solver_param%tol, this%solver_param%maxiter !****************************** !* read Solver parameters !****************************** read(iout,*)this%ir_solver%omega, this%ir_solver%nmr, this%ir_solver%nsap endif if (NPU > 1) then call comlib_bcast(this%quark_mass%kappa,0) call comlib_bcast(this%quark_mass%csw,0) call comlib_bcast(this%solver_param%tol,0) call comlib_bcast(this%solver_param%maxiter,0) call comlib_bcast(this%ir_solver%omega,0) call comlib_bcast(this%ir_solver%nmr,0) call comlib_bcast(this%ir_solver%nsap,0) endif return end subroutine
Subroutine : | |
iout : | integer, intent(in) |
this : | type(quark_prop_parameter_obj), intent(inout) |
read parameters for a quark propagator parameter
subroutine read_prop_parameter(iout,this) ! read parameters for a quark propagator parameter implicit none integer, intent(in) :: iout type(quark_prop_parameter_obj), intent(inout) :: this if (nodeid==0) then !****************************** !* read wilson quark mass parameters !****************************** #ifdef _CLOVER read(iout,*)this%quark_mass%kappa, this%quark_mass%csw #else read(iout,*)this%quark_mass%kappa this%quark_mass%csw=0.0d0 #endif !****************************** !* output quark propagetor !* file parameters !****************************** ! read(iout,'(A)')this%path ! save path ! read(iout,'(A)')this%fname ! file name !****************************** !* read Solver parameters !****************************** read(iout,*)this%solver_param%tol, this%solver_param%maxiter !****************************** !* read Solver parameters !****************************** read(iout,*)this%ir_solver%omega, this%ir_solver%nmr, this%ir_solver%nsap endif if (NPU > 1) then call comlib_bcast(this%quark_mass%kappa,0) call comlib_bcast(this%quark_mass%csw,0) call comlib_bcast(this%solver_param%tol,0) call comlib_bcast(this%solver_param%maxiter,0) call comlib_bcast(this%ir_solver%omega,0) call comlib_bcast(this%ir_solver%nmr,0) call comlib_bcast(this%ir_solver%nsap,0) endif return end subroutine
Subroutine : | |
this : | type(qprop_params), intent(inout) |
iout : | integer, intent(in) |
read parameters for a quark propagator parameter
subroutine read_qprop_params(this,iout) ! ! read parameters for a quark propagator parameter ! implicit none type(qprop_params), intent(inout) :: this integer, intent(in) :: iout real(DP) :: kappa,csw integer, parameter :: Nfone=1 ! ! read wilson quark mass parameters ! if (nodeid==0) then ! ! read Solver parameters ! #ifdef _CLOVER read(iout,*)kappa,csw #else read(iout,*)kappa #endif read(iout,*)this%tol endif if (NPU > 1) then call comlib_bcast(kappa,0) #ifdef _CLOVER call comlib_bcast(csw,0) #endif call comlib_bcast(this%tol,0) endif call set_nflavor(this%mass,Nfone) call set_kappa(this%mass,kappa) #ifdef _CLOVER call set_csw(this%mass,csw) #endif return end subroutine
Subroutine : | |
this : | type(qprop_params), intent(inout) |
iout : | integer, intent(in) |
read parameters for a quark propagator parameter
subroutine read_qprop_params(this,iout) ! ! read parameters for a quark propagator parameter ! implicit none type(qprop_params), intent(inout) :: this integer, intent(in) :: iout real(DP) :: kappa,csw integer, parameter :: Nfone=1 ! ! read wilson quark mass parameters ! if (nodeid==0) then ! ! read Solver parameters ! #ifdef _CLOVER read(iout,*)kappa,csw #else read(iout,*)kappa #endif read(iout,*)this%tol endif if (NPU > 1) then call comlib_bcast(kappa,0) #ifdef _CLOVER call comlib_bcast(csw,0) #endif call comlib_bcast(this%tol,0) endif call set_nflavor(this%mass,Nfone) call set_kappa(this%mass,kappa) #ifdef _CLOVER call set_csw(this%mass,csw) #endif return end subroutine
Subroutine : | |
this : | type(quark_prop), intent(inout) |
iout : | integer, intent(in) |
read parameters for a quark propagator
subroutine read_qprop(this,iout) ! ! read parameters for a quark propagator ! use error_class implicit none type(quark_prop), intent(inout) :: this integer, intent(in) :: iout call read(this%parameter,iout) return end subroutine
Subroutine : | |
this : | type(quark_prop), intent(inout) |
iout : | integer, intent(in) |
read parameters for a quark propagator
subroutine read_qprop(this,iout) ! ! read parameters for a quark propagator ! use error_class implicit none type(quark_prop), intent(inout) :: this integer, intent(in) :: iout call read(this%parameter,iout) return end subroutine