Class | quark_dwf_class |
In: |
QuarkDwOvlpClass/quark_dwf_class.F90
QuarkDwOvlpClass_v0.1/quark_dwf_class.F90 |
Note chiral projection notation
$ R y = (1-\gamma_5) y = P^{-} y $ , $ L y = (1+gamma_5) y = P^{+} y $
Domainwall operator notation:
\[
(D_{DW}(m_q))(n,m)_{s,r} = (5-M) E(n,m) \otimes E_{s,r} - \frac{1}{2} M_{hop}(n,m) \otimes E_{s,r} \] \[ - E(n,m) \otimes \frac{1}{2} \left[ (1-\gamma_5) \delta_{s+1,r} + (1+\gamma_5) \delta_{s-1,r} \right. \] \[ \left. - m_q (1-\gamma_5) \delta_{s,N}\delta_{1,r} - m_q (1+\gamma_5) \delta_{s,1}\delta_{N,r} \right]
\]
Hoping operator notation:
\[
M_{hop}(n,m) = \sum_{\mu=1}^{4} \left[ (1-\gamma_{\mu})U_{\mu}(n)\delta_{n+\hat{\mu},m} + (1+\gamma_{\mu})U_{\mu}^{\dag}(m)\delta_{n-\hat{\mu},m} \right]
\]
$Id: quark_dwf_class.F90,v 1.24 2011/06/14 11:10:33 ishikawa Exp $
Constant : | |||
DW_TYPE_BORICI = 2 : | integer, parameter
|
Constant : | |||
DW_TYPE_BORICI = 2 : | integer, parameter
|
Constant : | |||
DW_TYPE_SHAMIR = 1 : | integer, parameter
|
Constant : | |||
DW_TYPE_SHAMIR = 1 : | integer, parameter
|
Constant : | |||
DW_TYPE_ZOLOTAREV_CHIU = 4 : | integer, parameter
|
Constant : | |||
DW_TYPE_ZOLOTAREV_CHIU = 4 : | integer, parameter
|
Constant : | |||
DW_TYPE_ZOLOTAREV_SHAMIR = 3 : | integer, parameter
|
Constant : | |||
DW_TYPE_ZOLOTAREV_SHAMIR = 3 : | integer, parameter
|
Function : | |
my_abs2 : | real(DP) |
pe : | type(sfield_gluon_eo_wog), intent(in) |
return squared norm of gauge field (momentum)
Original external subprogram is field_gauge_class#abs2
Function : | |
my_abs2 : | real(DP) |
pe : | type(sfield_gluon_eo_wog), intent(in) |
return squared norm of gauge field (momentum)
Original external subprogram is field_gauge_class#abs2
Function : | |
my_abs2 : | real(DP) |
pe : | type(sfield_gluon_eo_wog), intent(in) |
return squared norm of gauge field (momentum)
Original external subprogram is field_gauge_class#abs2
Function : | |
my_abs2 : | real(DP) |
q : | type(field_dw_quark_wg), intent(in) |
abs2 = |q|^2
Original external subprogram is field_5dfermion_class#abs2
Function : | |
my_abs2 : | real(DP) |
q : | type(field_dw_quark_wg), intent(in) |
abs2 = |q|^2
Original external subprogram is field_5dfermion_class#abs2
Function : | |
my_abs2 : | real(DP) |
q : | type(field_dw_quark_wg), intent(in) |
abs2 = |q|^2
Original external subprogram is field_5dfermion_class#abs2
Function : | |
my_abs2 : | real(DP) |
q : | type(field_dw_quark_wg), intent(in) |
abs2 = |q|^2
Original external subprogram is field_5dfermion_class#abs2
Function : | |
my_abs2 : | real(DP) |
q : | type(field_dw_quark_wg), intent(in) |
abs2 = |q|^2
Original external subprogram is field_5dfermion_class#abs2
Function : | |
my_abs2 : | real(DP) |
q : | type(field_dw_quark_wg), intent(in) |
abs2 = |q|^2
Original external subprogram is field_5dfermion_class#abs2
Function : | |
my_abs2 : | real(DP) |
q : | type(field_dw_quark_wg), intent(in) |
abs2 = |q|^2
Original external subprogram is field_5dfermion_class#abs2
Function : | |
my_abs2 : | real(DP) |
q : | type(field_dw_quark_wg), intent(in) |
abs2 = |q|^2
Original external subprogram is field_5dfermion_class#abs2
Function : | |
my_abs2 : | real(DP) |
q : | type(field_quark_wg), intent(in) |
return |q|^2
Original external subprogram is field_fermion_class#abs2
Function : | |
my_abs2 : | real(DP) |
q : | type(field_quark_wg), intent(in) |
return |q|^2
Original external subprogram is field_fermion_class#abs2
Function : | |
my_abs2 : | real(DP) |
q : | type(field_quark_wg), intent(in) |
return |q|^2
Original external subprogram is field_fermion_class#abs2
Function : | |
fabs2 : | real(DP) |
q : | type(field_dw_quark_wg), intent(in) |
ieo : | integer, intent(in) |
vector norm abs2
q1^2 on even/odd sites only.
Original external subprogram is field_5dfermion_class#abs2
Function : | |
fabs2 : | real(DP) |
q : | type(field_dw_quark_wg), intent(in) |
ieo : | integer, intent(in) |
vector norm abs2
q1^2 on even/odd sites only.
Original external subprogram is field_5dfermion_class#abs2
Function : | |
fabs2 : | real(DP) |
q : | type(field_dw_quark_wg), intent(in) |
ieo : | integer, intent(in) |
vector norm abs2
q1^2 on even/odd sites only.
Original external subprogram is field_5dfermion_class#abs2
Function : | |
fabs2 : | real(DP) |
q : | type(field_dw_quark_wg), intent(in) |
ieo : | integer, intent(in) |
vector norm abs2
q1^2 on even/odd sites only.
Original external subprogram is field_5dfermion_class#abs2
Function : | |
fabs2 : | real(DP) |
q : | type(field_dw_quark_wg), intent(in) |
ieo : | integer, intent(in) |
vector norm abs2
q1^2 on even/odd sites only.
Original external subprogram is field_5dfermion_class#abs2
Function : | |
fabs2 : | real(DP) |
q : | type(field_dw_quark_wg), intent(in) |
ieo : | integer, intent(in) |
vector norm abs2
q1^2 on even/odd sites only.
Original external subprogram is field_5dfermion_class#abs2
Function : | |
fabs2 : | real(DP) |
q : | type(field_dw_quark_wg), intent(in) |
ieo : | integer, intent(in) |
vector norm abs2
q1^2 on even/odd sites only.
Original external subprogram is field_5dfermion_class#abs2
Function : | |
fabs2 : | real(DP) |
q : | type(field_dw_quark_wg), intent(in) |
ieo : | integer, intent(in) |
vector norm abs2
q1^2 on even/odd sites only.
Original external subprogram is field_5dfermion_class#abs2
Function : | |
my_abs2 : | real(DP) |
qe : | type(field_quark_eo_wg), intent(in) |
return |qe|^2
Original external subprogram is field_fermion_class#abs2
Function : | |
my_abs2 : | real(DP) |
qe : | type(field_quark_eo_wg), intent(in) |
return |qe|^2
Original external subprogram is field_fermion_class#abs2
Function : | |
my_abs2 : | real(DP) |
qe : | type(field_quark_eo_wg), intent(in) |
return |qe|^2
Original external subprogram is field_fermion_class#abs2
Subroutine : | |
q1 : | type(field_dw_quark_wg), intent(inout) |
q2 : | type(field_dw_quark_wg), intent(in) |
q1 <= q1 + q2
Original external subprogram is field_5dfermion_class#accum_add
Subroutine : | |
q1 : | type(field_dw_quark_wg), intent(inout) |
q2 : | type(field_dw_quark_wg), intent(in) |
q1 <= q1 + q2
Original external subprogram is field_5dfermion_class#accum_add
Subroutine : | |
q1 : | type(field_dw_quark_wg), intent(inout) |
q2 : | type(field_dw_quark_wg), intent(in) |
q1 <= q1 + q2
Original external subprogram is field_5dfermion_class#accum_add
Subroutine : | |
q1 : | type(field_dw_quark_wg), intent(inout) |
q2 : | type(field_dw_quark_wg), intent(in) |
q1 <= q1 + q2
Original external subprogram is field_5dfermion_class#accum_add
Subroutine : | |
q1 : | type(field_dw_quark_wg), intent(inout) |
q2 : | type(field_dw_quark_wg), intent(in) |
q1 <= q1 + q2
Original external subprogram is field_5dfermion_class#accum_add
Subroutine : | |
q1 : | type(field_dw_quark_wg), intent(inout) |
q2 : | type(field_dw_quark_wg), intent(in) |
q1 <= q1 + q2
Original external subprogram is field_5dfermion_class#accum_add
Subroutine : | |
q1 : | type(field_dw_quark_wg), intent(inout) |
q2 : | type(field_dw_quark_wg), intent(in) |
q1 <= q1 + q2
Original external subprogram is field_5dfermion_class#accum_add
Subroutine : | |
q1 : | type(field_dw_quark_wg), intent(inout) |
q2 : | type(field_dw_quark_wg), intent(in) |
q1 <= q1 + q2
Original external subprogram is field_5dfermion_class#accum_add
Subroutine : | |
q1 : | type(field_dw_quark_wg), intent(inout) |
q2 : | type(field_dw_quark_wg), intent(in) |
ieo : | integer, intent(in) |
Accumulate addition
q1 = q1 + q2 on even/odd sites only.
Original external subprogram is field_5dfermion_class#accum_add
Subroutine : | |
q1 : | type(field_dw_quark_wg), intent(inout) |
q2 : | type(field_dw_quark_wg), intent(in) |
ieo : | integer, intent(in) |
Accumulate addition
q1 = q1 + q2 on even/odd sites only.
Original external subprogram is field_5dfermion_class#accum_add
Subroutine : | |
q1 : | type(field_dw_quark_wg), intent(inout) |
q2 : | type(field_dw_quark_wg), intent(in) |
ieo : | integer, intent(in) |
Accumulate addition
q1 = q1 + q2 on even/odd sites only.
Original external subprogram is field_5dfermion_class#accum_add
Subroutine : | |
q1 : | type(field_dw_quark_wg), intent(inout) |
q2 : | type(field_dw_quark_wg), intent(in) |
ieo : | integer, intent(in) |
Accumulate addition
q1 = q1 + q2 on even/odd sites only.
Original external subprogram is field_5dfermion_class#accum_add
Subroutine : | |
q1 : | type(field_dw_quark_wg), intent(inout) |
q2 : | type(field_dw_quark_wg), intent(in) |
ieo : | integer, intent(in) |
Accumulate addition
q1 = q1 + q2 on even/odd sites only.
Original external subprogram is field_5dfermion_class#accum_add
Subroutine : | |
q1 : | type(field_dw_quark_wg), intent(inout) |
q2 : | type(field_dw_quark_wg), intent(in) |
ieo : | integer, intent(in) |
Accumulate addition
q1 = q1 + q2 on even/odd sites only.
Original external subprogram is field_5dfermion_class#accum_add
Subroutine : | |
q1 : | type(field_dw_quark_wg), intent(inout) |
q2 : | type(field_dw_quark_wg), intent(in) |
ieo : | integer, intent(in) |
Accumulate addition
q1 = q1 + q2 on even/odd sites only.
Original external subprogram is field_5dfermion_class#accum_add
Subroutine : | |
q1 : | type(field_dw_quark_wg), intent(inout) |
q2 : | type(field_dw_quark_wg), intent(in) |
ieo : | integer, intent(in) |
Accumulate addition
q1 = q1 + q2 on even/odd sites only.
Original external subprogram is field_5dfermion_class#accum_add
Subroutine : | |
q2 : | type(field_quark_wg), intent(inout) |
q1 : | type(field_quark_wg), intent(in) |
q2 <= q2 + q1
Original external subprogram is field_fermion_class#accum_add
Subroutine : | |
q2 : | type(field_quark_wg), intent(inout) |
q1 : | type(field_quark_wg), intent(in) |
q2 <= q2 + q1
Original external subprogram is field_fermion_class#accum_add
Subroutine : | |
q2 : | type(field_quark_wg), intent(inout) |
q1 : | type(field_quark_wg), intent(in) |
q2 <= q2 + q1
Original external subprogram is field_fermion_class#accum_add
Subroutine : | |
q2e : | type(field_quark_eo_wg), intent(inout) |
q1e : | type(field_quark_eo_wg), intent(in) |
q2e <= q2e + q1e
Original external subprogram is field_fermion_class#accum_add
Subroutine : | |
q2e : | type(field_quark_eo_wg), intent(inout) |
q1e : | type(field_quark_eo_wg), intent(in) |
q2e <= q2e + q1e
Original external subprogram is field_fermion_class#accum_add
Subroutine : | |
q2e : | type(field_quark_eo_wg), intent(inout) |
q1e : | type(field_quark_eo_wg), intent(in) |
q2e <= q2e + q1e
Original external subprogram is field_fermion_class#accum_add
Subroutine : | |
u2e : | type(sfield_gluon_eo_wg), intent(inout) |
u1e : | type(sfield_gluon_eo_wg), intent(in) |
u2e <= u2e + u1e
Original external subprogram is field_gauge_class#accum_add
Subroutine : | |
u2e : | type(sfield_gluon_eo_wg), intent(inout) |
u1e : | type(sfield_gluon_eo_wg), intent(in) |
u2e <= u2e + u1e
Original external subprogram is field_gauge_class#accum_add
Subroutine : | |
u2e : | type(sfield_gluon_eo_wg), intent(inout) |
u1e : | type(sfield_gluon_eo_wg), intent(in) |
u2e <= u2e + u1e
Original external subprogram is field_gauge_class#accum_add
Subroutine : | |
q : | type(field_dw_quark_wg), intent(inout) |
ccoef : | complex(DP), intent(in) |
q <= q * ccoef
Original external subprogram is field_5dfermion_class#accum_mult
Subroutine : | |
q : | type(field_dw_quark_wg), intent(inout) |
ccoef : | complex(DP), intent(in) |
q <= q * ccoef
Original external subprogram is field_5dfermion_class#accum_mult
Subroutine : | |
q : | type(field_dw_quark_wg), intent(inout) |
ccoef : | complex(DP), intent(in) |
q <= q * ccoef
Original external subprogram is field_5dfermion_class#accum_mult
Subroutine : | |
q : | type(field_dw_quark_wg), intent(inout) |
ccoef : | complex(DP), intent(in) |
q <= q * ccoef
Original external subprogram is field_5dfermion_class#accum_mult
Subroutine : | |
q : | type(field_dw_quark_wg), intent(inout) |
ccoef : | complex(DP), intent(in) |
q <= q * ccoef
Original external subprogram is field_5dfermion_class#accum_mult
Subroutine : | |
q : | type(field_dw_quark_wg), intent(inout) |
ccoef : | complex(DP), intent(in) |
q <= q * ccoef
Original external subprogram is field_5dfermion_class#accum_mult
Subroutine : | |
q : | type(field_dw_quark_wg), intent(inout) |
ccoef : | complex(DP), intent(in) |
q <= q * ccoef
Original external subprogram is field_5dfermion_class#accum_mult
Subroutine : | |
q : | type(field_dw_quark_wg), intent(inout) |
ccoef : | complex(DP), intent(in) |
q <= q * ccoef
Original external subprogram is field_5dfermion_class#accum_mult
Subroutine : | |
q : | type(field_dw_quark_wg), intent(inout) |
rcoef : | real(DP), intent(in) |
q <= q * rcoef
Original external subprogram is field_5dfermion_class#accum_mult
Subroutine : | |
q : | type(field_dw_quark_wg), intent(inout) |
rcoef : | real(DP), intent(in) |
q <= q * rcoef
Original external subprogram is field_5dfermion_class#accum_mult
Subroutine : | |
q : | type(field_dw_quark_wg), intent(inout) |
rcoef : | real(DP), intent(in) |
q <= q * rcoef
Original external subprogram is field_5dfermion_class#accum_mult
Subroutine : | |
q : | type(field_dw_quark_wg), intent(inout) |
rcoef : | real(DP), intent(in) |
q <= q * rcoef
Original external subprogram is field_5dfermion_class#accum_mult
Subroutine : | |
q : | type(field_dw_quark_wg), intent(inout) |
rcoef : | real(DP), intent(in) |
q <= q * rcoef
Original external subprogram is field_5dfermion_class#accum_mult
Subroutine : | |
q : | type(field_dw_quark_wg), intent(inout) |
rcoef : | real(DP), intent(in) |
q <= q * rcoef
Original external subprogram is field_5dfermion_class#accum_mult
Subroutine : | |
q : | type(field_dw_quark_wg), intent(inout) |
rcoef : | real(DP), intent(in) |
q <= q * rcoef
Original external subprogram is field_5dfermion_class#accum_mult
Subroutine : | |
q : | type(field_dw_quark_wg), intent(inout) |
rcoef : | real(DP), intent(in) |
q <= q * rcoef
Original external subprogram is field_5dfermion_class#accum_mult
Subroutine : | |
q1 : | type(field_quark_wg), intent(inout) |
coef : | complex(DP), intent(in) |
q1 <= q1 * coef
Original external subprogram is field_fermion_class#accum_mult
Subroutine : | |
q1 : | type(field_quark_wg), intent(inout) |
coef : | complex(DP), intent(in) |
q1 <= q1 * coef
Original external subprogram is field_fermion_class#accum_mult
Subroutine : | |
q1 : | type(field_quark_wg), intent(inout) |
coef : | complex(DP), intent(in) |
q1 <= q1 * coef
Original external subprogram is field_fermion_class#accum_mult
Subroutine : | |
q1 : | type(field_quark_wg), intent(inout) |
coef : | real(DP), intent(in) |
q1 <= q1 * coef
Original external subprogram is field_fermion_class#accum_mult
Subroutine : | |
q1 : | type(field_quark_wg), intent(inout) |
coef : | real(DP), intent(in) |
q1 <= q1 * coef
Original external subprogram is field_fermion_class#accum_mult
Subroutine : | |
q1 : | type(field_quark_wg), intent(inout) |
coef : | real(DP), intent(in) |
q1 <= q1 * coef
Original external subprogram is field_fermion_class#accum_mult
Subroutine : | |
q1 : | type(field_dw_quark_wg), intent(inout) |
rtmp : | real(DP), intent(in) |
ieo : | integer, intent(in) |
accumulate multiplication
q1 = q1 * rtmp on even/odd sites only.
Original external subprogram is field_5dfermion_class#accum_mult
Subroutine : | |
q1 : | type(field_dw_quark_wg), intent(inout) |
rtmp : | real(DP), intent(in) |
ieo : | integer, intent(in) |
accumulate multiplication
q1 = q1 * rtmp on even/odd sites only.
Original external subprogram is field_5dfermion_class#accum_mult
Subroutine : | |
q1 : | type(field_dw_quark_wg), intent(inout) |
rtmp : | real(DP), intent(in) |
ieo : | integer, intent(in) |
accumulate multiplication
q1 = q1 * rtmp on even/odd sites only.
Original external subprogram is field_5dfermion_class#accum_mult
Subroutine : | |
q1 : | type(field_dw_quark_wg), intent(inout) |
rtmp : | real(DP), intent(in) |
ieo : | integer, intent(in) |
accumulate multiplication
q1 = q1 * rtmp on even/odd sites only.
Original external subprogram is field_5dfermion_class#accum_mult
Subroutine : | |
q1 : | type(field_dw_quark_wg), intent(inout) |
rtmp : | real(DP), intent(in) |
ieo : | integer, intent(in) |
accumulate multiplication
q1 = q1 * rtmp on even/odd sites only.
Original external subprogram is field_5dfermion_class#accum_mult
Subroutine : | |
q1 : | type(field_dw_quark_wg), intent(inout) |
rtmp : | real(DP), intent(in) |
ieo : | integer, intent(in) |
accumulate multiplication
q1 = q1 * rtmp on even/odd sites only.
Original external subprogram is field_5dfermion_class#accum_mult
Subroutine : | |
q1 : | type(field_dw_quark_wg), intent(inout) |
rtmp : | real(DP), intent(in) |
ieo : | integer, intent(in) |
accumulate multiplication
q1 = q1 * rtmp on even/odd sites only.
Original external subprogram is field_5dfermion_class#accum_mult
Subroutine : | |
q1 : | type(field_dw_quark_wg), intent(inout) |
rtmp : | real(DP), intent(in) |
ieo : | integer, intent(in) |
accumulate multiplication
q1 = q1 * rtmp on even/odd sites only.
Original external subprogram is field_5dfermion_class#accum_mult
Subroutine : | |
q1e : | type(field_quark_eo_wg), intent(inout) |
coef : | complex(DP), intent(in) |
q1e <= q1e * coef
Original external subprogram is field_fermion_class#accum_mult
Subroutine : | |
q1e : | type(field_quark_eo_wg), intent(inout) |
coef : | complex(DP), intent(in) |
q1e <= q1e * coef
Original external subprogram is field_fermion_class#accum_mult
Subroutine : | |
q1e : | type(field_quark_eo_wg), intent(inout) |
coef : | complex(DP), intent(in) |
q1e <= q1e * coef
Original external subprogram is field_fermion_class#accum_mult
Subroutine : | |
q1e : | type(field_quark_eo_wg), intent(inout) |
coef : | real(DP), intent(in) |
q1e <= q1e * coef
Original external subprogram is field_fermion_class#accum_mult
Subroutine : | |
q1e : | type(field_quark_eo_wg), intent(inout) |
coef : | real(DP), intent(in) |
q1e <= q1e * coef
Original external subprogram is field_fermion_class#accum_mult
Subroutine : | |
q1e : | type(field_quark_eo_wg), intent(inout) |
coef : | real(DP), intent(in) |
q1e <= q1e * coef
Original external subprogram is field_fermion_class#accum_mult
Subroutine : | |
y : | type(field_dw_quark_wg), intent(inout) |
Multiply Dowmainwall fermion GAMMA5
y <= Gamma5 y
this includes permutaion in extra-dimension.
\[ y(n,s) <= gamma_5 y(n,NS-s+1) \]
with $ s=1,cdots,NS. $
subroutine accum_mult_gamma5_dwq(y) ! ! Multiply Dowmainwall fermion GAMMA5 ! ! y <= Gamma5 y ! ! this includes permutaion in extra-dimension. ! !\[ ! y(n,s) <= \gamma_5 y(n,NS-s+1) !\] ! ! with $ s=1,\cdots,NS. $ ! implicit none type(field_dw_quark_wg), intent(inout) :: y integer :: iw,ix,iy,iz,it,NS,ic,jw complex(DP) :: a1,a2,a3,a4 complex(DP) :: b1,b2,b3,b4 if ( (.not.is_allocated(y)) ) then call error_stop("5-dim size of y is wrong in accum_mult_gamma5_dwq.") endif NS = y%NS !$OMP PARALLEL DO & !$OMP PRIVATE(ix,iy,iz,it,iw,jw,ic,a1,a2,a3,a4,b1,b2,b3,b4) do ix=1,NX do iy=1,NY do iz=1,NZ do it=1,NT do iw=1,NS/2 jw = NS-iw+1 do ic=1,COL a1 = y%s(iw,it,iz,iy,ix)%y(ic,1) a2 = y%s(iw,it,iz,iy,ix)%y(ic,2) a3 = y%s(iw,it,iz,iy,ix)%y(ic,3) a4 = y%s(iw,it,iz,iy,ix)%y(ic,4) b1 = y%s(jw,it,iz,iy,ix)%y(ic,1) b2 = y%s(jw,it,iz,iy,ix)%y(ic,2) b3 = y%s(jw,it,iz,iy,ix)%y(ic,3) b4 = y%s(jw,it,iz,iy,ix)%y(ic,4) y%s(jw,it,iz,iy,ix)%y(ic,1) = a3 y%s(jw,it,iz,iy,ix)%y(ic,2) = a4 y%s(jw,it,iz,iy,ix)%y(ic,3) = a1 y%s(jw,it,iz,iy,ix)%y(ic,4) = a2 y%s(iw,it,iz,iy,ix)%y(ic,1) = b3 y%s(iw,it,iz,iy,ix)%y(ic,2) = b4 y%s(iw,it,iz,iy,ix)%y(ic,3) = b1 y%s(iw,it,iz,iy,ix)%y(ic,4) = b2 enddo enddo if (mod(NS,2)==1) then iw = NS/2 + 1 do ic=1,COL a1 = y%s(iw,it,iz,iy,ix)%y(ic,1) a2 = y%s(iw,it,iz,iy,ix)%y(ic,2) a3 = y%s(iw,it,iz,iy,ix)%y(ic,3) a4 = y%s(iw,it,iz,iy,ix)%y(ic,4) y%s(iw,it,iz,iy,ix)%y(ic,1) = a3 y%s(iw,it,iz,iy,ix)%y(ic,2) = a4 y%s(iw,it,iz,iy,ix)%y(ic,3) = a1 y%s(iw,it,iz,iy,ix)%y(ic,4) = a2 enddo endif enddo enddo enddo enddo return end subroutine
Subroutine : | |
y : | type(field_dw_quark_wg), intent(inout) |
Multiply Dowmainwall fermion GAMMA5
y <= Gamma5 y
this includes permutaion in extra-dimension.
\[ y(n,s) <= gamma_5 y(n,NS-s+1) \]
with $ s=1,cdots,NS. $
subroutine accum_mult_gamma5_dwq(y) ! ! Multiply Dowmainwall fermion GAMMA5 ! ! y <= Gamma5 y ! ! this includes permutaion in extra-dimension. ! !\[ ! y(n,s) <= \gamma_5 y(n,NS-s+1) !\] ! ! with $ s=1,\cdots,NS. $ ! implicit none type(field_dw_quark_wg), intent(inout) :: y integer :: iw,ix,iy,iz,it,NS,ic,jw complex(DP) :: a1,a2,a3,a4 complex(DP) :: b1,b2,b3,b4 if ( (.not.is_allocated(y)) ) then call error_stop("5-dim size of y is wrong in accum_mult_gamma5_dwq.") endif NS = y%NS !$OMP PARALLEL DO & !$OMP PRIVATE(ix,iy,iz,it,iw,jw,ic,a1,a2,a3,a4,b1,b2,b3,b4) do ix=1,NX do iy=1,NY do iz=1,NZ do it=1,NT do iw=1,NS/2 jw = NS-iw+1 do ic=1,COL a1 = y%s(iw,it,iz,iy,ix)%y(ic,1) a2 = y%s(iw,it,iz,iy,ix)%y(ic,2) a3 = y%s(iw,it,iz,iy,ix)%y(ic,3) a4 = y%s(iw,it,iz,iy,ix)%y(ic,4) b1 = y%s(jw,it,iz,iy,ix)%y(ic,1) b2 = y%s(jw,it,iz,iy,ix)%y(ic,2) b3 = y%s(jw,it,iz,iy,ix)%y(ic,3) b4 = y%s(jw,it,iz,iy,ix)%y(ic,4) y%s(jw,it,iz,iy,ix)%y(ic,1) = a3 y%s(jw,it,iz,iy,ix)%y(ic,2) = a4 y%s(jw,it,iz,iy,ix)%y(ic,3) = a1 y%s(jw,it,iz,iy,ix)%y(ic,4) = a2 y%s(iw,it,iz,iy,ix)%y(ic,1) = b3 y%s(iw,it,iz,iy,ix)%y(ic,2) = b4 y%s(iw,it,iz,iy,ix)%y(ic,3) = b1 y%s(iw,it,iz,iy,ix)%y(ic,4) = b2 enddo enddo if (mod(NS,2)==1) then iw = NS/2 + 1 do ic=1,COL a1 = y%s(iw,it,iz,iy,ix)%y(ic,1) a2 = y%s(iw,it,iz,iy,ix)%y(ic,2) a3 = y%s(iw,it,iz,iy,ix)%y(ic,3) a4 = y%s(iw,it,iz,iy,ix)%y(ic,4) y%s(iw,it,iz,iy,ix)%y(ic,1) = a3 y%s(iw,it,iz,iy,ix)%y(ic,2) = a4 y%s(iw,it,iz,iy,ix)%y(ic,3) = a1 y%s(iw,it,iz,iy,ix)%y(ic,4) = a2 enddo endif enddo enddo enddo enddo return end subroutine
Subroutine : | |
q1 : | type(field_dw_quark_wg), intent(inout) |
q2 : | type(field_dw_quark_wg), intent(in) |
q1 <= q1 - q2
Original external subprogram is field_5dfermion_class#accum_sub
Subroutine : | |
q1 : | type(field_dw_quark_wg), intent(inout) |
q2 : | type(field_dw_quark_wg), intent(in) |
q1 <= q1 - q2
Original external subprogram is field_5dfermion_class#accum_sub
Subroutine : | |
q1 : | type(field_dw_quark_wg), intent(inout) |
q2 : | type(field_dw_quark_wg), intent(in) |
q1 <= q1 - q2
Original external subprogram is field_5dfermion_class#accum_sub
Subroutine : | |
q1 : | type(field_dw_quark_wg), intent(inout) |
q2 : | type(field_dw_quark_wg), intent(in) |
q1 <= q1 - q2
Original external subprogram is field_5dfermion_class#accum_sub
Subroutine : | |
q1 : | type(field_dw_quark_wg), intent(inout) |
q2 : | type(field_dw_quark_wg), intent(in) |
q1 <= q1 - q2
Original external subprogram is field_5dfermion_class#accum_sub
Subroutine : | |
q1 : | type(field_dw_quark_wg), intent(inout) |
q2 : | type(field_dw_quark_wg), intent(in) |
q1 <= q1 - q2
Original external subprogram is field_5dfermion_class#accum_sub
Subroutine : | |
q1 : | type(field_dw_quark_wg), intent(inout) |
q2 : | type(field_dw_quark_wg), intent(in) |
q1 <= q1 - q2
Original external subprogram is field_5dfermion_class#accum_sub
Subroutine : | |
q1 : | type(field_dw_quark_wg), intent(inout) |
q2 : | type(field_dw_quark_wg), intent(in) |
q1 <= q1 - q2
Original external subprogram is field_5dfermion_class#accum_sub
Subroutine : | |
q1 : | type(field_dw_quark_wg), intent(inout) |
q2 : | type(field_dw_quark_wg), intent(in) |
ieo : | integer, intent(in) |
Accumulate subtraction
q1 = q1 - q2 on even/odd sites only.
Original external subprogram is field_5dfermion_class#accum_sub
Subroutine : | |
q1 : | type(field_dw_quark_wg), intent(inout) |
q2 : | type(field_dw_quark_wg), intent(in) |
ieo : | integer, intent(in) |
Accumulate subtraction
q1 = q1 - q2 on even/odd sites only.
Original external subprogram is field_5dfermion_class#accum_sub
Subroutine : | |
q1 : | type(field_dw_quark_wg), intent(inout) |
q2 : | type(field_dw_quark_wg), intent(in) |
ieo : | integer, intent(in) |
Accumulate subtraction
q1 = q1 - q2 on even/odd sites only.
Original external subprogram is field_5dfermion_class#accum_sub
Subroutine : | |
q1 : | type(field_dw_quark_wg), intent(inout) |
q2 : | type(field_dw_quark_wg), intent(in) |
ieo : | integer, intent(in) |
Accumulate subtraction
q1 = q1 - q2 on even/odd sites only.
Original external subprogram is field_5dfermion_class#accum_sub
Subroutine : | |
q1 : | type(field_dw_quark_wg), intent(inout) |
q2 : | type(field_dw_quark_wg), intent(in) |
ieo : | integer, intent(in) |
Accumulate subtraction
q1 = q1 - q2 on even/odd sites only.
Original external subprogram is field_5dfermion_class#accum_sub
Subroutine : | |
q1 : | type(field_dw_quark_wg), intent(inout) |
q2 : | type(field_dw_quark_wg), intent(in) |
ieo : | integer, intent(in) |
Accumulate subtraction
q1 = q1 - q2 on even/odd sites only.
Original external subprogram is field_5dfermion_class#accum_sub
Subroutine : | |
q1 : | type(field_dw_quark_wg), intent(inout) |
q2 : | type(field_dw_quark_wg), intent(in) |
ieo : | integer, intent(in) |
Accumulate subtraction
q1 = q1 - q2 on even/odd sites only.
Original external subprogram is field_5dfermion_class#accum_sub
Subroutine : | |
q1 : | type(field_dw_quark_wg), intent(inout) |
q2 : | type(field_dw_quark_wg), intent(in) |
ieo : | integer, intent(in) |
Accumulate subtraction
q1 = q1 - q2 on even/odd sites only.
Original external subprogram is field_5dfermion_class#accum_sub
Subroutine : | |
q2 : | type(field_quark_wg), intent(inout) |
q1 : | type(field_quark_wg), intent(in) |
q2 <= q2 - q1
Original external subprogram is field_fermion_class#accum_sub
Subroutine : | |
q2 : | type(field_quark_wg), intent(inout) |
q1 : | type(field_quark_wg), intent(in) |
q2 <= q2 - q1
Original external subprogram is field_fermion_class#accum_sub
Subroutine : | |
q2 : | type(field_quark_wg), intent(inout) |
q1 : | type(field_quark_wg), intent(in) |
q2 <= q2 - q1
Original external subprogram is field_fermion_class#accum_sub
Subroutine : | |
q2e : | type(field_quark_eo_wg), intent(inout) |
q1e : | type(field_quark_eo_wg), intent(in) |
q2e <= q2e - q1e
Original external subprogram is field_fermion_class#accum_sub
Subroutine : | |
q2e : | type(field_quark_eo_wg), intent(inout) |
q1e : | type(field_quark_eo_wg), intent(in) |
q2e <= q2e - q1e
Original external subprogram is field_fermion_class#accum_sub
Subroutine : | |
q2e : | type(field_quark_eo_wg), intent(inout) |
q1e : | type(field_quark_eo_wg), intent(in) |
q2e <= q2e - q1e
Original external subprogram is field_fermion_class#accum_sub
Subroutine : | |
u2e : | type(sfield_gluon_eo_wg), intent(inout) |
u1e : | type(sfield_gluon_eo_wg), intent(in) |
u2e <= u2e + u1e
Original external subprogram is field_gauge_class#accum_sub
Subroutine : | |
u2e : | type(sfield_gluon_eo_wg), intent(inout) |
u1e : | type(sfield_gluon_eo_wg), intent(in) |
u2e <= u2e + u1e
Original external subprogram is field_gauge_class#accum_sub
Subroutine : | |
u2e : | type(sfield_gluon_eo_wg), intent(inout) |
u1e : | type(sfield_gluon_eo_wg), intent(in) |
u2e <= u2e + u1e
Original external subprogram is field_gauge_class#accum_sub
Subroutine : | |
q : | type(field_dw_quark_wg), intent(inout) |
p : | type(field_dw_quark_wg), intent(in) |
q <= p
Original external subprogram is field_5dfermion_class#assign
Subroutine : | |
q : | type(field_dw_quark_wg), intent(inout) |
p : | type(field_dw_quark_wg), intent(in) |
q <= p
Original external subprogram is field_5dfermion_class#assign
Subroutine : | |
q : | type(field_dw_quark_wg), intent(inout) |
p : | type(field_dw_quark_wg), intent(in) |
q <= p
Original external subprogram is field_5dfermion_class#assign
Subroutine : | |
q : | type(field_dw_quark_wg), intent(inout) |
p : | type(field_dw_quark_wg), intent(in) |
q <= p
Original external subprogram is field_5dfermion_class#assign
Subroutine : | |
q : | type(field_dw_quark_wg), intent(inout) |
p : | type(field_dw_quark_wg), intent(in) |
q <= p
Original external subprogram is field_5dfermion_class#assign
Subroutine : | |
q : | type(field_dw_quark_wg), intent(inout) |
p : | type(field_dw_quark_wg), intent(in) |
q <= p
Original external subprogram is field_5dfermion_class#assign
Subroutine : | |
q : | type(field_dw_quark_wg), intent(inout) |
p : | type(field_dw_quark_wg), intent(in) |
q <= p
Original external subprogram is field_5dfermion_class#assign
Subroutine : | |
q : | type(field_dw_quark_wg), intent(inout) |
p : | type(field_dw_quark_wg), intent(in) |
q <= p
Original external subprogram is field_5dfermion_class#assign
Subroutine : | |
q1 : | type(field_dw_quark_wg), intent(inout) |
q2 : | type(field_dw_quark_wg), intent(in) |
ieo : | integer, intent(in) |
Assign subtraction
q1 = q2 on even/odd sites only.
Original external subprogram is field_5dfermion_class#assign
Subroutine : | |
q1 : | type(field_dw_quark_wg), intent(inout) |
q2 : | type(field_dw_quark_wg), intent(in) |
ieo : | integer, intent(in) |
Assign subtraction
q1 = q2 on even/odd sites only.
Original external subprogram is field_5dfermion_class#assign
Subroutine : | |
q1 : | type(field_dw_quark_wg), intent(inout) |
q2 : | type(field_dw_quark_wg), intent(in) |
ieo : | integer, intent(in) |
Assign subtraction
q1 = q2 on even/odd sites only.
Original external subprogram is field_5dfermion_class#assign
Subroutine : | |
q1 : | type(field_dw_quark_wg), intent(inout) |
q2 : | type(field_dw_quark_wg), intent(in) |
ieo : | integer, intent(in) |
Assign subtraction
q1 = q2 on even/odd sites only.
Original external subprogram is field_5dfermion_class#assign
Subroutine : | |
q1 : | type(field_dw_quark_wg), intent(inout) |
q2 : | type(field_dw_quark_wg), intent(in) |
ieo : | integer, intent(in) |
Assign subtraction
q1 = q2 on even/odd sites only.
Original external subprogram is field_5dfermion_class#assign
Subroutine : | |
q1 : | type(field_dw_quark_wg), intent(inout) |
q2 : | type(field_dw_quark_wg), intent(in) |
ieo : | integer, intent(in) |
Assign subtraction
q1 = q2 on even/odd sites only.
Original external subprogram is field_5dfermion_class#assign
Subroutine : | |
q1 : | type(field_dw_quark_wg), intent(inout) |
q2 : | type(field_dw_quark_wg), intent(in) |
ieo : | integer, intent(in) |
Assign subtraction
q1 = q2 on even/odd sites only.
Original external subprogram is field_5dfermion_class#assign
Subroutine : | |
q1 : | type(field_dw_quark_wg), intent(inout) |
q2 : | type(field_dw_quark_wg), intent(in) |
ieo : | integer, intent(in) |
Assign subtraction
q1 = q2 on even/odd sites only.
Original external subprogram is field_5dfermion_class#assign
Subroutine : | |
q2 : | type(field_quark_wg), intent(inout) |
q1 : | type(field_quark_wg), intent(in) |
q2 <= q1
Original external subprogram is field_fermion_class#assign
Subroutine : | |
q2 : | type(field_quark_wg), intent(inout) |
q1 : | type(field_quark_wg), intent(in) |
q2 <= q1
Original external subprogram is field_fermion_class#assign
Subroutine : | |
q2 : | type(field_quark_wg), intent(inout) |
q1 : | type(field_quark_wg), intent(in) |
q2 <= q1
Original external subprogram is field_fermion_class#assign
Subroutine : | |
q2e : | type(field_quark_eo_wg), intent(inout) |
q1e : | type(field_quark_eo_wg), intent(in) |
q2 <= q1
Original external subprogram is field_fermion_class#assign
Subroutine : | |
q2e : | type(field_quark_eo_wg), intent(inout) |
q1e : | type(field_quark_eo_wg), intent(in) |
q2 <= q1
Original external subprogram is field_fermion_class#assign
Subroutine : | |
q2e : | type(field_quark_eo_wg), intent(inout) |
q1e : | type(field_quark_eo_wg), intent(in) |
q2 <= q1
Original external subprogram is field_fermion_class#assign
Subroutine : | |
qp1 : | type(quark_wilson), intent(inout) |
qp2 : | type(quark_wilson), intent(in) |
Original external subprogram is quark_wilson_class#assign
Subroutine : | |
qp1 : | type(quark_wilson), intent(inout) |
qp2 : | type(quark_wilson), intent(in) |
Original external subprogram is quark_wilson_class#assign
Subroutine : | |
qp1 : | type(quark_wilson), intent(inout) |
qp2 : | type(quark_wilson), intent(in) |
Original external subprogram is quark_wilson_class#assign
Subroutine : | |
u2e : | type(sfield_gluon_eo_wg), intent(inout) |
u1e : | type(sfield_gluon_eo_wg), intent(in) |
u2e <= u1e
Original external subprogram is field_gauge_class#assign
Subroutine : | |
u2e : | type(sfield_gluon_eo_wg), intent(inout) |
u1e : | type(sfield_gluon_eo_wg), intent(in) |
u2e <= u1e
Original external subprogram is field_gauge_class#assign
Subroutine : | |
u2e : | type(sfield_gluon_eo_wg), intent(inout) |
u1e : | type(sfield_gluon_eo_wg), intent(in) |
u2e <= u1e
Original external subprogram is field_gauge_class#assign
Subroutine : | |
q3 : | type(field_quark_wg), intent(inout) |
q1 : | type(field_quark_wg), intent(in) |
q2 : | type(field_quark_wg), intent(in) |
q3 <= q1 + q2
Original external subprogram is field_5dfermion_class#assign_add
Subroutine : | |
q3 : | type(field_quark_wg), intent(inout) |
q1 : | type(field_quark_wg), intent(in) |
q2 : | type(field_quark_wg), intent(in) |
q3 <= q1 + q2
Original external subprogram is field_5dfermion_class#assign_add
Subroutine : | |
q3 : | type(field_quark_wg), intent(inout) |
q1 : | type(field_quark_wg), intent(in) |
q2 : | type(field_quark_wg), intent(in) |
q3 <= q1 + q2
Original external subprogram is field_5dfermion_class#assign_add
Subroutine : | |
q3 : | type(field_quark_wg), intent(inout) |
q1 : | type(field_quark_wg), intent(in) |
q2 : | type(field_quark_wg), intent(in) |
q3 <= q1 + q2
Original external subprogram is field_5dfermion_class#assign_add
Subroutine : | |
q3 : | type(field_quark_wg), intent(inout) |
q1 : | type(field_quark_wg), intent(in) |
q2 : | type(field_quark_wg), intent(in) |
q3 <= q1 + q2
Original external subprogram is field_fermion_class#assign_add
Subroutine : | |
q3 : | type(field_quark_wg), intent(inout) |
q1 : | type(field_quark_wg), intent(in) |
q2 : | type(field_quark_wg), intent(in) |
q3 <= q1 + q2
Original external subprogram is field_fermion_class#assign_add
Subroutine : | |
q3 : | type(field_quark_wg), intent(inout) |
q1 : | type(field_quark_wg), intent(in) |
q2 : | type(field_quark_wg), intent(in) |
q3 <= q1 + q2
Original external subprogram is field_fermion_class#assign_add
Subroutine : | |
q3e : | type(field_quark_eo_wg), intent(inout) |
q1e : | type(field_quark_eo_wg), intent(in) |
q2e : | type(field_quark_eo_wg), intent(in) |
q3e <= q1e + q2e
Original external subprogram is field_5dfermion_class#assign_add
Subroutine : | |
q3e : | type(field_quark_eo_wg), intent(inout) |
q1e : | type(field_quark_eo_wg), intent(in) |
q2e : | type(field_quark_eo_wg), intent(in) |
q3e <= q1e + q2e
Original external subprogram is field_5dfermion_class#assign_add
Subroutine : | |
q3e : | type(field_quark_eo_wg), intent(inout) |
q1e : | type(field_quark_eo_wg), intent(in) |
q2e : | type(field_quark_eo_wg), intent(in) |
q3e <= q1e + q2e
Original external subprogram is field_5dfermion_class#assign_add
Subroutine : | |
q3e : | type(field_quark_eo_wg), intent(inout) |
q1e : | type(field_quark_eo_wg), intent(in) |
q2e : | type(field_quark_eo_wg), intent(in) |
q3e <= q1e + q2e
Original external subprogram is field_5dfermion_class#assign_add
Subroutine : | |
q3e : | type(field_quark_eo_wg), intent(inout) |
q1e : | type(field_quark_eo_wg), intent(in) |
q2e : | type(field_quark_eo_wg), intent(in) |
q3e <= q1e + q2e
Original external subprogram is field_fermion_class#assign_add
Subroutine : | |
q3e : | type(field_quark_eo_wg), intent(inout) |
q1e : | type(field_quark_eo_wg), intent(in) |
q2e : | type(field_quark_eo_wg), intent(in) |
q3e <= q1e + q2e
Original external subprogram is field_fermion_class#assign_add
Subroutine : | |
q3e : | type(field_quark_eo_wg), intent(inout) |
q1e : | type(field_quark_eo_wg), intent(in) |
q2e : | type(field_quark_eo_wg), intent(in) |
q3e <= q1e + q2e
Original external subprogram is field_fermion_class#assign_add
Subroutine : | |
u3e : | type(sfield_gluon_eo_wg), intent(inout) |
u1e : | type(sfield_gluon_eo_wg), intent(in) |
u2e : | type(sfield_gluon_eo_wg), intent(in) |
u3e <= u1e + u2e
Original external subprogram is field_5dfermion_class#assign_add
Subroutine : | |
u3e : | type(sfield_gluon_eo_wg), intent(inout) |
u1e : | type(sfield_gluon_eo_wg), intent(in) |
u2e : | type(sfield_gluon_eo_wg), intent(in) |
u3e <= u1e + u2e
Original external subprogram is field_5dfermion_class#assign_add
Subroutine : | |
u3e : | type(sfield_gluon_eo_wg), intent(inout) |
u1e : | type(sfield_gluon_eo_wg), intent(in) |
u2e : | type(sfield_gluon_eo_wg), intent(in) |
u3e <= u1e + u2e
Original external subprogram is field_5dfermion_class#assign_add
Subroutine : | |
u3e : | type(sfield_gluon_eo_wg), intent(inout) |
u1e : | type(sfield_gluon_eo_wg), intent(in) |
u2e : | type(sfield_gluon_eo_wg), intent(in) |
u3e <= u1e + u2e
Original external subprogram is field_5dfermion_class#assign_add
Subroutine : | |
u3e : | type(sfield_gluon_eo_wg), intent(inout) |
u1e : | type(sfield_gluon_eo_wg), intent(in) |
u2e : | type(sfield_gluon_eo_wg), intent(in) |
u3e <= u1e + u2e
Original external subprogram is field_gauge_class#assign_add
Subroutine : | |
u3e : | type(sfield_gluon_eo_wg), intent(inout) |
u1e : | type(sfield_gluon_eo_wg), intent(in) |
u2e : | type(sfield_gluon_eo_wg), intent(in) |
u3e <= u1e + u2e
Original external subprogram is field_gauge_class#assign_add
Subroutine : | |
u3e : | type(sfield_gluon_eo_wg), intent(inout) |
u1e : | type(sfield_gluon_eo_wg), intent(in) |
u2e : | type(sfield_gluon_eo_wg), intent(in) |
u3e <= u1e + u2e
Original external subprogram is field_gauge_class#assign_add
Subroutine : | |
this : | class(quark_domainwall), intent(inout) |
iout : | integer, intent(in) |
tol : | real(DP), intent(in) |
iiter : | integer, intent(inout) |
dy : | type(field_dw_quark_wg), intent(inout) |
y : | type(field_dw_quark_wg), intent(inout) |
u : | type(vfield_gluon_wg), intent(in) |
LV : | type(dwf_low_modes), intent(in) |
Assign and multiply inverse low-mode improved Domainwall operator
dy <= Ddw \ y
using CGNE solver
subroutine assign_inv_mult_lowprojd_dwq(this,iout,tol,iiter,dy,y,u,LV) ! ! Assign and multiply inverse low-mode improved Domainwall operator ! ! dy <= Ddw \ y ! ! using CGNE solver ! use solver_class use counter_class implicit none class(quark_domainwall), intent(inout) :: this integer, intent(in) :: iout real(DP), intent(in) :: tol integer, intent(inout) :: iiter type(field_dw_quark_wg), intent(inout) :: dy type(field_dw_quark_wg), intent(inout) :: y type(vfield_gluon_wg), intent(in) :: u type(dwf_low_modes), intent(in) :: LV #if _PREC_ == _PREC_EO_ integer, parameter :: SLV_NSITE=COL*SPIN*NTH*NZ*NY*NX #else integer, parameter :: SLV_NSITE=COL*SPIN*NT*NZ*NY*NX #endif #if _PREC_ == _PREC_EO_ type(vfield_dw_gluon_wg), allocatable :: vu complex(DP), allocatable :: GGo(:,:,:,:) integer :: ieo,ioe type(field_dw_quark_wg), allocatable :: bb #endif type(field_dw_quark_wg), allocatable :: w,v type(cg_alg), allocatable :: solver type(timer) :: solver_time character(CHARLEN) :: str real(DP) :: etime,rtmp0,rtmp1 integer :: NS,istat,mult_count type(counter) :: imult call new(solver_time) call tic(solver_time) NS = this%NS if (NS /= y%NS) then call error_stop("this%NY /= y%NS, input y is wrong in assign_inv_mult_lowprojd_dwq.") endif if (NS /= dy%NS) then call new(dy,NS) endif allocate(w,v) call new(w,this%NS) call new(v,this%NS) imult = mult_iter !============================================== ! CGNE is used to solve ! D x = y. ! ! (D' D) x = D' y ! !============================================== #if _PREC_ == _PREC_NON_ !============== ! set source ! w = D' y !============== call assign_mult_dwf(this,LV,w,y,u,dagger=.true.) #elif _PREC_ == _PREC_EO_ ieo = 0 ioe = 1-ieo allocate(vu) allocate(GGo(LV%NEV,NS,LV%NEV,NS)) call conv_f_dwg_wg(u,vu) call make_midterm_eoprec_lowprojd_dwq(this,ioe,LV,GGo) call set_eoprec_lowprojd_source_dwq(this,ieo,LV,GGo,w,y,vu) #endif !============== ! set solver !============== allocate(solver) call new(solver,NSIZE=SLV_NSITE*NS,mode=MODE_NORMAL ,max_iter=iiter,tol=tol) #if _PREC_ == _PREC_EO_ call pack(w,solver%src_vec(:),ieo) #else call pack(w,solver%src_vec(:)) #endif !======================= ! start CG Solver !======================= do call solve(solver) istat = get_status(solver) select case(istat) case (OP_NOP) cycle case (OP_DO_MATVEC) !=================== ! Multiply (D'D) !=================== #if _PREC_ == _PREC_NON_ call unpack(solver%src_vec,w) call assign_mult_dwf(this,LV,v,w,u) call assign_mult_dwf(this,LV,w,v,u,dagger=.true.) call pack(w,solver%dst_vec) #elif _PREC_ == _PREC_EO_ call unpack(solver%src_vec,w,ieo) call assign_mult_eoprec_lowprojd_dwq(this,ieo,LV,GGo,v,w,vu,dagger=.true.) call assign_mult_eoprec_lowprojd_dwq(this,ieo,LV,GGo,w,v,vu) call pack(w,solver%dst_vec,ieo) #endif case (OP_PRINT_STATUS) #ifdef _DEBUG if (nodeid == 0) then mult_count = get_count(mult_iter) - get_count(imult) write(iout,'("#",I5," ERR_=",E24.16," MULT_=",I10)') get_current_iteration(solver), get_residual_norm(solver),mult_count write(* ,'("#",I5," ERR_=",E24.16," MULT_=",I10)') get_current_iteration(solver), get_residual_norm(solver),mult_count endif #endif cycle case (OP_CONVERGED) if (nodeid == 0) then mult_count = get_count(mult_iter) - get_count(imult) write(iout,'("#",A," iteration converged.")')TRIM(get_name(solver)) write(iout,'("#",I5," ERR_=",E24.16," MULT_=",I10)',advance='no') get_current_iteration(solver), get_residual_norm(solver),mult_count endif exit case (OP_MAXITER_REACHED) if (nodeid == 0) then mult_count = get_count(mult_iter) - get_count(imult) write(iout,'("#",A," iteration does not converge.")')TRIM(get_name(solver)) write(iout,'("#",I5," ERR_=",E24.16," MULT_=",I10)',advance='no') get_current_iteration(solver), get_residual_norm(solver),mult_count endif write(str,'("solver did not converge.: ",A,I4)')__FILE__,__LINE__ call error_stop(str) case default write(str,'("something is wrong in solver.: ",A,I4)')__FILE__,__LINE__ call error_stop(str) end select enddo #if _PREC_ == _PREC_EO_ call unpack(solver%dst_vec,v,ieo) call assign_mult_eoprec_lowprojd_dwq(this,ieo,LV,GGo,w,v,vu,dagger=.true.) call get_eoprec_lowprojd_sol_dwq(this,ieo,LV,GGo,w,y,vu) call assign_mult_invmprec_dwq(this,dy,w) deallocate(vu) deallocate(GGo) #else call unpack(solver%dst_vec,dy) #endif call delete(v) call delete(w) deallocate(w,v) iiter = get_current_iteration(solver) call delete(solver) deallocate(solver) !============================================ ! NOTE: get_elapse contains comlib_sumcast. ! This means that get_elapse should not used ! in if-(nodeid==0)-then-endif block. !============================================ call toc(solver_time) etime = get_elapse(solver_time) if (nodeid == 0) then write(iout,'(" ETIME_=",E24.16)')etime endif #ifdef _DEBUG allocate(w) call new(w,this%NS) call assign_mult_dwf(this,w,dy,u,LV) call accum_sub(w,y) rtmp0 = abs2(w) rtmp1 = abs2(y) if (nodeid==0) then write(iout,'("%",I5," ERR_=",3E24.16)',advance='no') iiter,sqrt(rtmp0/rtmp1),sqrt(rtmp0),sqrt(rtmp1) write(iout,'(" ETIME_=",E24.16)')etime write(* ,'("%",I5," ERR_=",3E24.16)',advance='no') iiter,sqrt(rtmp0/rtmp1),sqrt(rtmp0),sqrt(rtmp1) write(* ,'(" ETIME_=",E24.16)')etime endif call delete(w) deallocate(w) #endif return end subroutine
Subroutine : | |
this : | class(quark_domainwall), intent(inout) |
iout : | integer, intent(in) |
tol : | real(DP), intent(in) |
iiter : | integer, intent(inout) |
dy : | type(field_dw_quark_wg), intent(inout) |
y : | type(field_dw_quark_wg), intent(inout) |
u : | type(vfield_gluon_wg), intent(in) |
LV : | type(dwf_low_modes), intent(in) |
Assign and multiply inverse low-mode improved Domainwall operator
dy <= Ddw \ y
using CGNE solver
subroutine assign_inv_mult_lowprojd_dwq(this,iout,tol,iiter,dy,y,u,LV) ! ! Assign and multiply inverse low-mode improved Domainwall operator ! ! dy <= Ddw \ y ! ! using CGNE solver ! use solver_class use counter_class implicit none class(quark_domainwall), intent(inout) :: this integer, intent(in) :: iout real(DP), intent(in) :: tol integer, intent(inout) :: iiter type(field_dw_quark_wg), intent(inout) :: dy type(field_dw_quark_wg), intent(inout) :: y type(vfield_gluon_wg), intent(in) :: u type(dwf_low_modes), intent(in) :: LV #if _PREC_ == _PREC_EO_ integer, parameter :: SLV_NSITE=COL*SPIN*NTH*NZ*NY*NX #else integer, parameter :: SLV_NSITE=COL*SPIN*NT*NZ*NY*NX #endif #if _PREC_ == _PREC_EO_ type(vfield_dw_gluon_wg), allocatable :: vu complex(DP), allocatable :: GGo(:,:,:,:) integer :: ieo,ioe type(field_dw_quark_wg), allocatable :: bb #endif type(field_dw_quark_wg), allocatable :: w,v type(cg_alg), allocatable :: solver type(timer) :: solver_time character(CHARLEN) :: str real(DP) :: etime,rtmp0,rtmp1 integer :: NS,istat,mult_count type(counter) :: imult call new(solver_time) call tic(solver_time) NS = this%NS if (NS /= y%NS) then call error_stop("this%NY /= y%NS, input y is wrong in assign_inv_mult_lowprojd_dwq.") endif if (NS /= dy%NS) then call new(dy,NS) endif allocate(w,v) call new(w,this%NS) call new(v,this%NS) imult = mult_iter !============================================== ! CGNE is used to solve ! D x = y. ! ! (D' D) x = D' y ! !============================================== #if _PREC_ == _PREC_NON_ !============== ! set source ! w = D' y !============== call assign_mult_dwf(this,LV,w,y,u,dagger=.true.) #elif _PREC_ == _PREC_EO_ ieo = 0 ioe = 1-ieo allocate(vu) allocate(GGo(LV%NEV,NS,LV%NEV,NS)) call conv_f_dwg_wg(u,vu) call make_midterm_eoprec_lowprojd_dwq(this,ioe,LV,GGo) call set_eoprec_lowprojd_source_dwq(this,ieo,LV,GGo,w,y,vu) #endif !============== ! set solver !============== allocate(solver) call new(solver,NSIZE=SLV_NSITE*NS,mode=MODE_NORMAL ,max_iter=iiter,tol=tol) #if _PREC_ == _PREC_EO_ call pack(w,solver%src_vec(:),ieo) #else call pack(w,solver%src_vec(:)) #endif !======================= ! start CG Solver !======================= do call solve(solver) istat = get_status(solver) select case(istat) case (OP_NOP) cycle case (OP_DO_MATVEC) !=================== ! Multiply (D'D) !=================== #if _PREC_ == _PREC_NON_ call unpack(solver%src_vec,w) call assign_mult_dwf(this,LV,v,w,u) call assign_mult_dwf(this,LV,w,v,u,dagger=.true.) call pack(w,solver%dst_vec) #elif _PREC_ == _PREC_EO_ call unpack(solver%src_vec,w,ieo) call assign_mult_eoprec_lowprojd_dwq(this,ieo,LV,GGo,v,w,vu,dagger=.true.) call assign_mult_eoprec_lowprojd_dwq(this,ieo,LV,GGo,w,v,vu) call pack(w,solver%dst_vec,ieo) #endif case (OP_PRINT_STATUS) #ifdef _DEBUG if (nodeid == 0) then mult_count = get_count(mult_iter) - get_count(imult) write(iout,'("#",I5," ERR_=",E24.16," MULT_=",I10)') get_current_iteration(solver), get_residual_norm(solver),mult_count write(* ,'("#",I5," ERR_=",E24.16," MULT_=",I10)') get_current_iteration(solver), get_residual_norm(solver),mult_count endif #endif cycle case (OP_CONVERGED) if (nodeid == 0) then mult_count = get_count(mult_iter) - get_count(imult) write(iout,'("#",A," iteration converged.")')TRIM(get_name(solver)) write(iout,'("#",I5," ERR_=",E24.16," MULT_=",I10)',advance='no') get_current_iteration(solver), get_residual_norm(solver),mult_count endif exit case (OP_MAXITER_REACHED) if (nodeid == 0) then mult_count = get_count(mult_iter) - get_count(imult) write(iout,'("#",A," iteration does not converge.")')TRIM(get_name(solver)) write(iout,'("#",I5," ERR_=",E24.16," MULT_=",I10)',advance='no') get_current_iteration(solver), get_residual_norm(solver),mult_count endif write(str,'("solver did not converge.: ",A,I4)')__FILE__,__LINE__ call error_stop(str) case default write(str,'("something is wrong in solver.: ",A,I4)')__FILE__,__LINE__ call error_stop(str) end select enddo #if _PREC_ == _PREC_EO_ call unpack(solver%dst_vec,v,ieo) call assign_mult_eoprec_lowprojd_dwq(this,ieo,LV,GGo,w,v,vu,dagger=.true.) call get_eoprec_lowprojd_sol_dwq(this,ieo,LV,GGo,w,y,vu) call assign_mult_invmprec_dwq(this,dy,w) deallocate(vu) deallocate(GGo) #else call unpack(solver%dst_vec,dy) #endif call delete(v) call delete(w) deallocate(w,v) iiter = get_current_iteration(solver) call delete(solver) deallocate(solver) !============================================ ! NOTE: get_elapse contains comlib_sumcast. ! This means that get_elapse should not used ! in if-(nodeid==0)-then-endif block. !============================================ call toc(solver_time) etime = get_elapse(solver_time) if (nodeid == 0) then write(iout,'(" ETIME_=",E24.16)')etime endif #ifdef _DEBUG allocate(w) call new(w,this%NS) call assign_mult_dwf(this,w,dy,u,LV) call accum_sub(w,y) rtmp0 = abs2(w) rtmp1 = abs2(y) if (nodeid==0) then write(iout,'("%",I5," ERR_=",3E24.16)',advance='no') iiter,sqrt(rtmp0/rtmp1),sqrt(rtmp0),sqrt(rtmp1) write(iout,'(" ETIME_=",E24.16)')etime write(* ,'("%",I5," ERR_=",3E24.16)',advance='no') iiter,sqrt(rtmp0/rtmp1),sqrt(rtmp0),sqrt(rtmp1) write(* ,'(" ETIME_=",E24.16)')etime endif call delete(w) deallocate(w) #endif return end subroutine
Subroutine : | |
this : | class(quark_domainwall), intent(in) |
iout : | integer, intent(in) |
tol : | real(DP), intent(in) |
iiter : | integer, intent(inout) |
dy : | type(field_dw_quark_wg), intent(inout) |
y : | type(field_dw_quark_wg), intent(inout) |
u : | type(vfield_gluon_wg), intent(in) |
dagger : | logical, optional, intent(in) |
cron : | type(chrolog_alg), optional, intent(inout) |
Assign and multiply inverse Domainwall operator
dy <= Ddw \ y
or
dy <= Ddw^dag \ y
using CGNE solver
subroutine assign_inv_mult_dwq_all(this,iout,tol,iiter,dy,y,u,dagger,cron) ! ! Assign and multiply inverse Domainwall operator ! ! dy <= Ddw \ y ! ! or ! ! dy <= Ddw^dag \ y ! ! using CGNE solver ! use solver_class use counter_class #ifdef _PERFMON_ use perfmon_class #endif implicit none class(quark_domainwall), intent(in) :: this integer, intent(in) :: iout real(DP), intent(in) :: tol integer, intent(inout) :: iiter type(field_dw_quark_wg), intent(inout) :: dy type(field_dw_quark_wg), intent(inout) :: y type(vfield_gluon_wg), intent(in) :: u logical, optional, intent(in) :: dagger type(chrolog_alg), optional, intent(inout) :: cron type(field_dw_quark_wg), allocatable :: w,v,yy type(vfield_dw_gluon_wg), allocatable :: vu #if _PREC_ == _PREC_EO_ integer :: ieo,ioe integer, parameter :: SLV_NSITE=COL*SPIN*NTH*NZ*NY*NX #else integer, parameter :: SLV_NSITE=COL*SPIN*NT*NZ*NY*NX #endif character(CHARLEN) :: str real(DP) :: etime,rtmp0,rtmp1 type(timer) :: solver_time integer :: NS,istat,mult_count type(counter) :: imult type(cg_alg), allocatable :: solver integer :: i,j,NEV complex(DP) :: ctmp logical :: is_dagger logical :: do_cron #if _PREC_ == _PREC_4DSSOR_ real(DP), parameter :: omega = 1.5_DP real(DP), parameter :: omg2 = omega - 2.0_DP real(DP), parameter :: omginv = 1.0_DP/omega #endif #ifdef _PERFMON_ real(DP) :: fp0,fp1 type(flop_counter) :: flop call new(flop) #endif ! write(*,*)"assign_inv_mult_dwq_all" call new(solver_time) call tic(solver_time) if (present(dagger)) then is_dagger = .true. else is_dagger = .false. endif NS = this%NS if (NS /= y%NS) then call error_stop("this%NY /= y%NS, input y is wrong in assign_in_mult_dwq.") endif if (NS /= dy%NS) then call new(dy,NS) endif allocate(w,v) call new(w,this%NS) call new(v,this%NS) imult = mult_iter !============================================== ! CGNE is used to solve ! ! D x = y. ! ! D^dag D x = D^dag y ! ! or ! ! D^dag x = y. ! ! D D^dag x = D y ! !============================================== ! ! set source for CGNE ! ! w = D^dag y ! ! or ! ! w = D y ! #if _PREC_ == _PREC_NON_ if (.not.is_dagger) then call assign_mult_dagger_dwq(this,w,y,u) else call assign_mult_dwq(this,w,y,u) endif #elif _PREC_ == _PREC_EO_ ieo = 0 ioe = 1-ieo allocate(vu) call conv_f_dwg_wg(u,vu) if (.not.is_dagger) then call assign_inv_mult_ee_dwq(this,ioe,w,y) ! wo = Doo \ yo call assign_mult_eo_dwq(this,ieo,v,w,vu) ! ve = Deo wo call assign_sub(w,y,v,ieo) ! we = ye - ve call assign_inv_mult_ee_dwq(this,ieo,v,w) ! ve = Dee \ we call assign_mult_eoprec_dwq(this,ieo,w,v,vu,dagger=.true.) ! we = hat{Dee}^dag \ ve else ! write(*,*)"dagger mode" allocate(yy) call new(yy,this%NS) call assign_mult_invmprec_dwq(this,yy,y,dagger=.true.) ! yy = MB \ y call assign_inv_mult_ee_dwq(this,ioe,v,yy,dagger=.true.) ! vo = Doo \ yyo call assign_mult_eo_dwq(this,ieo,w,v,vu,dagger=.true.) ! we = Deo vo call assign_sub(v,yy,w,ieo) ! ve = yye - we call assign_mult_eoprec_dwq(this,ieo,w,v,vu) ! we = hat{Dee} \ ve endif #elif _PREC_ == _PREC_4DSSOR_ allocate(vu) call conv_f_dwg_wg(u,vu) if (.not.is_dagger) then call assign_mult_dagger_dwq(this,v,y,u) call assign_mult_invmprec_dwq(this,w,v,dagger=.true.) call assign_inv_mult2_diag_dwq(this,v,w) call assign_inv_mult2_forw_4dssor_dwq(this,omega,w,v,vu,forw=.true.) else call error_stop("assign_inv_mult_dwf for dagger is not implemented.") endif #endif !================================ ! set source and guess to solver !================================ do_cron = .false. if (present(cron)) then if (has_history(cron)) then do_cron = .true. endif endif if (do_cron) then !=================================== ! start Chronological guess solver !=================================== if (nodeid == 0) then write(iout,'("#CRON USED")') #ifdef _DEBUG write(* ,'("#CRON USED")') #endif endif #if _PREC_ == _PREC_EO_ call pack(w,cron%src_vec(:),ieo) #else call pack(w,cron%src_vec(:)) #endif do call solve(cron) select case(get_status(cron)) case (CHRON_OP_NOP) cycle case (CHRON_OP_DO_MATVEC) #if _PREC_ == _PREC_NON_ call unpack(cron%src_vec,w) if (.not.is_dagger) then ! ! w <= D^dag D w ! call assign_mult_dwq(this,v,w,u) call assign_mult_dagger_dwq(this,w,v,u) else ! ! w <= D D^dag w ! call assign_mult_dagger_dwq(this,v,w,u) call assign_mult_dwq(this,w,v,u) endif call pack(w,cron%dst_vec) #elif _PREC_ == _PREC_EO_ call unpack(cron%src_vec,w,ieo) if (.not.is_dagger) then ! ! w <= D^dag D w ! call assign_mult_eoprec_dwq(this,ieo,v,w,vu) call assign_mult_eoprec_dwq(this,ieo,w,v,vu,dagger=.true.) else ! ! w <= D D^dag w ! call assign_mult_eoprec_dwq(this,ieo,v,w,vu,dagger=.true.) call assign_mult_eoprec_dwq(this,ieo,w,v,vu) endif call pack(w,cron%dst_vec,ieo) #elif _PREC_ == _PREC_4DSSOR_ call unpack(cron%src_vec,w) if (.not.is_dagger) then call assign_inv_mult2_forw_4dssor_dwq(this,omega,dy,w,vu,forw=.false.) ! dy = BACK w call accum_add_mult(w,dy,omg2) ! w = w + dy * omg2 call assign_inv_mult2_forw_4dssor_dwq(this,omega, v,w,vu,forw=.true.) ! v = FORW w call accum_add(v,dy) ! v = v + dy call accum_mult(v,omginv) ! v = v * omginv endif call pack(v,cron%dst_vec) #endif case (CHRON_OP_CONVERGED) if (nodeid == 0) then mult_count = get_count(mult_iter) - get_count(imult) write(iout,'("#",I5," ERR_=",E24.16," MULT_=",I10)') 0, get_residual_norm(cron),mult_count #ifdef _DEBUG write(* ,'("#",I5," ERR_=",E24.16," MULT_=",I10)') 0, get_residual_norm(cron),mult_count #endif endif exit end select enddo allocate(solver) call new(solver,NSIZE=SLV_NSITE*NS,guess=GUESS_USE,mode=MODE_NORMAL ,max_iter=iiter,tol=tol) solver%src_vec(:) = cron%src_vec(:) solver%dst_vec(:) = cron%dst_vec(:) else allocate(solver) call new(solver,NSIZE=SLV_NSITE*NS,mode=MODE_NORMAL ,max_iter=iiter,tol=tol) #if _PREC_ == _PREC_EO_ call pack(w,solver%src_vec(:),ieo) #else call pack(w,solver%src_vec(:)) #endif endif !======================= ! start CG Solver !======================= #ifdef _PERFMON_ call start(flop) #endif do call solve(solver) istat = get_status(solver) select case(istat) case (OP_NOP) cycle case (OP_PROJECTION) cycle case (OP_DO_MATVEC) #if _PREC_ == _PREC_NON_ call unpack(solver%src_vec,w) if (.not.is_dagger) then ! ! w <= D^dag D w ! call assign_mult_dwq(this,v,w,u) call assign_mult_dagger_dwq(this,w,v,u) else ! ! w <= D D^dag w ! call assign_mult_dagger_dwq(this,v,w,u) call assign_mult_dwq(this,w,v,u) endif call pack(w,solver%dst_vec) #elif _PREC_ == _PREC_EO_ call unpack(solver%src_vec,w,ieo) #ifdef _PERFMON_ call read(flop) fp0 = flop%flop #endif if (.not.is_dagger) then ! ! w <= D^dag D w ! call assign_mult_eoprec_dwq(this,ieo,v,w,vu) call assign_mult_eoprec_dwq(this,ieo,w,v,vu,dagger=.true.) else ! ! w <= D D^dag w ! call assign_mult_eoprec_dwq(this,ieo,v,w,vu,dagger=.true.) call assign_mult_eoprec_dwq(this,ieo,w,v,vu) endif #ifdef _PERFMON_ call read(flop) fp1 = flop%flop if (nodeid == 0) write(*,'("@@",E24.16)')fp1-fp0 #endif call pack(w,solver%dst_vec,ieo) #elif _PREC_ == _PREC_4DSSOR_ call unpack(solver%src_vec,w) #ifdef _PERFMON_ call read(flop) fp0 = flop%flop #endif if (.not.is_dagger) then call assign_inv_mult2_forw_4dssor_dwq(this,omega,dy,w,vu,forw=.false.) ! dy = BACK w call accum_add_mult(w,dy,omg2) ! w = w + dy * omg2 call assign_inv_mult2_forw_4dssor_dwq(this,omega, v,w,vu,forw=.true.) ! v = FORW w call accum_add(v,dy) ! v = v + dy call accum_mult(v,omginv) ! v = v * omginv endif #ifdef _PERFMON_ call read(flop) fp1 = flop%flop if (nodeid == 0) write(*,'("@@",E24.16)')fp1-fp0 #endif call pack(v,solver%dst_vec) #endif case (OP_PRINT_STATUS) #ifdef _DEBUG #ifdef _PERFMON_ call read(flop) if (nodeid == 0) then mult_count = get_count(mult_iter) - get_count(imult) write(iout,'("#",I5," ERR_=",E24.16," MULT_=",I10," FLOP_=",E24.16," ELAPSE_=",E24.15)') get_current_iteration(solver), get_residual_norm(solver),mult_count,flop%flop,flop%interval write( *,'("#",I5," ERR_=",E24.16," MULT_=",I10," FLOP_=",E24.16," ELAPSE_=",E24.15)') get_current_iteration(solver), get_residual_norm(solver),mult_count,flop%flop,flop%interval endif #else if (nodeid == 0) then mult_count = get_count(mult_iter) - get_count(imult) write(iout,'("#",I5," ERR_=",E24.16," MULT_=",I10)') get_current_iteration(solver), get_residual_norm(solver),mult_count write( *,'("#",I5," ERR_=",E24.16," MULT_=",I10)') get_current_iteration(solver), get_residual_norm(solver),mult_count endif #endif #endif cycle case (OP_CONVERGED) #ifdef _PERFMON_ call read(flop) if (nodeid == 0) then mult_count = get_count(mult_iter) - get_count(imult) write(iout,'("#",A," iteration converged.")')TRIM(get_name(solver)) write(iout,'("#",I5," ERR_=",E24.16," MULT_=",I10," FLOP_=",E24.16," ELAPSE_=",E24.15)',advance='no') get_current_iteration(solver), get_residual_norm(solver),mult_count,flop%flop,flop%interval endif #else if (nodeid == 0) then mult_count = get_count(mult_iter) - get_count(imult) write(iout,'("#",A," iteration converged.")')TRIM(get_name(solver)) write(iout,'("#",I5," ERR_=",E24.16," MULT_=",I10)',advance='no') get_current_iteration(solver), get_residual_norm(solver),mult_count endif #endif exit case (OP_MAXITER_REACHED) if (nodeid == 0) then mult_count = get_count(mult_iter) - get_count(imult) write(iout,'("#",A," iteration does not converge.")')TRIM(get_name(solver)) write(iout,'("#",I5," ERR_=",E24.16," MULT_=",I10)',advance='no') get_current_iteration(solver), get_residual_norm(solver),mult_count endif write(str,'("solver did not converge.: ",A,I4)')__FILE__,__LINE__ call error_stop(str) case default write(str,'("something is wrong in solver.: ",A,I4)')__FILE__,__LINE__ call error_stop(str) end select enddo #ifdef _PERFMON_ call stop(flop) call delete(flop) #endif if (present(cron)) then cron%store_vec(:) = solver%dst_vec(:) call store(cron) endif ! ! construct solution ! #if _PREC_ == _PREC_NON_ call unpack(solver%dst_vec,dy) #elif _PREC_ == _PREC_EO_ call unpack(solver%dst_vec,w,ieo) if (.not.is_dagger) then call assign_mult_eo_dwq(this,ioe,v,w,vu) ! vo = Doe we call assign_sub(dy,y,v,ioe) ! dyo = yo - vo call assign_inv_mult_ee_dwq(this,ioe,w,dy) ! wo = Doo \ dyo call assign_mult_invmprec_dwq(this,dy,w) ! dy = MB \ w else call assign_inv_mult_ee_dwq(this,ieo,dy,w,dagger=.true.) ! dye = Dee \ we call assign_mult_eo_dwq(this,ioe,v,dy,vu,dagger=.true.) ! vo = Doe dye call assign_sub(w,yy,v,ioe) ! wo = yyo - vo call assign_inv_mult_ee_dwq(this,ioe,dy,w,dagger=.true.) ! dyo = Doo \ wo call delete(yy) deallocate(yy) endif deallocate(vu) #elif _PREC_ == _PREC_4DSSOR_ call unpack(solver%dst_vec,w) if (.not.is_dagger) then call assign_inv_mult2_forw_4dssor_dwq(this,omega,v,w,vu,forw=.false.) call assign_mult_invmprec_dwq(this,dy,v) ! dy = MB \ w endif deallocate(vu) #endif call delete(v) call delete(w) deallocate(w,v) iiter = get_current_iteration(solver) call delete(solver) deallocate(solver) call toc(solver_time) !============================================ ! NOTE: get_elapse contains comlib_sumcast. ! This means that get_elapse should not used ! in if-(nodeid==0)-then-endif block. !============================================ etime = get_elapse(solver_time) if (nodeid == 0) then write(iout,'(" ETIME_=",E24.16)')etime endif #ifdef _DEBUG allocate(w) call new(w,this%NS) if (.not.is_dagger) then call assign_mult_dwq_all(this,w,dy,u) else call assign_mult_dwq_all(this,w,dy,u,dagger=dagger) endif call accum_sub(w,y) rtmp0 = abs2(w) rtmp1 = abs2(y) if (nodeid==0) then write(* ,'("%",I5," ERR_=",3E24.16)',advance='no') iiter,sqrt(rtmp0/rtmp1),sqrt(rtmp0),sqrt(rtmp1) write(* ,'(" ETIME_=",E24.16)')etime write(iout,'("%",I5," ERR_=",3E24.16)',advance='no') iiter,sqrt(rtmp0/rtmp1),sqrt(rtmp0),sqrt(rtmp1) write(iout,'(" ETIME_=",E24.16)')etime endif call delete(w) deallocate(w) #endif return end subroutine
Subroutine : | |
this : | class(quark_domainwall), intent(in) |
iout : | integer, intent(in) |
tol : | real(DP), intent(in) |
iiter : | integer, intent(inout) |
dy : | type(field_dw_quark_wg), intent(inout) |
y : | type(field_dw_quark_wg), intent(inout) |
u : | type(vfield_gluon_wg), intent(in) |
dagger : | logical, optional, intent(in) |
cron : | type(chrolog_alg), optional, intent(inout) |
Assign and multiply inverse Domainwall operator
dy <= Ddw \ y
or
dy <= Ddw^dag \ y
using CGNE solver
subroutine assign_inv_mult_dwq_all(this,iout,tol,iiter,dy,y,u,dagger,cron) ! ! Assign and multiply inverse Domainwall operator ! ! dy <= Ddw \ y ! ! or ! ! dy <= Ddw^dag \ y ! ! using CGNE solver ! use solver_class use counter_class #ifdef _PERFMON_ use perfmon_class #endif implicit none class(quark_domainwall), intent(in) :: this integer, intent(in) :: iout real(DP), intent(in) :: tol integer, intent(inout) :: iiter type(field_dw_quark_wg), intent(inout) :: dy type(field_dw_quark_wg), intent(inout) :: y type(vfield_gluon_wg), intent(in) :: u logical, optional, intent(in) :: dagger type(chrolog_alg), optional, intent(inout) :: cron type(field_dw_quark_wg), allocatable :: w,v,yy type(vfield_dw_gluon_wg), allocatable :: vu #if _PREC_ == _PREC_EO_ integer :: ieo,ioe integer, parameter :: SLV_NSITE=COL*SPIN*NTH*NZ*NY*NX #else integer, parameter :: SLV_NSITE=COL*SPIN*NT*NZ*NY*NX #endif character(CHARLEN) :: str real(DP) :: etime,rtmp0,rtmp1 type(timer) :: solver_time integer :: NS,istat,mult_count type(counter) :: imult type(cg_alg), allocatable :: solver integer :: i,j,NEV complex(DP) :: ctmp logical :: is_dagger logical :: do_cron #if _PREC_ == _PREC_4DSSOR_ real(DP), parameter :: omega = 1.5_DP real(DP), parameter :: omg2 = omega - 2.0_DP real(DP), parameter :: omginv = 1.0_DP/omega #endif #ifdef _PERFMON_ real(DP) :: fp0,fp1 type(flop_counter) :: flop call new(flop) #endif ! write(*,*)"assign_inv_mult_dwq_all" call new(solver_time) call tic(solver_time) if (present(dagger)) then is_dagger = .true. else is_dagger = .false. endif NS = this%NS if (NS /= y%NS) then call error_stop("this%NY /= y%NS, input y is wrong in assign_in_mult_dwq.") endif if (NS /= dy%NS) then call new(dy,NS) endif allocate(w,v) call new(w,this%NS) call new(v,this%NS) imult = mult_iter !============================================== ! CGNE is used to solve ! ! D x = y. ! ! D^dag D x = D^dag y ! ! or ! ! D^dag x = y. ! ! D D^dag x = D y ! !============================================== ! ! set source for CGNE ! ! w = D^dag y ! ! or ! ! w = D y ! #if _PREC_ == _PREC_NON_ if (.not.is_dagger) then call assign_mult_dagger_dwq(this,w,y,u) else call assign_mult_dwq(this,w,y,u) endif #elif _PREC_ == _PREC_EO_ ieo = 0 ioe = 1-ieo allocate(vu) call conv_f_dwg_wg(u,vu) if (.not.is_dagger) then call assign_inv_mult_ee_dwq(this,ioe,w,y) ! wo = Doo \ yo call assign_mult_eo_dwq(this,ieo,v,w,vu) ! ve = Deo wo call assign_sub(w,y,v,ieo) ! we = ye - ve call assign_inv_mult_ee_dwq(this,ieo,v,w) ! ve = Dee \ we call assign_mult_eoprec_dwq(this,ieo,w,v,vu,dagger=.true.) ! we = hat{Dee}^dag \ ve else ! write(*,*)"dagger mode" allocate(yy) call new(yy,this%NS) call assign_mult_invmprec_dwq(this,yy,y,dagger=.true.) ! yy = MB \ y call assign_inv_mult_ee_dwq(this,ioe,v,yy,dagger=.true.) ! vo = Doo \ yyo call assign_mult_eo_dwq(this,ieo,w,v,vu,dagger=.true.) ! we = Deo vo call assign_sub(v,yy,w,ieo) ! ve = yye - we call assign_mult_eoprec_dwq(this,ieo,w,v,vu) ! we = hat{Dee} \ ve endif #elif _PREC_ == _PREC_4DSSOR_ allocate(vu) call conv_f_dwg_wg(u,vu) if (.not.is_dagger) then call assign_mult_dagger_dwq(this,v,y,u) call assign_mult_invmprec_dwq(this,w,v,dagger=.true.) call assign_inv_mult2_diag_dwq(this,v,w) call assign_inv_mult2_forw_4dssor_dwq(this,omega,w,v,vu,forw=.true.) else call error_stop("assign_inv_mult_dwf for dagger is not implemented.") endif #endif !================================ ! set source and guess to solver !================================ do_cron = .false. if (present(cron)) then if (has_history(cron)) then do_cron = .true. endif endif if (do_cron) then !=================================== ! start Chronological guess solver !=================================== if (nodeid == 0) then write(iout,'("#CRON USED")') #ifdef _DEBUG write(* ,'("#CRON USED")') #endif endif #if _PREC_ == _PREC_EO_ call pack(w,cron%src_vec(:),ieo) #else call pack(w,cron%src_vec(:)) #endif do call solve(cron) select case(get_status(cron)) case (CHRON_OP_NOP) cycle case (CHRON_OP_DO_MATVEC) #if _PREC_ == _PREC_NON_ call unpack(cron%src_vec,w) if (.not.is_dagger) then ! ! w <= D^dag D w ! call assign_mult_dwq(this,v,w,u) call assign_mult_dagger_dwq(this,w,v,u) else ! ! w <= D D^dag w ! call assign_mult_dagger_dwq(this,v,w,u) call assign_mult_dwq(this,w,v,u) endif call pack(w,cron%dst_vec) #elif _PREC_ == _PREC_EO_ call unpack(cron%src_vec,w,ieo) if (.not.is_dagger) then ! ! w <= D^dag D w ! call assign_mult_eoprec_dwq(this,ieo,v,w,vu) call assign_mult_eoprec_dwq(this,ieo,w,v,vu,dagger=.true.) else ! ! w <= D D^dag w ! call assign_mult_eoprec_dwq(this,ieo,v,w,vu,dagger=.true.) call assign_mult_eoprec_dwq(this,ieo,w,v,vu) endif call pack(w,cron%dst_vec,ieo) #elif _PREC_ == _PREC_4DSSOR_ call unpack(cron%src_vec,w) if (.not.is_dagger) then call assign_inv_mult2_forw_4dssor_dwq(this,omega,dy,w,vu,forw=.false.) ! dy = BACK w call accum_add_mult(w,dy,omg2) ! w = w + dy * omg2 call assign_inv_mult2_forw_4dssor_dwq(this,omega, v,w,vu,forw=.true.) ! v = FORW w call accum_add(v,dy) ! v = v + dy call accum_mult(v,omginv) ! v = v * omginv endif call pack(v,cron%dst_vec) #endif case (CHRON_OP_CONVERGED) if (nodeid == 0) then mult_count = get_count(mult_iter) - get_count(imult) write(iout,'("#",I5," ERR_=",E24.16," MULT_=",I10)') 0, get_residual_norm(cron),mult_count #ifdef _DEBUG write(* ,'("#",I5," ERR_=",E24.16," MULT_=",I10)') 0, get_residual_norm(cron),mult_count #endif endif exit end select enddo allocate(solver) call new(solver,NSIZE=SLV_NSITE*NS,guess=GUESS_USE,mode=MODE_NORMAL ,max_iter=iiter,tol=tol) solver%src_vec(:) = cron%src_vec(:) solver%dst_vec(:) = cron%dst_vec(:) else allocate(solver) call new(solver,NSIZE=SLV_NSITE*NS,mode=MODE_NORMAL ,max_iter=iiter,tol=tol) #if _PREC_ == _PREC_EO_ call pack(w,solver%src_vec(:),ieo) #else call pack(w,solver%src_vec(:)) #endif endif !======================= ! start CG Solver !======================= #ifdef _PERFMON_ call start(flop) #endif do call solve(solver) istat = get_status(solver) select case(istat) case (OP_NOP) cycle case (OP_PROJECTION) cycle case (OP_DO_MATVEC) #if _PREC_ == _PREC_NON_ call unpack(solver%src_vec,w) if (.not.is_dagger) then ! ! w <= D^dag D w ! call assign_mult_dwq(this,v,w,u) call assign_mult_dagger_dwq(this,w,v,u) else ! ! w <= D D^dag w ! call assign_mult_dagger_dwq(this,v,w,u) call assign_mult_dwq(this,w,v,u) endif call pack(w,solver%dst_vec) #elif _PREC_ == _PREC_EO_ call unpack(solver%src_vec,w,ieo) #ifdef _PERFMON_ call read(flop) fp0 = flop%flop #endif if (.not.is_dagger) then ! ! w <= D^dag D w ! call assign_mult_eoprec_dwq(this,ieo,v,w,vu) call assign_mult_eoprec_dwq(this,ieo,w,v,vu,dagger=.true.) else ! ! w <= D D^dag w ! call assign_mult_eoprec_dwq(this,ieo,v,w,vu,dagger=.true.) call assign_mult_eoprec_dwq(this,ieo,w,v,vu) endif #ifdef _PERFMON_ call read(flop) fp1 = flop%flop if (nodeid == 0) write(*,'("@@",E24.16)')fp1-fp0 #endif call pack(w,solver%dst_vec,ieo) #elif _PREC_ == _PREC_4DSSOR_ call unpack(solver%src_vec,w) #ifdef _PERFMON_ call read(flop) fp0 = flop%flop #endif if (.not.is_dagger) then call assign_inv_mult2_forw_4dssor_dwq(this,omega,dy,w,vu,forw=.false.) ! dy = BACK w call accum_add_mult(w,dy,omg2) ! w = w + dy * omg2 call assign_inv_mult2_forw_4dssor_dwq(this,omega, v,w,vu,forw=.true.) ! v = FORW w call accum_add(v,dy) ! v = v + dy call accum_mult(v,omginv) ! v = v * omginv endif #ifdef _PERFMON_ call read(flop) fp1 = flop%flop if (nodeid == 0) write(*,'("@@",E24.16)')fp1-fp0 #endif call pack(v,solver%dst_vec) #endif case (OP_PRINT_STATUS) #ifdef _DEBUG #ifdef _PERFMON_ call read(flop) if (nodeid == 0) then mult_count = get_count(mult_iter) - get_count(imult) write(iout,'("#",I5," ERR_=",E24.16," MULT_=",I10," FLOP_=",E24.16," ELAPSE_=",E24.15)') get_current_iteration(solver), get_residual_norm(solver),mult_count,flop%flop,flop%interval write( *,'("#",I5," ERR_=",E24.16," MULT_=",I10," FLOP_=",E24.16," ELAPSE_=",E24.15)') get_current_iteration(solver), get_residual_norm(solver),mult_count,flop%flop,flop%interval endif #else if (nodeid == 0) then mult_count = get_count(mult_iter) - get_count(imult) write(iout,'("#",I5," ERR_=",E24.16," MULT_=",I10)') get_current_iteration(solver), get_residual_norm(solver),mult_count write( *,'("#",I5," ERR_=",E24.16," MULT_=",I10)') get_current_iteration(solver), get_residual_norm(solver),mult_count endif #endif #endif cycle case (OP_CONVERGED) #ifdef _PERFMON_ call read(flop) if (nodeid == 0) then mult_count = get_count(mult_iter) - get_count(imult) write(iout,'("#",A," iteration converged.")')TRIM(get_name(solver)) write(iout,'("#",I5," ERR_=",E24.16," MULT_=",I10," FLOP_=",E24.16," ELAPSE_=",E24.15)',advance='no') get_current_iteration(solver), get_residual_norm(solver),mult_count,flop%flop,flop%interval endif #else if (nodeid == 0) then mult_count = get_count(mult_iter) - get_count(imult) write(iout,'("#",A," iteration converged.")')TRIM(get_name(solver)) write(iout,'("#",I5," ERR_=",E24.16," MULT_=",I10)',advance='no') get_current_iteration(solver), get_residual_norm(solver),mult_count endif #endif exit case (OP_MAXITER_REACHED) if (nodeid == 0) then mult_count = get_count(mult_iter) - get_count(imult) write(iout,'("#",A," iteration does not converge.")')TRIM(get_name(solver)) write(iout,'("#",I5," ERR_=",E24.16," MULT_=",I10)',advance='no') get_current_iteration(solver), get_residual_norm(solver),mult_count endif write(str,'("solver did not converge.: ",A,I4)')__FILE__,__LINE__ call error_stop(str) case default write(str,'("something is wrong in solver.: ",A,I4)')__FILE__,__LINE__ call error_stop(str) end select enddo #ifdef _PERFMON_ call stop(flop) call delete(flop) #endif if (present(cron)) then cron%store_vec(:) = solver%dst_vec(:) call store(cron) endif ! ! construct solution ! #if _PREC_ == _PREC_NON_ call unpack(solver%dst_vec,dy) #elif _PREC_ == _PREC_EO_ call unpack(solver%dst_vec,w,ieo) if (.not.is_dagger) then call assign_mult_eo_dwq(this,ioe,v,w,vu) ! vo = Doe we call assign_sub(dy,y,v,ioe) ! dyo = yo - vo call assign_inv_mult_ee_dwq(this,ioe,w,dy) ! wo = Doo \ dyo call assign_mult_invmprec_dwq(this,dy,w) ! dy = MB \ w else call assign_inv_mult_ee_dwq(this,ieo,dy,w,dagger=.true.) ! dye = Dee \ we call assign_mult_eo_dwq(this,ioe,v,dy,vu,dagger=.true.) ! vo = Doe dye call assign_sub(w,yy,v,ioe) ! wo = yyo - vo call assign_inv_mult_ee_dwq(this,ioe,dy,w,dagger=.true.) ! dyo = Doo \ wo call delete(yy) deallocate(yy) endif deallocate(vu) #elif _PREC_ == _PREC_4DSSOR_ call unpack(solver%dst_vec,w) if (.not.is_dagger) then call assign_inv_mult2_forw_4dssor_dwq(this,omega,v,w,vu,forw=.false.) call assign_mult_invmprec_dwq(this,dy,v) ! dy = MB \ w endif deallocate(vu) #endif call delete(v) call delete(w) deallocate(w,v) iiter = get_current_iteration(solver) call delete(solver) deallocate(solver) call toc(solver_time) !============================================ ! NOTE: get_elapse contains comlib_sumcast. ! This means that get_elapse should not used ! in if-(nodeid==0)-then-endif block. !============================================ etime = get_elapse(solver_time) if (nodeid == 0) then write(iout,'(" ETIME_=",E24.16)')etime endif #ifdef _DEBUG allocate(w) call new(w,this%NS) if (.not.is_dagger) then call assign_mult_dwq_all(this,w,dy,u) else call assign_mult_dwq_all(this,w,dy,u,dagger=dagger) endif call accum_sub(w,y) rtmp0 = abs2(w) rtmp1 = abs2(y) if (nodeid==0) then write(* ,'("%",I5," ERR_=",3E24.16)',advance='no') iiter,sqrt(rtmp0/rtmp1),sqrt(rtmp0),sqrt(rtmp1) write(* ,'(" ETIME_=",E24.16)')etime write(iout,'("%",I5," ERR_=",3E24.16)',advance='no') iiter,sqrt(rtmp0/rtmp1),sqrt(rtmp0),sqrt(rtmp1) write(iout,'(" ETIME_=",E24.16)')etime endif call delete(w) deallocate(w) #endif return end subroutine
Subroutine : | |
this : | class(quark_domainwall), intent(in) |
dq : | type(field_dw_quark_wg), intent(inout) |
q : | type(field_dw_quark_wg), intent(inout) |
u : | type(vfield_gluon_wg), intent(in) |
LV : | type(dwf_low_modes), intent(in) |
dagger : | logical, optional, intent(in) |
Assign and multiply Domainwall operator with low-mode improvement
dq <= (Ddw + W X W^dag gamma_5 (B+C M_5) ) q
or
dq <= (Ddw^dag + (B + C M_5^dag) gamma_5 W X W^dag) q
for dagger replace gamma_mu => -gamma_mu.
subroutine assign_mult_lowprojd_dwq(this,dq,q,u,LV,dagger) ! ! Assign and multiply Domainwall operator with low-mode improvement ! ! dq <= (Ddw + W X W^dag gamma_5 (B+C M_5) ) q ! ! or ! ! dq <= (Ddw^dag + (B + C M_5^dag) gamma_5 W X W^dag) q ! ! for dagger replace gamma_mu => -gamma_mu. ! implicit none class(quark_domainwall), intent(in) :: this type(field_dw_quark_wg), intent(inout) :: dq type(field_dw_quark_wg), intent(inout) :: q type(vfield_gluon_wg), intent(in) :: u type(dwf_low_modes), intent(in) :: LV logical, optional, intent(in) :: dagger type(field_dw_quark_wg), allocatable :: v complex(DP), allocatable :: cf1(:,:),cf2(:,:) complex(DP) :: ctmp integer :: NS,NEV,iev,kev integer :: ix,iy,iz,it,iw,ith,ieoxyz,ieo,ioe,ic,is logical :: is_dagger if (present(dagger)) then is_dagger=.true. else is_dagger=.false. endif NS = q%NS NEV = LV%NEV allocate(v) call new(v,NS) allocate(cf1(NEV,NS)) allocate(cf2(NEV,NS)) if (.not. is_dagger) then ! ! dq <= Ddw + W X W^dag \gamma_5 (B + C M5) ! ! ! dq <= Ddw q ! call assign_mult_dwf(this,dq,q,u) ! ! v <= (B + C M5) q ! call assign_mult_impterm_dwf(this,v,q) ! ! cf1(iev,iw) = W(iev)^dag gamma_5 v(iw) ! cf2(iev,iw) = sum_kev(X(iev,kev) * cf1(kev,iw)) ! do iw=1,NS do iev=1,NEV ctmp = Z0 !$OMP PARALLEL DO PRIVATE(ix,iy,iz,it,ic,is) REDUCTION(+:ctmp) do ix=1,NX do iy=1,NY do iz=1,NZ do it=1,NT do is=1,SPIN do ic=1,COL ctmp = ctmp + CONJG(LV%W%s(iev,it,iz,iy,ix)%y(ic, is )) * v%s( iw,it,iz,iy,ix)%y(ic,igamma(is,5)) enddo enddo enddo enddo enddo enddo #ifndef _singlePU call comlib_sumcast(ctmp) #endif cf1(iev,iw) = ctmp enddo enddo ! ! cf2(1:NEV,1:NS) = MATMUL(LV%XX(1:NEV,1:NEV),cf1(1:NEV,1:NS)) ! !$OMP PARALLEL DO PRIVATE(iw,iev,kev) do iw=1,NS do iev=1,NEV cf2(iev,iw) = Z0 do kev=1,NEV cf2(iev,iw) = cf2(iev,iw) + LV%XX(iev,kev)*cf1(kev,iw) enddo enddo enddo ! ! dq(iw) = dq(iw) + sum_iev W(iev) cf2(iev,iw) ! !$OMP PARALLEL DO PRIVATE(ix,iy,iz,it,iw,iev) do ix=1,NX do iy=1,NY do iz=1,NZ do it=1,NT do iw=1,NS do iev=1,NEV dq%s(iw,it,iz,iy,ix)%y(:,:) = dq%s( iw,it,iz,iy,ix)%y(:,:) + LV%W%s(iev,it,iz,iy,ix)%y(:,:)*cf2(iev,iw) enddo enddo enddo enddo enddo enddo else ! ! dq <= Ddw^dag + (B+C M_5)^dag gamma_5 W X W^dag ! ! ! cf1(iev,iw) = W(iev)^dag q(iw) ! cf2(iev,iw) = sum_kev(X(kev,iev)^* * cf1(kev,iw)) ! do iw=1,NS do iev=1,NEV ctmp = Z0 !$OMP PARALLEL DO PRIVATE(ix,iy,iz,it,ic,is) REDUCTION(+:ctmp) do ix=1,NX do iy=1,NY do iz=1,NZ do it=1,NT do is=1,SPIN do ic=1,COL ctmp = ctmp + CONJG(LV%W%s(iev,it,iz,iy,ix)%y(ic,is)) * q%s( iw,it,iz,iy,ix)%y(ic,is) enddo enddo enddo enddo enddo enddo #ifndef _singlePU call comlib_sumcast(ctmp) #endif cf1(iev,iw) = ctmp enddo enddo ! ! cf2(1:NEV,1:NS) = MATMUL(CONJG(TRANSPOSE(LV%XX(1:NEV,1:NEV))),cf1(1:NEV,1:NS)) ! !$OMP PARALLEL DO PRIVATE(iw,iev,kev) do iw=1,NS do iev=1,NEV cf2(iev,iw) = Z0 do kev=1,NEV cf2(iev,iw) = cf2(iev,iw) + CONJG(LV%XX(kev,iev))*cf1(kev,iw) enddo enddo enddo ! ! v(iw) = sum_iev (gamma_5 W_(iev)) cf2(iev,iw) = (gamma_5 W X W^dag)(iw) ! call clear(v) !$OMP PARALLEL DO PRIVATE(ix,iy,iz,it,iw,iev) do ix=1,NX do iy=1,NY do iz=1,NZ do it=1,NT do iw=1,NS do iev=1,NEV v%s(iw,it,iz,iy,ix)%y(:,:) = v%s( iw,it,iz,iy,ix)%y(:,:) + LV%W%s(iev,it,iz,iy,ix)%y(:,:)*cf2(iev,iw) enddo enddo enddo enddo enddo enddo ! ! dq <= (B + M_5^dag C) v ! = (B + M_5^dag C) gamma_5 W X W^dag ! call assign_mult_impterm_dwf(this,dq,v,dagger=.true.) ! ! v <= Ddw^dag q ! call assign_mult_dagger_dwq(this,v,q,u) ! ! dq <= dq + v ! call accum_add(dq,v) endif call delete(v) deallocate(v) deallocate(cf1,cf2) return end subroutine
Subroutine : | |
this : | class(quark_domainwall), intent(in) |
dq : | type(field_dw_quark_wg), intent(inout) |
q : | type(field_dw_quark_wg), intent(inout) |
u : | type(vfield_gluon_wg), intent(in) |
LV : | type(dwf_low_modes), intent(in) |
dagger : | logical, optional, intent(in) |
Assign and multiply Domainwall operator with low-mode improvement
dq <= (Ddw + W X W^dag gamma_5 (B+C M_5) ) q
or
dq <= (Ddw^dag + (B + C M_5^dag) gamma_5 W X W^dag) q
for dagger replace gamma_mu => -gamma_mu.
subroutine assign_mult_lowprojd_dwq(this,dq,q,u,LV,dagger) ! ! Assign and multiply Domainwall operator with low-mode improvement ! ! dq <= (Ddw + W X W^dag gamma_5 (B+C M_5) ) q ! ! or ! ! dq <= (Ddw^dag + (B + C M_5^dag) gamma_5 W X W^dag) q ! ! for dagger replace gamma_mu => -gamma_mu. ! implicit none class(quark_domainwall), intent(in) :: this type(field_dw_quark_wg), intent(inout) :: dq type(field_dw_quark_wg), intent(inout) :: q type(vfield_gluon_wg), intent(in) :: u type(dwf_low_modes), intent(in) :: LV logical, optional, intent(in) :: dagger type(field_dw_quark_wg), allocatable :: v complex(DP), allocatable :: cf1(:,:),cf2(:,:) complex(DP) :: ctmp integer :: NS,NEV,iev,kev integer :: ix,iy,iz,it,iw,ith,ieoxyz,ieo,ioe,ic,is logical :: is_dagger if (present(dagger)) then is_dagger=.true. else is_dagger=.false. endif NS = q%NS NEV = LV%NEV allocate(v) call new(v,NS) allocate(cf1(NEV,NS)) allocate(cf2(NEV,NS)) if (.not. is_dagger) then ! ! dq <= Ddw + W X W^dag \gamma_5 (B + C M5) ! ! ! dq <= Ddw q ! call assign_mult_dwf(this,dq,q,u) ! ! v <= (B + C M5) q ! call assign_mult_impterm_dwf(this,v,q) ! ! cf1(iev,iw) = W(iev)^dag gamma_5 v(iw) ! cf2(iev,iw) = sum_kev(X(iev,kev) * cf1(kev,iw)) ! do iw=1,NS do iev=1,NEV ctmp = Z0 !$OMP PARALLEL DO PRIVATE(ix,iy,iz,it,ic,is) REDUCTION(+:ctmp) do ix=1,NX do iy=1,NY do iz=1,NZ do it=1,NT do is=1,SPIN do ic=1,COL ctmp = ctmp + CONJG(LV%W%s(iev,it,iz,iy,ix)%y(ic, is )) * v%s( iw,it,iz,iy,ix)%y(ic,igamma(is,5)) enddo enddo enddo enddo enddo enddo #ifndef _singlePU call comlib_sumcast(ctmp) #endif cf1(iev,iw) = ctmp enddo enddo ! ! cf2(1:NEV,1:NS) = MATMUL(LV%XX(1:NEV,1:NEV),cf1(1:NEV,1:NS)) ! !$OMP PARALLEL DO PRIVATE(iw,iev,kev) do iw=1,NS do iev=1,NEV cf2(iev,iw) = Z0 do kev=1,NEV cf2(iev,iw) = cf2(iev,iw) + LV%XX(iev,kev)*cf1(kev,iw) enddo enddo enddo ! ! dq(iw) = dq(iw) + sum_iev W(iev) cf2(iev,iw) ! !$OMP PARALLEL DO PRIVATE(ix,iy,iz,it,iw,iev) do ix=1,NX do iy=1,NY do iz=1,NZ do it=1,NT do iw=1,NS do iev=1,NEV dq%s(iw,it,iz,iy,ix)%y(:,:) = dq%s( iw,it,iz,iy,ix)%y(:,:) + LV%W%s(iev,it,iz,iy,ix)%y(:,:)*cf2(iev,iw) enddo enddo enddo enddo enddo enddo else ! ! dq <= Ddw^dag + (B+C M_5)^dag gamma_5 W X W^dag ! ! ! cf1(iev,iw) = W(iev)^dag q(iw) ! cf2(iev,iw) = sum_kev(X(kev,iev)^* * cf1(kev,iw)) ! do iw=1,NS do iev=1,NEV ctmp = Z0 !$OMP PARALLEL DO PRIVATE(ix,iy,iz,it,ic,is) REDUCTION(+:ctmp) do ix=1,NX do iy=1,NY do iz=1,NZ do it=1,NT do is=1,SPIN do ic=1,COL ctmp = ctmp + CONJG(LV%W%s(iev,it,iz,iy,ix)%y(ic,is)) * q%s( iw,it,iz,iy,ix)%y(ic,is) enddo enddo enddo enddo enddo enddo #ifndef _singlePU call comlib_sumcast(ctmp) #endif cf1(iev,iw) = ctmp enddo enddo ! ! cf2(1:NEV,1:NS) = MATMUL(CONJG(TRANSPOSE(LV%XX(1:NEV,1:NEV))),cf1(1:NEV,1:NS)) ! !$OMP PARALLEL DO PRIVATE(iw,iev,kev) do iw=1,NS do iev=1,NEV cf2(iev,iw) = Z0 do kev=1,NEV cf2(iev,iw) = cf2(iev,iw) + CONJG(LV%XX(kev,iev))*cf1(kev,iw) enddo enddo enddo ! ! v(iw) = sum_iev (gamma_5 W_(iev)) cf2(iev,iw) = (gamma_5 W X W^dag)(iw) ! call clear(v) !$OMP PARALLEL DO PRIVATE(ix,iy,iz,it,iw,iev) do ix=1,NX do iy=1,NY do iz=1,NZ do it=1,NT do iw=1,NS do iev=1,NEV v%s(iw,it,iz,iy,ix)%y(:,:) = v%s( iw,it,iz,iy,ix)%y(:,:) + LV%W%s(iev,it,iz,iy,ix)%y(:,:)*cf2(iev,iw) enddo enddo enddo enddo enddo enddo ! ! dq <= (B + M_5^dag C) v ! = (B + M_5^dag C) gamma_5 W X W^dag ! call assign_mult_impterm_dwf(this,dq,v,dagger=.true.) ! ! v <= Ddw^dag q ! call assign_mult_dagger_dwq(this,v,q,u) ! ! dq <= dq + v ! call accum_add(dq,v) endif call delete(v) deallocate(v) deallocate(cf1,cf2) return end subroutine
Subroutine : | |||
this : | class(quark_domainwall), intent(in) | ||
dq : | type(field_dw_quark_wg), intent(inout) | ||
q : | type(field_dw_quark_wg), intent(inout) | ||
u : | type(vfield_gluon_wg), intent(in) | ||
dagger : | logical, optional, intent(in)
|
assign and multiply dwf operaotr
dq <= Ddw q
or
dq <= Ddw^dag q
subroutine assign_mult_dwq_all(this,dq,q,u,dagger) ! ! assign and multiply dwf operaotr ! ! dq <= Ddw q ! ! or ! ! dq <= Ddw^dag q ! implicit none class(quark_domainwall), intent(in) :: this type(field_dw_quark_wg), intent(inout) :: dq type(field_dw_quark_wg), intent(inout) :: q type(vfield_gluon_wg), intent(in) :: u logical, optional, intent(in) :: dagger ! if present, Ddw^dagger is multiplyed. logical :: is_dagger if (present(dagger)) then is_dagger=.true. else is_dagger=.false. endif if (.not.is_dagger) then call assign_mult_dwq(this,dq,q,u) else call assign_mult_dagger_dwq(this,dq,q,u) endif return end subroutine
Subroutine : | |||
this : | class(quark_domainwall), intent(in) | ||
dq : | type(field_dw_quark_wg), intent(inout) | ||
q : | type(field_dw_quark_wg), intent(inout) | ||
u : | type(vfield_gluon_wg), intent(in) | ||
dagger : | logical, optional, intent(in)
|
assign and multiply dwf operaotr
dq <= Ddw q
or
dq <= Ddw^dag q
subroutine assign_mult_dwq_all(this,dq,q,u,dagger) ! ! assign and multiply dwf operaotr ! ! dq <= Ddw q ! ! or ! ! dq <= Ddw^dag q ! implicit none class(quark_domainwall), intent(in) :: this type(field_dw_quark_wg), intent(inout) :: dq type(field_dw_quark_wg), intent(inout) :: q type(vfield_gluon_wg), intent(in) :: u logical, optional, intent(in) :: dagger ! if present, Ddw^dagger is multiplyed. logical :: is_dagger if (present(dagger)) then is_dagger=.true. else is_dagger=.false. endif if (.not.is_dagger) then call assign_mult_dwq(this,dq,q,u) else call assign_mult_dagger_dwq(this,dq,q,u) endif return end subroutine
Subroutine : | |
gy : | type(field_dw_quark_wg), intent(inout) |
y : | type(field_dw_quark_wg), intent(in) |
Multiply Dowmainwall fermion GAMMA5
gy <= Gamma5 y
this includes permutaion in extra-dimension.
\[ gy(n,s) <= gamma_5 y(n,NS-s+1) \]
with $ s=1,cdots,NS. $
subroutine assign_mult_gamma5_dwq(gy,y) ! ! Multiply Dowmainwall fermion GAMMA5 ! ! gy <= Gamma5 y ! ! this includes permutaion in extra-dimension. ! !\[ ! gy(n,s) <= \gamma_5 y(n,NS-s+1) !\] ! ! with $ s=1,\cdots,NS. $ ! implicit none type(field_dw_quark_wg), intent(inout) :: gy type(field_dw_quark_wg), intent(in) :: y integer :: iw,ix,iy,iz,it,NS,ic,jw complex(DP) :: a1,a2,a3,a4 if ( (.not.is_allocated(gy)) .or. (.not.is_allocated(y)) .or. (.not.is_same_size(gy,y)) ) then call error_stop("5-dim size of gy,y is wrong in assign_mult_gamma5_dwq.") endif NS = y%NS !$OMP PARALLEL DO & !$OMP PRIVATE(ix,iy,iz,it,iw,jw,ic,a1,a2,a3,a4) do ix=1,NX do iy=1,NY do iz=1,NZ do it=1,NT do iw=1,NS jw = NS-iw+1 do ic=1,COL a1 = y%s(iw,it,iz,iy,ix)%y(ic,1) a2 = y%s(iw,it,iz,iy,ix)%y(ic,2) a3 = y%s(iw,it,iz,iy,ix)%y(ic,3) a4 = y%s(iw,it,iz,iy,ix)%y(ic,4) gy%s(jw,it,iz,iy,ix)%y(ic,1) = a3 gy%s(jw,it,iz,iy,ix)%y(ic,2) = a4 gy%s(jw,it,iz,iy,ix)%y(ic,3) = a1 gy%s(jw,it,iz,iy,ix)%y(ic,4) = a2 enddo enddo enddo enddo enddo enddo return end subroutine
Subroutine : | |
gy : | type(field_dw_quark_wg), intent(inout) |
y : | type(field_dw_quark_wg), intent(in) |
Multiply Dowmainwall fermion GAMMA5
gy <= Gamma5 y
this includes permutaion in extra-dimension.
\[ gy(n,s) <= gamma_5 y(n,NS-s+1) \]
with $ s=1,cdots,NS. $
subroutine assign_mult_gamma5_dwq(gy,y) ! ! Multiply Dowmainwall fermion GAMMA5 ! ! gy <= Gamma5 y ! ! this includes permutaion in extra-dimension. ! !\[ ! gy(n,s) <= \gamma_5 y(n,NS-s+1) !\] ! ! with $ s=1,\cdots,NS. $ ! implicit none type(field_dw_quark_wg), intent(inout) :: gy type(field_dw_quark_wg), intent(in) :: y integer :: iw,ix,iy,iz,it,NS,ic,jw complex(DP) :: a1,a2,a3,a4 if ( (.not.is_allocated(gy)) .or. (.not.is_allocated(y)) .or. (.not.is_same_size(gy,y)) ) then call error_stop("5-dim size of gy,y is wrong in assign_mult_gamma5_dwq.") endif NS = y%NS !$OMP PARALLEL DO & !$OMP PRIVATE(ix,iy,iz,it,iw,jw,ic,a1,a2,a3,a4) do ix=1,NX do iy=1,NY do iz=1,NZ do it=1,NT do iw=1,NS jw = NS-iw+1 do ic=1,COL a1 = y%s(iw,it,iz,iy,ix)%y(ic,1) a2 = y%s(iw,it,iz,iy,ix)%y(ic,2) a3 = y%s(iw,it,iz,iy,ix)%y(ic,3) a4 = y%s(iw,it,iz,iy,ix)%y(ic,4) gy%s(jw,it,iz,iy,ix)%y(ic,1) = a3 gy%s(jw,it,iz,iy,ix)%y(ic,2) = a4 gy%s(jw,it,iz,iy,ix)%y(ic,3) = a1 gy%s(jw,it,iz,iy,ix)%y(ic,4) = a2 enddo enddo enddo enddo enddo enddo return end subroutine
Subroutine : | |
this : | class(quark_domainwall), intent(in) |
dq : | type(field_dw_quark_wg), intent(inout) |
q : | type(field_dw_quark_wg), intent(inout) |
dagger : | logical, optional, intent(in) |
Assign and multiply improvement term
dq = (B + C M5) q
or
dq = (B + M5^dag C) q B^dag = B, C^dag = C M5: hopping in 5th direction
subroutine assign_mult_impterm_dwq(this,dq,q,dagger) ! ! Assign and multiply improvement term ! ! dq = (B + C M5) q ! ! or ! ! dq = (B + M5^dag C) q ! ! B^dag = B, C^dag = C ! ! M5: hopping in 5th direction ! implicit none class(quark_domainwall), intent(in) :: this type(field_dw_quark_wg), intent(inout) :: dq type(field_dw_quark_wg), intent(inout) :: q logical, optional, intent(in) :: dagger type(su3fv_spinor) :: yy,yt(this%NS) complex(DP) :: ctmp(COL,SPIN) integer :: ic integer :: NS,ix,iy,iz,it,iw integer :: kw logical :: is_dagger if (present(dagger)) then is_dagger = .true. else is_dagger = .false. endif NS = q%NS if (DW_TYPE_SHAMIR /= this%dw_type) then if (.not.is_dagger) then ! ! dq = (B + C M5) q = MB q ! !$OMP PARALLEL DO & !$OMP PRIVATE(ix,iy,iz,it,iw,kw,yt,yy) do ix=1,NX do iy=1,NY do iz=1,NZ do it=1,NT do iw=1,NS yt(iw)%y(:,1:2) = q%s(iw,it,iz,iy,ix)%y(:,1:2) - q%s(iw,it,iz,iy,ix)%y(:,3:4) yt(iw)%y(:,3:4) = q%s(iw,it,iz,iy,ix)%y(:,1:2) + q%s(iw,it,iz,iy,ix)%y(:,3:4) enddo do iw=1,NS yy%y(:,:) = Z0 do kw=1,NS yy%y(:,1:2) = yy%y(:,1:2)+this%MBP(iw,kw) * yt(kw)%y(:,1:2) yy%y(:,3:4) = yy%y(:,3:4)+this%MBN(iw,kw) * yt(kw)%y(:,3:4) enddo dq%s(iw,it,iz,iy,ix)%y(:,1:2) = (+ yy%y(:,1:2) + yy%y(:,3:4))*0.5_DP dq%s(iw,it,iz,iy,ix)%y(:,3:4) = (- yy%y(:,1:2) + yy%y(:,3:4))*0.5_DP enddo enddo enddo enddo enddo else ! ! dq = (B + M5^dag C) q = MB^dag q ! !$OMP PARALLEL DO & !$OMP PRIVATE(ix,iy,iz,it,iw,kw,yt,yy) do ix=1,NX do iy=1,NY do iz=1,NZ do it=1,NT do iw=1,NS yt(iw)%y(:,1:2) = q%s(iw,it,iz,iy,ix)%y(:,1:2) - q%s(iw,it,iz,iy,ix)%y(:,3:4) yt(iw)%y(:,3:4) = q%s(iw,it,iz,iy,ix)%y(:,1:2) + q%s(iw,it,iz,iy,ix)%y(:,3:4) enddo do iw=1,NS yy%y(:,:) = Z0 do kw=1,NS yy%y(:,1:2) = yy%y(:,1:2)+this%MBP(kw,iw) * yt(kw)%y(:,1:2) yy%y(:,3:4) = yy%y(:,3:4)+this%MBN(kw,iw) * yt(kw)%y(:,3:4) enddo dq%s(iw,it,iz,iy,ix)%y(:,1:2) = (+ yy%y(:,1:2) + yy%y(:,3:4))*0.5_DP dq%s(iw,it,iz,iy,ix)%y(:,3:4) = (- yy%y(:,1:2) + yy%y(:,3:4))*0.5_DP enddo enddo enddo enddo enddo endif else call assign(dq,q) endif return end subroutine
Subroutine : | |
this : | class(quark_domainwall), intent(in) |
dq : | type(field_dw_quark_wg), intent(inout) |
q : | type(field_dw_quark_wg), intent(inout) |
dagger : | logical, optional, intent(in) |
Assign and multiply improvement term
dq = (B + C M5) q
or
dq = (B + M5^dag C) q B^dag = B, C^dag = C M5: hopping in 5th direction
subroutine assign_mult_impterm_dwq(this,dq,q,dagger) ! ! Assign and multiply improvement term ! ! dq = (B + C M5) q ! ! or ! ! dq = (B + M5^dag C) q ! ! B^dag = B, C^dag = C ! ! M5: hopping in 5th direction ! implicit none class(quark_domainwall), intent(in) :: this type(field_dw_quark_wg), intent(inout) :: dq type(field_dw_quark_wg), intent(inout) :: q logical, optional, intent(in) :: dagger type(su3fv_spinor) :: yy,yt(this%NS) complex(DP) :: ctmp(COL,SPIN) integer :: ic integer :: NS,ix,iy,iz,it,iw integer :: kw logical :: is_dagger if (present(dagger)) then is_dagger = .true. else is_dagger = .false. endif NS = q%NS if (DW_TYPE_SHAMIR /= this%dw_type) then if (.not.is_dagger) then ! ! dq = (B + C M5) q = MB q ! !$OMP PARALLEL DO & !$OMP PRIVATE(ix,iy,iz,it,iw,kw,yt,yy) do ix=1,NX do iy=1,NY do iz=1,NZ do it=1,NT do iw=1,NS yt(iw)%y(:,1:2) = q%s(iw,it,iz,iy,ix)%y(:,1:2) - q%s(iw,it,iz,iy,ix)%y(:,3:4) yt(iw)%y(:,3:4) = q%s(iw,it,iz,iy,ix)%y(:,1:2) + q%s(iw,it,iz,iy,ix)%y(:,3:4) enddo do iw=1,NS yy%y(:,:) = Z0 do kw=1,NS yy%y(:,1:2) = yy%y(:,1:2)+this%MBP(iw,kw) * yt(kw)%y(:,1:2) yy%y(:,3:4) = yy%y(:,3:4)+this%MBN(iw,kw) * yt(kw)%y(:,3:4) enddo dq%s(iw,it,iz,iy,ix)%y(:,1:2) = (+ yy%y(:,1:2) + yy%y(:,3:4))*0.5_DP dq%s(iw,it,iz,iy,ix)%y(:,3:4) = (- yy%y(:,1:2) + yy%y(:,3:4))*0.5_DP enddo enddo enddo enddo enddo else ! ! dq = (B + M5^dag C) q = MB^dag q ! !$OMP PARALLEL DO & !$OMP PRIVATE(ix,iy,iz,it,iw,kw,yt,yy) do ix=1,NX do iy=1,NY do iz=1,NZ do it=1,NT do iw=1,NS yt(iw)%y(:,1:2) = q%s(iw,it,iz,iy,ix)%y(:,1:2) - q%s(iw,it,iz,iy,ix)%y(:,3:4) yt(iw)%y(:,3:4) = q%s(iw,it,iz,iy,ix)%y(:,1:2) + q%s(iw,it,iz,iy,ix)%y(:,3:4) enddo do iw=1,NS yy%y(:,:) = Z0 do kw=1,NS yy%y(:,1:2) = yy%y(:,1:2)+this%MBP(kw,iw) * yt(kw)%y(:,1:2) yy%y(:,3:4) = yy%y(:,3:4)+this%MBN(kw,iw) * yt(kw)%y(:,3:4) enddo dq%s(iw,it,iz,iy,ix)%y(:,1:2) = (+ yy%y(:,1:2) + yy%y(:,3:4))*0.5_DP dq%s(iw,it,iz,iy,ix)%y(:,3:4) = (- yy%y(:,1:2) + yy%y(:,3:4))*0.5_DP enddo enddo enddo enddo enddo endif else call assign(dq,q) endif return end subroutine
Subroutine : | |
py : | type(field_dw_quark_wg), intent(inout) |
y : | type(field_quark_wg), intent(in) |
Multiply permutation + chiral projection
Normal permutation + chiral projection (4D->5D)
subroutine assign_proj_4dto5d(py,y) ! ! Multiply permutation + chiral projection ! !------------------------------------------------------- ! Normal permutation + chiral projection (4D->5D) ! !* $ py(1) = (P^{-} y)/2 $ !* $ py(2:NS-1) = 0 $ !* $ py(NS) = (P^{+} y)/2 $ ! !------------------------------------------------------- ! !* $ (1-\gamma_5) y = P^{-} y $ . !* $ (1+\gamma_5) y = P^{+} y $ . ! implicit none type(field_dw_quark_wg), intent(inout) :: py type(field_quark_wg), intent(in) :: y integer :: ix,iy,iz,it,ic,iw,NS,itb,ieo complex(DP) :: a1,a2,a3,a4,w1,w2,v1,v2 if ( (.not.is_allocated(py)) ) then call error_stop("5-dim size of py is wrong in assign_proj_4dto5d.") endif NS = py%NS !$OMP PARALLEL DO & !$OMP PRIVATE(ix,iy,iz,it,itb,ieo,iw,ic, & !$OMP a1,a2,a3,a4,w1,w2,v1,v2) do ix=1,NX do iy=1,NY do iz=1,NZ do it=1,NT ieo = mod(ipeo+it+iz+iy+ix,2) itb = it/2 do ic=1,COL a1 = y%eo(ieo)%s(itb,iz,iy,ix)%y(ic,1) a2 = y%eo(ieo)%s(itb,iz,iy,ix)%y(ic,2) a3 = y%eo(ieo)%s(itb,iz,iy,ix)%y(ic,3) a4 = y%eo(ieo)%s(itb,iz,iy,ix)%y(ic,4) w1 = (a1 - a3)/2.0_DP w2 = (a2 - a4)/2.0_DP py%s( 1,it,iz,iy,ix)%y(ic,1) = w1 py%s( 1,it,iz,iy,ix)%y(ic,2) = w2 py%s( 1,it,iz,iy,ix)%y(ic,3) = -w1 py%s( 1,it,iz,iy,ix)%y(ic,4) = -w2 v1 = (a1 + a3)/2.0_DP v2 = (a2 + a4)/2.0_DP py%s(NS,it,iz,iy,ix)%y(ic,1) = v1 py%s(NS,it,iz,iy,ix)%y(ic,2) = v2 py%s(NS,it,iz,iy,ix)%y(ic,3) = v1 py%s(NS,it,iz,iy,ix)%y(ic,4) = v2 enddo do iw=2,NS-1 py%s(iw,it,iz,iy,ix)%y(:,:) = Z0 enddo enddo enddo enddo enddo return end subroutine
Subroutine : | |
py : | type(field_dw_quark_wg), intent(inout) |
y : | type(field_quark_wg), intent(in) |
Multiply permutation + chiral projection
Normal permutation + chiral projection (4D->5D)
subroutine assign_proj_4dto5d(py,y) ! ! Multiply permutation + chiral projection ! !------------------------------------------------------- ! Normal permutation + chiral projection (4D->5D) ! !* $ py(1) = (P^{-} y)/2 $ !* $ py(2:NS-1) = 0 $ !* $ py(NS) = (P^{+} y)/2 $ ! !------------------------------------------------------- ! !* $ (1-\gamma_5) y = P^{-} y $ . !* $ (1+\gamma_5) y = P^{+} y $ . ! implicit none type(field_dw_quark_wg), intent(inout) :: py type(field_quark_wg), intent(in) :: y integer :: ix,iy,iz,it,ic,iw,NS,itb,ieo complex(DP) :: a1,a2,a3,a4,w1,w2,v1,v2 if ( (.not.is_allocated(py)) ) then call error_stop("5-dim size of py is wrong in assign_proj_4dto5d.") endif NS = py%NS !$OMP PARALLEL DO & !$OMP PRIVATE(ix,iy,iz,it,itb,ieo,iw,ic, & !$OMP a1,a2,a3,a4,w1,w2,v1,v2) do ix=1,NX do iy=1,NY do iz=1,NZ do it=1,NT ieo = mod(ipeo+it+iz+iy+ix,2) itb = it/2 do ic=1,COL a1 = y%eo(ieo)%s(itb,iz,iy,ix)%y(ic,1) a2 = y%eo(ieo)%s(itb,iz,iy,ix)%y(ic,2) a3 = y%eo(ieo)%s(itb,iz,iy,ix)%y(ic,3) a4 = y%eo(ieo)%s(itb,iz,iy,ix)%y(ic,4) w1 = (a1 - a3)/2.0_DP w2 = (a2 - a4)/2.0_DP py%s( 1,it,iz,iy,ix)%y(ic,1) = w1 py%s( 1,it,iz,iy,ix)%y(ic,2) = w2 py%s( 1,it,iz,iy,ix)%y(ic,3) = -w1 py%s( 1,it,iz,iy,ix)%y(ic,4) = -w2 v1 = (a1 + a3)/2.0_DP v2 = (a2 + a4)/2.0_DP py%s(NS,it,iz,iy,ix)%y(ic,1) = v1 py%s(NS,it,iz,iy,ix)%y(ic,2) = v2 py%s(NS,it,iz,iy,ix)%y(ic,3) = v1 py%s(NS,it,iz,iy,ix)%y(ic,4) = v2 enddo do iw=2,NS-1 py%s(iw,it,iz,iy,ix)%y(:,:) = Z0 enddo enddo enddo enddo enddo return end subroutine
Subroutine : | |
y : | type(field_quark_wg), intent(inout) |
py : | type(field_dw_quark_wg), intent(in) |
Multiply permutation + chiral projection
Normal permutation + chiral projection (5D->4D)
subroutine assign_proj_5dto4d(y,py) ! ! Multiply permutation + chiral projection ! !------------------------------------------------------- ! Normal permutation + chiral projection (5D->4D) ! !* $ y = (P^{-} py(1) + P^{+} py(NS))/2 $ ! !------------------------------------------------------- ! !* $ (1-\gamma_5) y = P^{-} y $ . !* $ (1+\gamma_5) y = P^{+} y $ . ! implicit none type(field_quark_wg), intent(inout) :: y type(field_dw_quark_wg), intent(in) :: py integer :: ix,iy,iz,it,ieo,itb,ic,iw,NS complex(DP) :: a1,a2,a3,a4,w1,w2,v1,v2 if ( (.not.is_allocated(py)) ) then call error_stop("5-dim size of py is wrong in assign_proj_5dto4d.") endif call new(y) NS = py%NS !$OMP PARALLEL DO & !$OMP PRIVATE(ix,iy,iz,it,ieo,itb,ic, & !$OMP a1,a2,a3,a4,w1,w2,v1,v2) do ix=1,NX do iy=1,NY do iz=1,NZ do it=1,NT ieo = mod(ipeo+it+iz+iy+ix,2) itb = it/2 do ic=1,COL a1 = py%s( 1,it,iz,iy,ix)%y(ic,1) a2 = py%s( 1,it,iz,iy,ix)%y(ic,2) a3 = py%s( 1,it,iz,iy,ix)%y(ic,3) a4 = py%s( 1,it,iz,iy,ix)%y(ic,4) w1 = (a1 - a3)/2.0_DP w2 = (a2 - a4)/2.0_DP a1 = py%s(NS,it,iz,iy,ix)%y(ic,1) a2 = py%s(NS,it,iz,iy,ix)%y(ic,2) a3 = py%s(NS,it,iz,iy,ix)%y(ic,3) a4 = py%s(NS,it,iz,iy,ix)%y(ic,4) v1 = (a1 + a3)/2.0_DP v2 = (a2 + a4)/2.0_DP y%eo(ieo)%s(itb,iz,iy,ix)%y(ic,1) = w1 + v1 y%eo(ieo)%s(itb,iz,iy,ix)%y(ic,2) = w2 + v2 y%eo(ieo)%s(itb,iz,iy,ix)%y(ic,3) = -w1 + v1 y%eo(ieo)%s(itb,iz,iy,ix)%y(ic,4) = -w2 + v2 enddo enddo enddo enddo enddo return end subroutine
Subroutine : | |
y : | type(field_quark_wg), intent(inout) |
py : | type(field_dw_quark_wg), intent(in) |
Multiply permutation + chiral projection
Normal permutation + chiral projection (5D->4D)
subroutine assign_proj_5dto4d(y,py) ! ! Multiply permutation + chiral projection ! !------------------------------------------------------- ! Normal permutation + chiral projection (5D->4D) ! !* $ y = (P^{-} py(1) + P^{+} py(NS))/2 $ ! !------------------------------------------------------- ! !* $ (1-\gamma_5) y = P^{-} y $ . !* $ (1+\gamma_5) y = P^{+} y $ . ! implicit none type(field_quark_wg), intent(inout) :: y type(field_dw_quark_wg), intent(in) :: py integer :: ix,iy,iz,it,ieo,itb,ic,iw,NS complex(DP) :: a1,a2,a3,a4,w1,w2,v1,v2 if ( (.not.is_allocated(py)) ) then call error_stop("5-dim size of py is wrong in assign_proj_5dto4d.") endif call new(y) NS = py%NS !$OMP PARALLEL DO & !$OMP PRIVATE(ix,iy,iz,it,ieo,itb,ic, & !$OMP a1,a2,a3,a4,w1,w2,v1,v2) do ix=1,NX do iy=1,NY do iz=1,NZ do it=1,NT ieo = mod(ipeo+it+iz+iy+ix,2) itb = it/2 do ic=1,COL a1 = py%s( 1,it,iz,iy,ix)%y(ic,1) a2 = py%s( 1,it,iz,iy,ix)%y(ic,2) a3 = py%s( 1,it,iz,iy,ix)%y(ic,3) a4 = py%s( 1,it,iz,iy,ix)%y(ic,4) w1 = (a1 - a3)/2.0_DP w2 = (a2 - a4)/2.0_DP a1 = py%s(NS,it,iz,iy,ix)%y(ic,1) a2 = py%s(NS,it,iz,iy,ix)%y(ic,2) a3 = py%s(NS,it,iz,iy,ix)%y(ic,3) a4 = py%s(NS,it,iz,iy,ix)%y(ic,4) v1 = (a1 + a3)/2.0_DP v2 = (a2 + a4)/2.0_DP y%eo(ieo)%s(itb,iz,iy,ix)%y(ic,1) = w1 + v1 y%eo(ieo)%s(itb,iz,iy,ix)%y(ic,2) = w2 + v2 y%eo(ieo)%s(itb,iz,iy,ix)%y(ic,3) = -w1 + v1 y%eo(ieo)%s(itb,iz,iy,ix)%y(ic,4) = -w2 + v2 enddo enddo enddo enddo enddo return end subroutine
Subroutine : | |
q1 : | type(field_dw_quark_wg), intent(inout) |
q2 : | type(field_dw_quark_wg), intent(in) |
q3 : | type(field_dw_quark_wg), intent(in) |
ieo : | integer, intent(in) |
Assign subtraction
q1 = q2 - q3 on even/odd sites only.
Original external subprogram is field_5dfermion_class#assign_sub
Subroutine : | |
q1 : | type(field_dw_quark_wg), intent(inout) |
q2 : | type(field_dw_quark_wg), intent(in) |
q3 : | type(field_dw_quark_wg), intent(in) |
ieo : | integer, intent(in) |
Assign subtraction
q1 = q2 - q3 on even/odd sites only.
Original external subprogram is field_5dfermion_class#assign_sub
Subroutine : | |
q1 : | type(field_dw_quark_wg), intent(inout) |
q2 : | type(field_dw_quark_wg), intent(in) |
q3 : | type(field_dw_quark_wg), intent(in) |
ieo : | integer, intent(in) |
Assign subtraction
q1 = q2 - q3 on even/odd sites only.
Original external subprogram is field_5dfermion_class#assign_sub
Subroutine : | |
q1 : | type(field_dw_quark_wg), intent(inout) |
q2 : | type(field_dw_quark_wg), intent(in) |
q3 : | type(field_dw_quark_wg), intent(in) |
ieo : | integer, intent(in) |
Assign subtraction
q1 = q2 - q3 on even/odd sites only.
Original external subprogram is field_5dfermion_class#assign_sub
Subroutine : | |
q1 : | type(field_dw_quark_wg), intent(inout) |
q2 : | type(field_dw_quark_wg), intent(in) |
q3 : | type(field_dw_quark_wg), intent(in) |
ieo : | integer, intent(in) |
Assign subtraction
q1 = q2 - q3 on even/odd sites only.
Original external subprogram is field_5dfermion_class#assign_sub
Subroutine : | |
q1 : | type(field_dw_quark_wg), intent(inout) |
q2 : | type(field_dw_quark_wg), intent(in) |
q3 : | type(field_dw_quark_wg), intent(in) |
ieo : | integer, intent(in) |
Assign subtraction
q1 = q2 - q3 on even/odd sites only.
Original external subprogram is field_5dfermion_class#assign_sub
Subroutine : | |
q1 : | type(field_dw_quark_wg), intent(inout) |
q2 : | type(field_dw_quark_wg), intent(in) |
q3 : | type(field_dw_quark_wg), intent(in) |
ieo : | integer, intent(in) |
Assign subtraction
q1 = q2 - q3 on even/odd sites only.
Original external subprogram is field_5dfermion_class#assign_sub
Subroutine : | |
q1 : | type(field_dw_quark_wg), intent(inout) |
q2 : | type(field_dw_quark_wg), intent(in) |
q3 : | type(field_dw_quark_wg), intent(in) |
ieo : | integer, intent(in) |
Assign subtraction
q1 = q2 - q3 on even/odd sites only.
Original external subprogram is field_5dfermion_class#assign_sub
Subroutine : | |
q3 : | type(field_quark_wg), intent(inout) |
q1 : | type(field_quark_wg), intent(in) |
q2 : | type(field_quark_wg), intent(in) |
q3 <= q1 - q2
Original external subprogram is field_fermion_class#assign_sub
Subroutine : | |
q3 : | type(field_quark_wg), intent(inout) |
q1 : | type(field_quark_wg), intent(in) |
q2 : | type(field_quark_wg), intent(in) |
q3 <= q1 - q2
Original external subprogram is field_fermion_class#assign_sub
Subroutine : | |
q3 : | type(field_quark_wg), intent(inout) |
q1 : | type(field_quark_wg), intent(in) |
q2 : | type(field_quark_wg), intent(in) |
q3 <= q1 - q2
Original external subprogram is field_fermion_class#assign_sub
Subroutine : | |
q3e : | type(field_quark_eo_wg), intent(inout) |
q1e : | type(field_quark_eo_wg), intent(in) |
q2e : | type(field_quark_eo_wg), intent(in) |
q3e <= q1e - q2e
Original external subprogram is field_fermion_class#assign_sub
Subroutine : | |
q3e : | type(field_quark_eo_wg), intent(inout) |
q1e : | type(field_quark_eo_wg), intent(in) |
q2e : | type(field_quark_eo_wg), intent(in) |
q3e <= q1e - q2e
Original external subprogram is field_fermion_class#assign_sub
Subroutine : | |
q3e : | type(field_quark_eo_wg), intent(inout) |
q1e : | type(field_quark_eo_wg), intent(in) |
q2e : | type(field_quark_eo_wg), intent(in) |
q3e <= q1e - q2e
Original external subprogram is field_fermion_class#assign_sub
Subroutine : | |
u3e : | type(sfield_gluon_eo_wg), intent(inout) |
u1e : | type(sfield_gluon_eo_wg), intent(in) |
u2e : | type(sfield_gluon_eo_wg), intent(in) |
u3e = u1e - u2e
Original external subprogram is field_gauge_class#assign_sub
Subroutine : | |
u3e : | type(sfield_gluon_eo_wg), intent(inout) |
u1e : | type(sfield_gluon_eo_wg), intent(in) |
u2e : | type(sfield_gluon_eo_wg), intent(in) |
u3e = u1e - u2e
Original external subprogram is field_gauge_class#assign_sub
Subroutine : | |
u3e : | type(sfield_gluon_eo_wg), intent(inout) |
u1e : | type(sfield_gluon_eo_wg), intent(in) |
u2e : | type(sfield_gluon_eo_wg), intent(in) |
u3e = u1e - u2e
Original external subprogram is field_gauge_class#assign_sub
Subroutine : | |
q : | type(field_dw_quark_wg), intent(inout) |
q <= 0
Original external subprogram is field_5dfermion_class#clear
Subroutine : | |
q : | type(field_dw_quark_wg), intent(inout) |
q <= 0
Original external subprogram is field_5dfermion_class#clear
Subroutine : | |
q : | type(field_dw_quark_wg), intent(inout) |
q <= 0
Original external subprogram is field_5dfermion_class#clear
Subroutine : | |
q : | type(field_dw_quark_wg), intent(inout) |
q <= 0
Original external subprogram is field_5dfermion_class#clear
Subroutine : | |
q : | type(field_dw_quark_wg), intent(inout) |
q <= 0
Original external subprogram is field_5dfermion_class#clear
Subroutine : | |
q : | type(field_dw_quark_wg), intent(inout) |
q <= 0
Original external subprogram is field_5dfermion_class#clear
Subroutine : | |
q : | type(field_dw_quark_wg), intent(inout) |
q <= 0
Original external subprogram is field_5dfermion_class#clear
Subroutine : | |
q : | type(field_dw_quark_wg), intent(inout) |
q <= 0
Original external subprogram is field_5dfermion_class#clear
Subroutine : | |
q : | type(field_quark_wg), intent(inout) |
set zero on field
Original external subprogram is field_fermion_class#clear
Subroutine : | |
q : | type(field_quark_wg), intent(inout) |
set zero on field
Original external subprogram is field_fermion_class#clear
Subroutine : | |
q : | type(field_quark_wg), intent(inout) |
set zero on field
Original external subprogram is field_fermion_class#clear
Subroutine : | |
q : | type(field_quark_wog), intent(inout) |
set zero on field
Original external subprogram is field_fermion_class#clear
Subroutine : | |
q : | type(field_quark_wog), intent(inout) |
set zero on field
Original external subprogram is field_fermion_class#clear
Subroutine : | |
q : | type(field_quark_wog), intent(inout) |
set zero on field
Original external subprogram is field_fermion_class#clear
Subroutine : | |
qe : | type(field_quark_eo_wg), intent(inout) |
set zero on field
Original external subprogram is field_fermion_class#clear
Subroutine : | |
qe : | type(field_quark_eo_wg), intent(inout) |
set zero on field
Original external subprogram is field_fermion_class#clear
Subroutine : | |
qe : | type(field_quark_eo_wg), intent(inout) |
set zero on field
Original external subprogram is field_fermion_class#clear
Subroutine : | |
qe : | type(field_quark_eo_wog), intent(inout) |
set zero on field
Original external subprogram is field_fermion_class#clear
Subroutine : | |
qe : | type(field_quark_eo_wog), intent(inout) |
set zero on field
Original external subprogram is field_fermion_class#clear
Subroutine : | |
qe : | type(field_quark_eo_wog), intent(inout) |
set zero on field
Original external subprogram is field_fermion_class#clear
Subroutine : | |
u : | type(tfield_gluon_wg), intent(inout) |
Original external subprogram is field_gauge_class#clear
Subroutine : | |
u : | type(tfield_gluon_wg), intent(inout) |
Original external subprogram is field_gauge_class#clear
Subroutine : | |
u : | type(tfield_gluon_wg), intent(inout) |
Original external subprogram is field_gauge_class#clear
Subroutine : | |
u : | type(vfield_gluon_wg), intent(inout) |
Original external subprogram is field_gauge_class#clear
Subroutine : | |
u : | type(vfield_gluon_wg), intent(inout) |
Original external subprogram is field_gauge_class#clear
Subroutine : | |
u : | type(vfield_gluon_wg), intent(inout) |
Original external subprogram is field_gauge_class#clear
Subroutine : | |
u : | type(vfield_gluon_wog), intent(inout) |
Original external subprogram is field_gauge_class#clear
Subroutine : | |
u : | type(vfield_gluon_wog), intent(inout) |
Original external subprogram is field_gauge_class#clear
Subroutine : | |
u : | type(vfield_gluon_wog), intent(inout) |
Original external subprogram is field_gauge_class#clear
Subroutine : | |
ue : | type(sfield_gluon_eo_wg), intent(inout) |
Original external subprogram is field_gauge_class#clear
Subroutine : | |
ue : | type(sfield_gluon_eo_wg), intent(inout) |
Original external subprogram is field_gauge_class#clear
Subroutine : | |
ue : | type(sfield_gluon_eo_wg), intent(inout) |
Original external subprogram is field_gauge_class#clear
Subroutine : | |
ue : | type(sfield_gluon_eo_wog), intent(inout) |
Original external subprogram is field_gauge_class#clear
Subroutine : | |
ue : | type(sfield_gluon_eo_wog), intent(inout) |
Original external subprogram is field_gauge_class#clear
Subroutine : | |
ue : | type(sfield_gluon_eo_wog), intent(inout) |
Original external subprogram is field_gauge_class#clear
Subroutine : | |
ue : | type(tfield_gluon_eo_wg), intent(inout) |
Original external subprogram is field_gauge_class#clear
Subroutine : | |
ue : | type(tfield_gluon_eo_wg), intent(inout) |
Original external subprogram is field_gauge_class#clear
Subroutine : | |
ue : | type(tfield_gluon_eo_wg), intent(inout) |
Original external subprogram is field_gauge_class#clear
Subroutine : | |
ue : | type(vfield_gluon_eo_wg), intent(inout) |
Original external subprogram is field_gauge_class#clear
Subroutine : | |
ue : | type(vfield_gluon_eo_wg), intent(inout) |
Original external subprogram is field_gauge_class#clear
Subroutine : | |
ue : | type(vfield_gluon_eo_wg), intent(inout) |
Original external subprogram is field_gauge_class#clear
Subroutine : | |
ue : | type(vfield_gluon_eo_wog), intent(inout) |
Original external subprogram is field_gauge_class#clear
Subroutine : | |
ue : | type(vfield_gluon_eo_wog), intent(inout) |
Original external subprogram is field_gauge_class#clear
Subroutine : | |
ue : | type(vfield_gluon_eo_wog), intent(inout) |
Original external subprogram is field_gauge_class#clear
Subroutine : | |
q : | type(field_dw_quark_wg), intent(inout) |
copy boundary
Original external subprogram is field_5dfermion_class#copy_boundary
Subroutine : | |
q : | type(field_dw_quark_wg), intent(inout) |
copy boundary
Original external subprogram is field_5dfermion_class#copy_boundary
Subroutine : | |
q : | type(field_dw_quark_wg), intent(inout) |
copy boundary
Original external subprogram is field_5dfermion_class#copy_boundary
Subroutine : | |
q : | type(field_dw_quark_wg), intent(inout) |
copy boundary
Original external subprogram is field_5dfermion_class#copy_boundary
Subroutine : | |
q : | type(field_dw_quark_wg), intent(inout) |
copy boundary
Original external subprogram is field_5dfermion_class#copy_boundary
Subroutine : | |
q : | type(field_dw_quark_wg), intent(inout) |
copy boundary
Original external subprogram is field_5dfermion_class#copy_boundary
Subroutine : | |
q : | type(field_dw_quark_wg), intent(inout) |
copy boundary
Original external subprogram is field_5dfermion_class#copy_boundary
Subroutine : | |
q : | type(field_dw_quark_wg), intent(inout) |
copy boundary
Original external subprogram is field_5dfermion_class#copy_boundary
Subroutine : | |
u : | type(sfield_gluon_wg), intent(inout) |
Original external subprogram is field_gauge_class#copy_boundary
Subroutine : | |
u : | type(sfield_gluon_wg), intent(inout) |
Original external subprogram is field_gauge_class#copy_boundary
Subroutine : | |
u : | type(sfield_gluon_wg), intent(inout) |
Original external subprogram is field_gauge_class#copy_boundary
Subroutine : | |
u : | type(tfield_gluon_wg), intent(inout) |
Original external subprogram is field_gauge_class#copy_boundary
Subroutine : | |
u : | type(tfield_gluon_wg), intent(inout) |
Original external subprogram is field_gauge_class#copy_boundary
Subroutine : | |
u : | type(tfield_gluon_wg), intent(inout) |
Original external subprogram is field_gauge_class#copy_boundary
Subroutine : | |
u : | type(vfield_gluon_wg), intent(inout) |
Original external subprogram is field_gauge_class#copy_boundary
Subroutine : | |
u : | type(vfield_gluon_wg), intent(inout) |
Original external subprogram is field_gauge_class#copy_boundary
Subroutine : | |
u : | type(vfield_gluon_wg), intent(inout) |
Original external subprogram is field_gauge_class#copy_boundary
Subroutine : | |
ue : | type(sfield_gluon_eo_wg), intent(inout) |
Boundary copy for su(3) scalar field with periodic boundary condition.
ue : even/odd site su3 scalar field (ieo=0/1)
Original external subprogram is field_gauge_class#copy_boundary
Subroutine : | |
ue : | type(sfield_gluon_eo_wg), intent(inout) |
Boundary copy for su(3) scalar field with periodic boundary condition.
ue : even/odd site su3 scalar field (ieo=0/1)
Original external subprogram is field_gauge_class#copy_boundary
Subroutine : | |
ue : | type(sfield_gluon_eo_wg), intent(inout) |
Boundary copy for su(3) scalar field with periodic boundary condition.
ue : even/odd site su3 scalar field (ieo=0/1)
Original external subprogram is field_gauge_class#copy_boundary
Subroutine : | |
ue : | type(tfield_gluon_eo_wg), intent(inout) |
Original external subprogram is field_gauge_class#copy_boundary
Subroutine : | |
ue : | type(tfield_gluon_eo_wg), intent(inout) |
Original external subprogram is field_gauge_class#copy_boundary
Subroutine : | |
ue : | type(tfield_gluon_eo_wg), intent(inout) |
Original external subprogram is field_gauge_class#copy_boundary
Subroutine : | |
ue : | type(vfield_gluon_eo_wg), intent(inout) |
Original external subprogram is field_gauge_class#copy_boundary
Subroutine : | |
ue : | type(vfield_gluon_eo_wg), intent(inout) |
Original external subprogram is field_gauge_class#copy_boundary
Subroutine : | |
ue : | type(vfield_gluon_eo_wg), intent(inout) |
Original external subprogram is field_gauge_class#copy_boundary
Subroutine : | |
y : | type(field_quark_wg), intent(inout) |
Boundary copy
Original external subprogram is field_fermion_class#copy_boundary
Subroutine : | |
y : | type(field_quark_wg), intent(inout) |
Boundary copy
Original external subprogram is field_fermion_class#copy_boundary
Subroutine : | |
y : | type(field_quark_wg), intent(inout) |
Boundary copy
Original external subprogram is field_fermion_class#copy_boundary
Subroutine : | |
ye : | type(field_quark_eo_wg), intent(inout) |
Boundary copy on even/odd sites only
Original external subprogram is field_fermion_class#copy_boundary
Subroutine : | |
ye : | type(field_quark_eo_wg), intent(inout) |
Boundary copy on even/odd sites only
Original external subprogram is field_fermion_class#copy_boundary
Subroutine : | |
ye : | type(field_quark_eo_wg), intent(inout) |
Boundary copy on even/odd sites only
Original external subprogram is field_fermion_class#copy_boundary
Variable : | |||
copy_fq_time : | type(timer), save
|
Original external subprogram is field_5dfermion_class#copy_fq_time
Variable : | |||
copy_fq_time : | type(timer), save
|
Original external subprogram is field_5dfermion_class#copy_fq_time
Variable : | |||
copy_fq_time : | type(timer), save
|
Original external subprogram is field_5dfermion_class#copy_fq_time
Variable : | |||
copy_fq_time : | type(timer), save
|
Original external subprogram is field_5dfermion_class#copy_fq_time
Variable : | |||
copy_fq_time : | type(timer), save
|
Original external subprogram is field_fermion_class#copy_fq_time
Variable : | |||
copy_fq_time : | type(timer), save
|
Original external subprogram is field_fermion_class#copy_fq_time
Variable : | |||
copy_fq_time : | type(timer), save
|
Original external subprogram is field_fermion_class#copy_fq_time
Subroutine : | |
this : | class(quark_domainwall), intent(inout) |
delete dwf parameter
subroutine delete_dwq(this) ! ! delete dwf parameter ! implicit none class(quark_domainwall), intent(inout) :: this call delete_mass_term_dwq(this) return end subroutine
Subroutine : | |
this : | class(quark_domainwall), intent(inout) |
delete dwf parameter
subroutine delete_dwq(this) ! ! delete dwf parameter ! implicit none class(quark_domainwall), intent(inout) :: this call delete_mass_term_dwq(this) return end subroutine
Subroutine : | |
this : | type(dwf_low_modes), intent(inout) |
delete dwf low-modes container
subroutine delete_dwq_low_modes(this) ! ! delete dwf low-modes container ! implicit none type(dwf_low_modes), intent(inout) :: this integer :: i if (allocated(this%W)) then call delete(this%W) deallocate(this%W) endif if (allocated(this%XX)) deallocate(this%XX) return end subroutine
Subroutine : | |
this : | type(dwf_low_modes), intent(inout) |
delete dwf low-modes container
subroutine delete_dwq_low_modes(this) ! ! delete dwf low-modes container ! implicit none type(dwf_low_modes), intent(inout) :: this integer :: i if (allocated(this%W)) then call delete(this%W) deallocate(this%W) endif if (allocated(this%XX)) deallocate(this%XX) return end subroutine
Derived Type : | |
s(:,:,:,:,:) : | type(su3fv_spinor), allocatable |
NS = 0 : | integer |
idummy(3) = 0 : | integer |
Original external subprogram is field_5dfermion_class#field_dw_quark_wg
Derived Type : | |
s(:,:,:,:,:) : | type(su3fv_spinor), allocatable |
NS = 0 : | integer |
idummy(3) = 0 : | integer |
Original external subprogram is field_5dfermion_class#field_dw_quark_wg
Derived Type : | |
s(:,:,:,:,:) : | type(su3fv_spinor), allocatable |
NS = 0 : | integer |
idummy(3) = 0 : | integer |
Original external subprogram is field_5dfermion_class#field_dw_quark_wg
Derived Type : | |
s(:,:,:,:,:) : | type(su3fv_spinor), allocatable |
NS = 0 : | integer |
idummy(3) = 0 : | integer |
Original external subprogram is field_5dfermion_class#field_dw_quark_wg
Derived Type : | |
s(:,:,:,:,:) : | type(su3fv_spinor), allocatable |
NS = 0 : | integer |
idummy(3) = 0 : | integer |
Original external subprogram is field_5dfermion_class#field_dw_quark_wg
Derived Type : | |
s(:,:,:,:,:) : | type(su3fv_spinor), allocatable |
NS = 0 : | integer |
idummy(3) = 0 : | integer |
Original external subprogram is field_5dfermion_class#field_dw_quark_wg
Derived Type : | |
s(:,:,:,:,:) : | type(su3fv_spinor), allocatable |
NS = 0 : | integer |
idummy(3) = 0 : | integer |
Original external subprogram is field_5dfermion_class#field_dw_quark_wg
Derived Type : | |
s(:,:,:,:,:) : | type(su3fv_spinor), allocatable |
NS = 0 : | integer |
idummy(3) = 0 : | integer |
Original external subprogram is field_5dfermion_class#field_dw_quark_wg
Derived Type : | |||
s(0:NTH,0:NZ1,0:NY1,0:NX1) : | type(su3fv_spinor)
| ||
ieo : | integer
| ||
idummy(3) : | integer
|
quark field on even/odd sites with ghost sites
Original external subprogram is field_5dfermion_class#field_quark_eo_wg
Derived Type : | |||
s(0:NTH,0:NZ1,0:NY1,0:NX1) : | type(su3fv_spinor)
| ||
ieo : | integer
| ||
idummy(3) : | integer
|
quark field on even/odd sites with ghost sites
Original external subprogram is field_5dfermion_class#field_quark_eo_wg
Derived Type : | |||
s(0:NTH,0:NZ1,0:NY1,0:NX1) : | type(su3fv_spinor)
| ||
ieo : | integer
| ||
idummy(3) : | integer
|
quark field on even/odd sites with ghost sites
Original external subprogram is field_5dfermion_class#field_quark_eo_wg
Derived Type : | |||
s(0:NTH,0:NZ1,0:NY1,0:NX1) : | type(su3fv_spinor)
| ||
ieo : | integer
| ||
idummy(3) : | integer
|
quark field on even/odd sites with ghost sites
Original external subprogram is field_5dfermion_class#field_quark_eo_wg
Derived Type : | |||
s(0:NTH,0:NZ1,0:NY1,0:NX1) : | type(su3fv_spinor)
| ||
ieo : | integer
| ||
idummy(3) : | integer
|
quark field on even/odd sites with ghost sites
Original external subprogram is field_fermion_class#field_quark_eo_wg
Derived Type : | |||
s(0:NTH,0:NZ1,0:NY1,0:NX1) : | type(su3fv_spinor)
| ||
ieo : | integer
| ||
idummy(3) : | integer
|
quark field on even/odd sites with ghost sites
Original external subprogram is field_fermion_class#field_quark_eo_wg
Derived Type : | |||
s(0:NTH,0:NZ1,0:NY1,0:NX1) : | type(su3fv_spinor)
| ||
ieo : | integer
| ||
idummy(3) : | integer
|
quark field on even/odd sites with ghost sites
Original external subprogram is field_fermion_class#field_quark_eo_wg
Derived Type : | |
s(NTH,NZ,NY,NX) : | type(su3fv_spinor) |
ieo : | integer |
idummy(3) : | integer |
quark field on even/odd sites without ghost sites
Original external subprogram is field_5dfermion_class#field_quark_eo_wog
Derived Type : | |
s(NTH,NZ,NY,NX) : | type(su3fv_spinor) |
ieo : | integer |
idummy(3) : | integer |
quark field on even/odd sites without ghost sites
Original external subprogram is field_5dfermion_class#field_quark_eo_wog
Derived Type : | |
s(NTH,NZ,NY,NX) : | type(su3fv_spinor) |
ieo : | integer |
idummy(3) : | integer |
quark field on even/odd sites without ghost sites
Original external subprogram is field_5dfermion_class#field_quark_eo_wog
Derived Type : | |
s(NTH,NZ,NY,NX) : | type(su3fv_spinor) |
ieo : | integer |
idummy(3) : | integer |
quark field on even/odd sites without ghost sites
Original external subprogram is field_5dfermion_class#field_quark_eo_wog
Derived Type : | |
s(NTH,NZ,NY,NX) : | type(su3fv_spinor) |
ieo : | integer |
idummy(3) : | integer |
quark field on even/odd sites without ghost sites
Original external subprogram is field_fermion_class#field_quark_eo_wog
Derived Type : | |
s(NTH,NZ,NY,NX) : | type(su3fv_spinor) |
ieo : | integer |
idummy(3) : | integer |
quark field on even/odd sites without ghost sites
Original external subprogram is field_fermion_class#field_quark_eo_wog
Derived Type : | |
s(NTH,NZ,NY,NX) : | type(su3fv_spinor) |
ieo : | integer |
idummy(3) : | integer |
quark field on even/odd sites without ghost sites
Original external subprogram is field_fermion_class#field_quark_eo_wog
Derived Type : | |||
eo(0:1) : | type(field_quark_eo_wg)
|
quark field with ghost sites
Original external subprogram is field_5dfermion_class#field_quark_wg
Derived Type : | |||
eo(0:1) : | type(field_quark_eo_wg)
|
quark field with ghost sites
Original external subprogram is field_5dfermion_class#field_quark_wg
Derived Type : | |||
eo(0:1) : | type(field_quark_eo_wg)
|
quark field with ghost sites
Original external subprogram is field_5dfermion_class#field_quark_wg
Derived Type : | |||
eo(0:1) : | type(field_quark_eo_wg)
|
quark field with ghost sites
Original external subprogram is field_5dfermion_class#field_quark_wg
Derived Type : | |||
eo(0:1) : | type(field_quark_eo_wg)
|
quark field with ghost sites
Original external subprogram is field_fermion_class#field_quark_wg
Derived Type : | |||
eo(0:1) : | type(field_quark_eo_wg)
|
quark field with ghost sites
Original external subprogram is field_fermion_class#field_quark_wg
Derived Type : | |||
eo(0:1) : | type(field_quark_eo_wg)
|
quark field with ghost sites
Original external subprogram is field_fermion_class#field_quark_wg
Derived Type : | |
eo(0:1) : | type(field_quark_eo_wog) |
quark field without ghost sites
Original external subprogram is field_5dfermion_class#field_quark_wog
Derived Type : | |
eo(0:1) : | type(field_quark_eo_wog) |
quark field without ghost sites
Original external subprogram is field_5dfermion_class#field_quark_wog
Derived Type : | |
eo(0:1) : | type(field_quark_eo_wog) |
quark field without ghost sites
Original external subprogram is field_5dfermion_class#field_quark_wog
Derived Type : | |
eo(0:1) : | type(field_quark_eo_wog) |
quark field without ghost sites
Original external subprogram is field_5dfermion_class#field_quark_wog
Derived Type : | |
eo(0:1) : | type(field_quark_eo_wog) |
quark field without ghost sites
Original external subprogram is field_fermion_class#field_quark_wog
Derived Type : | |
eo(0:1) : | type(field_quark_eo_wog) |
quark field without ghost sites
Original external subprogram is field_fermion_class#field_quark_wog
Derived Type : | |
eo(0:1) : | type(field_quark_eo_wog) |
quark field without ghost sites
Original external subprogram is field_fermion_class#field_quark_wog
Subroutine : | |||
BB : | type(vfield_gluon_wg), intent(inout)
| ||
fcoef : | real(DP), intent(in)
| ||
fx : | type(field_dw_quark_wg),
intent(inout)
| ||
fy : | type(field_dw_quark_wg),
intent(inout)
|
compute MD force from hopping matrix of Ddw operator
NS field contributions are accumulated on BB.
fx,fy, boundary sites are copied.
Original external subprogram is field_5dfermion_class#force_hmc_hopping
Subroutine : | |||
BB : | type(vfield_gluon_wg), intent(inout)
| ||
fcoef : | real(DP), intent(in)
| ||
fx : | type(field_dw_quark_wg),
intent(inout)
| ||
fy : | type(field_dw_quark_wg),
intent(inout)
|
compute MD force from hopping matrix of Ddw operator
NS field contributions are accumulated on BB.
fx,fy, boundary sites are copied.
Original external subprogram is field_5dfermion_class#force_hmc_hopping
Subroutine : | |||
BB : | type(vfield_gluon_wg), intent(inout)
| ||
fcoef : | real(DP), intent(in)
| ||
fx : | type(field_dw_quark_wg),
intent(inout)
| ||
fy : | type(field_dw_quark_wg),
intent(inout)
|
compute MD force from hopping matrix of Ddw operator
NS field contributions are accumulated on BB.
fx,fy, boundary sites are copied.
Original external subprogram is field_5dfermion_class#force_hmc_hopping
Subroutine : | |||
BB : | type(vfield_gluon_wg), intent(inout)
| ||
fcoef : | real(DP), intent(in)
| ||
fx : | type(field_dw_quark_wg),
intent(inout)
| ||
fy : | type(field_dw_quark_wg),
intent(inout)
|
compute MD force from hopping matrix of Ddw operator
NS field contributions are accumulated on BB.
fx,fy, boundary sites are copied.
Original external subprogram is field_5dfermion_class#force_hmc_hopping
Subroutine : | |||
BB : | type(vfield_gluon_wg), intent(inout)
| ||
fcoef : | real(DP), intent(in)
| ||
fx : | type(field_dw_quark_wg),
intent(inout)
| ||
fy : | type(field_dw_quark_wg),
intent(inout)
|
compute MD force from hopping matrix of Ddw operator
NS field contributions are accumulated on BB.
fx,fy, boundary sites are copied.
Original external subprogram is field_5dfermion_class#force_hmc_hopping
Subroutine : | |||
BB : | type(vfield_gluon_wg), intent(inout)
| ||
fcoef : | real(DP), intent(in)
| ||
fx : | type(field_dw_quark_wg),
intent(inout)
| ||
fy : | type(field_dw_quark_wg),
intent(inout)
|
compute MD force from hopping matrix of Ddw operator
NS field contributions are accumulated on BB.
fx,fy, boundary sites are copied.
Original external subprogram is field_5dfermion_class#force_hmc_hopping
Subroutine : | |||
BB : | type(vfield_gluon_wg), intent(inout)
| ||
fcoef : | real(DP), intent(in)
| ||
fx : | type(field_dw_quark_wg),
intent(inout)
| ||
fy : | type(field_dw_quark_wg),
intent(inout)
|
compute MD force from hopping matrix of Ddw operator
NS field contributions are accumulated on BB.
fx,fy, boundary sites are copied.
Original external subprogram is field_5dfermion_class#force_hmc_hopping
Subroutine : | |||
BB : | type(vfield_gluon_wg), intent(inout)
| ||
fcoef : | real(DP), intent(in)
| ||
fx : | type(field_dw_quark_wg),
intent(inout)
| ||
fy : | type(field_dw_quark_wg),
intent(inout)
|
compute MD force from hopping matrix of Ddw operator
NS field contributions are accumulated on BB.
fx,fy, boundary sites are copied.
Original external subprogram is field_5dfermion_class#force_hmc_hopping
Subroutine : | |||
BB : | type(vfield_gluon_wg), intent(inout)
| ||
fcoef : | real(DP), intent(in)
| ||
fx : | type(field_quark_wg),
intent(in)
| ||
fy : | type(field_quark_wg),
intent(in)
|
Calc MD force from hopping matrix
User should copy boundary of the input field (fx,fy) before calling this subroutine.
\[
BB_{\mu}(n) = BB_{\mu}(n) + \mathrm{fcoef}\times \mathrm{tr}\left[(1-\gamma_{\mu}) fy(n+\hat{\mu}) fx(n)^{\dag} + fx(n+\hat{\mu}) fy(n)^{\dag} (1+\gamma_{\mu})\right].
\] this comes from \[
\delta S = fx^{\dag}\delta M_{hop} fy + fy^{\dag}\delta M_{hop}^{\dag} fx,
\] with hopping matrix $ M_{hop} $ .
Original external subprogram is field_fermion_class#force_hmc_hopping
Subroutine : | |||
BB : | type(vfield_gluon_wg), intent(inout)
| ||
fcoef : | real(DP), intent(in)
| ||
fx : | type(field_quark_wg),
intent(in)
| ||
fy : | type(field_quark_wg),
intent(in)
|
Calc MD force from hopping matrix
User should copy boundary of the input field (fx,fy) before calling this subroutine.
\[
BB_{\mu}(n) = BB_{\mu}(n) + \mathrm{fcoef}\times \mathrm{tr}\left[(1-\gamma_{\mu}) fy(n+\hat{\mu}) fx(n)^{\dag} + fx(n+\hat{\mu}) fy(n)^{\dag} (1+\gamma_{\mu})\right].
\] this comes from \[
\delta S = fx^{\dag}\delta M_{hop} fy + fy^{\dag}\delta M_{hop}^{\dag} fx,
\] with hopping matrix $ M_{hop} $ .
Original external subprogram is field_fermion_class#force_hmc_hopping
Subroutine : | |||
BB : | type(vfield_gluon_wg), intent(inout)
| ||
fcoef : | real(DP), intent(in)
| ||
fx : | type(field_quark_wg),
intent(in)
| ||
fy : | type(field_quark_wg),
intent(in)
|
Calc MD force from hopping matrix
User should copy boundary of the input field (fx,fy) before calling this subroutine.
\[
BB_{\mu}(n) = BB_{\mu}(n) + \mathrm{fcoef}\times \mathrm{tr}\left[(1-\gamma_{\mu}) fy(n+\hat{\mu}) fx(n)^{\dag} + fx(n+\hat{\mu}) fy(n)^{\dag} (1+\gamma_{\mu})\right].
\] this comes from \[
\delta S = fx^{\dag}\delta M_{hop} fy + fy^{\dag}\delta M_{hop}^{\dag} fx,
\] with hopping matrix $ M_{hop} $ .
Original external subprogram is field_fermion_class#force_hmc_hopping
Subroutine : | |||
BBe : | type(vfield_gluon_eo_wg), intent(inout)
| ||
fcoef : | real(DP), intent(in)
| ||
fxe : | type(field_quark_eo_wg),
intent(in)
| ||
fxo : | type(field_quark_eo_wg),
intent(in)
| ||
fye : | type(field_quark_eo_wg),
intent(in)
| ||
fyo : | type(field_quark_eo_wg),
intent(in)
|
Calc MD force from hopping matrix (even/odd sites only)
User should copy boundary of the input field (fx,fy) before calling this subroutine.
\[
BB_{\mu}(n) = BB_{\mu}(n) + \mathrm{fcoef}\times \mathrm{tr}\left[(1-\gamma_{\mu}) fy(n+\hat{\mu}) fx(n)^{\dag} + fx(n+\hat{\mu}) fy(n)^{\dag} (1+\gamma_{\mu})\right].
\] this comes from \[
\delta S = fx^{\dag}\delta M_{hop} fy + fy^{\dag}\delta M_{hop}^{\dag} fx,
\] with hopping matrix $ M_{hop} $ .
Original external subprogram is field_fermion_class#force_hmc_hopping
Subroutine : | |||
BBe : | type(vfield_gluon_eo_wg), intent(inout)
| ||
fcoef : | real(DP), intent(in)
| ||
fxe : | type(field_quark_eo_wg),
intent(in)
| ||
fxo : | type(field_quark_eo_wg),
intent(in)
| ||
fye : | type(field_quark_eo_wg),
intent(in)
| ||
fyo : | type(field_quark_eo_wg),
intent(in)
|
Calc MD force from hopping matrix (even/odd sites only)
User should copy boundary of the input field (fx,fy) before calling this subroutine.
\[
BB_{\mu}(n) = BB_{\mu}(n) + \mathrm{fcoef}\times \mathrm{tr}\left[(1-\gamma_{\mu}) fy(n+\hat{\mu}) fx(n)^{\dag} + fx(n+\hat{\mu}) fy(n)^{\dag} (1+\gamma_{\mu})\right].
\] this comes from \[
\delta S = fx^{\dag}\delta M_{hop} fy + fy^{\dag}\delta M_{hop}^{\dag} fx,
\] with hopping matrix $ M_{hop} $ .
Original external subprogram is field_fermion_class#force_hmc_hopping
Subroutine : | |||
BBe : | type(vfield_gluon_eo_wg), intent(inout)
| ||
fcoef : | real(DP), intent(in)
| ||
fxe : | type(field_quark_eo_wg),
intent(in)
| ||
fxo : | type(field_quark_eo_wg),
intent(in)
| ||
fye : | type(field_quark_eo_wg),
intent(in)
| ||
fyo : | type(field_quark_eo_wg),
intent(in)
|
Calc MD force from hopping matrix (even/odd sites only)
User should copy boundary of the input field (fx,fy) before calling this subroutine.
\[
BB_{\mu}(n) = BB_{\mu}(n) + \mathrm{fcoef}\times \mathrm{tr}\left[(1-\gamma_{\mu}) fy(n+\hat{\mu}) fx(n)^{\dag} + fx(n+\hat{\mu}) fy(n)^{\dag} (1+\gamma_{\mu})\right].
\] this comes from \[
\delta S = fx^{\dag}\delta M_{hop} fy + fy^{\dag}\delta M_{hop}^{\dag} fx,
\] with hopping matrix $ M_{hop} $ .
Original external subprogram is field_fermion_class#force_hmc_hopping
Function : | |
NS : | integer |
this : | class(quark_domainwall), intent(in) |
return size of extra-dimensiion (extra-flavors)
function get_NS_dwq(this) result(NS) ! ! return size of extra-dimensiion (extra-flavors) ! implicit none class(quark_domainwall), intent(in) :: this integer :: NS NS = this%NS return end function
Function : | |
NS : | integer |
this : | class(quark_domainwall), intent(in) |
return size of extra-dimensiion (extra-flavors)
function get_NS_dwq(this) result(NS) ! ! return size of extra-dimensiion (extra-flavors) ! implicit none class(quark_domainwall), intent(in) :: this integer :: NS NS = this%NS return end function
Function : | |
id : | integer |
this : | class(action_parameters), intent(in) |
Original external subprogram is quark_wilson_class#get_id
Function : | |
id : | integer |
this : | class(action_parameters), intent(in) |
Original external subprogram is quark_wilson_class#get_id
Function : | |
id : | integer |
this : | class(action_parameters), intent(in) |
Original external subprogram is action_base_class#get_id
Function : | |
id : | integer |
this : | class(action_parameters), intent(in) |
Original external subprogram is action_base_class#get_id
Function : | |
id : | integer |
this : | class(action_parameters), intent(in) |
Original external subprogram is action_base_class#get_id
Subroutine : | |
this : | type(dwf_low_modes), intent(inout) |
quark : | class(quark_domainwall), intent(inout) |
iout : | integer, intent(in) |
tol : | real(DP), intent(in) |
iiter : | integer, intent(inout) |
u : | type(vfield_gluon_wg), intent(in) |
compute low-mode vectors for dwf chiral-symmetory improvement and eigen-value range
subroutine get_dwq_low_modes(this,quark,iout,tol,iiter,u) ! ! compute low-mode vectors for dwf chiral-symmetory improvement ! and eigen-value range ! use f95_lapack, only : LA_HESV use quark_ovlp_kern_eigmodes_class implicit none type(dwf_low_modes), intent(inout) :: this class(quark_domainwall), intent(inout) :: quark integer, intent(in) :: iout integer, intent(inout) :: iiter real(DP), intent(in) :: tol type(vfield_gluon_wg), intent(in) :: u type(quark_ovlp_kern_eigmodes), allocatable :: emodes type(field_quark_wg), allocatable :: w,gv integer, parameter :: NUM_MAX_EVAL = 5 integer :: i,j,NEV,INFO real(DP) :: ETMP(this%NEV),rtmp0,rtmp1,rtmp2 complex(DP) :: MTMP(this%NEV,this%NEV) character(CHARLEN) :: str NEV = this%NEV ! ! Compute Lower eigen pairs from the sign kernel operator, construct chiral-symemtry ! improvement vectors for domainwall fermions ! allocate(emodes) emodes%NEV = NEV call new(emodes) emodes%which_modes = SIGN_KERNEL_LOW_MODES if (is_kernel_type_shamir(quark)) then emodes%a5 = quark%a5 else emodes%a5 = 0.0d0 endif emodes%m0 = quark%dw_height #ifdef _DEBUG emodes%debug = .true. #endif call get_sign_kernel_eigen_modes(emodes,iout,tol,iiter,u) allocate(w,gv) call new(w) call new(gv) !------------------------------------- ! construct lowmode subspace vectors ! for domainwall fermion !------------------------------------- ETMP(:) = 0.0_DP MTMP(:,:) = Z0 do i=1,NEV call assign_mult_gamma5(gv,emodes%V(i)) ! gv = gamma5 V(i) if (is_kernel_type_shamir(quark)) then ! ! w_i = (a5/2)*(Dw + 2/a5) gamma_5 v_i ! rtmp0 = quark%dw_height - 2.0_DP/quark%a5 call assign_mult_wd(rtmp0,w,gv,u) ! w := (Dw(m0) + 2/a5) gamma_5 v(i) call accum_mult(w,quark%a5/2.0_DP) ! w := (a5/2) w = (Dw(m0)*a5/2 + 1) gamma_5 v(i) call conv_wqf_to_dwqf(w,this%W,i) ! W(i) := w ! ! X(i,i) = - a * v_i'w_i (a=a5/2) ! MTMP(i,i) = - (quark%a5/2.0_DP)*prod(emodes%V(i),w) ! ! X(j,i) = - a * v_j'w_i (a=a5/2) ! do j=i+1,NEV MTMP(j,i) = - (quark%a5/2.0_DP)*prod(emodes%V(j),w) MTMP(i,j) = conjg(MTMP(j,i)) enddo else ! ! W(i) := gamma_5 v_i ! call conv_wqf_to_dwqf(gv,this%W,i) endif enddo !------------------------- ! get miniumum eigenvalue !------------------------- do i=1,NEV ETMP(i) = ABS(emodes%EV(i)) enddo rtmp0 = MINVAL(ETMP(:)) quark%ev_min_true = rtmp0 quark%ev_min = MAXVAL(ETMP(:)) if (0 == nodeid) then write(iout,'("%EVALMIN_TRUE",E24.15)') quark%ev_min_true write(iout,'("%EVALMIN ",E24.15)') quark%ev_min endif !-------------------- ! X = 1/S - a*V'W !-------------------- do i=1,nev ! ! shift low-modes ! rtmp0 = emodes%EV(i) rtmp1 = 2*SIGN(quark%ev_min,rtmp0) - rtmp0 ! 2*|lambda_max|*sign(lambda_i) - lambda_i MTMP(i,i) = MTMP(i,i) + 1.0_DP/rtmp1 if (0 == nodeid) write(iout,'("%EVAL",I3,E24.15," => EVAL_SHFT=",E24.15)')i,rtmp0,rtmp1 enddo do j=1,NEV do i=1,NEV if (0 == nodeid) write(iout,'("%MAT",2I3,2E24.15)')i,j,MTMP(i,j) enddo enddo this%XX(:,:) = Z0 do i=1,NEV this%XX(i,i) = Z1 enddo call LA_HESV(MTMP,this%XX,INFO=INFO) ! LV%XX = inv(X) if (0 /= INFO) then write(str,'("LA_HESV error (@get_dwq_low_mode). INFO=",I4,1X,A,I5)')INFO,__FILE__,__LINE__ call error_stop(TRIM(str)) endif do j=1,NEV do i=1,NEV if (0 == nodeid) write(iout,'("%MATINV",2I3,2E24.15)')i,j,this%XX(i,j) enddo enddo ! ! Compute High modes. ! ! The Largest eigen value is requred to estimate the eigenvalue range of the sign kerenel operator ! and The eigen vectors are dropped. ! call delete(emodes) deallocate(w,gv) emodes%NEV = this%NEV call new(emodes) emodes%which_modes = SIGN_KERNEL_HIGH_MODES if (is_kernel_type_shamir(quark)) then emodes%a5 = quark%a5 else emodes%a5 = 0.0d0 endif emodes%m0 = quark%dw_height #ifdef _DEBUG emodes%debug = .true. #endif call get_sign_kernel_eigen_modes(emodes,iout,tol,iiter,u) do i=1,emodes%NEV ETMP(i) = ABS(emodes%EV(i)) enddo quark%ev_max = MAXVAL(ETMP(1:emodes%NEV)) if (0 == nodeid) then write(iout,'("%EVALMAX ",E24.15)') quark%ev_max do i=1,emodes%NEV rtmp0 = emodes%EV(i) write(iout,'("%EVAL",I3,E24.15)')i,rtmp0 enddo endif call delete(emodes) deallocate(emodes) return end subroutine
Subroutine : | |
this : | type(dwf_low_modes), intent(inout) |
quark : | class(quark_domainwall), intent(inout) |
iout : | integer, intent(in) |
tol : | real(DP), intent(in) |
iiter : | integer, intent(inout) |
u : | type(vfield_gluon_wg), intent(in) |
compute low-mode vectors for dwf chiral-symmetory improvement and eigen-value range
subroutine get_dwq_low_modes(this,quark,iout,tol,iiter,u) ! ! compute low-mode vectors for dwf chiral-symmetory improvement ! and eigen-value range ! use f95_lapack, only : LA_HESV use quark_ovlp_kern_eigmodes_class implicit none type(dwf_low_modes), intent(inout) :: this class(quark_domainwall), intent(inout) :: quark integer, intent(in) :: iout integer, intent(inout) :: iiter real(DP), intent(in) :: tol type(vfield_gluon_wg), intent(in) :: u type(quark_ovlp_kern_eigmodes), allocatable :: emodes type(field_quark_wg), allocatable :: w,gv integer, parameter :: NUM_MAX_EVAL = 5 integer :: i,j,NEV,INFO real(DP) :: ETMP(this%NEV),rtmp0,rtmp1,rtmp2 complex(DP) :: MTMP(this%NEV,this%NEV) character(CHARLEN) :: str NEV = this%NEV ! ! Compute Lower eigen pairs from the sign kernel operator, construct chiral-symemtry ! improvement vectors for domainwall fermions ! allocate(emodes) emodes%NEV = NEV call new(emodes) emodes%which_modes = SIGN_KERNEL_LOW_MODES if (is_kernel_type_shamir(quark)) then emodes%a5 = quark%a5 else emodes%a5 = 0.0d0 endif emodes%m0 = quark%dw_height #ifdef _DEBUG emodes%debug = .true. #endif call get_sign_kernel_eigen_modes(emodes,iout,tol,iiter,u) allocate(w,gv) call new(w) call new(gv) !------------------------------------- ! construct lowmode subspace vectors ! for domainwall fermion !------------------------------------- ETMP(:) = 0.0_DP MTMP(:,:) = Z0 do i=1,NEV call assign_mult_gamma5(gv,emodes%V(i)) ! gv = gamma5 V(i) if (is_kernel_type_shamir(quark)) then ! ! w_i = (a5/2)*(Dw + 2/a5) gamma_5 v_i ! rtmp0 = quark%dw_height - 2.0_DP/quark%a5 call assign_mult_wd(rtmp0,w,gv,u) ! w := (Dw(m0) + 2/a5) gamma_5 v(i) call accum_mult(w,quark%a5/2.0_DP) ! w := (a5/2) w = (Dw(m0)*a5/2 + 1) gamma_5 v(i) call conv_wqf_to_dwqf(w,this%W,i) ! W(i) := w ! ! X(i,i) = - a * v_i'w_i (a=a5/2) ! MTMP(i,i) = - (quark%a5/2.0_DP)*prod(emodes%V(i),w) ! ! X(j,i) = - a * v_j'w_i (a=a5/2) ! do j=i+1,NEV MTMP(j,i) = - (quark%a5/2.0_DP)*prod(emodes%V(j),w) MTMP(i,j) = conjg(MTMP(j,i)) enddo else ! ! W(i) := gamma_5 v_i ! call conv_wqf_to_dwqf(gv,this%W,i) endif enddo !------------------------- ! get miniumum eigenvalue !------------------------- do i=1,NEV ETMP(i) = ABS(emodes%EV(i)) enddo rtmp0 = MINVAL(ETMP(:)) quark%ev_min_true = rtmp0 quark%ev_min = MAXVAL(ETMP(:)) if (0 == nodeid) then write(iout,'("%EVALMIN_TRUE",E24.15)') quark%ev_min_true write(iout,'("%EVALMIN ",E24.15)') quark%ev_min endif !-------------------- ! X = 1/S - a*V'W !-------------------- do i=1,nev ! ! shift low-modes ! rtmp0 = emodes%EV(i) rtmp1 = 2*SIGN(quark%ev_min,rtmp0) - rtmp0 ! 2*|lambda_max|*sign(lambda_i) - lambda_i MTMP(i,i) = MTMP(i,i) + 1.0_DP/rtmp1 if (0 == nodeid) write(iout,'("%EVAL",I3,E24.15," => EVAL_SHFT=",E24.15)')i,rtmp0,rtmp1 enddo do j=1,NEV do i=1,NEV if (0 == nodeid) write(iout,'("%MAT",2I3,2E24.15)')i,j,MTMP(i,j) enddo enddo this%XX(:,:) = Z0 do i=1,NEV this%XX(i,i) = Z1 enddo call LA_HESV(MTMP,this%XX,INFO=INFO) ! LV%XX = inv(X) if (0 /= INFO) then write(str,'("LA_HESV error (@get_dwq_low_mode). INFO=",I4,1X,A,I5)')INFO,__FILE__,__LINE__ call error_stop(TRIM(str)) endif do j=1,NEV do i=1,NEV if (0 == nodeid) write(iout,'("%MATINV",2I3,2E24.15)')i,j,this%XX(i,j) enddo enddo ! ! Compute High modes. ! ! The Largest eigen value is requred to estimate the eigenvalue range of the sign kerenel operator ! and The eigen vectors are dropped. ! call delete(emodes) deallocate(w,gv) emodes%NEV = this%NEV call new(emodes) emodes%which_modes = SIGN_KERNEL_HIGH_MODES if (is_kernel_type_shamir(quark)) then emodes%a5 = quark%a5 else emodes%a5 = 0.0d0 endif emodes%m0 = quark%dw_height #ifdef _DEBUG emodes%debug = .true. #endif call get_sign_kernel_eigen_modes(emodes,iout,tol,iiter,u) do i=1,emodes%NEV ETMP(i) = ABS(emodes%EV(i)) enddo quark%ev_max = MAXVAL(ETMP(1:emodes%NEV)) if (0 == nodeid) then write(iout,'("%EVALMAX ",E24.15)') quark%ev_max do i=1,emodes%NEV rtmp0 = emodes%EV(i) write(iout,'("%EVAL",I3,E24.15)')i,rtmp0 enddo endif call delete(emodes) deallocate(emodes) return end subroutine
Function : | |
mass : | real(DP) |
this : | class(quark_domainwall), intent(in) |
return quark mass
function get_mass_dwq(this) result(mass) ! ! return quark mass ! implicit none class(quark_domainwall), intent(in) :: this real(DP) :: mass mass = this%mass return end function
Function : | |
mass : | real(DP) |
this : | class(quark_domainwall), intent(in) |
return quark mass
function get_mass_dwq(this) result(mass) ! ! return quark mass ! implicit none class(quark_domainwall), intent(in) :: this real(DP) :: mass mass = this%mass return end function
Subroutine : | |
this : | class(quark_domainwall), intent(inout) |
compute 5D massterm from dwf chiral-symmetry improvement parameters
subroutine make_mass_term(this) ! ! compute 5D massterm from dwf chiral-symmetry improvement parameters ! use f95_lapack, only : LA_GESV implicit none class(quark_domainwall), intent(inout) :: this real(DP) :: mq real(DP) :: M5P,M5N real(DP) :: TMPP(this%NS,this%NS) real(DP) :: TMPN(this%NS,this%NS) integer :: NS,iw,jw,kw,is,js,INFO character(CHARLEN) :: str NS = this%NS mq = this%mass !$OMP PARALLEL DO PRIVATE(jw,iw,M5P,M5N) do jw=1,NS do iw=1,NS M5P = delta(iw+1,jw) - mq*delta(iw,NS)*delta( 1,jw) M5N = delta(iw,jw+1) - mq*delta(iw, 1)*delta(NS,jw) this%MAP(iw,jw) = delta(iw,jw) - M5P this%MAN(iw,jw) = delta(iw,jw) - M5N this%MBP(iw,jw) = this%b(iw)*delta(iw,jw) + this%c(iw)*M5P this%MBN(iw,jw) = this%b(iw)*delta(iw,jw) + this%c(iw)*M5N this%INVMBP(iw,jw) = 0.0_DP this%INVMBN(iw,jw) = 0.0_DP enddo enddo !$OMP PARALLEL DO PRIVATE(iw) do iw=1,NS this%INVMBP(iw,iw) = 1.0_DP this%INVMBN(iw,iw) = 1.0_DP enddo !$OMP PARALLEL DO PRIVATE(jw,iw) do jw=1,NS do iw=1,NS TMPP(iw,jw) = this%MBP(iw,jw) TMPN(iw,jw) = this%MBN(iw,jw) enddo enddo call LA_GESV(TMPP,this%INVMBP,INFO=INFO) if (INFO /= 0) then write(str,'("Error stop at LA_GESV for INVMBP: INFO =",I4,1X,A,I5)')INFO,__FILE__,__LINE__ call error_stop(str) endif call LA_GESV(TMPN,this%INVMBN,INFO=INFO) if (INFO /= 0) then write(str,'("Error stop at LA_GESV for INVMBN: INFO =",I4,1X,A,I5)')INFO,__FILE__,__LINE__ call error_stop(str) endif ! ! MATMUL KP = MAP * INVMBP ! MATMUL KN = MAN * INVMBN ! !$OMP PARALLEL DO PRIVATE(jw,iw,kw) do jw=1,NS do iw=1,NS this%KP(iw,jw) = (4.0_DP-this%dw_height)*delta(iw,jw) this%KN(iw,jw) = (4.0_DP-this%dw_height)*delta(iw,jw) do kw=1,NS this%KP(iw,jw) = this%KP(iw,jw) + this%MAP(iw,kw)*this%INVMBP(kw,jw) this%KN(iw,jw) = this%KN(iw,jw) + this%MAN(iw,kw)*this%INVMBN(kw,jw) enddo enddo enddo !$OMP PARALLEL DO PRIVATE(jw,iw) do iw=1,NS do jw=1,NS this%INVDIAGP(iw,jw) = 0.0_DP this%INVDIAGN(iw,jw) = 0.0_DP enddo this%INVDIAGP(iw,iw) = 1.0_DP this%INVDIAGN(iw,iw) = 1.0_DP enddo !$OMP PARALLEL DO PRIVATE(jw,iw) do jw=1,NS do iw=1,NS TMPP(iw,jw) = this%KP(iw,jw) TMPN(iw,jw) = this%KN(iw,jw) enddo enddo call LA_GESV(TMPP,this%INVDIAGP,INFO=INFO) if (INFO /= 0) then write(str,'("Error stop at LA_GESV for INVDIAGP: INFO =",I4,1X,A,I5)')INFO,__FILE__,__LINE__ call error_stop(str) endif call LA_GESV(TMPN,this%INVDIAGN,INFO=INFO) if (INFO /= 0) then write(str,'("Error stop at LA_GESV for INVDIAGN: INFO =",I4,1X,A,I5)')INFO,__FILE__,__LINE__ call error_stop(str) endif !================================================== ! Diagnal part of Normal equation Ddw'Ddw ! ! Ddw' Ddw = (K + Hop/2)' (K + Hop/2) ! = K'K + K'Hop/2 + Hop'K/2 + Hop'Hop/4 ! ! Diag(Ddw'Ddw) = K'K + 4 ! !================================================== !$OMP PARALLEL DO PRIVATE(jw,iw) do iw=1,NS do jw=1,NS this%INV_NORMAL_DIAGP(iw,jw) = 0.0_DP this%INV_NORMAL_DIAGN(iw,jw) = 0.0_DP TMPP(iw,jw) = 0.0_DP TMPN(iw,jw) = 0.0_DP enddo this%INV_NORMAL_DIAGP(iw,iw) = 1.0_DP this%INV_NORMAL_DIAGN(iw,iw) = 1.0_DP enddo !$OMP PARALLEL DO PRIVATE(jw,iw,kw) do jw=1,NS do iw=1,NS TMPP(iw,jw) = 4.0_DP*delta(iw,jw) TMPN(iw,jw) = 4.0_DP*delta(iw,jw) do kw=1,NS TMPP(iw,jw) = TMPP(iw,jw) + this%KP(kw,iw)*this%KP(kw,jw) TMPN(iw,jw) = TMPN(iw,jw) + this%KN(kw,iw)*this%KN(kw,jw) enddo enddo enddo call LA_GESV(TMPP,this%INV_NORMAL_DIAGP,INFO=INFO) if (INFO /= 0) then write(str,'("Error stop at LA_GESV for INV_NORMAL_DIAGP: INFO =",I4,1X,A,I5)')INFO,__FILE__,__LINE__ call error_stop(str) endif call LA_GESV(TMPN,this%INV_NORMAL_DIAGN,INFO=INFO) if (INFO /= 0) then write(str,'("Error stop at LA_GESV for INV_NORMAL_DIAGN: INFO =",I4,1X,A,I5)')INFO,__FILE__,__LINE__ call error_stop(str) endif return end subroutine
Subroutine : | |
this : | class(quark_domainwall), intent(inout) |
compute 5D massterm from dwf chiral-symmetry improvement parameters
subroutine make_mass_term(this) ! ! compute 5D massterm from dwf chiral-symmetry improvement parameters ! use f95_lapack, only : LA_GESV implicit none class(quark_domainwall), intent(inout) :: this real(DP) :: mq real(DP) :: M5P,M5N real(DP) :: TMPP(this%NS,this%NS) real(DP) :: TMPN(this%NS,this%NS) integer :: NS,iw,jw,kw,is,js,INFO character(CHARLEN) :: str NS = this%NS mq = this%mass !$OMP PARALLEL DO PRIVATE(jw,iw,M5P,M5N) do jw=1,NS do iw=1,NS M5P = delta(iw+1,jw) - mq*delta(iw,NS)*delta( 1,jw) M5N = delta(iw,jw+1) - mq*delta(iw, 1)*delta(NS,jw) this%MAP(iw,jw) = delta(iw,jw) - M5P this%MAN(iw,jw) = delta(iw,jw) - M5N this%MBP(iw,jw) = this%b(iw)*delta(iw,jw) + this%c(iw)*M5P this%MBN(iw,jw) = this%b(iw)*delta(iw,jw) + this%c(iw)*M5N this%INVMBP(iw,jw) = 0.0_DP this%INVMBN(iw,jw) = 0.0_DP enddo enddo !$OMP PARALLEL DO PRIVATE(iw) do iw=1,NS this%INVMBP(iw,iw) = 1.0_DP this%INVMBN(iw,iw) = 1.0_DP enddo !$OMP PARALLEL DO PRIVATE(jw,iw) do jw=1,NS do iw=1,NS TMPP(iw,jw) = this%MBP(iw,jw) TMPN(iw,jw) = this%MBN(iw,jw) enddo enddo call LA_GESV(TMPP,this%INVMBP,INFO=INFO) if (INFO /= 0) then write(str,'("Error stop at LA_GESV for INVMBP: INFO =",I4,1X,A,I5)')INFO,__FILE__,__LINE__ call error_stop(str) endif call LA_GESV(TMPN,this%INVMBN,INFO=INFO) if (INFO /= 0) then write(str,'("Error stop at LA_GESV for INVMBN: INFO =",I4,1X,A,I5)')INFO,__FILE__,__LINE__ call error_stop(str) endif ! ! MATMUL KP = MAP * INVMBP ! MATMUL KN = MAN * INVMBN ! !$OMP PARALLEL DO PRIVATE(jw,iw,kw) do jw=1,NS do iw=1,NS this%KP(iw,jw) = (4.0_DP-this%dw_height)*delta(iw,jw) this%KN(iw,jw) = (4.0_DP-this%dw_height)*delta(iw,jw) do kw=1,NS this%KP(iw,jw) = this%KP(iw,jw) + this%MAP(iw,kw)*this%INVMBP(kw,jw) this%KN(iw,jw) = this%KN(iw,jw) + this%MAN(iw,kw)*this%INVMBN(kw,jw) enddo enddo enddo !$OMP PARALLEL DO PRIVATE(jw,iw) do iw=1,NS do jw=1,NS this%INVDIAGP(iw,jw) = 0.0_DP this%INVDIAGN(iw,jw) = 0.0_DP enddo this%INVDIAGP(iw,iw) = 1.0_DP this%INVDIAGN(iw,iw) = 1.0_DP enddo !$OMP PARALLEL DO PRIVATE(jw,iw) do jw=1,NS do iw=1,NS TMPP(iw,jw) = this%KP(iw,jw) TMPN(iw,jw) = this%KN(iw,jw) enddo enddo call LA_GESV(TMPP,this%INVDIAGP,INFO=INFO) if (INFO /= 0) then write(str,'("Error stop at LA_GESV for INVDIAGP: INFO =",I4,1X,A,I5)')INFO,__FILE__,__LINE__ call error_stop(str) endif call LA_GESV(TMPN,this%INVDIAGN,INFO=INFO) if (INFO /= 0) then write(str,'("Error stop at LA_GESV for INVDIAGN: INFO =",I4,1X,A,I5)')INFO,__FILE__,__LINE__ call error_stop(str) endif !================================================== ! Diagnal part of Normal equation Ddw'Ddw ! ! Ddw' Ddw = (K + Hop/2)' (K + Hop/2) ! = K'K + K'Hop/2 + Hop'K/2 + Hop'Hop/4 ! ! Diag(Ddw'Ddw) = K'K + 4 ! !================================================== !$OMP PARALLEL DO PRIVATE(jw,iw) do iw=1,NS do jw=1,NS this%INV_NORMAL_DIAGP(iw,jw) = 0.0_DP this%INV_NORMAL_DIAGN(iw,jw) = 0.0_DP TMPP(iw,jw) = 0.0_DP TMPN(iw,jw) = 0.0_DP enddo this%INV_NORMAL_DIAGP(iw,iw) = 1.0_DP this%INV_NORMAL_DIAGN(iw,iw) = 1.0_DP enddo !$OMP PARALLEL DO PRIVATE(jw,iw,kw) do jw=1,NS do iw=1,NS TMPP(iw,jw) = 4.0_DP*delta(iw,jw) TMPN(iw,jw) = 4.0_DP*delta(iw,jw) do kw=1,NS TMPP(iw,jw) = TMPP(iw,jw) + this%KP(kw,iw)*this%KP(kw,jw) TMPN(iw,jw) = TMPN(iw,jw) + this%KN(kw,iw)*this%KN(kw,jw) enddo enddo enddo call LA_GESV(TMPP,this%INV_NORMAL_DIAGP,INFO=INFO) if (INFO /= 0) then write(str,'("Error stop at LA_GESV for INV_NORMAL_DIAGP: INFO =",I4,1X,A,I5)')INFO,__FILE__,__LINE__ call error_stop(str) endif call LA_GESV(TMPN,this%INV_NORMAL_DIAGN,INFO=INFO) if (INFO /= 0) then write(str,'("Error stop at LA_GESV for INV_NORMAL_DIAGN: INFO =",I4,1X,A,I5)')INFO,__FILE__,__LINE__ call error_stop(str) endif return end subroutine
Subroutine : | |||
yde : | type(field_quark_eo_wg),
intent(inout)
| ||
yo : | type(field_quark_eo_wg),
intent(in)
| ||
u : | type(vfield_gluon_wg), intent(in)
|
Multiply hopping matrix (odd->even/even->odd sites only)
User should copy boundary of the input field before calling this subroutine.
yde <= Meo yo
\[
M(n,m) = \sum_{\mu=1}^{4} \left[ (1-\gamma_{\mu})U_{\mu}(n)\delta_{n+\hat{\mu},m} +(1+\gamma_{\mu})U_{\mu}^{\dag}(m)\delta_{n-\hat{\mu},m}\right]
\]
Original external subprogram is field_5dfermion_class#mult_hopping_tzyx_eo
Subroutine : | |||
yde : | type(field_quark_eo_wg),
intent(inout)
| ||
yo : | type(field_quark_eo_wg),
intent(in)
| ||
u : | type(vfield_gluon_wg), intent(in)
|
Multiply hopping matrix (odd->even/even->odd sites only)
User should copy boundary of the input field before calling this subroutine.
yde <= Meo yo
\[
M(n,m) = \sum_{\mu=1}^{4} \left[ (1-\gamma_{\mu})U_{\mu}(n)\delta_{n+\hat{\mu},m} +(1+\gamma_{\mu})U_{\mu}^{\dag}(m)\delta_{n-\hat{\mu},m}\right]
\]
Original external subprogram is field_5dfermion_class#mult_hopping_tzyx_eo
Subroutine : | |||
yde : | type(field_quark_eo_wg),
intent(inout)
| ||
yo : | type(field_quark_eo_wg),
intent(in)
| ||
u : | type(vfield_gluon_wg), intent(in)
|
Multiply hopping matrix (odd->even/even->odd sites only)
User should copy boundary of the input field before calling this subroutine.
yde <= Meo yo
\[
M(n,m) = \sum_{\mu=1}^{4} \left[ (1-\gamma_{\mu})U_{\mu}(n)\delta_{n+\hat{\mu},m} +(1+\gamma_{\mu})U_{\mu}^{\dag}(m)\delta_{n-\hat{\mu},m}\right]
\]
Original external subprogram is field_5dfermion_class#mult_hopping_tzyx_eo
Subroutine : | |||
yde : | type(field_quark_eo_wg),
intent(inout)
| ||
yo : | type(field_quark_eo_wg),
intent(in)
| ||
u : | type(vfield_gluon_wg), intent(in)
|
Multiply hopping matrix (odd->even/even->odd sites only)
User should copy boundary of the input field before calling this subroutine.
yde <= Meo yo
\[
M(n,m) = \sum_{\mu=1}^{4} \left[ (1-\gamma_{\mu})U_{\mu}(n)\delta_{n+\hat{\mu},m} +(1+\gamma_{\mu})U_{\mu}^{\dag}(m)\delta_{n-\hat{\mu},m}\right]
\]
Original external subprogram is field_5dfermion_class#mult_hopping_tzyx_eo
Subroutine : | |||
yde : | type(field_quark_eo_wg),
intent(inout)
| ||
yo : | type(field_quark_eo_wg),
intent(in)
| ||
u : | type(vfield_gluon_wg), intent(in)
|
Multiply hopping matrix (odd->even/even->odd sites only)
User should copy boundary of the input field before calling this subroutine.
yde <= Meo yo
\[
M(n,m) = \sum_{\mu=1}^{4} \left[ (1-\gamma_{\mu})U_{\mu}(n)\delta_{n+\hat{\mu},m} +(1+\gamma_{\mu})U_{\mu}^{\dag}(m)\delta_{n-\hat{\mu},m}\right]
\]
Original external subprogram is field_fermion_class#mult_hopping_tzyx_eo
Subroutine : | |||
yde : | type(field_quark_eo_wg),
intent(inout)
| ||
yo : | type(field_quark_eo_wg),
intent(in)
| ||
u : | type(vfield_gluon_wg), intent(in)
|
Multiply hopping matrix (odd->even/even->odd sites only)
User should copy boundary of the input field before calling this subroutine.
yde <= Meo yo
\[
M(n,m) = \sum_{\mu=1}^{4} \left[ (1-\gamma_{\mu})U_{\mu}(n)\delta_{n+\hat{\mu},m} +(1+\gamma_{\mu})U_{\mu}^{\dag}(m)\delta_{n-\hat{\mu},m}\right]
\]
Original external subprogram is field_fermion_class#mult_hopping_tzyx_eo
Subroutine : | |||
yde : | type(field_quark_eo_wg),
intent(inout)
| ||
yo : | type(field_quark_eo_wg),
intent(in)
| ||
u : | type(vfield_gluon_wg), intent(in)
|
Multiply hopping matrix (odd->even/even->odd sites only)
User should copy boundary of the input field before calling this subroutine.
yde <= Meo yo
\[
M(n,m) = \sum_{\mu=1}^{4} \left[ (1-\gamma_{\mu})U_{\mu}(n)\delta_{n+\hat{\mu},m} +(1+\gamma_{\mu})U_{\mu}^{\dag}(m)\delta_{n-\hat{\mu},m}\right]
\]
Original external subprogram is field_fermion_class#mult_hopping_tzyx_eo
Variable : | |||
mult_iter : | type(counter), save
|
Original external subprogram is field_5dfermion_class#mult_iter
Variable : | |||
mult_iter : | type(counter), save
|
Original external subprogram is field_5dfermion_class#mult_iter
Variable : | |||
mult_iter : | type(counter), save
|
Original external subprogram is field_5dfermion_class#mult_iter
Variable : | |||
mult_iter : | type(counter), save
|
Original external subprogram is field_5dfermion_class#mult_iter
Variable : | |||
mult_iter : | type(counter), save
|
Original external subprogram is field_fermion_class#mult_iter
Variable : | |||
mult_iter : | type(counter), save
|
Original external subprogram is field_fermion_class#mult_iter
Variable : | |||
mult_iter : | type(counter), save
|
Original external subprogram is field_fermion_class#mult_iter
Subroutine : | |
this : | type(dwf_low_modes), intent(inout) |
create/initialize dwf low-modes container
subroutine new_dwq_low_modes(this) ! ! create/initialize dwf low-modes container ! implicit none type(dwf_low_modes), intent(inout) :: this integer :: i if (this%NEV < 0) then call error_stop("Negative number is not valid. (dwf_low_modes).") endif if (allocated(this%W)) then call delete(this%W) deallocate(this%W) endif if (allocated(this%XX)) deallocate(this%XX) allocate(this%W) call new(this%W,this%NEV) allocate(this%XX(1:this%NEV,1:this%NEV)) this%XX(:,:) = Z0 return end subroutine
Subroutine : | |
this : | type(dwf_low_modes), intent(inout) |
create/initialize dwf low-modes container
subroutine new_dwq_low_modes(this) ! ! create/initialize dwf low-modes container ! implicit none type(dwf_low_modes), intent(inout) :: this integer :: i if (this%NEV < 0) then call error_stop("Negative number is not valid. (dwf_low_modes).") endif if (allocated(this%W)) then call delete(this%W) deallocate(this%W) endif if (allocated(this%XX)) deallocate(this%XX) allocate(this%W) call new(this%W,this%NEV) allocate(this%XX(1:this%NEV,1:this%NEV)) this%XX(:,:) = Z0 return end subroutine
Subroutine : | |
this : | class(quark_domainwall), intent(inout) |
id : | integer, intent(in) |
initialize dwf parameter
subroutine new_dwq(this,id) ! ! initialize dwf parameter ! implicit none class(quark_domainwall), intent(inout) :: this integer, intent(in) :: id this%dw_height = 1.0d0 this%mass = 0.1d0 this%NS = 4 call new(this%quark_wilson,id) this%action_name = ACTION_NAME call delete_mass_term_dwq(this) return end subroutine
Subroutine : | |
this : | class(quark_domainwall), intent(inout) |
id : | integer, intent(in) |
initialize dwf parameter
subroutine new_dwq(this,id) ! ! initialize dwf parameter ! implicit none class(quark_domainwall), intent(inout) :: this integer, intent(in) :: id this%dw_height = 1.0d0 this%mass = 0.1d0 this%NS = 4 call new(this%quark_wilson,id) this%action_name = ACTION_NAME call delete_mass_term_dwq(this) return end subroutine
Subroutine : | |
y : | type(field_dw_quark_wg), intent(in) |
v(1:NSITE*y%NS) : | complex(DP), intent(out) |
Pack field
Original external subprogram is field_5dfermion_class#pack
Subroutine : | |
y : | type(field_dw_quark_wg), intent(in) |
v(1:NSITE*y%NS) : | complex(DP), intent(out) |
Pack field
Original external subprogram is field_5dfermion_class#pack
Subroutine : | |
y : | type(field_dw_quark_wg), intent(in) |
v(1:NSITE*y%NS) : | complex(DP), intent(out) |
Pack field
Original external subprogram is field_5dfermion_class#pack
Subroutine : | |
y : | type(field_dw_quark_wg), intent(in) |
v(1:NSITE*y%NS) : | complex(DP), intent(out) |
Pack field
Original external subprogram is field_5dfermion_class#pack
Subroutine : | |
y : | type(field_dw_quark_wg), intent(in) |
v(1:NSITE*y%NS) : | complex(DP), intent(out) |
Pack field
Original external subprogram is field_5dfermion_class#pack
Subroutine : | |
y : | type(field_dw_quark_wg), intent(in) |
v(1:NSITE*y%NS) : | complex(DP), intent(out) |
Pack field
Original external subprogram is field_5dfermion_class#pack
Subroutine : | |
y : | type(field_dw_quark_wg), intent(in) |
v(1:NSITE*y%NS) : | complex(DP), intent(out) |
Pack field
Original external subprogram is field_5dfermion_class#pack
Subroutine : | |
y : | type(field_dw_quark_wg), intent(in) |
v(1:NSITE*y%NS) : | complex(DP), intent(out) |
Pack field
Original external subprogram is field_5dfermion_class#pack
Subroutine : | |
y : | type(field_quark_wg), intent(in) |
v(COL*SPIN*NT*NZ*NY*NX) : | complex(DP), intent(out) |
\Pack (copy) fermion field to one dimensional complex array Ghost sites data are not copied. User should keep the even-odd-ness of the field in mind.
Original external subprogram is field_fermion_class#pack
Subroutine : | |
y : | type(field_quark_wg), intent(in) |
v(COL*SPIN*NT*NZ*NY*NX) : | complex(DP), intent(out) |
\Pack (copy) fermion field to one dimensional complex array Ghost sites data are not copied. User should keep the even-odd-ness of the field in mind.
Original external subprogram is field_fermion_class#pack
Subroutine : | |
y : | type(field_quark_wg), intent(in) |
v(COL*SPIN*NT*NZ*NY*NX) : | complex(DP), intent(out) |
\Pack (copy) fermion field to one dimensional complex array Ghost sites data are not copied. User should keep the even-odd-ness of the field in mind.
Original external subprogram is field_fermion_class#pack
Subroutine : | |
y : | type(field_dw_quark_wg), intent(in) |
v(1:NHSITE*y%NS) : | complex(DP), intent(inout) |
ieo : | integer, intent(in) |
Pack field on even/odd sites only
Original external subprogram is field_5dfermion_class#pack
Subroutine : | |
y : | type(field_dw_quark_wg), intent(in) |
v(1:NHSITE*y%NS) : | complex(DP), intent(inout) |
ieo : | integer, intent(in) |
Pack field on even/odd sites only
Original external subprogram is field_5dfermion_class#pack
Subroutine : | |
y : | type(field_dw_quark_wg), intent(in) |
v(1:NHSITE*y%NS) : | complex(DP), intent(inout) |
ieo : | integer, intent(in) |
Pack field on even/odd sites only
Original external subprogram is field_5dfermion_class#pack
Subroutine : | |
y : | type(field_dw_quark_wg), intent(in) |
v(1:NHSITE*y%NS) : | complex(DP), intent(inout) |
ieo : | integer, intent(in) |
Pack field on even/odd sites only
Original external subprogram is field_5dfermion_class#pack
Subroutine : | |
y : | type(field_dw_quark_wg), intent(in) |
v(1:NHSITE*y%NS) : | complex(DP), intent(inout) |
ieo : | integer, intent(in) |
Pack field on even/odd sites only
Original external subprogram is field_5dfermion_class#pack
Subroutine : | |
y : | type(field_dw_quark_wg), intent(in) |
v(1:NHSITE*y%NS) : | complex(DP), intent(inout) |
ieo : | integer, intent(in) |
Pack field on even/odd sites only
Original external subprogram is field_5dfermion_class#pack
Subroutine : | |
y : | type(field_dw_quark_wg), intent(in) |
v(1:NHSITE*y%NS) : | complex(DP), intent(inout) |
ieo : | integer, intent(in) |
Pack field on even/odd sites only
Original external subprogram is field_5dfermion_class#pack
Subroutine : | |
y : | type(field_dw_quark_wg), intent(in) |
v(1:NHSITE*y%NS) : | complex(DP), intent(inout) |
ieo : | integer, intent(in) |
Pack field on even/odd sites only
Original external subprogram is field_5dfermion_class#pack
Subroutine : | |
yeo : | type(field_quark_eo_wg), intent(in) |
vec(COL*SPIN*NTH*NZ*NY*NX) : | complex(DP), intent(out) |
\Pack (copy) fermion field to one dimensional complex array Ghost sites data are not copied. User should keep the even-odd-ness of the field in mind.
Original external subprogram is field_fermion_class#pack
Subroutine : | |
yeo : | type(field_quark_eo_wg), intent(in) |
vec(COL*SPIN*NTH*NZ*NY*NX) : | complex(DP), intent(out) |
\Pack (copy) fermion field to one dimensional complex array Ghost sites data are not copied. User should keep the even-odd-ness of the field in mind.
Original external subprogram is field_fermion_class#pack
Subroutine : | |
yeo : | type(field_quark_eo_wg), intent(in) |
vec(COL*SPIN*NTH*NZ*NY*NX) : | complex(DP), intent(out) |
\Pack (copy) fermion field to one dimensional complex array Ghost sites data are not copied. User should keep the even-odd-ness of the field in mind.
Original external subprogram is field_fermion_class#pack
Subroutine : | |
this : | class(quark_domainwall), intent(in) |
print out dwf paramters
subroutine print_dwq(this) ! ! print out dwf paramters ! implicit none class(quark_domainwall), intent(in) :: this integer :: nflavor character(CHARLEN) :: str nflavor = get_nflavor(this%quark_wilson) if (nflavor /= 2) then write(str,'("Num of Flavor should be 2:",I3)')nflavor call error_stop(TRIM(str)) endif if (nodeid==0) then write(*,'(16X," Num Flavor :",I4)') nflavor write(*,'(16X," Mass :",F12.8)')this%mass write(*,'(16X,"Domainwall Height :",F12.8)')this%dw_height write(*,'(16X," NS :",I4)') this%NS write(*,'(16X," a5 :",F12.8)')this%a5 write(*,'(16X," Type : ",A)')TRIM(DW_TYPE_NAME(this%dw_type)) if (is_type_zolotarev(this)) then write(*,'(12X,"Zolotarev approx. tol :",E12.4)')this%zol_tol endif endif return end subroutine
Subroutine : | |
this : | class(quark_domainwall), intent(in) |
print out dwf paramters
subroutine print_dwq(this) ! ! print out dwf paramters ! implicit none class(quark_domainwall), intent(in) :: this integer :: nflavor character(CHARLEN) :: str nflavor = get_nflavor(this%quark_wilson) if (nflavor /= 2) then write(str,'("Num of Flavor should be 2:",I3)')nflavor call error_stop(TRIM(str)) endif if (nodeid==0) then write(*,'(16X," Num Flavor :",I4)') nflavor write(*,'(16X," Mass :",F12.8)')this%mass write(*,'(16X,"Domainwall Height :",F12.8)')this%dw_height write(*,'(16X," NS :",I4)') this%NS write(*,'(16X," a5 :",F12.8)')this%a5 write(*,'(16X," Type : ",A)')TRIM(DW_TYPE_NAME(this%dw_type)) if (is_type_zolotarev(this)) then write(*,'(12X,"Zolotarev approx. tol :",E12.4)')this%zol_tol endif endif return end subroutine
Function : | |
a : | complex(DP) |
q(:) : | complex(DP), intent(in) |
p(:) : | complex(DP), intent(in) |
Original external subprogram is chrolog_class#prod
Function : | |
a : | complex(DP) |
q(:) : | complex(DP), intent(in) |
p(:) : | complex(DP), intent(in) |
Original external subprogram is chrolog_class#prod
Function : | |
a : | complex(DP) |
q(:) : | complex(DP), intent(in) |
p(:) : | complex(DP), intent(in) |
Original external subprogram is chrolog_class#prod
Function : | |
my_prod : | complex(DP) |
q : | type(field_dw_quark_wg), intent(in) |
p : | type(field_dw_quark_wg), intent(in) |
prod = q’ * p
Original external subprogram is field_5dfermion_class#prod
Function : | |
my_prod : | complex(DP) |
q : | type(field_dw_quark_wg), intent(in) |
p : | type(field_dw_quark_wg), intent(in) |
prod = q’ * p
Original external subprogram is field_5dfermion_class#prod
Function : | |
my_prod : | complex(DP) |
q : | type(field_dw_quark_wg), intent(in) |
p : | type(field_dw_quark_wg), intent(in) |
prod = q’ * p
Original external subprogram is field_5dfermion_class#prod
Function : | |
my_prod : | complex(DP) |
q : | type(field_dw_quark_wg), intent(in) |
p : | type(field_dw_quark_wg), intent(in) |
prod = q’ * p
Original external subprogram is field_5dfermion_class#prod
Function : | |
my_prod : | complex(DP) |
q : | type(field_dw_quark_wg), intent(in) |
p : | type(field_dw_quark_wg), intent(in) |
prod = q’ * p
Original external subprogram is field_5dfermion_class#prod
Function : | |
my_prod : | complex(DP) |
q : | type(field_dw_quark_wg), intent(in) |
p : | type(field_dw_quark_wg), intent(in) |
prod = q’ * p
Original external subprogram is field_5dfermion_class#prod
Function : | |
my_prod : | complex(DP) |
q : | type(field_dw_quark_wg), intent(in) |
p : | type(field_dw_quark_wg), intent(in) |
prod = q’ * p
Original external subprogram is field_5dfermion_class#prod
Function : | |
my_prod : | complex(DP) |
q : | type(field_dw_quark_wg), intent(in) |
p : | type(field_dw_quark_wg), intent(in) |
prod = q’ * p
Original external subprogram is field_5dfermion_class#prod
Function : | |
my_prod : | complex(DP) |
q1 : | type(field_quark_wg), intent(in) |
q2 : | type(field_quark_wg), intent(in) |
return inner-product : q1’ .dot. q2
Original external subprogram is field_fermion_class#prod
Function : | |
my_prod : | complex(DP) |
q1 : | type(field_quark_wg), intent(in) |
q2 : | type(field_quark_wg), intent(in) |
return inner-product : q1’ .dot. q2
Original external subprogram is field_fermion_class#prod
Function : | |
my_prod : | complex(DP) |
q1 : | type(field_quark_wg), intent(in) |
q2 : | type(field_quark_wg), intent(in) |
return inner-product : q1’ .dot. q2
Original external subprogram is field_fermion_class#prod
Function : | |
my_prod : | complex(DP) |
q1e : | type(field_quark_eo_wg), intent(in) |
q2e : | type(field_quark_eo_wg), intent(in) |
return inner-product : q1e’ .dot. q2e
Original external subprogram is field_fermion_class#prod
Function : | |
my_prod : | complex(DP) |
q1e : | type(field_quark_eo_wg), intent(in) |
q2e : | type(field_quark_eo_wg), intent(in) |
return inner-product : q1e’ .dot. q2e
Original external subprogram is field_fermion_class#prod
Function : | |
my_prod : | complex(DP) |
q1e : | type(field_quark_eo_wg), intent(in) |
q2e : | type(field_quark_eo_wg), intent(in) |
return inner-product : q1e’ .dot. q2e
Original external subprogram is field_fermion_class#prod
Subroutine : | |
this : | class(quark_domainwall), intent(inout) |
iout : | integer, intent(in) |
read dwf paramters
subroutine read_dwq(this,iout) ! ! read dwf paramters ! implicit none class(quark_domainwall), intent(inout) :: this integer, intent(in) :: iout character(CHARLEN) :: str integer :: nflavor if (nodeid==0) then read(iout,*) nflavor read(iout,*) this%mass read(iout,*) this%dw_height read(iout,*) this%NS read(iout,*) this%dw_type read(iout,*) this%zol_tol endif #ifndef _singlePU call comlib_bcast(nflavor,0) call comlib_bcast(this%mass,0) call comlib_bcast(this%dw_height,0) call comlib_bcast(this%NS,0) call comlib_bcast(this%dw_type,0) call comlib_bcast(this%zol_tol,0) #endif if (nflavor < 0 .or. mod(nflavor,2) /= 0 ) then write(str,'("nflavor is invalid. nf=",I4,A,I5)')nflavor,__FILE__,__LINE__ call error_stop(str) endif if (this%mass < 0.0_DP) then write(str,'("mass is invalid. mass=",E24.15,A,I5)')this%mass,__FILE__,__LINE__ call error_stop(str) endif if (this%dw_height < 0.0_DP) then write(str,'("dw_height is invalid. dw_height=",E24.15,A,I5)')this%dw_height,__FILE__,__LINE__ call error_stop(str) endif if (this%NS < 0.0_DP) then write(str,'("NS is invalid. NS=",I5,A,I5)')this%NS,__FILE__,__LINE__ call error_stop(str) endif if (this%dw_type < 0.0_DP) then write(str,'("dw_type is invalid. dw_type=",I5,A,I5)')this%dw_type,__FILE__,__LINE__ call error_stop(str) endif if (this%zol_tol < 0.0_DP) then write(str,'("zol_tol is invalid. zol_tol=",E24.5,A,I5)')this%zol_tol,__FILE__,__LINE__ call error_stop(str) endif call set_nflavor(this%quark_wilson,nflavor) return end subroutine
Subroutine : | |
this : | class(quark_domainwall), intent(inout) |
iout : | integer, intent(in) |
read dwf paramters
subroutine read_dwq(this,iout) ! ! read dwf paramters ! implicit none class(quark_domainwall), intent(inout) :: this integer, intent(in) :: iout character(CHARLEN) :: str integer :: nflavor if (nodeid==0) then read(iout,*) nflavor read(iout,*) this%mass read(iout,*) this%dw_height read(iout,*) this%NS read(iout,*) this%dw_type read(iout,*) this%zol_tol endif #ifndef _singlePU call comlib_bcast(nflavor,0) call comlib_bcast(this%mass,0) call comlib_bcast(this%dw_height,0) call comlib_bcast(this%NS,0) call comlib_bcast(this%dw_type,0) call comlib_bcast(this%zol_tol,0) #endif if (nflavor < 0 .or. mod(nflavor,2) /= 0 ) then write(str,'("nflavor is invalid. nf=",I4,A,I5)')nflavor,__FILE__,__LINE__ call error_stop(str) endif if (this%mass < 0.0_DP) then write(str,'("mass is invalid. mass=",E24.15,A,I5)')this%mass,__FILE__,__LINE__ call error_stop(str) endif if (this%dw_height < 0.0_DP) then write(str,'("dw_height is invalid. dw_height=",E24.15,A,I5)')this%dw_height,__FILE__,__LINE__ call error_stop(str) endif if (this%NS < 0.0_DP) then write(str,'("NS is invalid. NS=",I5,A,I5)')this%NS,__FILE__,__LINE__ call error_stop(str) endif if (this%dw_type < 0.0_DP) then write(str,'("dw_type is invalid. dw_type=",I5,A,I5)')this%dw_type,__FILE__,__LINE__ call error_stop(str) endif if (this%zol_tol < 0.0_DP) then write(str,'("zol_tol is invalid. zol_tol=",E24.5,A,I5)')this%zol_tol,__FILE__,__LINE__ call error_stop(str) endif call set_nflavor(this%quark_wilson,nflavor) return end subroutine
Subroutine : | |
this : | class(quark_domainwall), intent(in) |
iout : | integer, intent(in) |
save dwf paramters on config file
subroutine save_config_dwq(this,iout) ! ! save dwf paramters on config file ! implicit none class(quark_domainwall), intent(in) :: this integer, intent(in) :: iout integer :: nflavor nflavor = get_nflavor(this%quark_wilson) if (nodeid==0) then write(iout)nflavor write(iout)this%mass write(iout)this%dw_height write(iout)this%NS endif return end subroutine
Subroutine : | |
this : | class(quark_domainwall), intent(in) |
iout : | integer, intent(in) |
save dwf paramters on config file
subroutine save_config_dwq(this,iout) ! ! save dwf paramters on config file ! implicit none class(quark_domainwall), intent(in) :: this integer, intent(in) :: iout integer :: nflavor nflavor = get_nflavor(this%quark_wilson) if (nodeid==0) then write(iout)nflavor write(iout)this%mass write(iout)this%dw_height write(iout)this%NS endif return end subroutine
Subroutine : | |
this : | class(quark_domainwall), intent(inout) |
set dwf chiral-symmetry improvemnt parameters
subroutine set_coef_dwq(this) ! ! set dwf chiral-symmetry improvemnt parameters ! use signfunc_mod implicit none class(quark_domainwall), intent(inout) :: this real(DP) :: eps type(zolotarev_signfunc) :: sf real(DP), parameter :: LMAX=1.01_DP, LMIN=0.99_DP integer:: iw eps = this%zol_tol call delete_mass_term_dwq(this) select case(this%dw_type) case(DW_TYPE_SHAMIR) call allocate_mass_term_dwq(this) this%b(:) = this%a5 this%c(:) = 0.0_DP case(DW_TYPE_BORICI) call allocate_mass_term_dwq(this) this%b(:) = this%a5 this%c(:) = this%a5 case(DW_TYPE_ZOLOTAREV_SHAMIR) call new(sf,this%ev_max*LMAX,this%ev_min*LMIN,eps) this%NS = sf%NS call allocate_mass_term_dwq(this) this%b(:) = (2*sf%omg(:)/(this%ev_min)+this%a5)/2.0_DP this%c(:) = (2*sf%omg(:)/(this%ev_min)-this%a5)/2.0_DP if (0==nodeid) then write(*,'(80("-"))') write(*,'(" ZOLOTAREV_SHAMIR")') write(*,'(" EV max:",E24.15)')this%ev_max write(*,'(" EV min:",E24.15)')this%ev_min write(*,'(" EV max*LMAX:",E24.15)')this%ev_max*LMAX write(*,'(" EV min*LMIN:",E24.15)')this%ev_min*LMIN write(*,'(" EPS :",E24.15)')eps write(*,'(" ERR :",E24.15)')sf%delta write(*,'(" reallocated NS:",I3)')this%NS do iw=1,this%NS write(*,'(" omg(",I3,"):",E24.15," b(",I3,"):",E24.15," c(",I3,"):",E24.15)') iw,sf%omg(iw),iw,this%b(iw),iw,this%c(iw) enddo write(*,'(80("-"))') endif call delete(sf) case(DW_TYPE_ZOLOTAREV_CHIU) call new(sf,this%ev_max*LMAX,this%ev_min*LMIN,eps) this%NS = sf%NS call allocate_mass_term_dwq(this) this%b(:) = sf%omg(:)/(this%ev_min) this%c(:) = sf%omg(:)/(this%ev_min) if (0==nodeid) then write(*,'(80("-"))') write(*,'(" ZOLOTAREV_CHIU")') write(*,'(" EV max:",E24.15)')this%ev_max write(*,'(" EV min:",E24.15)')this%ev_min write(*,'(" EV max*LMAX:",E24.15)')this%ev_max*LMAX write(*,'(" EV min*LMIN:",E24.15)')this%ev_min*LMIN write(*,'(" EPS :",E24.15)')eps write(*,'(" ERR :",E24.15)')sf%delta write(*,'(" reallocated NS:",I3)')this%NS do iw=1,this%NS write(*,'(" omg(",I3,"):",E24.15," b(",I3,"):",E24.15," c(",I3,"):",E24.15)') iw,sf%omg(iw),iw,this%b(iw),iw,this%c(iw) enddo write(*,'(80("-"))') endif call delete(sf) end select call make_mass_term(this) return end subroutine
Subroutine : | |
this : | class(quark_domainwall), intent(inout) |
set dwf chiral-symmetry improvemnt parameters
subroutine set_coef_dwq(this) ! ! set dwf chiral-symmetry improvemnt parameters ! use signfunc_mod implicit none class(quark_domainwall), intent(inout) :: this real(DP) :: eps type(zolotarev_signfunc) :: sf real(DP), parameter :: LMAX=1.01_DP, LMIN=0.99_DP integer:: iw eps = this%zol_tol call delete_mass_term_dwq(this) select case(this%dw_type) case(DW_TYPE_SHAMIR) call allocate_mass_term_dwq(this) this%b(:) = this%a5 this%c(:) = 0.0_DP case(DW_TYPE_BORICI) call allocate_mass_term_dwq(this) this%b(:) = this%a5 this%c(:) = this%a5 case(DW_TYPE_ZOLOTAREV_SHAMIR) call new(sf,this%ev_max*LMAX,this%ev_min*LMIN,eps) this%NS = sf%NS call allocate_mass_term_dwq(this) this%b(:) = (2*sf%omg(:)/(this%ev_min)+this%a5)/2.0_DP this%c(:) = (2*sf%omg(:)/(this%ev_min)-this%a5)/2.0_DP if (0==nodeid) then write(*,'(80("-"))') write(*,'(" ZOLOTAREV_SHAMIR")') write(*,'(" EV max:",E24.15)')this%ev_max write(*,'(" EV min:",E24.15)')this%ev_min write(*,'(" EV max*LMAX:",E24.15)')this%ev_max*LMAX write(*,'(" EV min*LMIN:",E24.15)')this%ev_min*LMIN write(*,'(" EPS :",E24.15)')eps write(*,'(" ERR :",E24.15)')sf%delta write(*,'(" reallocated NS:",I3)')this%NS do iw=1,this%NS write(*,'(" omg(",I3,"):",E24.15," b(",I3,"):",E24.15," c(",I3,"):",E24.15)') iw,sf%omg(iw),iw,this%b(iw),iw,this%c(iw) enddo write(*,'(80("-"))') endif call delete(sf) case(DW_TYPE_ZOLOTAREV_CHIU) call new(sf,this%ev_max*LMAX,this%ev_min*LMIN,eps) this%NS = sf%NS call allocate_mass_term_dwq(this) this%b(:) = sf%omg(:)/(this%ev_min) this%c(:) = sf%omg(:)/(this%ev_min) if (0==nodeid) then write(*,'(80("-"))') write(*,'(" ZOLOTAREV_CHIU")') write(*,'(" EV max:",E24.15)')this%ev_max write(*,'(" EV min:",E24.15)')this%ev_min write(*,'(" EV max*LMAX:",E24.15)')this%ev_max*LMAX write(*,'(" EV min*LMIN:",E24.15)')this%ev_min*LMIN write(*,'(" EPS :",E24.15)')eps write(*,'(" ERR :",E24.15)')sf%delta write(*,'(" reallocated NS:",I3)')this%NS do iw=1,this%NS write(*,'(" omg(",I3,"):",E24.15," b(",I3,"):",E24.15," c(",I3,"):",E24.15)') iw,sf%omg(iw),iw,this%b(iw),iw,this%c(iw) enddo write(*,'(80("-"))') endif call delete(sf) end select call make_mass_term(this) return end subroutine
Subroutine : | |||
p : | type(vfield_gluon_wog), intent(inout)
|
set Gaussian noise on canonical momentum (su(3) Lie algebra) of gauge field (SU(3) Lie group)
Original external subprogram is field_5dfermion_class#set_gaussian_noise
Subroutine : | |||
p : | type(vfield_gluon_wog), intent(inout)
|
set Gaussian noise on canonical momentum (su(3) Lie algebra) of gauge field (SU(3) Lie group)
Original external subprogram is field_5dfermion_class#set_gaussian_noise
Subroutine : | |||
p : | type(vfield_gluon_wog), intent(inout)
|
set Gaussian noise on canonical momentum (su(3) Lie algebra) of gauge field (SU(3) Lie group)
Original external subprogram is field_5dfermion_class#set_gaussian_noise
Subroutine : | |||
p : | type(vfield_gluon_wog), intent(inout)
|
set Gaussian noise on canonical momentum (su(3) Lie algebra) of gauge field (SU(3) Lie group)
Original external subprogram is field_5dfermion_class#set_gaussian_noise
Subroutine : | |||
p : | type(vfield_gluon_wog), intent(inout)
|
set Gaussian noise on canonical momentum (su(3) Lie algebra) of gauge field (SU(3) Lie group)
Original external subprogram is quark_wilson_class#set_gaussian_noise
Subroutine : | |||
p : | type(vfield_gluon_wog), intent(inout)
|
set Gaussian noise on canonical momentum (su(3) Lie algebra) of gauge field (SU(3) Lie group)
Original external subprogram is quark_wilson_class#set_gaussian_noise
Subroutine : | |||
p : | type(vfield_gluon_wog), intent(inout)
|
set Gaussian noise on canonical momentum (su(3) Lie algebra) of gauge field (SU(3) Lie group)
Original external subprogram is field_gauge_class#set_gaussian_noise
Subroutine : | |||
p : | type(vfield_gluon_wog), intent(inout)
|
set Gaussian noise on canonical momentum (su(3) Lie algebra) of gauge field (SU(3) Lie group)
Original external subprogram is field_gauge_class#set_gaussian_noise
Subroutine : | |||
p : | type(vfield_gluon_wog), intent(inout)
|
set Gaussian noise on canonical momentum (su(3) Lie algebra) of gauge field (SU(3) Lie group)
Original external subprogram is field_gauge_class#set_gaussian_noise
Subroutine : | |
y : | type(field_quark_wg), intent(inout) |
set Gaussian noise on y
Original external subprogram is field_5dfermion_class#set_gaussian_noise
Subroutine : | |
y : | type(field_quark_wg), intent(inout) |
set Gaussian noise on y
Original external subprogram is field_5dfermion_class#set_gaussian_noise
Subroutine : | |
y : | type(field_quark_wg), intent(inout) |
set Gaussian noise on y
Original external subprogram is field_5dfermion_class#set_gaussian_noise
Subroutine : | |
y : | type(field_quark_wg), intent(inout) |
set Gaussian noise on y
Original external subprogram is field_5dfermion_class#set_gaussian_noise
Subroutine : | |
y : | type(field_quark_wg), intent(inout) |
set Gaussian noise on y
Original external subprogram is quark_wilson_class#set_gaussian_noise
Subroutine : | |
y : | type(field_quark_wg), intent(inout) |
set Gaussian noise on y
Original external subprogram is quark_wilson_class#set_gaussian_noise
Subroutine : | |
y : | type(field_quark_wg), intent(inout) |
set Gaussian noise on y
Original external subprogram is field_fermion_class#set_gaussian_noise
Subroutine : | |
y : | type(field_quark_wg), intent(inout) |
set Gaussian noise on y
Original external subprogram is field_fermion_class#set_gaussian_noise
Subroutine : | |
y : | type(field_quark_wg), intent(inout) |
set Gaussian noise on y
Original external subprogram is field_fermion_class#set_gaussian_noise
Subroutine : | |
ye : | type(field_quark_eo_wg), intent(inout) |
set Gaussian noise on even/odd sites only
Original external subprogram is field_5dfermion_class#set_gaussian_noise
Subroutine : | |
ye : | type(field_quark_eo_wg), intent(inout) |
set Gaussian noise on even/odd sites only
Original external subprogram is field_5dfermion_class#set_gaussian_noise
Subroutine : | |
ye : | type(field_quark_eo_wg), intent(inout) |
set Gaussian noise on even/odd sites only
Original external subprogram is field_5dfermion_class#set_gaussian_noise
Subroutine : | |
ye : | type(field_quark_eo_wg), intent(inout) |
set Gaussian noise on even/odd sites only
Original external subprogram is field_5dfermion_class#set_gaussian_noise
Subroutine : | |
ye : | type(field_quark_eo_wg), intent(inout) |
set Gaussian noise on even/odd sites only
Original external subprogram is quark_wilson_class#set_gaussian_noise
Subroutine : | |
ye : | type(field_quark_eo_wg), intent(inout) |
set Gaussian noise on even/odd sites only
Original external subprogram is quark_wilson_class#set_gaussian_noise
Subroutine : | |
ye : | type(field_quark_eo_wg), intent(inout) |
set Gaussian noise on even/odd sites only
Original external subprogram is field_fermion_class#set_gaussian_noise
Subroutine : | |
ye : | type(field_quark_eo_wg), intent(inout) |
set Gaussian noise on even/odd sites only
Original external subprogram is field_fermion_class#set_gaussian_noise
Subroutine : | |
ye : | type(field_quark_eo_wg), intent(inout) |
set Gaussian noise on even/odd sites only
Original external subprogram is field_fermion_class#set_gaussian_noise
Subroutine : | |
this : | class(action_parameters), intent(inout) |
id : | integer, intent(in) |
Original external subprogram is quark_wilson_class#set_id
Subroutine : | |
this : | class(action_parameters), intent(inout) |
id : | integer, intent(in) |
Original external subprogram is quark_wilson_class#set_id
Subroutine : | |
this : | class(action_parameters), intent(inout) |
id : | integer, intent(in) |
Original external subprogram is action_base_class#set_id
Subroutine : | |
this : | class(action_parameters), intent(inout) |
id : | integer, intent(in) |
Original external subprogram is action_base_class#set_id
Subroutine : | |
this : | class(action_parameters), intent(inout) |
id : | integer, intent(in) |
Original external subprogram is action_base_class#set_id
Subroutine : | |
this : | class(quark_domainwall), intent(inout) |
mass : | real(DP), intent(in) |
set quark mass
subroutine set_mass_dwq(this,mass) ! ! set quark mass ! implicit none class(quark_domainwall), intent(inout) :: this real(DP), intent(in) :: mass this%mass = mass return end subroutine
Subroutine : | |
this : | class(quark_domainwall), intent(inout) |
mass : | real(DP), intent(in) |
set quark mass
subroutine set_mass_dwq(this,mass) ! ! set quark mass ! implicit none class(quark_domainwall), intent(inout) :: this real(DP), intent(in) :: mass this%mass = mass return end subroutine
Derived Type : | |
y(COL,SPIN) : | complex(DP) |
su(3) fundamentarl rep vector, spinor
Original external subprogram is field_5dfermion_class#su3fv_spinor
Derived Type : | |
y(COL,SPIN) : | complex(DP) |
su(3) fundamentarl rep vector, spinor
Original external subprogram is field_5dfermion_class#su3fv_spinor
Derived Type : | |
y(COL,SPIN) : | complex(DP) |
su(3) fundamentarl rep vector, spinor
Original external subprogram is field_5dfermion_class#su3fv_spinor
Derived Type : | |
y(COL,SPIN) : | complex(DP) |
su(3) fundamentarl rep vector, spinor
Original external subprogram is field_5dfermion_class#su3fv_spinor
Derived Type : | |
y(COL,SPIN) : | complex(DP) |
su(3) fundamentarl rep vector, spinor
Original external subprogram is field_fermion_class#su3fv_spinor
Derived Type : | |
y(COL,SPIN) : | complex(DP) |
su(3) fundamentarl rep vector, spinor
Original external subprogram is field_fermion_class#su3fv_spinor
Derived Type : | |
y(COL,SPIN) : | complex(DP) |
su(3) fundamentarl rep vector, spinor
Original external subprogram is field_fermion_class#su3fv_spinor
Subroutine : | |
v(1:NSITE*y%NS) : | complex(DP), intent(in) |
y : | type(field_dw_quark_wg), intent(inout) |
unack field
Original external subprogram is field_5dfermion_class#unpack
Subroutine : | |
v(1:NSITE*y%NS) : | complex(DP), intent(in) |
y : | type(field_dw_quark_wg), intent(inout) |
unack field
Original external subprogram is field_5dfermion_class#unpack
Subroutine : | |
v(1:NSITE*y%NS) : | complex(DP), intent(in) |
y : | type(field_dw_quark_wg), intent(inout) |
unack field
Original external subprogram is field_5dfermion_class#unpack
Subroutine : | |
v(1:NSITE*y%NS) : | complex(DP), intent(in) |
y : | type(field_dw_quark_wg), intent(inout) |
unack field
Original external subprogram is field_5dfermion_class#unpack
Subroutine : | |
v(1:NSITE*y%NS) : | complex(DP), intent(in) |
y : | type(field_dw_quark_wg), intent(inout) |
unack field
Original external subprogram is field_5dfermion_class#unpack
Subroutine : | |
v(1:NSITE*y%NS) : | complex(DP), intent(in) |
y : | type(field_dw_quark_wg), intent(inout) |
unack field
Original external subprogram is field_5dfermion_class#unpack
Subroutine : | |
v(1:NSITE*y%NS) : | complex(DP), intent(in) |
y : | type(field_dw_quark_wg), intent(inout) |
unack field
Original external subprogram is field_5dfermion_class#unpack
Subroutine : | |
v(1:NSITE*y%NS) : | complex(DP), intent(in) |
y : | type(field_dw_quark_wg), intent(inout) |
unack field
Original external subprogram is field_5dfermion_class#unpack
Subroutine : | |
v(COL*SPIN*NT*NZ*NY*NX) : | complex(DP), intent(in) |
y : | type(field_quark_wg), intent(inout) |
Unpack one-dimensional complex array to fermion field. User should set the even/odd-ness on the fermion field.
Original external subprogram is field_fermion_class#unpack
Subroutine : | |
v(COL*SPIN*NT*NZ*NY*NX) : | complex(DP), intent(in) |
y : | type(field_quark_wg), intent(inout) |
Unpack one-dimensional complex array to fermion field. User should set the even/odd-ness on the fermion field.
Original external subprogram is field_fermion_class#unpack
Subroutine : | |
v(COL*SPIN*NT*NZ*NY*NX) : | complex(DP), intent(in) |
y : | type(field_quark_wg), intent(inout) |
Unpack one-dimensional complex array to fermion field. User should set the even/odd-ness on the fermion field.
Original external subprogram is field_fermion_class#unpack
Subroutine : | |
v(1:NHSITE*y%NS) : | complex(DP), intent(in) |
y : | type(field_dw_quark_wg), intent(inout) |
ieo : | integer, intent(in) |
Unpack field on even/odd sites only
Original external subprogram is field_5dfermion_class#unpack
Subroutine : | |
v(1:NHSITE*y%NS) : | complex(DP), intent(in) |
y : | type(field_dw_quark_wg), intent(inout) |
ieo : | integer, intent(in) |
Unpack field on even/odd sites only
Original external subprogram is field_5dfermion_class#unpack
Subroutine : | |
v(1:NHSITE*y%NS) : | complex(DP), intent(in) |
y : | type(field_dw_quark_wg), intent(inout) |
ieo : | integer, intent(in) |
Unpack field on even/odd sites only
Original external subprogram is field_5dfermion_class#unpack
Subroutine : | |
v(1:NHSITE*y%NS) : | complex(DP), intent(in) |
y : | type(field_dw_quark_wg), intent(inout) |
ieo : | integer, intent(in) |
Unpack field on even/odd sites only
Original external subprogram is field_5dfermion_class#unpack
Subroutine : | |
v(1:NHSITE*y%NS) : | complex(DP), intent(in) |
y : | type(field_dw_quark_wg), intent(inout) |
ieo : | integer, intent(in) |
Unpack field on even/odd sites only
Original external subprogram is field_5dfermion_class#unpack
Subroutine : | |
v(1:NHSITE*y%NS) : | complex(DP), intent(in) |
y : | type(field_dw_quark_wg), intent(inout) |
ieo : | integer, intent(in) |
Unpack field on even/odd sites only
Original external subprogram is field_5dfermion_class#unpack
Subroutine : | |
v(1:NHSITE*y%NS) : | complex(DP), intent(in) |
y : | type(field_dw_quark_wg), intent(inout) |
ieo : | integer, intent(in) |
Unpack field on even/odd sites only
Original external subprogram is field_5dfermion_class#unpack
Subroutine : | |
v(1:NHSITE*y%NS) : | complex(DP), intent(in) |
y : | type(field_dw_quark_wg), intent(inout) |
ieo : | integer, intent(in) |
Unpack field on even/odd sites only
Original external subprogram is field_5dfermion_class#unpack
Subroutine : | |||
vec(COL*SPIN*NTH*NZ*NY*NX) : | complex(DP), intent(in) | ||
yeo : | type(field_quark_eo_wg),
intent(inout)
|
Unpack one-dimensional complex array to fermion field. User should set the even/odd-ness on the fermion field.
Original external subprogram is field_fermion_class#unpack
Subroutine : | |||
vec(COL*SPIN*NTH*NZ*NY*NX) : | complex(DP), intent(in) | ||
yeo : | type(field_quark_eo_wg),
intent(inout)
|
Unpack one-dimensional complex array to fermion field. User should set the even/odd-ness on the fermion field.
Original external subprogram is field_fermion_class#unpack
Subroutine : | |||
vec(COL*SPIN*NTH*NZ*NY*NX) : | complex(DP), intent(in) | ||
yeo : | type(field_quark_eo_wg),
intent(inout)
|
Unpack one-dimensional complex array to fermion field. User should set the even/odd-ness on the fermion field.
Original external subprogram is field_fermion_class#unpack